2025-01-10 15:27:29 +04:00
{- # LANGUAGE CPP # -}
2024-05-08 15:36:20 +01:00
{- # LANGUAGE DuplicateRecordFields # -}
2023-02-01 17:21:13 +00:00
{- # LANGUAGE OverloadedStrings # -}
{- # LANGUAGE PostfixOperators # -}
2024-08-27 22:12:55 +01:00
{- # LANGUAGE TypeApplications # -}
2024-11-14 17:43:34 +00:00
{- # OPTIONS_GHC - fno - warn - ambiguous - fields # -}
2023-02-01 17:21:13 +00:00
module ChatTests.Profiles where
import ChatClient
2025-01-24 09:44:53 +00:00
import ChatTests.DBUtils
2023-02-01 17:21:13 +00:00
import ChatTests.Utils
import Control.Concurrent ( threadDelay )
import Control.Concurrent.Async ( concurrently_ )
2023-11-26 18:16:37 +00:00
import Control.Monad
2023-11-07 17:45:59 +04:00
import Control.Monad.Except
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Char8 as B
2023-02-01 17:21:13 +00:00
import qualified Data.Text as T
2024-10-11 18:37:38 +04:00
import Simplex.Chat.Controller ( ChatConfig ( .. ) )
import Simplex.Chat.Options
2025-01-04 18:33:27 +00:00
import Simplex.Chat.Protocol ( currentChatVersion )
2023-11-26 18:16:37 +00:00
import Simplex.Chat.Store.Shared ( createContact )
2024-04-04 20:41:56 +01:00
import Simplex.Chat.Types ( ConnStatus ( .. ) , Profile ( .. ) )
import Simplex.Chat.Types.Shared ( GroupMemberRole ( .. ) )
2024-05-08 15:36:20 +01:00
import Simplex.Chat.Types.UITheme
2024-10-11 18:37:38 +04:00
import Simplex.Messaging.Agent.Env.SQLite
import Simplex.Messaging.Agent.RetryInterval
2023-11-26 18:16:37 +00:00
import Simplex.Messaging.Encoding.String ( StrEncoding ( .. ) )
2024-08-27 22:12:55 +01:00
import Simplex.Messaging.Server.Env.STM hiding ( subscriptions )
import Simplex.Messaging.Transport
2024-07-04 07:58:13 +01:00
import Simplex.Messaging.Util ( encodeJSON )
2023-02-01 17:21:13 +00:00
import System.Directory ( copyFile , createDirectoryIfMissing )
2024-01-17 15:20:13 +00:00
import Test.Hspec hiding ( it )
2023-02-01 17:21:13 +00:00
2025-01-24 09:44:53 +00:00
chatProfileTests :: SpecWith TestParams
2023-02-01 17:21:13 +00:00
chatProfileTests = do
describe " user profiles " $ do
it " update user profile and notify contacts " testUpdateProfile
it " update user profile with image " testUpdateProfileImage
2023-10-02 21:56:11 +01:00
it " use multiword profile names " testMultiWordProfileNames
2023-02-01 17:21:13 +00:00
describe " user contact link " $ do
2023-09-05 20:15:50 +04:00
it " create and connect via contact link " testUserContactLink
2024-10-11 18:37:38 +04:00
it " retry accepting connection via contact link " testRetryAcceptingViaContactLink
2023-04-27 17:19:21 +04:00
it " add contact link to profile " testProfileLink
2023-02-01 17:21:13 +00: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
it " auto-reply message " testAutoReplyMessage
it " auto-reply message in incognito " testAutoReplyMessageInIncognito
2024-12-02 14:01:23 +00:00
describe " business address " $ do
it " create and connect via business address " testBusinessAddress
2024-12-04 16:32:01 +00:00
it " update profiles with business address " testBusinessUpdateProfiles
2023-10-10 21:19:04 +04:00
describe " contact address connection plan " $ do
it " contact address ok to connect; known contact " testPlanAddressOkKnown
it " own contact address " testPlanAddressOwn
it " connecting via contact address " testPlanAddressConnecting
2024-07-04 07:58:13 +01:00
it " connecting via contact address (slow handshake) " testPlanAddressConnectingSlow
2023-10-10 21:19:04 +04:00
it " re-connect with deleted contact " testPlanAddressContactDeletedReconnected
2023-11-07 17:45:59 +04:00
it " contact via address " testPlanAddressContactViaAddress
2023-08-08 17:25:28 +04:00
describe " incognito " $ do
2023-02-01 17:21:13 +00:00
it " connect incognito via invitation link " testConnectIncognitoInvitationLink
it " connect incognito via contact address " testConnectIncognitoContactAddress
it " accept contact request incognito " testAcceptContactRequestIncognito
2023-08-08 17:25:28 +04:00
it " set connection incognito " testSetConnectionIncognito
it " reset connection incognito " testResetConnectionIncognito
it " set connection incognito prohibited during negotiation " testSetConnectionIncognitoProhibitedDuringNegotiation
2024-07-04 07:58:13 +01:00
it " set connection incognito prohibited during negotiation (slow handshake) " testSetConnectionIncognitoProhibitedDuringNegotiationSlow
2023-08-08 17:25:28 +04:00
it " connection incognito unchanged errors " testConnectionIncognitoUnchangedErrors
it " set, reset, set connection incognito " testSetResetSetConnectionIncognito
2023-02-01 17:21:13 +00:00
it " join group incognito " testJoinGroupIncognito
it " can't invite contact to whom user connected incognito to a group " testCantInviteContactIncognito
it " can't see global preferences update " testCantSeeGlobalPrefsUpdateIncognito
it " deleting contact first, group second deletes incognito profile " testDeleteContactThenGroupDeletesIncognitoProfile
it " deleting group first, contact second deletes incognito profile " testDeleteGroupThenContactDeletesIncognitoProfile
describe " contact aliases " $ do
it " set contact alias " testSetAlias
it " set connection alias " testSetConnectionAlias
2025-01-20 18:06:00 +00:00
describe " group aliases " $ do
it " set group alias " testSetGroupAlias
2024-08-21 10:27:58 +01:00
describe " pending connection users " $ do
it " change user for pending connection " testChangePCCUser
it " change from incognito profile connects as new user " testChangePCCUserFromIncognito
it " change user for pending connection and later set incognito connects as incognito in changed profile " testChangePCCUserAndThenIncognito
it " change user for user without matching servers creates new connection " testChangePCCUserDiffSrv
2023-02-01 17:21:13 +00:00
describe " preferences " $ do
it " set contact preferences " testSetContactPrefs
it " feature offers " testFeatureOffers
it " update group preferences " testUpdateGroupPrefs
it " allow full deletion to contact " testAllowFullDeletionContact
it " allow full deletion to group " testAllowFullDeletionGroup
it " prohibit direct messages to group members " testProhibitDirectMessages
2023-04-04 13:09:07 +01:00
xit'' " enable timed messages with contact " testEnableTimedMessagesContact
2023-02-01 17:21:13 +00:00
it " enable timed messages in group " testEnableTimedMessagesGroup
2023-04-04 13:09:07 +01:00
xit'' " timed messages enabled globally, contact turns on " testTimedMessagesEnabledGlobally
2024-01-05 11:35:48 +04:00
it " update multiple user preferences for multiple contacts " testUpdateMultipleUserPrefs
2024-04-04 20:41:56 +01:00
describe " group preferences for specific member role " $ do
it " direct messages " testGroupPrefsDirectForRole
it " files & media " testGroupPrefsFilesForRole
it " SimpleX links " testGroupPrefsSimplexLinksForRole
2024-05-08 15:36:20 +01:00
it " set user, contact and group UI theme " testSetUITheme
2025-04-14 21:25:32 +01:00
describe " short links " $ do
it " should connect via one-time inviation " testShortLinkInvitation
it " should plan and connect via one-time inviation " testPlanShortLinkInvitation
it " should connect via contact address " testShortLinkContactAddress
it " should join group " testShortLinkJoinGroup
2023-02-01 17:21:13 +00:00
2025-01-24 09:44:53 +00:00
testUpdateProfile :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testUpdateProfile =
2025-01-31 10:32:07 +04:00
testChat3 aliceProfile bobProfile cathProfile $
2023-02-01 17:21:13 +00:00
\ alice bob cath -> do
2025-01-31 10:32:07 +04:00
connectUsers alice bob
connectUsers alice cath
connectUsers bob cath
2023-02-01 17:21:13 +00:00
alice ##> " /p "
alice <## " user profile: alice (Alice) "
2023-10-02 21:56:11 +01:00
alice <## " use /p <display name> to change it "
2023-02-01 17:21:13 +00:00
alice <## " (the updated profile will be sent to all your contacts) "
alice ##> " /p alice "
concurrentlyN_
2023-06-17 10:34:04 +01:00
[ alice <## " user full name removed (your 2 contacts are notified) " ,
2023-02-01 17:21:13 +00:00
bob <## " contact alice removed full name " ,
cath <## " contact alice removed full name "
]
alice ##> " /p alice Alice Jones "
concurrentlyN_
2023-06-17 10:34:04 +01:00
[ alice <## " user full name changed to Alice Jones (your 2 contacts are notified) " ,
2023-02-01 17:21:13 +00:00
bob <## " contact alice updated full name: Alice Jones " ,
cath <## " contact alice updated full name: Alice Jones "
]
cath ##> " /p cate "
concurrentlyN_
2023-06-17 10:34:04 +01:00
[ cath <## " user profile is changed to cate (your 2 contacts are notified) " ,
2023-02-01 17:21:13 +00:00
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_
2023-06-17 10:34:04 +01:00
[ cath <## " user profile is changed to cat (Cate) (your 2 contacts are notified) " ,
2023-02-01 17:21:13 +00:00
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 "
]
2025-01-24 09:44:53 +00:00
testUpdateProfileImage :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testUpdateProfileImage =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
2023-06-17 10:34:04 +01:00
alice ##> " /set profile image data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII= "
2023-02-01 17:21:13 +00:00
alice <## " profile image updated "
2023-06-17 10:34:04 +01:00
alice ##> " /show profile image "
alice <## " Profile image: "
alice <## " data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII= "
alice ##> " /delete profile image "
2023-02-01 17:21:13 +00:00
alice <## " profile image removed "
2023-06-17 10:34:04 +01:00
alice ##> " /show profile image "
alice <## " No profile image "
2023-07-13 23:48:25 +01:00
alice ##> " /_profile 1 { \ " displayName \ " : \ " alice2 \ " , \ " fullName \ " : \ " \ " , \ " preferences \ " : { \ " receipts \ " : { \ " allow \ " : \ " yes \ " , \ " activated \ " : true}}} "
2023-06-17 10:34:04 +01:00
alice <## " user profile is changed to alice2 (your 1 contacts are notified) "
2023-02-01 17:21:13 +00:00
bob <## " contact alice changed to alice2 "
bob <## " use @alice2 <message> to send messages "
( bob </ )
2025-01-24 09:44:53 +00:00
testMultiWordProfileNames :: HasCallStack => TestParams -> IO ()
2023-10-02 21:56:11 +01:00
testMultiWordProfileNames =
testChat3 aliceProfile' bobProfile' cathProfile' $
\ alice bob cath -> do
alice ##> " /c "
inv <- getInvitation alice
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
concurrently_
( bob <## " 'Alice Jones': contact is connected " )
( alice <## " 'Bob James': contact is connected " )
alice #> " @'Bob James' hi "
bob <# " 'Alice Jones'> hi "
alice ##> " /g 'Our Team' "
alice <## " group #'Our Team' is created "
alice <## " to add members use /a 'Our Team' <name> or /create link #'Our Team' "
alice ##> " /a 'Our Team' 'Bob James' admin "
alice <## " invitation to join the group #'Our Team' sent to 'Bob James' "
bob <## " #'Our Team': 'Alice Jones' invites you to join the group as admin "
bob <## " use /j 'Our Team' to accept "
bob ##> " /j 'Our Team' "
bob <## " #'Our Team': you joined the group "
alice <## " #'Our Team': 'Bob James' joined the group "
bob ##> " /c "
inv' <- getInvitation bob
cath ##> ( " /c " <> inv' )
cath <## " confirmation sent! "
concurrently_
( cath <## " 'Bob James': contact is connected " )
( bob <## " 'Cath Johnson': contact is connected " )
bob ##> " /a 'Our Team' 'Cath Johnson' "
bob <## " invitation to join the group #'Our Team' sent to 'Cath Johnson' "
cath <## " #'Our Team': 'Bob James' invites you to join the group as member "
cath <## " use /j 'Our Team' to accept "
cath ##> " /j 'Our Team' "
concurrentlyN_
[ bob <## " #'Our Team': 'Cath Johnson' joined the group " ,
do
cath <## " #'Our Team': you joined the group "
cath <## " #'Our Team': member 'Alice Jones' is connected " ,
do
alice <## " #'Our Team': 'Bob James' added 'Cath Johnson' to the group (connecting...) "
alice <## " #'Our Team': new member 'Cath Johnson' is connected "
]
bob #> " #'Our Team' hi "
alice <# " #'Our Team' 'Bob James'> hi "
cath <# " #'Our Team' 'Bob James'> hi "
alice ` send ` " @'Cath Johnson' hello "
2024-04-04 22:24:42 +04:00
alice
<### [ " member #'Our Team' 'Cath Johnson' does not have direct connection, creating " ,
" contact for member #'Our Team' 'Cath Johnson' is created " ,
" sent invitation to connect directly to member #'Our Team' 'Cath Johnson' " ,
WithTime " @'Cath Johnson' hello "
]
2023-10-02 21:56:11 +01:00
cath <## " #'Our Team' 'Alice Jones' is creating direct contact 'Alice Jones' with you "
cath <# " 'Alice Jones'> hello "
2024-07-18 20:33:51 +04:00
cath <## " 'Alice Jones': you can send messages to contact "
2023-10-02 21:56:11 +01:00
cath <## " 'Alice Jones': contact is connected "
alice <## " 'Cath Johnson': contact is connected "
cath ##> " /p 'Cath J' "
cath <## " user profile is changed to 'Cath J' (your 2 contacts are notified) "
alice <## " contact 'Cath Johnson' changed to 'Cath J' "
alice <## " use @'Cath J' <message> to send messages "
bob <## " contact 'Cath Johnson' changed to 'Cath J' "
bob <## " use @'Cath J' <message> to send messages "
alice #> " @'Cath J' hi "
cath <# " 'Alice Jones'> hi "
where
aliceProfile' = baseProfile { displayName = " Alice Jones " }
bobProfile' = baseProfile { displayName = " Bob James " }
cathProfile' = baseProfile { displayName = " Cath Johnson " }
baseProfile = Profile { displayName = " " , fullName = " " , image = Nothing , contactLink = Nothing , preferences = defaultPrefs }
2025-01-24 09:44:53 +00:00
testUserContactLink :: HasCallStack => TestParams -> IO ()
2023-09-05 20:15:50 +04:00
testUserContactLink =
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
alice ##> " /ad "
cLink <- getContactLink alice True
bob ##> ( " /c " <> cLink )
alice <#? bob
alice @@@ [ ( " <@bob " , " " ) ]
alice ##> " /ac bob "
2024-07-18 20:33:51 +04:00
alice <## " bob (Bob): accepting contact request, you can send messages to contact "
2023-09-05 20:15:50 +04:00
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
threadDelay 100000
alice @@@ [ ( " @bob " , lastChatFeature ) ]
alice <##> bob
cath ##> ( " /c " <> cLink )
alice <#? cath
alice @@@ [ ( " <@cath " , " " ) , ( " @bob " , " hey " ) ]
alice ##> " /ac cath "
2024-07-18 20:33:51 +04:00
alice <## " cath (Catherine): accepting contact request, you can send messages to contact "
2023-09-05 20:15:50 +04:00
concurrently_
( cath <## " alice (Alice): contact is connected " )
( alice <## " cath (Catherine): contact is connected " )
threadDelay 100000
alice @@@ [ ( " @cath " , lastChatFeature ) , ( " @bob " , " hey " ) ]
alice <##> cath
2023-02-01 17:21:13 +00:00
2025-01-24 09:44:53 +00:00
testRetryAcceptingViaContactLink :: HasCallStack => TestParams -> IO ()
testRetryAcceptingViaContactLink ps = testChatCfgOpts2 cfg' opts' aliceProfile bobProfile test ps
2024-10-11 18:37:38 +04:00
where
2025-01-24 09:44:53 +00:00
tmp = tmpPath ps
2024-10-11 18:37:38 +04:00
test alice bob = do
cLink <- withSmpServer' serverCfg' $ do
alice ##> " /ad "
getContactLink alice True
alice <## " server disconnected localhost () "
bob ##> ( " /_connect plan 1 " <> cLink )
bob <## " contact address: ok to connect "
bob ##> ( " /_connect 1 " <> cLink )
bob <##. " smp agent error: BROKER "
withSmpServer' serverCfg' $ do
alice <## " server connected localhost () "
2024-11-18 18:44:28 +00:00
threadDelay 250000
2024-10-11 18:37:38 +04:00
bob ##> ( " /_connect plan 1 " <> cLink )
bob <## " contact address: ok to connect "
bob ##> ( " /_connect 1 " <> cLink )
alice <#? bob
alice <## " server disconnected localhost () "
bob <## " server disconnected localhost () "
alice ##> " /ac bob "
alice <##. " smp agent error: BROKER "
withSmpServer' serverCfg' $ do
alice <## " server connected localhost () "
bob <## " server connected localhost () "
alice ##> " /ac bob "
alice <## " bob (Bob): accepting contact request, you can send messages to contact "
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
alice #> " @bob message 1 "
bob <# " alice> message 1 "
bob #> " @alice message 2 "
alice <# " bob> message 2 "
alice <## " server disconnected localhost (@bob) "
bob <## " server disconnected localhost (@alice) "
serverCfg' =
smpServerCfg
{ transports = [ ( " 7003 " , transport @ TLS , False ) ] ,
msgQueueQuota = 2 ,
2025-03-19 07:16:31 +00:00
serverStoreCfg = persistentServerStoreCfg tmp
2024-10-11 18:37:38 +04:00
}
fastRetryInterval = defaultReconnectInterval { initialInterval = 50000 } -- same as in agent tests
cfg' =
testCfg
{ agentConfig =
testAgentCfg
{ quotaExceededTimeout = 1 ,
messageRetryInterval = RetryInterval2 { riFast = fastRetryInterval , riSlow = fastRetryInterval }
}
}
opts' =
testOpts
{ coreOptions =
testCoreOpts
{ smpServers = [ " smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7003 " ]
}
}
2025-01-24 09:44:53 +00:00
testProfileLink :: HasCallStack => TestParams -> IO ()
2023-04-27 17:19:21 +04:00
testProfileLink =
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
alice ##> " /ad "
cLink <- getContactLink alice True
bob ##> ( " /c " <> cLink )
alice <#? bob
alice ##> " /ac bob "
2024-07-18 20:33:51 +04:00
alice <## " bob (Bob): accepting contact request, you can send messages to contact "
2023-04-27 17:19:21 +04:00
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
alice <##> bob
alice ##> " /pa on "
alice <## " new contact address set "
bob <## " alice set new contact address, use /info alice to view "
checkAliceProfileLink bob cLink
cath ##> ( " /c " <> cLink )
alice <#? cath
alice ##> " /ac cath "
2024-07-18 20:33:51 +04:00
alice <## " cath (Catherine): accepting contact request, you can send messages to contact "
2023-04-27 17:19:21 +04:00
concurrently_
( cath <## " alice (Alice): contact is connected " )
( alice <## " cath (Catherine): contact is connected " )
alice <##> cath
checkAliceProfileLink cath cLink
alice ##> " /pa off "
alice <## " contact address removed "
bob <## " alice removed contact address "
checkAliceNoProfileLink bob
cath <## " alice removed contact address "
checkAliceNoProfileLink cath
alice ##> " /pa on "
alice <## " new contact address set "
bob <## " alice set new contact address, use /info alice to view "
checkAliceProfileLink bob cLink
cath <## " alice set new contact address, use /info alice to view "
checkAliceProfileLink cath cLink
alice ##> " /da "
alice <## " Your chat address is deleted - accepted contacts will remain connected. "
alice <## " To create a new chat address use /ad "
bob <## " alice removed contact address "
checkAliceNoProfileLink bob
cath <## " alice removed contact address "
checkAliceNoProfileLink cath
where
checkAliceProfileLink cc cLink = do
cc ##> " /info alice "
cc <## " contact ID: 2 "
cc <##. " receiving messages via "
cc <##. " sending messages via "
cc <## ( " contact address: " <> cLink )
cc <## " you've shared main profile with this contact "
cc <## " connection not verified, use /code command to see security code "
2024-04-22 20:46:48 +04:00
cc <## " quantum resistant end-to-end encryption "
2023-09-01 19:20:07 +04:00
cc <## currentChatVRangeInfo
2023-04-27 17:19:21 +04:00
checkAliceNoProfileLink cc = do
cc ##> " /info alice "
cc <## " contact ID: 2 "
cc <##. " receiving messages via "
cc <##. " sending messages via "
cc <## " you've shared main profile with this contact "
cc <## " connection not verified, use /code command to see security code "
2024-04-22 20:46:48 +04:00
cc <## " quantum resistant end-to-end encryption "
2023-09-01 19:20:07 +04:00
cc <## currentChatVRangeInfo
2023-04-27 17:19:21 +04:00
2025-01-24 09:44:53 +00:00
testUserContactLinkAutoAccept :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testUserContactLinkAutoAccept =
testChat4 aliceProfile bobProfile cathProfile danProfile $
\ alice bob cath dan -> do
alice ##> " /ad "
cLink <- getContactLink alice True
bob ##> ( " /c " <> cLink )
alice <#? bob
alice @@@ [ ( " <@bob " , " " ) ]
alice ##> " /ac bob "
2024-07-18 20:33:51 +04:00
alice <## " bob (Bob): accepting contact request, you can send messages to contact "
2023-02-01 17:21:13 +00:00
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
threadDelay 100000
2023-04-17 11:18:04 +02:00
alice @@@ [ ( " @bob " , lastChatFeature ) ]
2023-02-01 17:21:13 +00:00
alice <##> bob
alice ##> " /auto_accept on "
alice <## " auto_accept on "
cath ##> ( " /c " <> cLink )
cath <## " connection request sent! "
alice <## " cath (Catherine): accepting contact request... "
2024-07-18 20:33:51 +04:00
alice <## " cath (Catherine): you can send messages to contact "
2023-02-01 17:21:13 +00:00
concurrently_
( cath <## " alice (Alice): contact is connected " )
( alice <## " cath (Catherine): contact is connected " )
threadDelay 100000
2023-04-17 11:18:04 +02:00
alice @@@ [ ( " @cath " , lastChatFeature ) , ( " @bob " , " hey " ) ]
2023-02-01 17:21:13 +00:00
alice <##> cath
alice ##> " /auto_accept off "
alice <## " auto_accept off "
dan ##> ( " /c " <> cLink )
alice <#? dan
alice @@@ [ ( " <@dan " , " " ) , ( " @cath " , " hey " ) , ( " @bob " , " hey " ) ]
alice ##> " /ac dan "
2024-07-18 20:33:51 +04:00
alice <## " dan (Daniel): accepting contact request, you can send messages to contact "
2023-02-01 17:21:13 +00:00
concurrently_
( dan <## " alice (Alice): contact is connected " )
( alice <## " dan (Daniel): contact is connected " )
threadDelay 100000
2023-04-17 11:18:04 +02:00
alice @@@ [ ( " @dan " , lastChatFeature ) , ( " @cath " , " hey " ) , ( " @bob " , " hey " ) ]
2023-02-01 17:21:13 +00:00
alice <##> dan
2025-01-24 09:44:53 +00:00
testDeduplicateContactRequests :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testDeduplicateContactRequests = testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
alice ##> " /ad "
cLink <- getContactLink alice True
bob ##> ( " /c " <> cLink )
alice <#? bob
alice @@@ [ ( " <@bob " , " " ) ]
bob @@@! [ ( " :1 " , " " , Just ConnJoined ) ]
bob ##> ( " /c " <> cLink )
alice <#? bob
bob ##> ( " /c " <> cLink )
alice <#? bob
alice @@@ [ ( " <@bob " , " " ) ]
bob @@@! [ ( " :3 " , " " , Just ConnJoined ) , ( " :2 " , " " , Just ConnJoined ) , ( " :1 " , " " , Just ConnJoined ) ]
alice ##> " /ac bob "
2024-07-18 20:33:51 +04:00
alice <## " bob (Bob): accepting contact request, you can send messages to contact "
2023-02-01 17:21:13 +00:00
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
bob ##> ( " /c " <> cLink )
2023-10-10 21:19:04 +04:00
bob <## " contact address: known contact alice "
bob <## " use @alice <message> to send messages "
2024-05-15 11:16:38 +01:00
threadDelay 100000
2023-04-17 11:18:04 +02:00
alice @@@ [ ( " @bob " , lastChatFeature ) ]
bob @@@ [ ( " @alice " , lastChatFeature ) , ( " :2 " , " " ) , ( " :1 " , " " ) ]
2023-02-01 17:21:13 +00:00
bob ##> " /_delete :1 "
bob <## " connection :1 deleted "
bob ##> " /_delete :2 "
bob <## " connection :2 deleted "
alice <##> bob
alice @@@ [ ( " @bob " , " hey " ) ]
bob @@@ [ ( " @alice " , " hey " ) ]
bob ##> ( " /c " <> cLink )
2023-10-10 21:19:04 +04:00
bob <## " contact address: known contact alice "
bob <## " use @alice <message> to send messages "
2023-02-01 17:21:13 +00:00
alice <##> bob
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 " ) ] )
cath ##> ( " /c " <> cLink )
alice <#? cath
alice @@@ [ ( " <@cath " , " " ) , ( " @bob " , " hey " ) ]
alice ##> " /ac cath "
2024-07-18 20:33:51 +04:00
alice <## " cath (Catherine): accepting contact request, you can send messages to contact "
2023-02-01 17:21:13 +00:00
concurrently_
( cath <## " alice (Alice): contact is connected " )
( alice <## " cath (Catherine): contact is connected " )
threadDelay 100000
2023-04-17 11:18:04 +02:00
alice @@@ [ ( " @cath " , lastChatFeature ) , ( " @bob " , " hey " ) ]
2023-02-01 17:21:13 +00:00
alice <##> cath
2025-01-24 09:44:53 +00:00
testDeduplicateContactRequestsProfileChange :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testDeduplicateContactRequestsProfileChange = testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
alice ##> " /ad "
cLink <- getContactLink alice True
bob ##> ( " /c " <> cLink )
alice <#? bob
alice @@@ [ ( " <@bob " , " " ) ]
bob ##> " /p bob "
2023-06-17 10:34:04 +01:00
bob <## " user full name removed (your 0 contacts are notified) "
2023-02-01 17:21:13 +00:00
bob ##> ( " /c " <> cLink )
bob <## " connection request sent! "
alice <## " bob wants to connect to you! "
alice <## " to accept: /ac bob "
alice <## " to reject: /rc bob (the sender will NOT be notified) "
alice @@@ [ ( " <@bob " , " " ) ]
bob ##> " /p bob Bob Ross "
2023-06-17 10:34:04 +01:00
bob <## " user full name changed to Bob Ross (your 0 contacts are notified) "
2023-02-01 17:21:13 +00:00
bob ##> ( " /c " <> cLink )
alice <#? bob
alice @@@ [ ( " <@bob " , " " ) ]
bob ##> " /p robert Robert "
2023-06-17 10:34:04 +01:00
bob <## " user profile is changed to robert (Robert) (your 0 contacts are notified) "
2023-02-01 17:21:13 +00:00
bob ##> ( " /c " <> cLink )
alice <#? bob
alice @@@ [ ( " <@robert " , " " ) ]
alice ##> " /ac bob "
alice <## " no contact request from bob "
alice ##> " /ac robert "
2024-07-18 20:33:51 +04:00
alice <## " robert (Robert): accepting contact request, you can send messages to contact "
2023-02-01 17:21:13 +00:00
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " robert (Robert): contact is connected " )
bob ##> ( " /c " <> cLink )
2023-10-10 21:19:04 +04:00
bob <## " contact address: known contact alice "
bob <## " use @alice <message> to send messages "
2024-05-15 11:16:38 +01:00
threadDelay 100000
2023-04-17 11:18:04 +02:00
alice @@@ [ ( " @robert " , lastChatFeature ) ]
bob @@@ [ ( " @alice " , lastChatFeature ) , ( " :3 " , " " ) , ( " :2 " , " " ) , ( " :1 " , " " ) ]
2023-02-01 17:21:13 +00:00
bob ##> " /_delete :1 "
bob <## " connection :1 deleted "
bob ##> " /_delete :2 "
bob <## " connection :2 deleted "
bob ##> " /_delete :3 "
bob <## " connection :3 deleted "
alice <##> bob
alice @@@ [ ( " @robert " , " hey " ) ]
bob @@@ [ ( " @alice " , " hey " ) ]
bob ##> ( " /c " <> cLink )
2023-10-10 21:19:04 +04:00
bob <## " contact address: known contact alice "
bob <## " use @alice <message> to send messages "
2023-02-01 17:21:13 +00:00
alice <##> bob
2024-05-15 11:16:38 +01:00
threadDelay 100000
2023-02-01 17:21:13 +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 " ) ] )
cath ##> ( " /c " <> cLink )
alice <#? cath
alice @@@ [ ( " <@cath " , " " ) , ( " @robert " , " hey " ) ]
alice ##> " /ac cath "
2024-07-18 20:33:51 +04:00
alice <## " cath (Catherine): accepting contact request, you can send messages to contact "
2023-02-01 17:21:13 +00:00
concurrently_
( cath <## " alice (Alice): contact is connected " )
( alice <## " cath (Catherine): contact is connected " )
threadDelay 100000
2023-04-17 11:18:04 +02:00
alice @@@ [ ( " @cath " , lastChatFeature ) , ( " @robert " , " hey " ) ]
2023-02-01 17:21:13 +00:00
alice <##> cath
2025-01-24 09:44:53 +00:00
testRejectContactAndDeleteUserContact :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testRejectContactAndDeleteUserContact = testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
alice ##> " /_address 1 "
cLink <- getContactLink alice True
bob ##> ( " /c " <> cLink )
alice <#? bob
alice ##> " /rc bob "
alice <## " bob: contact request rejected "
( bob </ )
alice ##> " /_show_address 1 "
cLink' <- getContactLink alice False
alice <## " auto_accept off "
cLink' ` shouldBe ` cLink
alice ##> " /_delete_address 1 "
alice <## " Your chat address is deleted - accepted contacts will remain connected. "
alice <## " To create a new chat address use /ad "
cath ##> ( " /c " <> cLink )
cath <## " error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection "
2025-01-24 09:44:53 +00:00
testDeleteConnectionRequests :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +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
2025-01-24 09:44:53 +00:00
testAutoReplyMessage :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testAutoReplyMessage = testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /ad "
cLink <- getContactLink alice True
alice ##> " /_auto_accept 1 on incognito=off text hello! "
alice <## " auto_accept on "
alice <## " auto reply: "
alice <## " hello! "
bob ##> ( " /c " <> cLink )
bob <## " connection request sent! "
alice <## " bob (Bob): accepting contact request... "
2024-07-18 20:33:51 +04:00
alice <## " bob (Bob): you can send messages to contact "
alice <# " @bob hello! "
2023-02-01 17:21:13 +00:00
concurrentlyN_
[ do
2024-07-18 20:33:51 +04:00
bob <# " alice> hello! "
bob <## " alice (Alice): contact is connected " ,
alice <## " bob (Bob): contact is connected "
2023-02-01 17:21:13 +00:00
]
2025-01-24 09:44:53 +00:00
testAutoReplyMessageInIncognito :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00: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... "
2024-07-18 20:33:51 +04:00
alice <## " bob (Bob): you can send messages to contact "
alice <# " i @bob hello! "
2023-02-01 17:21:13 +00:00
aliceIncognito <- getTermLine alice
concurrentlyN_
[ do
2024-07-18 20:33:51 +04:00
bob <# ( aliceIncognito <> " > hello! " )
bob <## ( aliceIncognito <> " : contact is connected " ) ,
2023-02-01 17:21:13 +00:00
do
alice <## ( " bob (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognito )
2024-07-18 20:33:51 +04:00
alice <## " use /i bob to print out this incognito profile again "
2023-02-01 17:21:13 +00:00
]
2025-01-24 09:44:53 +00:00
testBusinessAddress :: HasCallStack => TestParams -> IO ()
2024-12-02 14:01:23 +00:00
testBusinessAddress = testChat3 businessProfile aliceProfile { fullName = " Alice @ Biz " } bobProfile $
\ biz alice bob -> do
biz ##> " /ad "
cLink <- getContactLink biz True
biz ##> " /auto_accept on business "
biz <## " auto_accept on, business "
2024-12-03 12:11:38 +00:00
bob ##> ( " /_connect plan 1 " <> cLink )
bob <## " contact address: ok to connect "
2024-12-02 14:01:23 +00:00
bob ##> ( " /c " <> cLink )
bob <## " connection request sent! "
2024-12-03 12:11:38 +00:00
bob ##> ( " /_connect plan 1 " <> cLink )
bob <## " contact address: connecting, allowed to reconnect "
2024-12-02 20:30:05 +04:00
biz <## " #bob (Bob): accepting business address request... "
2024-12-02 14:01:23 +00:00
bob <## " #biz: joining the group... "
2024-12-03 12:11:38 +00:00
-- the next command can be prone to race conditions
bob ##> ( " /_connect plan 1 " <> cLink )
bob <## " business link: connecting to business #biz "
biz <## " #bob: bob_1 joined the group "
2024-12-02 14:01:23 +00:00
bob <## " #biz: you joined the group "
2024-12-02 20:30:05 +04:00
biz #> " #bob hi "
2024-12-02 14:01:23 +00:00
bob <# " #biz biz_1> hi "
bob #> " #biz hello "
2024-12-02 20:30:05 +04:00
biz <# " #bob bob_1> hello "
2024-12-03 12:11:38 +00:00
bob ##> ( " /_connect plan 1 " <> cLink )
bob <## " business link: known business #biz "
bob <## " use #biz <message> to send messages "
2024-12-02 14:01:23 +00:00
connectUsers biz alice
biz <##> alice
2024-12-02 20:30:05 +04:00
biz ##> " /a #bob alice "
biz <## " invitation to join the group #bob sent to alice "
2024-12-02 14:01:23 +00:00
alice <## " #bob (Bob): biz invites you to join the group as member "
alice <## " use /j bob to accept "
alice ##> " /j bob "
concurrentlyN_
[ do
alice <## " #bob: you joined the group "
alice <### [ WithTime " #bob biz> hi [>>] " , WithTime " #bob bob_1> hello [>>] " ]
alice <## " #bob: member bob_1 (Bob) is connected " ,
2024-12-02 20:30:05 +04:00
biz <## " #bob: alice joined the group " ,
2024-12-02 14:01:23 +00:00
do
bob <## " #biz: biz_1 added alice (Alice @ Biz) to the group (connecting...) "
bob <## " #biz: new member alice is connected "
]
alice #> " #bob hey "
concurrently_
( bob <# " #biz alice> hey " )
2024-12-02 20:30:05 +04:00
( biz <# " #bob alice> hey " )
2024-12-02 14:01:23 +00:00
bob #> " #biz hey there "
concurrently_
( alice <# " #bob bob_1> hey there " )
2024-12-02 20:30:05 +04:00
( biz <# " #bob bob_1> hey there " )
2024-12-02 14:01:23 +00:00
2025-01-24 09:44:53 +00:00
testBusinessUpdateProfiles :: HasCallStack => TestParams -> IO ()
2025-04-02 07:57:18 +00:00
testBusinessUpdateProfiles = testChat4 businessProfile aliceProfile bobProfile cathProfile $
2024-12-05 18:32:00 +00:00
\ biz alice bob cath -> do
2024-12-04 16:32:01 +00:00
biz ##> " /ad "
cLink <- getContactLink biz True
biz ##> " /auto_accept on business text Welcome "
biz <## " auto_accept on, business "
biz <## " auto reply: "
biz <## " Welcome "
alice ##> ( " /c " <> cLink )
alice <## " connection request sent! "
biz <## " #alice (Alice): accepting business address request... "
alice <## " #biz: joining the group... "
biz <# " #alice Welcome " -- auto reply
biz <## " #alice: alice_1 joined the group "
2025-02-15 16:18:34 +00:00
alice
<###
[ WithTime " #biz biz_1> Welcome " ,
" #biz: you joined the group "
]
2024-12-04 16:32:01 +00:00
biz #> " #alice hi "
alice <# " #biz biz_1> hi "
alice #> " #biz hello "
biz <# " #alice alice_1> hello "
alice ##> " /p alisa "
alice <## " user profile is changed to alisa (your 0 contacts are notified) "
alice #> " #biz hello again " -- profile update is sent with message
biz <## " alice_1 updated group #alice: "
biz <## " changed to #alisa "
biz <# " #alisa alisa_1> hello again "
-- customer can invite members too, if business allows
biz ##> " /mr alisa alisa_1 admin "
2025-02-28 22:43:39 +04:00
biz <## " #alisa: you changed the role of alisa_1 to admin "
2024-12-04 16:32:01 +00:00
alice <## " #biz: biz_1 changed your role from member to admin "
connectUsers alice bob
alice ##> " /a #biz bob "
alice <## " invitation to join the group #biz sent to bob "
bob <## " #biz (Biz Inc): alisa invites you to join the group as member "
bob <## " use /j biz to accept "
bob ##> " /j biz "
concurrentlyN_
[ do
bob <## " #biz: you joined the group "
bob
<###
[ WithTime " #biz biz_1> Welcome [>>] " ,
WithTime " #biz biz_1> hi [>>] " ,
WithTime " #biz alisa> hello [>>] " ,
WithTime " #biz alisa> hello again [>>] "
]
bob <## " #biz: member biz_1 (Biz Inc) is connected " ,
alice <## " #biz: bob joined the group " ,
do
biz <## " #alisa: alisa_1 added bob (Bob) to the group (connecting...) "
biz <## " #alisa: new member bob is connected "
]
-- changing other member profiles does not change group profile
bob ##> " /p robert "
bob <## " user profile is changed to robert (your 1 contacts are notified) "
alice <## " contact bob changed to robert " -- only alice receives profile update
alice <## " use @robert <message> to send messages "
bob #> " #biz hi there " -- profile update is sent to group with message
alice <# " #biz robert> hi there "
biz <# " #alisa robert> hi there "
2024-12-05 18:32:00 +00:00
-- add business team member
connectUsers biz cath
biz ##> " /a #alisa cath "
biz <## " invitation to join the group #alisa sent to cath "
cath <## " #alisa: biz invites you to join the group as member "
cath <## " use /j alisa to accept "
cath ##> " /j alisa "
concurrentlyN_
[ do
cath <## " #alisa: you joined the group "
cath
<###
[ WithTime " #alisa biz> Welcome [>>] " ,
WithTime " #alisa biz> hi [>>] " ,
WithTime " #alisa alisa_1> hello [>>] " ,
WithTime " #alisa alisa_1> hello again [>>] " ,
WithTime " #alisa robert> hi there [>>] "
]
cath <## " #alisa: member alisa_1 is connected "
cath <## " #alisa: member robert is connected " ,
biz <## " #alisa: cath joined the group " ,
do
alice <## " #biz: biz_1 added cath (Catherine) to the group (connecting...) "
alice <## " #biz: new member cath is connected " ,
do
bob <## " #biz: biz_1 added cath (Catherine) to the group (connecting...) "
bob <## " #biz: new member cath is connected "
]
2024-12-04 16:32:01 +00:00
-- both customers receive business profile change
biz ##> " /p business "
2024-12-05 18:32:00 +00:00
biz <## " user profile is changed to business (your 1 contacts are notified) "
2024-12-04 16:32:01 +00:00
biz #> " #alisa hey "
concurrentlyN_
[ do
alice <## " biz_1 updated group #biz: "
alice <## " changed to #business "
alice <# " #business business_1> hey " ,
do
bob <## " biz_1 updated group #biz: "
bob <## " changed to #business "
2024-12-05 18:32:00 +00:00
bob <# " #business business_1> hey " ,
do
cath <## " contact biz changed to business "
cath <## " use @business <message> to send messages "
cath <# " #alisa business> hey "
]
biz ##> " /set voice #alisa on "
biz <## " updated group preferences: "
biz <## " Voice messages: on "
concurrentlyN_
[ do
alice <## " business_1 updated group #business: "
alice <## " updated group preferences: "
alice <## " Voice messages: on " ,
do
bob <## " business_1 updated group #business: "
bob <## " updated group preferences: "
bob <## " Voice messages: on " ,
do
cath <## " business updated group #alisa: "
cath <## " updated group preferences: "
cath <## " Voice messages: on "
2024-12-04 16:32:01 +00:00
]
2024-12-06 10:18:48 +00:00
biz #$> ( " /_get chat #1 count=1 " , chat , [ ( 1 , " Voice messages: on " ) ] )
alice #$> ( " /_get chat #1 count=1 " , chat , [ ( 0 , " Voice messages: on " ) ] )
bob #$> ( " /_get chat #1 count=1 " , chat , [ ( 0 , " Voice messages: on " ) ] )
cath #$> ( " /_get chat #1 count=1 " , chat , [ ( 0 , " Voice messages: on " ) ] )
2024-12-04 16:32:01 +00:00
2025-01-24 09:44:53 +00:00
testPlanAddressOkKnown :: HasCallStack => TestParams -> IO ()
2023-10-10 21:19:04 +04:00
testPlanAddressOkKnown =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /ad "
cLink <- getContactLink alice True
bob ##> ( " /_connect plan 1 " <> cLink )
bob <## " contact address: ok to connect "
bob ##> ( " /c " <> cLink )
alice <#? bob
alice @@@ [ ( " <@bob " , " " ) ]
alice ##> " /ac bob "
2024-07-18 20:33:51 +04:00
alice <## " bob (Bob): accepting contact request, you can send messages to contact "
2023-10-10 21:19:04 +04:00
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
alice <##> bob
bob ##> ( " /_connect plan 1 " <> cLink )
bob <## " contact address: known contact alice "
bob <## " use @alice <message> to send messages "
2023-10-16 16:16:03 +04:00
let cLinkSchema2 = linkAnotherSchema cLink
bob ##> ( " /_connect plan 1 " <> cLinkSchema2 )
bob <## " contact address: known contact alice "
bob <## " use @alice <message> to send messages "
2023-10-10 21:19:04 +04:00
bob ##> ( " /c " <> cLink )
bob <## " contact address: known contact alice "
bob <## " use @alice <message> to send messages "
2025-01-24 09:44:53 +00:00
testPlanAddressOwn :: HasCallStack => TestParams -> IO ()
testPlanAddressOwn ps =
withNewTestChat ps " alice " aliceProfile $ \ alice -> do
2023-10-10 21:19:04 +04:00
alice ##> " /ad "
cLink <- getContactLink alice True
alice ##> ( " /_connect plan 1 " <> cLink )
alice <## " contact address: own address "
2023-10-16 16:16:03 +04:00
let cLinkSchema2 = linkAnotherSchema cLink
alice ##> ( " /_connect plan 1 " <> cLinkSchema2 )
alice <## " contact address: own address "
2023-10-10 21:19:04 +04:00
alice ##> ( " /c " <> cLink )
alice <## " connection request sent! "
alice <## " alice_1 (Alice) wants to connect to you! "
alice <## " to accept: /ac alice_1 "
2023-10-16 16:16:03 +04:00
alice <## " to reject: /rc alice_1 (the sender will NOT be notified) "
2023-11-26 18:16:37 +00:00
alice @@@ [ ( " <@alice_1 " , " " ) , ( " :2 " , " " ) ]
2023-10-10 21:19:04 +04:00
alice ##> " /ac alice_1 "
2024-07-18 20:33:51 +04:00
alice <## " alice_1 (Alice): accepting contact request, you can send messages to contact "
2023-10-10 21:19:04 +04:00
alice
<### [ " alice_1 (Alice): contact is connected " ,
" alice_2 (Alice): contact is connected "
]
2024-05-15 11:16:38 +01:00
threadDelay 100000
2023-10-10 21:19:04 +04:00
alice @@@ [ ( " @alice_1 " , lastChatFeature ) , ( " @alice_2 " , lastChatFeature ) ]
alice ` send ` " @alice_2 hi "
alice
<### [ WithTime " @alice_2 hi " ,
WithTime " alice_1> hi "
]
alice ` send ` " @alice_1 hey "
alice
<### [ WithTime " @alice_1 hey " ,
WithTime " alice_2> hey "
]
alice @@@ [ ( " @alice_1 " , " hey " ) , ( " @alice_2 " , " hey " ) ]
alice ##> ( " /_connect plan 1 " <> cLink )
alice <## " contact address: own address "
alice ##> ( " /c " <> cLink )
alice <## " alice_2 (Alice): contact already exists "
2025-01-24 09:44:53 +00:00
testPlanAddressConnecting :: HasCallStack => TestParams -> IO ()
testPlanAddressConnecting ps = do
cLink <- withNewTestChat ps " alice " aliceProfile $ \ alice -> do
2023-10-10 21:19:04 +04:00
alice ##> " /ad "
getContactLink alice True
2025-01-24 09:44:53 +00:00
withNewTestChat ps " bob " bobProfile $ \ bob -> do
2023-10-12 11:52:14 +04:00
threadDelay 100000
2023-10-16 16:10:56 +04:00
2023-10-10 21:19:04 +04:00
bob ##> ( " /c " <> cLink )
bob <## " connection request sent! "
2023-10-16 16:10:56 +04:00
bob ##> ( " /_connect plan 1 " <> cLink )
bob <## " contact address: connecting, allowed to reconnect "
2023-10-16 16:16:03 +04:00
let cLinkSchema2 = linkAnotherSchema cLink
bob ##> ( " /_connect plan 1 " <> cLinkSchema2 )
bob <## " contact address: connecting, allowed to reconnect "
2023-10-12 11:52:14 +04:00
threadDelay 100000
2025-01-24 09:44:53 +00:00
withTestChat ps " alice " $ \ alice -> do
2023-10-10 21:19:04 +04:00
alice <## " Your address is active! To show: /sa "
alice <## " bob (Bob) wants to connect to you! "
alice <## " to accept: /ac bob "
alice <## " to reject: /rc bob (the sender will NOT be notified) "
alice ##> " /ac bob "
2024-07-18 20:33:51 +04:00
alice <## " bob (Bob): accepting contact request, you can send messages to contact "
2025-01-24 09:44:53 +00:00
withTestChat ps " bob " $ \ bob -> do
2024-07-04 07:58:13 +01:00
threadDelay 500000
bob <## " alice (Alice): contact is connected "
bob @@@ [ ( " @alice " , " Audio/video calls: enabled " ) ]
bob ##> ( " /_connect plan 1 " <> cLink )
bob <## " contact address: known contact alice "
bob <## " use @alice <message> to send messages "
let cLinkSchema2 = linkAnotherSchema cLink
bob ##> ( " /_connect plan 1 " <> cLinkSchema2 )
bob <## " contact address: known contact alice "
bob <## " use @alice <message> to send messages "
bob ##> ( " /c " <> cLink )
bob <## " contact address: known contact alice "
bob <## " use @alice <message> to send messages "
2025-01-24 09:44:53 +00:00
testPlanAddressConnectingSlow :: HasCallStack => TestParams -> IO ()
testPlanAddressConnectingSlow ps = do
cLink <- withNewTestChatCfg ps testCfgSlow " alice " aliceProfile $ \ alice -> do
2024-07-04 07:58:13 +01:00
alice ##> " /ad "
getContactLink alice True
2025-01-24 09:44:53 +00:00
withNewTestChatCfg ps testCfgSlow " bob " bobProfile $ \ bob -> do
2024-07-04 07:58:13 +01:00
threadDelay 100000
bob ##> ( " /c " <> cLink )
bob <## " connection request sent! "
bob ##> ( " /_connect plan 1 " <> cLink )
bob <## " contact address: connecting, allowed to reconnect "
let cLinkSchema2 = linkAnotherSchema cLink
bob ##> ( " /_connect plan 1 " <> cLinkSchema2 )
bob <## " contact address: connecting, allowed to reconnect "
threadDelay 100000
2025-01-24 09:44:53 +00:00
withTestChatCfg ps testCfgSlow " alice " $ \ alice -> do
2024-07-04 07:58:13 +01:00
alice <## " Your address is active! To show: /sa "
alice <## " bob (Bob) wants to connect to you! "
alice <## " to accept: /ac bob "
alice <## " to reject: /rc bob (the sender will NOT be notified) "
alice ##> " /ac bob "
alice <## " bob (Bob): accepting contact request... "
2025-01-24 09:44:53 +00:00
withTestChatCfg ps testCfgSlow " bob " $ \ bob -> do
2023-10-10 21:19:04 +04:00
threadDelay 500000
bob @@@ [ ( " @alice " , " " ) ]
bob ##> ( " /_connect plan 1 " <> cLink )
bob <## " contact address: connecting to contact alice "
2023-10-16 16:16:03 +04:00
let cLinkSchema2 = linkAnotherSchema cLink
bob ##> ( " /_connect plan 1 " <> cLinkSchema2 )
bob <## " contact address: connecting to contact alice "
2023-10-10 21:19:04 +04:00
bob ##> ( " /c " <> cLink )
bob <## " contact address: connecting to contact alice "
2025-01-24 09:44:53 +00:00
testPlanAddressContactDeletedReconnected :: HasCallStack => TestParams -> IO ()
2023-10-10 21:19:04 +04:00
testPlanAddressContactDeletedReconnected =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /ad "
cLink <- getContactLink alice True
bob ##> ( " /c " <> cLink )
alice <#? bob
alice ##> " /ac bob "
2024-07-18 20:33:51 +04:00
alice <## " bob (Bob): accepting contact request, you can send messages to contact "
2023-10-10 21:19:04 +04:00
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
alice <##> bob
bob ##> ( " /_connect plan 1 " <> cLink )
bob <## " contact address: known contact alice "
bob <## " use @alice <message> to send messages "
bob ##> ( " /c " <> cLink )
bob <## " contact address: known contact alice "
bob <## " use @alice <message> to send messages "
alice ##> " /d bob "
alice <## " bob: contact is deleted "
bob <## " alice (Alice) deleted contact with you "
bob ##> ( " /_connect plan 1 " <> cLink )
bob <## " contact address: ok to connect "
2023-10-16 16:16:03 +04:00
let cLinkSchema2 = linkAnotherSchema cLink
bob ##> ( " /_connect plan 1 " <> cLinkSchema2 )
bob <## " contact address: ok to connect "
2023-10-10 21:19:04 +04:00
bob ##> ( " /c " <> cLink )
bob <## " connection request sent! "
alice <## " bob (Bob) wants to connect to you! "
alice <## " to accept: /ac bob "
alice <## " to reject: /rc bob (the sender will NOT be notified) "
alice ##> " /ac bob "
2024-07-18 20:33:51 +04:00
alice <## " bob (Bob): accepting contact request, you can send messages to contact "
2023-10-10 21:19:04 +04:00
concurrently_
( bob <## " alice_1 (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
alice #> " @bob hi "
bob <# " alice_1> hi "
bob #> " @alice_1 hey "
alice <# " bob> hey "
bob ##> ( " /_connect plan 1 " <> cLink )
bob <## " contact address: known contact alice_1 "
bob <## " use @alice_1 <message> to send messages "
2023-10-16 16:16:03 +04:00
bob ##> ( " /_connect plan 1 " <> cLinkSchema2 )
bob <## " contact address: known contact alice_1 "
bob <## " use @alice_1 <message> to send messages "
2023-10-10 21:19:04 +04:00
bob ##> ( " /c " <> cLink )
bob <## " contact address: known contact alice_1 "
bob <## " use @alice_1 <message> to send messages "
2025-01-24 09:44:53 +00:00
testPlanAddressContactViaAddress :: HasCallStack => TestParams -> IO ()
2023-11-07 17:45:59 +04:00
testPlanAddressContactViaAddress =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /ad "
cLink <- getContactLink alice True
alice ##> " /pa on " -- not necessary, without it bob would receive profile update removing contact link
alice <## " new contact address set "
case A . parseOnly strP ( B . pack cLink ) of
Left _ -> error " error parsing contact link "
Right cReq -> do
let profile = aliceProfile { contactLink = Just cReq }
void $ withCCUser bob $ \ user -> withCCTransaction bob $ \ db -> runExceptT $ createContact db user profile
bob @@@ [ ( " @alice " , " " ) ]
2023-11-08 13:15:08 +04:00
bob ##> " /delete @alice "
bob <## " alice: contact is deleted "
void $ withCCUser bob $ \ user -> withCCTransaction bob $ \ db -> runExceptT $ createContact db user profile
bob @@@ [ ( " @alice " , " " ) ]
2023-11-07 17:45:59 +04:00
bob ##> ( " /_connect plan 1 " <> cLink )
bob <## " contact address: known contact without connection alice "
let cLinkSchema2 = linkAnotherSchema cLink
bob ##> ( " /_connect plan 1 " <> cLinkSchema2 )
bob <## " contact address: known contact without connection alice "
-- terminal api
bob ##> ( " /c " <> cLink )
connecting alice bob
2025-01-10 15:27:29 +04:00
bob ##> " /delete @alice "
2023-11-07 17:45:59 +04:00
bob <## " alice: contact is deleted "
2025-01-10 15:27:29 +04:00
alice ##> " /delete @bob "
2023-11-07 17:45:59 +04:00
alice <## " bob: contact is deleted "
void $ withCCUser bob $ \ user -> withCCTransaction bob $ \ db -> runExceptT $ createContact db user profile
bob @@@ [ ( " @alice " , " " ) ]
-- GUI api
2025-01-10 15:27:29 +04:00
# if defined ( dbPostgres )
bob ##> " /_connect contact 1 4 "
# else
2023-11-07 17:45:59 +04:00
bob ##> " /_connect contact 1 2 "
2025-01-10 15:27:29 +04:00
# endif
2023-11-07 17:45:59 +04:00
connecting alice bob
where
connecting alice bob = do
bob <## " connection request sent! "
alice <## " bob (Bob) wants to connect to you! "
alice <## " to accept: /ac bob "
alice <## " to reject: /rc bob (the sender will NOT be notified) "
alice ##> " /ac bob "
2024-07-18 20:33:51 +04:00
alice <## " bob (Bob): accepting contact request, you can send messages to contact "
2023-11-07 17:45:59 +04:00
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
alice <##> bob
bob @@@ [ ( " @alice " , " hey " ) ]
2025-01-24 09:44:53 +00:00
testConnectIncognitoInvitationLink :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
2023-08-08 17:25:28 +04:00
alice ##> " /connect incognito "
2023-02-01 17:21:13 +00:00
inv <- getInvitation alice
2023-08-08 17:25:28 +04:00
bob ##> ( " /connect incognito " <> inv )
2023-02-01 17:21:13 +00:00
bob <## " confirmation sent! "
bobIncognito <- getTermLine bob
aliceIncognito <- getTermLine alice
concurrentlyN_
[ do
bob <## ( aliceIncognito <> " : contact is connected, your incognito profile for this contact is " <> bobIncognito )
bob <## ( " use /i " <> aliceIncognito <> " to print out this incognito profile again " ) ,
do
alice <## ( bobIncognito <> " : contact is connected, your incognito profile for this contact is " <> aliceIncognito )
alice <## ( " use /i " <> bobIncognito <> " to print out this incognito profile again " )
]
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_
2023-06-17 10:34:04 +01:00
[ alice <## " user full name removed (your 1 contacts are notified) " ,
2023-02-01 17:21:13 +00:00
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 " )
alice ##> " /_set prefs @2 {} "
alice <## ( " your preferences for " <> bobIncognito <> " did not change " )
( bob </ )
alice ##> " /_set prefs @2 { \ " fullDelete \ " : { \ " allow \ " : \ " always \ " }} "
alice <## ( " you updated preferences for " <> bobIncognito <> " : " )
alice <## " Full deletion: enabled for contact (you allow: always, contact allows: no) "
bob <## ( aliceIncognito <> " updated preferences for you: " )
bob <## " Full deletion: enabled for you (you allow: no, contact allows: always) "
bob ##> " /_set prefs @2 {} "
bob <## ( " your preferences for " <> aliceIncognito <> " did not change " )
( alice </ )
alice ##> " /_set prefs @2 { \ " fullDelete \ " : { \ " allow \ " : \ " no \ " }} "
alice <## ( " you updated preferences for " <> bobIncognito <> " : " )
alice <## " Full deletion: off (you allow: no, contact allows: no) "
bob <## ( aliceIncognito <> " updated preferences for you: " )
bob <## " Full deletion: off (you allow: no, contact allows: no) "
-- list contacts
alice ##> " /contacts "
alice
<### [ ConsoleString $ " i " <> bobIncognito ,
" cath (Catherine) "
]
alice ` hasContactProfiles ` [ " alice " , T . pack aliceIncognito , T . pack bobIncognito , " cath " ]
bob ##> " /contacts "
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-09-27 19:36:13 +04:00
bob <## ( aliceIncognito <> " deleted contact with you " )
2023-02-01 17:21:13 +00:00
alice ##> " /contacts "
alice <## " cath (Catherine) "
alice ` hasContactProfiles ` [ " alice " , " cath " ]
-- bob deletes contact, incognito profile is deleted
bob ##> ( " /d " <> aliceIncognito )
bob <## ( aliceIncognito <> " : contact is deleted " )
bob ##> " /contacts "
( bob </ )
bob ` hasContactProfiles ` [ " bob " ]
2025-01-24 09:44:53 +00:00
testConnectIncognitoContactAddress :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /ad "
cLink <- getContactLink alice True
2023-08-08 17:25:28 +04:00
bob ##> ( " /c i " <> cLink )
2023-02-01 17:21:13 +00:00
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 )
2024-07-18 20:33:51 +04:00
alice <## ( bobIncognito <> " : accepting contact request, you can send messages to contact " )
2023-02-01 17:21:13 +00:00
_ <- getTermLine bob
concurrentlyN_
[ do
bob <## ( " alice (Alice): contact is connected, your incognito profile for this contact is " <> bobIncognito )
bob <## " use /i alice to print out this incognito profile again " ,
alice <## ( bobIncognito <> " : contact is connected " )
]
2023-08-08 17:25:28 +04:00
-- conversation is incognito
2023-02-01 17:21:13 +00:00
alice #> ( " @ " <> bobIncognito <> " who are you? " )
bob ?<# " alice> who are you? "
bob ?#> " @alice I'm Batman "
alice <# ( bobIncognito <> " > I'm Batman " )
-- list contacts
bob ##> " /contacts "
bob <## " i alice (Alice) "
bob ` hasContactProfiles ` [ " alice " , " bob " , T . pack bobIncognito ]
2023-07-13 23:48:25 +01:00
threadDelay 500000
2023-02-01 17:21:13 +00:00
-- delete contact, incognito profile is deleted
bob ##> " /d alice "
bob <## " alice: contact is deleted "
2023-09-27 19:36:13 +04:00
alice <## ( bobIncognito <> " deleted contact with you " )
2023-02-01 17:21:13 +00:00
bob ##> " /contacts "
( bob </ )
bob ` hasContactProfiles ` [ " bob " ]
2025-01-24 09:44:53 +00:00
testAcceptContactRequestIncognito :: HasCallStack => TestParams -> IO ()
2023-08-08 17:25:28 +04:00
testAcceptContactRequestIncognito = testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
2023-02-01 17:21:13 +00:00
alice ##> " /ad "
cLink <- getContactLink alice True
2025-01-10 15:27:29 +04:00
-- GUI /_accept api
2023-02-01 17:21:13 +00:00
bob ##> ( " /c " <> cLink )
alice <#? bob
2025-01-10 15:27:29 +04:00
alice ##> " /_accept incognito=on 1 "
2024-07-18 20:33:51 +04:00
alice <## " bob (Bob): accepting contact request, you can send messages to contact "
2023-08-08 17:25:28 +04:00
aliceIncognitoBob <- getTermLine alice
2023-02-01 17:21:13 +00:00
concurrentlyN_
2023-08-08 17:25:28 +04:00
[ bob <## ( aliceIncognitoBob <> " : contact is connected " ) ,
2023-02-01 17:21:13 +00:00
do
2023-08-08 17:25:28 +04:00
alice <## ( " bob (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognitoBob )
2023-02-01 17:21:13 +00:00
alice <## " use /i bob to print out this incognito profile again "
]
2023-08-08 17:25:28 +04:00
-- conversation is incognito
2023-02-01 17:21:13 +00:00
alice ?#> " @bob my profile is totally inconspicuous "
2023-08-08 17:25:28 +04:00
bob <# ( aliceIncognitoBob <> " > my profile is totally inconspicuous " )
bob #> ( " @ " <> aliceIncognitoBob <> " I know! " )
2023-02-01 17:21:13 +00:00
alice ?<# " bob> I know! "
-- list contacts
alice ##> " /contacts "
alice <## " i bob (Bob) "
2023-08-08 17:25:28 +04:00
alice ` hasContactProfiles ` [ " alice " , " bob " , T . pack aliceIncognitoBob ]
2023-02-01 17:21:13 +00:00
-- delete contact, incognito profile is deleted
alice ##> " /d bob "
alice <## " bob: contact is deleted "
2023-09-27 19:36:13 +04:00
bob <## ( aliceIncognitoBob <> " deleted contact with you " )
2023-02-01 17:21:13 +00:00
alice ##> " /contacts "
( alice </ )
alice ` hasContactProfiles ` [ " alice " ]
2025-01-10 15:27:29 +04:00
-- terminal /accept api
2023-08-08 17:25:28 +04:00
cath ##> ( " /c " <> cLink )
alice <#? cath
2025-01-10 15:27:29 +04:00
alice ##> " /accept incognito cath "
2024-07-18 20:33:51 +04:00
alice <## " cath (Catherine): accepting contact request, you can send messages to contact "
2023-08-08 17:25:28 +04:00
aliceIncognitoCath <- getTermLine alice
concurrentlyN_
[ cath <## ( aliceIncognitoCath <> " : contact is connected " ) ,
do
alice <## ( " cath (Catherine): contact is connected, your incognito profile for this contact is " <> aliceIncognitoCath )
alice <## " use /i cath to print out this incognito profile again "
]
alice ` hasContactProfiles ` [ " alice " , " cath " , T . pack aliceIncognitoCath ]
cath ` hasContactProfiles ` [ " cath " , T . pack aliceIncognitoCath ]
2025-01-24 09:44:53 +00:00
testSetConnectionIncognito :: HasCallStack => TestParams -> IO ()
2023-08-08 17:25:28 +04:00
testSetConnectionIncognito = testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /connect "
inv <- getInvitation alice
alice ##> " /_set incognito :1 on "
alice <## " connection 1 changed to incognito "
bob ##> ( " /connect " <> inv )
bob <## " confirmation sent! "
aliceIncognito <- getTermLine alice
concurrentlyN_
[ bob <## ( aliceIncognito <> " : contact is connected " ) ,
do
alice <## ( " bob (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognito )
alice <## ( " use /i bob to print out this incognito profile again " )
]
alice ?#> ( " @bob hi " )
bob <# ( aliceIncognito <> " > hi " )
bob #> ( " @ " <> aliceIncognito <> " hey " )
alice ?<# ( " bob> hey " )
alice ` hasContactProfiles ` [ " alice " , " bob " , T . pack aliceIncognito ]
bob ` hasContactProfiles ` [ " bob " , T . pack aliceIncognito ]
2025-01-24 09:44:53 +00:00
testResetConnectionIncognito :: HasCallStack => TestParams -> IO ()
2023-08-08 17:25:28 +04:00
testResetConnectionIncognito = testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /_connect 1 incognito=on "
inv <- getInvitation alice
alice ##> " /_set incognito :1 off "
alice <## " connection 1 changed to non incognito "
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
alice <##> bob
alice ` hasContactProfiles ` [ " alice " , " bob " ]
bob ` hasContactProfiles ` [ " alice " , " bob " ]
2025-01-24 09:44:53 +00:00
testSetConnectionIncognitoProhibitedDuringNegotiation :: HasCallStack => TestParams -> IO ()
testSetConnectionIncognitoProhibitedDuringNegotiation ps = do
inv <- withNewTestChat ps " alice " aliceProfile $ \ alice -> do
2023-08-08 17:25:28 +04:00
threadDelay 250000
alice ##> " /connect "
getInvitation alice
2025-01-24 09:44:53 +00:00
withNewTestChat ps " bob " bobProfile $ \ bob -> do
2023-08-08 17:25:28 +04:00
threadDelay 250000
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
2025-01-24 09:44:53 +00:00
withTestChat ps " alice " $ \ alice -> do
2023-08-08 17:25:28 +04:00
threadDelay 250000
2024-07-04 07:58:13 +01:00
alice <## " bob (Bob): contact is connected "
2023-08-08 17:25:28 +04:00
alice ##> " /_set incognito :1 on "
alice <## " chat db error: SEPendingConnectionNotFound {connId = 1} "
2025-01-24 09:44:53 +00:00
withTestChat ps " bob " $ \ bob -> do
2024-07-04 07:58:13 +01:00
bob <## " alice (Alice): contact is connected "
alice <##> bob
alice ` hasContactProfiles ` [ " alice " , " bob " ]
bob ` hasContactProfiles ` [ " alice " , " bob " ]
2025-01-24 09:44:53 +00:00
testSetConnectionIncognitoProhibitedDuringNegotiationSlow :: HasCallStack => TestParams -> IO ()
testSetConnectionIncognitoProhibitedDuringNegotiationSlow ps = do
inv <- withNewTestChatCfg ps testCfgSlow " alice " aliceProfile $ \ alice -> do
2024-07-04 07:58:13 +01:00
threadDelay 250000
alice ##> " /connect "
getInvitation alice
2025-01-24 09:44:53 +00:00
withNewTestChatCfg ps testCfgSlow " bob " bobProfile $ \ bob -> do
2024-07-04 07:58:13 +01:00
threadDelay 250000
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
2025-01-24 09:44:53 +00:00
withTestChatCfg ps testCfgSlow " alice " $ \ alice -> do
2024-07-04 07:58:13 +01:00
threadDelay 250000
alice ##> " /_set incognito :1 on "
alice <## " chat db error: SEPendingConnectionNotFound {connId = 1} "
2025-01-24 09:44:53 +00:00
withTestChatCfg ps testCfgSlow " bob " $ \ bob -> do
2023-08-08 17:25:28 +04:00
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
alice <##> bob
alice ` hasContactProfiles ` [ " alice " , " bob " ]
bob ` hasContactProfiles ` [ " alice " , " bob " ]
2025-01-24 09:44:53 +00:00
testConnectionIncognitoUnchangedErrors :: HasCallStack => TestParams -> IO ()
2023-08-08 17:25:28 +04:00
testConnectionIncognitoUnchangedErrors = testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /connect "
inv <- getInvitation alice
alice ##> " /_set incognito :1 off "
alice <## " incognito mode change prohibited "
alice ##> " /_set incognito :1 on "
alice <## " connection 1 changed to incognito "
alice ##> " /_set incognito :1 on "
alice <## " incognito mode change prohibited "
alice ##> " /_set incognito :1 off "
alice <## " connection 1 changed to non incognito "
alice ##> " /_set incognito :1 off "
alice <## " incognito mode change prohibited "
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
alice <##> bob
alice ` hasContactProfiles ` [ " alice " , " bob " ]
bob ` hasContactProfiles ` [ " alice " , " bob " ]
2025-01-24 09:44:53 +00:00
testSetResetSetConnectionIncognito :: HasCallStack => TestParams -> IO ()
2023-08-08 17:25:28 +04:00
testSetResetSetConnectionIncognito = testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /_connect 1 incognito=off "
inv <- getInvitation alice
alice ##> " /_set incognito :1 on "
alice <## " connection 1 changed to incognito "
alice ##> " /_set incognito :1 off "
alice <## " connection 1 changed to non incognito "
alice ##> " /_set incognito :1 on "
alice <## " connection 1 changed to incognito "
bob ##> ( " /_connect 1 incognito=off " <> inv )
bob <## " confirmation sent! "
aliceIncognito <- getTermLine alice
concurrentlyN_
[ bob <## ( aliceIncognito <> " : contact is connected " ) ,
do
alice <## ( " bob (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognito )
alice <## ( " use /i bob to print out this incognito profile again " )
]
alice ?#> ( " @bob hi " )
bob <# ( aliceIncognito <> " > hi " )
bob #> ( " @ " <> aliceIncognito <> " hey " )
alice ?<# ( " bob> hey " )
alice ` hasContactProfiles ` [ " alice " , " bob " , T . pack aliceIncognito ]
bob ` hasContactProfiles ` [ " bob " , T . pack aliceIncognito ]
2023-02-01 17:21:13 +00:00
2025-01-24 09:44:53 +00:00
testJoinGroupIncognito :: HasCallStack => TestParams -> IO ()
2023-09-05 20:15:50 +04:00
testJoinGroupIncognito =
2025-01-31 10:32:07 +04:00
testChat4 aliceProfile bobProfile cathProfile danProfile $
2023-09-05 20:15:50 +04:00
\ alice bob cath dan -> do
-- non incognito connections
connectUsers alice bob
connectUsers alice dan
connectUsers bob cath
connectUsers bob dan
connectUsers cath dan
-- cath connected incognito to alice
alice ##> " /c "
inv <- getInvitation alice
cath ##> ( " /c i " <> inv )
cath <## " confirmation sent! "
cathIncognito <- getTermLine cath
concurrentlyN_
[ do
cath <## ( " alice (Alice): contact is connected, your incognito profile for this contact is " <> cathIncognito )
cath <## " use /i alice to print out this incognito profile again " ,
alice <## ( cathIncognito <> " : contact is connected " )
]
-- alice creates group
alice ##> " /g secret_club "
alice <## " group #secret_club is created "
alice <## " to add members use /a secret_club <name> or /create link #secret_club "
-- alice invites bob
alice ##> " /a secret_club bob admin "
concurrentlyN_
[ alice <## " invitation to join the group #secret_club sent to bob " ,
do
bob <## " #secret_club: alice invites you to join the group as admin "
bob <## " use /j secret_club to accept "
]
bob ##> " /j secret_club "
concurrently_
( alice <## " #secret_club: bob joined the group " )
( bob <## " #secret_club: you joined the group " )
-- alice invites cath
alice ##> ( " /a secret_club " <> cathIncognito <> " admin " )
concurrentlyN_
[ alice <## ( " invitation to join the group #secret_club sent to " <> cathIncognito ) ,
do
cath <## " #secret_club: alice invites you to join the group as admin "
cath <## ( " use /j secret_club to join incognito as " <> cathIncognito )
]
-- cath uses the same incognito profile when joining group, cath and bob don't merge contacts
cath ##> " /j secret_club "
concurrentlyN_
[ alice <## ( " #secret_club: " <> cathIncognito <> " joined the group " ) ,
do
cath <## ( " #secret_club: you joined the group incognito as " <> cathIncognito )
cath <## " #secret_club: member bob_1 (Bob) is connected " ,
do
bob <## ( " #secret_club: alice added " <> cathIncognito <> " to the group (connecting...) " )
bob <## ( " #secret_club: new member " <> cathIncognito <> " is connected " )
]
-- cath cannot invite to the group because her membership is incognito
cath ##> " /a secret_club dan "
2023-10-24 20:59:06 +04:00
cath <## " you are using an incognito profile for this group - prohibited to invite contacts "
2023-09-05 20:15:50 +04:00
-- alice invites dan
alice ##> " /a secret_club dan admin "
concurrentlyN_
[ alice <## " invitation to join the group #secret_club sent to dan " ,
do
dan <## " #secret_club: alice invites you to join the group as admin "
dan <## " use /j secret_club to accept "
]
dan ##> " /j secret_club "
-- cath and dan don't merge contacts
concurrentlyN_
[ alice <## " #secret_club: dan joined the group " ,
do
dan <## " #secret_club: you joined the group "
dan
<### [ ConsoleString $ " #secret_club: member " <> cathIncognito <> " is connected " ,
" #secret_club: member bob_1 (Bob) is connected " ,
2025-01-31 10:32:07 +04:00
" contact and member are merged: bob, #secret_club bob_1 " ,
2023-09-05 20:15:50 +04:00
" use @bob <message> to send messages "
] ,
do
bob <## " #secret_club: alice added dan_1 (Daniel) to the group (connecting...) "
bob <## " #secret_club: new member dan_1 is connected "
2025-01-31 10:32:07 +04:00
bob <## " contact and member are merged: dan, #secret_club dan_1 "
2023-09-05 20:15:50 +04:00
bob <## " use @dan <message> to send messages " ,
do
cath <## " #secret_club: alice added dan_1 (Daniel) to the group (connecting...) "
cath <## " #secret_club: new member dan_1 is connected "
]
-- send messages - group is incognito for cath
alice #> " #secret_club hello "
concurrentlyN_
[ bob <# " #secret_club alice> hello " ,
cath ?<# " #secret_club alice> hello " ,
dan <# " #secret_club alice> hello "
]
bob #> " #secret_club hi there "
concurrentlyN_
[ alice <# " #secret_club bob> hi there " ,
cath ?<# " #secret_club bob_1> hi there " ,
dan <# " #secret_club bob> hi there "
]
cath ?#> " #secret_club hey "
concurrentlyN_
[ alice <# ( " #secret_club " <> cathIncognito <> " > hey " ) ,
bob <# ( " #secret_club " <> cathIncognito <> " > hey " ) ,
dan <# ( " #secret_club " <> cathIncognito <> " > hey " )
]
dan #> " #secret_club how is it going? "
concurrentlyN_
[ 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? "
]
2025-01-31 10:32:07 +04:00
-- non incognito direct connections are separate
2023-09-05 20:15:50 +04:00
bob <##> cath
dan <##> cath
-- list groups
cath ##> " /gs "
cath <## " i #secret_club (4 members) "
-- list group members
alice ##> " /ms secret_club "
alice
<### [ " alice (Alice): owner, you, created group " ,
" bob (Bob): admin, invited, connected " ,
ConsoleString $ cathIncognito <> " : admin, invited, connected " ,
" dan (Daniel): admin, invited, connected "
]
bob ##> " /ms secret_club "
bob
<### [ " alice (Alice): owner, host, connected " ,
" bob (Bob): admin, you, connected " ,
ConsoleString $ cathIncognito <> " : admin, connected " ,
" dan (Daniel): admin, connected "
]
cath ##> " /ms secret_club "
cath
<### [ " alice (Alice): owner, host, connected " ,
" bob_1 (Bob): admin, connected " ,
ConsoleString $ " i " <> cathIncognito <> " : admin, you, connected " ,
" dan_1 (Daniel): admin, connected "
]
dan ##> " /ms secret_club "
dan
<### [ " alice (Alice): owner, host, connected " ,
" bob (Bob): admin, connected " ,
ConsoleString $ cathIncognito <> " : admin, connected " ,
" dan (Daniel): admin, you, connected "
]
-- 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 "
2025-04-02 07:57:18 +00:00
cath <## " bad chat command: not current member "
2023-02-01 17:21:13 +00:00
2025-01-24 09:44:53 +00:00
testCantInviteContactIncognito :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testCantInviteContactIncognito = testChat2 aliceProfile bobProfile $
\ alice bob -> do
-- alice connected incognito to bob
2023-08-08 17:25:28 +04:00
alice ##> " /c i "
2023-02-01 17:21:13 +00:00
inv <- getInvitation alice
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
aliceIncognito <- getTermLine alice
concurrentlyN_
[ bob <## ( aliceIncognito <> " : contact is connected " ) ,
do
alice <## ( " bob (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognito )
alice <## " use /i bob to print out this incognito profile again "
]
-- alice creates group non incognito
alice ##> " /g club "
alice <## " group #club is created "
alice <## " to add members use /a club <name> or /create link #club "
alice ##> " /a club bob "
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 </ )
2025-01-24 09:44:53 +00:00
testCantSeeGlobalPrefsUpdateIncognito :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testCantSeeGlobalPrefsUpdateIncognito = testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
2023-08-08 17:25:28 +04:00
alice ##> " /c i "
2023-02-01 17:21:13 +00:00
invIncognito <- getInvitation alice
alice ##> " /c "
inv <- getInvitation alice
bob ##> ( " /c " <> invIncognito )
bob <## " confirmation sent! "
aliceIncognito <- getTermLine alice
cath ##> ( " /c " <> inv )
cath <## " confirmation sent! "
concurrentlyN_
[ bob <## ( aliceIncognito <> " : contact is connected " ) ,
do
alice <## ( " bob (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognito )
alice <## " use /i bob to print out this incognito profile again " ,
do
cath <## " alice (Alice): contact is connected "
]
alice <## " cath (Catherine): contact is connected "
2023-07-13 23:48:25 +01:00
alice ##> " /_profile 1 { \ " displayName \ " : \ " alice \ " , \ " fullName \ " : \ " \ " , \ " preferences \ " : { \ " fullDelete \ " : { \ " allow \ " : \ " always \ " }, \ " receipts \ " : { \ " allow \ " : \ " yes \ " , \ " activated \ " : true}}} "
2023-06-17 10:34:04 +01:00
alice <## " user full name removed (your 1 contacts are notified) "
2023-02-01 17:21:13 +00:00
alice <## " updated preferences: "
alice <## " Full deletion allowed: always "
( alice </ )
-- bob doesn't receive profile update
( bob </ )
cath <## " contact alice removed full name "
cath <## " alice updated preferences for you: "
cath <## " Full deletion: enabled for you (you allow: default (no), contact allows: always) "
( cath </ )
bob ##> " /_set prefs @2 { \ " fullDelete \ " : { \ " allow \ " : \ " always \ " }} "
bob <## ( " you updated preferences for " <> aliceIncognito <> " : " )
bob <## " Full deletion: enabled for contact (you allow: always, contact allows: no) "
alice <## " bob updated preferences for you: "
alice <## " Full deletion: enabled for you (you allow: no, contact allows: always) "
alice ##> " /_set prefs @2 { \ " fullDelete \ " : { \ " allow \ " : \ " yes \ " }} "
alice <## " you updated preferences for bob: "
alice <## " Full deletion: enabled (you allow: yes, contact allows: always) "
bob <## ( aliceIncognito <> " updated preferences for you: " )
bob <## " Full deletion: enabled (you allow: always, contact allows: yes) "
( cath </ )
alice ##> " /_set prefs @3 { \ " fullDelete \ " : { \ " allow \ " : \ " always \ " }} "
alice <## " your preferences for cath did not change "
alice ##> " /_set prefs @3 { \ " fullDelete \ " : { \ " allow \ " : \ " yes \ " }} "
alice <## " you updated preferences for cath: "
alice <## " Full deletion: off (you allow: yes, contact allows: no) "
cath <## " alice updated preferences for you: "
cath <## " Full deletion: off (you allow: default (no), contact allows: yes) "
2025-01-24 09:44:53 +00:00
testDeleteContactThenGroupDeletesIncognitoProfile :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testDeleteContactThenGroupDeletesIncognitoProfile = testChat2 aliceProfile bobProfile $
\ alice bob -> do
-- bob connects incognito to alice
alice ##> " /c "
inv <- getInvitation alice
2023-08-08 17:25:28 +04:00
bob ##> ( " /c i " <> inv )
2023-02-01 17:21:13 +00:00
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 )
bob <## " use /i alice to print out this incognito profile again "
]
-- bob joins group using incognito profile
alice ##> " /g team "
alice <## " group #team is created "
alice <## " to add members use /a team <name> or /create link #team "
alice ##> ( " /a team " <> bobIncognito )
concurrentlyN_
[ alice <## ( " invitation to join the group #team sent to " <> bobIncognito ) ,
do
2023-08-14 07:37:04 +01:00
bob <## " #team: alice invites you to join the group as member "
2023-02-01 17:21:13 +00:00
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 ##> " /contacts "
bob <## " i alice (Alice) "
bob ` hasContactProfiles ` [ " alice " , " bob " , T . pack bobIncognito ]
-- delete contact
bob ##> " /d alice "
bob <## " alice: contact is deleted "
2023-09-27 19:36:13 +04:00
alice <## ( bobIncognito <> " deleted contact with you " )
2023-02-01 17:21:13 +00:00
bob ##> " /contacts "
( 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 " ]
2025-01-24 09:44:53 +00:00
testDeleteGroupThenContactDeletesIncognitoProfile :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testDeleteGroupThenContactDeletesIncognitoProfile = testChat2 aliceProfile bobProfile $
\ alice bob -> do
-- bob connects incognito to alice
alice ##> " /c "
inv <- getInvitation alice
2023-08-08 17:25:28 +04:00
bob ##> ( " /c i " <> inv )
2023-02-01 17:21:13 +00:00
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 )
bob <## " use /i alice to print out this incognito profile again "
]
-- bob joins group using incognito profile
alice ##> " /g team "
alice <## " group #team is created "
alice <## " to add members use /a team <name> or /create link #team "
alice ##> ( " /a team " <> bobIncognito )
concurrentlyN_
[ alice <## ( " invitation to join the group #team sent to " <> bobIncognito ) ,
do
2023-08-14 07:37:04 +01:00
bob <## " #team: alice invites you to join the group as member "
2023-02-01 17:21:13 +00:00
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 ##> " /contacts "
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-09-27 19:36:13 +04:00
alice <## ( bobIncognito <> " deleted contact with you " )
2023-02-01 17:21:13 +00:00
bob ##> " /contacts "
( bob </ )
bob ` hasContactProfiles ` [ " bob " ]
2025-01-24 09:44:53 +00:00
testSetAlias :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00: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 " )
alice ##> " /contacts "
alice <## " bob (Bob) (alias: my friend bob) "
alice #$> ( " /_set alias @2 " , id , " contact bob alias removed " )
alice ##> " /contacts "
alice <## " bob (Bob) "
2025-01-24 09:44:53 +00:00
testChangePCCUser :: HasCallStack => TestParams -> IO ()
2024-08-21 10:27:58 +01:00
testChangePCCUser = testChat2 aliceProfile bobProfile $
\ alice bob -> do
-- Create a new invite
alice ##> " /connect "
2025-06-16 21:38:02 +00:00
_ <- getInvitation alice
2024-08-21 10:27:58 +01:00
-- Create new user and go back to original user
alice ##> " /create user alisa "
showActiveUser alice " alisa "
alice ##> " /create user alisa2 "
showActiveUser alice " alisa2 "
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
-- Change connection to newly created user
alice ##> " /_set conn user :1 2 "
2025-06-16 21:38:02 +00:00
alice <## " connection 1 changed from user alice to user alisa, new link: "
alice <## " "
_ <- getTermLine alice
alice <## " "
2024-08-21 10:27:58 +01:00
alice ##> " /user alisa "
showActiveUser alice " alisa "
-- Change connection back to other user
alice ##> " /_set conn user :1 3 "
2025-06-16 21:38:02 +00:00
alice <## " connection 1 changed from user alisa to user alisa2, new link: "
alice <## " "
inv <- getTermLine alice
alice <## " "
2024-08-21 10:27:58 +01:00
alice ##> " /user alisa2 "
showActiveUser alice " alisa2 "
-- Connect
bob ##> ( " /connect " <> inv )
bob <## " confirmation sent! "
concurrently_
( alice <## " bob (Bob): contact is connected " )
( bob <## " alisa2: contact is connected " )
2025-06-16 21:38:02 +00:00
alice <##> bob
2024-08-21 10:27:58 +01:00
2025-01-24 09:44:53 +00:00
testChangePCCUserFromIncognito :: HasCallStack => TestParams -> IO ()
2024-08-21 10:27:58 +01:00
testChangePCCUserFromIncognito = testChat2 aliceProfile bobProfile $
\ alice bob -> do
-- Create a new invite and set as incognito
alice ##> " /connect "
2025-06-16 21:38:02 +00:00
_ <- getInvitation alice
2024-08-21 10:27:58 +01:00
alice ##> " /_set incognito :1 on "
alice <## " connection 1 changed to incognito "
-- Create new user and go back to original user
alice ##> " /create user alisa "
showActiveUser alice " alisa "
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
-- Change connection to newly created user
alice ##> " /_set conn user :1 2 "
2025-06-16 21:38:02 +00:00
alice <## " connection 1 changed from user alice to user alisa, new link: "
alice <## " "
_ <- getTermLine alice
alice <## " "
2024-08-21 10:27:58 +01:00
alice ` hasContactProfiles ` [ " alice " ]
alice ##> " /user alisa "
showActiveUser alice " alisa "
-- Change connection back to initial user
alice ##> " /_set conn user :1 1 "
2025-06-16 21:38:02 +00:00
alice <## " connection 1 changed from user alisa to user alice, new link: "
alice <## " "
inv <- getTermLine alice
alice <## " "
2024-08-21 10:27:58 +01:00
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
-- Connect
bob ##> ( " /connect " <> inv )
bob <## " confirmation sent! "
concurrently_
( alice <## " bob (Bob): contact is connected " )
( bob <## " alice (Alice): contact is connected " )
2025-06-16 21:38:02 +00:00
alice <##> bob
2024-08-21 10:27:58 +01:00
2025-01-24 09:44:53 +00:00
testChangePCCUserAndThenIncognito :: HasCallStack => TestParams -> IO ()
2024-08-21 10:27:58 +01:00
testChangePCCUserAndThenIncognito = testChat2 aliceProfile bobProfile $
\ alice bob -> do
-- Create a new invite and set as incognito
alice ##> " /connect "
2025-06-16 21:38:02 +00:00
_ <- getInvitation alice
2024-08-21 10:27:58 +01:00
-- Create new user and go back to original user
alice ##> " /create user alisa "
showActiveUser alice " alisa "
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
-- Change connection to newly created user
alice ##> " /_set conn user :1 2 "
2025-06-16 21:38:02 +00:00
alice <## " connection 1 changed from user alice to user alisa, new link: "
alice <## " "
inv <- getTermLine alice
alice <## " "
2024-08-21 10:27:58 +01:00
alice ##> " /user alisa "
showActiveUser alice " alisa "
-- Change connection to incognito and make sure it's attached to the newly created user profile
alice ##> " /_set incognito :1 on "
alice <## " connection 1 changed to incognito "
bob ##> ( " /connect " <> inv )
bob <## " confirmation sent! "
alisaIncognito <- getTermLine alice
concurrentlyN_
[ bob <## ( alisaIncognito <> " : contact is connected " ) ,
do
alice <## ( " bob (Bob): contact is connected, your incognito profile for this contact is " <> alisaIncognito )
alice <## ( " use /i bob to print out this incognito profile again " )
]
2025-06-16 21:38:02 +00:00
alice ?#> " @bob hi "
bob <# ( alisaIncognito <> " > hi " )
bob #> ( " @ " <> alisaIncognito <> " hey " )
alice ?<# " bob> hey "
2024-08-21 10:27:58 +01:00
2025-01-24 09:44:53 +00:00
testChangePCCUserDiffSrv :: HasCallStack => TestParams -> IO ()
testChangePCCUserDiffSrv ps = do
2024-08-27 22:12:55 +01:00
withSmpServer' serverCfg' $ do
2025-01-24 09:44:53 +00:00
withNewTestChatCfgOpts ps testCfg testOpts " alice " aliceProfile $ \ alice -> do
withNewTestChatCfgOpts ps testCfg testOpts " bob " bobProfile $ \ bob -> do
2024-08-27 22:12:55 +01:00
-- Create a new invite
alice ##> " /connect "
_ <- getInvitation alice
alice ##> " /_set incognito :1 on "
alice <## " connection 1 changed to incognito "
-- Create new user with different servers
alice ##> " /create user alisa "
showActiveUser alice " alisa "
2024-11-14 17:43:34 +00:00
alice ##> " /smp "
alice <## " Your servers "
alice <## " SMP servers "
2024-11-18 18:44:28 +00:00
alice <## " smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001 "
2024-11-14 17:43:34 +00:00
alice #$> ( " /smp smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@127.0.0.1:7003 " , id , " ok " )
alice ##> " /smp "
alice <## " Your servers "
alice <## " SMP servers "
alice <## " smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@127.0.0.1:7003 "
2024-08-27 22:12:55 +01:00
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
-- Change connection to newly created user and use the newly created connection
alice ##> " /_set conn user :1 2 "
alice <## " connection 1 changed from user alice to user alisa, new link: "
alice <## " "
inv <- getTermLine alice
alice <## " "
alice ` hasContactProfiles ` [ " alice " ]
alice ##> " /user alisa "
showActiveUser alice " alisa "
-- Connect
bob ##> ( " /connect " <> inv )
bob <## " confirmation sent! "
concurrently_
( alice <## " bob (Bob): contact is connected " )
( bob <## " alisa: contact is connected " )
2025-06-16 21:38:02 +00:00
alice <##> bob
2024-08-27 22:12:55 +01:00
where
serverCfg' =
smpServerCfg
2024-09-30 14:53:36 +04:00
{ transports = [ ( " 7003 " , transport @ TLS , False ) , ( " 7002 " , transport @ TLS , False ) ] ,
2024-08-27 22:12:55 +01:00
msgQueueQuota = 2
}
2024-08-21 10:27:58 +01:00
2025-01-24 09:44:53 +00:00
testSetConnectionAlias :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testSetConnectionAlias = testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /c "
inv <- getInvitation alice
alice @@@ [ ( " :1 " , " " ) ]
alice ##> " /_set alias :1 friend "
alice <## " connection 1 alias updated: friend "
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
concurrently_
( alice <## " bob (Bob): contact is connected " )
( bob <## " alice (Alice): contact is connected " )
threadDelay 100000
2023-04-17 11:18:04 +02:00
alice @@@ [ ( " @bob " , lastChatFeature ) ]
2023-02-01 17:21:13 +00:00
alice ##> " /contacts "
alice <## " bob (Bob) (alias: friend) "
2025-01-24 09:44:53 +00:00
testSetGroupAlias :: HasCallStack => TestParams -> IO ()
2025-01-20 18:06:00 +00:00
testSetGroupAlias = testChat2 aliceProfile bobProfile $
\ alice bob -> do
createGroup2 " team " alice bob
threadDelay 1500000
alice ##> " /_set alias #1 friends "
alice <## " group #team alias updated: friends "
alice ##> " /groups "
alice <## " #team (2 members) (alias: friends) "
alice ##> " /_set alias #1 "
alice <## " group #team alias removed "
alice ##> " /groups "
alice <## " #team (2 members) "
2025-01-24 09:44:53 +00:00
testSetContactPrefs :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testSetContactPrefs = testChat2 aliceProfile bobProfile $
2024-02-20 13:56:31 +04:00
\ alice bob -> withXFTPServer $ do
2023-02-01 17:21:13 +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-07-13 23:48:25 +01:00
bob ##> " /_profile 1 { \ " displayName \ " : \ " bob \ " , \ " fullName \ " : \ " Bob \ " , \ " preferences \ " : { \ " voice \ " : { \ " allow \ " : \ " no \ " }, \ " receipts \ " : { \ " allow \ " : \ " yes \ " , \ " activated \ " : true}}} "
2023-02-01 17:21:13 +00:00
bob <## " profile image removed "
bob <## " updated preferences: "
bob <## " Voice messages allowed: no "
( bob </ )
connectUsers alice bob
alice ##> " /_set prefs @2 {} "
alice <## " your preferences for bob did not change "
( bob </ )
2024-04-22 20:46:48 +04:00
let startFeatures = [ ( 0 , e2eeInfoPQStr ) , ( 0 , " Disappearing messages: allowed " ) , ( 0 , " Full deletion: off " ) , ( 0 , " Message reactions: enabled " ) , ( 0 , " Voice messages: off " ) , ( 0 , " Audio/video calls: enabled " ) ]
2023-02-01 17:21:13 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , startFeatures )
bob #$> ( " /_get chat @2 count=100 " , chat , startFeatures )
2024-08-22 21:36:35 +04:00
let sendVoice = " /_send @2 json [{ \ " filePath \ " : \ " test.txt \ " , \ " msgContent \ " : { \ " type \ " : \ " voice \ " , \ " text \ " : \ " \ " , \ " duration \ " : 10}}] "
2023-02-01 17:21:13 +00:00
voiceNotAllowed = " bad chat command: feature not allowed Voice messages "
alice ##> sendVoice
alice <## voiceNotAllowed
bob ##> sendVoice
bob <## voiceNotAllowed
-- alice ##> "/_set prefs @2 {\"voice\": {\"allow\": \"always\"}}"
alice ##> " /set voice @bob always "
alice <## " you updated preferences for bob: "
alice <## " Voice messages: enabled for contact (you allow: always, contact allows: no) "
alice #$> ( " /_get chat @2 count=100 " , chat , startFeatures <> [ ( 1 , " Voice messages: enabled for contact " ) ] )
bob <## " alice updated preferences for you: "
bob <## " Voice messages: enabled for you (you allow: default (no), contact allows: always) "
bob #$> ( " /_get chat @2 count=100 " , chat , startFeatures <> [ ( 0 , " Voice messages: enabled for you " ) ] )
alice ##> sendVoice
alice <## voiceNotAllowed
2024-02-20 13:56:31 +04:00
-- sending voice message allowed
2023-02-01 17:21:13 +00:00
bob ##> sendVoice
bob <# " @alice voice message (00:10) "
bob <# " /f @alice test.txt "
2024-02-20 13:56:31 +04:00
bob <## " use /fc 1 to cancel sending "
2023-02-01 17:21:13 +00:00
alice <# " bob> voice message (00:10) "
alice <# " bob> sends file test.txt (11 bytes / 11 bytes) "
2024-02-20 13:56:31 +04:00
alice <## " use /fr 1 [<dir>/ | <path>] to receive it "
bob <## " completed uploading file 1 (test.txt) for alice "
alice ##> " /fr 1 "
alice
<### [ " saving file 1 from bob to test_1.txt " ,
" started receiving file 1 (test.txt) from bob "
]
2023-02-01 17:21:13 +00:00
alice <## " completed receiving file 1 (test.txt) from bob "
( bob </ )
2024-02-20 13:56:31 +04:00
2023-02-01 17:21:13 +00:00
-- alice ##> "/_profile 1 {\"displayName\": \"alice\", \"fullName\": \"Alice\", \"preferences\": {\"voice\": {\"allow\": \"no\"}}}"
alice ##> " /set voice no "
alice <## " updated preferences: "
alice <## " Voice messages allowed: no "
( alice </ )
alice ##> " /_set prefs @2 { \ " voice \ " : { \ " allow \ " : \ " yes \ " }} "
alice <## " you updated preferences for bob: "
alice <## " Voice messages: off (you allow: yes, contact allows: no) "
alice #$> ( " /_get chat @2 count=100 " , chat , startFeatures <> [ ( 1 , " Voice messages: enabled for contact " ) , ( 0 , " voice message (00:10) " ) , ( 1 , " Voice messages: off " ) ] )
bob <## " alice updated preferences for you: "
bob <## " Voice messages: off (you allow: default (no), contact allows: yes) "
bob #$> ( " /_get chat @2 count=100 " , chat , startFeatures <> [ ( 0 , " Voice messages: enabled for you " ) , ( 1 , " voice message (00:10) " ) , ( 0 , " Voice messages: off " ) ] )
( bob </ )
2023-07-13 23:48:25 +01:00
bob ##> " /_profile 1 { \ " displayName \ " : \ " bob \ " , \ " fullName \ " : \ " \ " , \ " preferences \ " : { \ " voice \ " : { \ " allow \ " : \ " yes \ " }, \ " receipts \ " : { \ " allow \ " : \ " yes \ " , \ " activated \ " : true}}} "
2023-06-17 10:34:04 +01:00
bob <## " user full name removed (your 1 contacts are notified) "
2023-02-01 17:21:13 +00:00
bob <## " updated preferences: "
bob <## " Voice messages allowed: yes "
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 </ )
alice <## " contact bob removed full name "
alice <## " bob updated preferences for you: "
alice <## " Voice messages: enabled (you allow: yes, contact allows: yes) "
2024-01-15 19:56:11 +04: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 , " updated profile " ) , ( 0 , " Voice messages: enabled " ) ] )
2023-02-01 17:21:13 +00:00
( alice </ )
bob ##> " /_set prefs @2 {} "
bob <## " your preferences for alice did not change "
-- 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 </ )
( alice </ )
alice ##> " /_set prefs @2 { \ " voice \ " : { \ " allow \ " : \ " no \ " }} "
alice <## " you updated preferences for bob: "
alice <## " Voice messages: off (you allow: no, contact allows: yes) "
2024-01-15 19:56:11 +04: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 , " updated profile " ) , ( 0 , " Voice messages: enabled " ) , ( 1 , " Voice messages: off " ) ] )
2023-02-01 17:21:13 +00:00
bob <## " alice updated preferences for you: "
bob <## " Voice messages: off (you allow: default (yes), contact allows: no) "
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 " ) ] )
2025-01-24 09:44:53 +00:00
testFeatureOffers :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +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 " ) ] )
2025-01-24 09:44:53 +00:00
testUpdateGroupPrefs :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testUpdateGroupPrefs =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
createGroup2 " team " alice bob
2024-12-03 12:11:38 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , sndGroupFeatures <> [ ( 0 , " connected " ) ] )
2023-02-01 17:21:13 +00:00
threadDelay 500000
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) ] )
2023-12-23 17:07:23 +04:00
alice ##> " /_group_profile #1 { \ " displayName \ " : \ " team \ " , \ " fullName \ " : \ " \ " , \ " groupPreferences \ " : { \ " fullDelete \ " : { \ " enable \ " : \ " on \ " }, \ " directMessages \ " : { \ " enable \ " : \ " on \ " }, \ " history \ " : { \ " enable \ " : \ " on \ " }}} "
2023-02-01 17:21:13 +00:00
alice <## " updated group preferences: "
alice <## " Full deletion: on "
2024-12-03 12:11:38 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , sndGroupFeatures <> [ ( 0 , " connected " ) , ( 1 , " Full deletion: on " ) ] )
2023-02-01 17:21:13 +00:00
bob <## " alice updated group #team: "
bob <## " updated group preferences: "
bob <## " Full deletion: on "
threadDelay 500000
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) , ( 0 , " Full deletion: on " ) ] )
2023-12-23 17:07:23 +04:00
alice ##> " /_group_profile #1 { \ " displayName \ " : \ " team \ " , \ " fullName \ " : \ " \ " , \ " groupPreferences \ " : { \ " fullDelete \ " : { \ " enable \ " : \ " off \ " }, \ " voice \ " : { \ " enable \ " : \ " off \ " }, \ " directMessages \ " : { \ " enable \ " : \ " on \ " }, \ " history \ " : { \ " enable \ " : \ " on \ " }}} "
2023-02-01 17:21:13 +00:00
alice <## " updated group preferences: "
alice <## " Full deletion: off "
alice <## " Voice messages: off "
2024-12-03 12:11:38 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , sndGroupFeatures <> [ ( 0 , " connected " ) , ( 1 , " Full deletion: on " ) , ( 1 , " Full deletion: off " ) , ( 1 , " Voice messages: off " ) ] )
2023-02-01 17:21:13 +00:00
bob <## " alice updated group #team: "
bob <## " updated group preferences: "
bob <## " Full deletion: off "
bob <## " Voice messages: off "
threadDelay 500000
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) , ( 0 , " Full deletion: on " ) , ( 0 , " Full deletion: off " ) , ( 0 , " Voice messages: off " ) ] )
alice ##> " /set voice #team on "
alice <## " updated group preferences: "
alice <## " Voice messages: on "
2024-12-03 12:11:38 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , sndGroupFeatures <> [ ( 0 , " connected " ) , ( 1 , " Full deletion: on " ) , ( 1 , " Full deletion: off " ) , ( 1 , " Voice messages: off " ) , ( 1 , " Voice messages: on " ) ] )
2023-02-01 17:21:13 +00:00
bob <## " alice updated group #team: "
bob <## " updated group preferences: "
bob <## " Voice messages: on "
threadDelay 500000
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 " ) ] )
threadDelay 500000
2023-12-23 17:07:23 +04:00
alice ##> " /_group_profile #1 { \ " displayName \ " : \ " team \ " , \ " fullName \ " : \ " \ " , \ " groupPreferences \ " : { \ " fullDelete \ " : { \ " enable \ " : \ " off \ " }, \ " voice \ " : { \ " enable \ " : \ " on \ " }, \ " directMessages \ " : { \ " enable \ " : \ " on \ " }, \ " history \ " : { \ " enable \ " : \ " on \ " }}} "
2023-02-01 17:21:13 +00:00
-- no update
threadDelay 500000
2024-12-03 12:11:38 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , sndGroupFeatures <> [ ( 0 , " connected " ) , ( 1 , " Full deletion: on " ) , ( 1 , " Full deletion: off " ) , ( 1 , " Voice messages: off " ) , ( 1 , " Voice messages: on " ) ] )
2023-02-01 17:21:13 +00:00
alice #> " #team hey "
bob <# " #team alice> hey "
threadDelay 1000000
bob #> " #team hi "
alice <# " #team bob> hi "
threadDelay 500000
2024-12-03 12:11:38 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , sndGroupFeatures <> [ ( 0 , " connected " ) , ( 1 , " Full deletion: on " ) , ( 1 , " Full deletion: off " ) , ( 1 , " Voice messages: off " ) , ( 1 , " Voice messages: on " ) , ( 1 , " hey " ) , ( 0 , " hi " ) ] )
2023-02-01 17:21:13 +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 " ) , ( 0 , " hey " ) , ( 1 , " hi " ) ] )
2025-01-24 09:44:53 +00:00
testAllowFullDeletionContact :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testAllowFullDeletionContact =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice <##> bob
alice ##> " /set delete @bob always "
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 " ) ] )
2025-01-24 09:44:53 +00:00
testAllowFullDeletionGroup :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testAllowFullDeletionGroup =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
createGroup2 " team " alice bob
2024-03-05 20:27:00 +04:00
threadDelay 1500000
2023-02-01 17:21:13 +00:00
alice #> " #team hi "
bob <# " #team alice> hi "
threadDelay 1000000
bob #> " #team hey "
bob ##> " /last_item_id #team "
msgItemId <- getTermLine bob
alice <# " #team bob> hey "
alice ##> " /set delete #team on "
alice <## " updated group preferences: "
alice <## " Full deletion: on "
bob <## " alice updated group #team: "
bob <## " updated group preferences: "
bob <## " Full deletion: on "
2024-12-03 12:11:38 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , sndGroupFeatures <> [ ( 0 , " connected " ) , ( 1 , " hi " ) , ( 0 , " hey " ) , ( 1 , " Full deletion: on " ) ] )
2023-02-01 17:21:13 +00:00
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) , ( 0 , " hi " ) , ( 1 , " hey " ) , ( 0 , " Full deletion: on " ) ] )
bob #$> ( " /_delete item #1 " <> msgItemId <> " broadcast " , id , " message deleted " )
alice <# " #team bob> [deleted] hey "
2024-12-03 12:11:38 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , sndGroupFeatures <> [ ( 0 , " connected " ) , ( 1 , " hi " ) , ( 1 , " Full deletion: on " ) ] )
2023-02-01 17:21:13 +00:00
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) , ( 0 , " hi " ) , ( 0 , " Full deletion: on " ) ] )
2025-01-24 09:44:53 +00:00
testProhibitDirectMessages :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testProhibitDirectMessages =
2025-01-31 10:32:07 +04:00
testChat4 aliceProfile bobProfile cathProfile danProfile $
2023-09-05 20:15:50 +04:00
\ alice bob cath dan -> do
createGroup3 " team " alice bob cath
threadDelay 1000000
alice ##> " /set direct #team off "
alice <## " updated group preferences: "
alice <## " Direct messages: off "
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 "
2025-01-31 10:32:07 +04:00
bob <## " bad chat command: direct messages not allowed "
2023-09-05 20:15:50 +04:00
( cath </ )
connectUsers cath dan
addMember " team " cath dan GRMember
dan ##> " /j #team "
concurrentlyN_
[ cath <## " #team: dan joined the group " ,
do
dan <## " #team: you joined the group "
dan
<### [ " #team: member alice (Alice) is connected " ,
" #team: member bob (Bob) is connected "
] ,
do
alice <## " #team: cath added dan (Daniel) to the group (connecting...) "
alice <## " #team: new member dan is connected " ,
do
bob <## " #team: cath added dan (Daniel) to the group (connecting...) "
bob <## " #team: new member dan is connected "
]
alice ##> " @dan hi "
2025-01-31 10:32:07 +04:00
alice <## " bad chat command: direct messages not allowed "
2023-09-05 20:15:50 +04:00
bob ##> " @dan hi "
2025-01-31 10:32:07 +04:00
bob <## " bad chat command: direct messages not allowed "
2023-09-05 20:15:50 +04:00
( dan </ )
dan ##> " @alice hi "
2025-01-31 10:32:07 +04:00
dan <## " bad chat command: direct messages not allowed "
2023-09-05 20:15:50 +04:00
dan ##> " @bob hi "
2025-01-31 10:32:07 +04:00
dan <## " bad chat command: direct messages not allowed "
2023-09-05 20:15:50 +04:00
dan #> " @cath hi "
cath <# " dan> hi "
cath #> " @dan hi "
dan <# " cath> hi "
2023-02-01 17:21:13 +00:00
where
directProhibited :: HasCallStack => TestCC -> IO ()
directProhibited cc = do
cc <## " alice updated group #team: "
cc <## " updated group preferences: "
cc <## " Direct messages: off "
2025-01-24 09:44:53 +00:00
testEnableTimedMessagesContact :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00: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: "
2023-04-17 19:13:10 +02:00
alice <## " Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes) "
2023-02-01 17:21:13 +00:00
bob <## " alice updated preferences for you: "
bob <## " Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes (1 sec)) "
2023-04-17 19:13:10 +02:00
bob ##> " /set disappear @alice yes "
bob <## " your preferences for alice did not change "
2023-02-01 17:21:13 +00:00
alice <##> bob
threadDelay 500000
2023-04-17 19:13:10 +02:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " Disappearing messages: enabled (1 sec) " ) , ( 1 , " hi " ) , ( 0 , " hey " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " Disappearing messages: enabled (1 sec) " ) , ( 0 , " hi " ) , ( 1 , " hey " ) ] )
2023-02-01 17:21:13 +00:00
threadDelay 1000000
2023-02-08 07:08:53 +00:00
alice <## " timed message deleted: hi "
alice <## " timed message deleted: hey "
bob <## " timed message deleted: hi "
bob <## " timed message deleted: hey "
2023-04-17 19:13:10 +02:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " Disappearing messages: enabled (1 sec) " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " Disappearing messages: enabled (1 sec) " ) ] )
2023-02-01 17:21:13 +00:00
-- turn off, messages are not disappearing
bob ##> " /set disappear @alice no "
bob <## " you updated preferences for alice: "
bob <## " Disappearing messages: off (you allow: no, contact allows: yes (1 sec)) "
alice <## " bob updated preferences for you: "
alice <## " Disappearing messages: off (you allow: yes (1 sec), contact allows: no) "
alice <##> bob
threadDelay 1500000
2023-04-17 19:13:10 +02:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " Disappearing messages: enabled (1 sec) " ) , ( 0 , " Disappearing messages: off " ) , ( 1 , " hi " ) , ( 0 , " hey " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " Disappearing messages: enabled (1 sec) " ) , ( 1 , " Disappearing messages: off " ) , ( 0 , " hi " ) , ( 1 , " hey " ) ] )
2023-02-01 17:21:13 +00:00
-- test api
bob ##> " /set disappear @alice yes 30s "
bob <## " you updated preferences for alice: "
bob <## " Disappearing messages: enabled (you allow: yes (30 sec), contact allows: yes (1 sec)) "
alice <## " bob updated preferences for you: "
alice <## " Disappearing messages: enabled (you allow: yes (30 sec), contact allows: yes (30 sec)) "
bob ##> " /set disappear @alice week " -- "yes" is optional
bob <## " you updated preferences for alice: "
bob <## " Disappearing messages: enabled (you allow: yes (1 week), contact allows: yes (1 sec)) "
alice <## " bob updated preferences for you: "
alice <## " Disappearing messages: enabled (you allow: yes (1 week), contact allows: yes (1 week)) "
2025-01-24 09:44:53 +00:00
testEnableTimedMessagesGroup :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testEnableTimedMessagesGroup =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
createGroup2 " team " alice bob
threadDelay 1000000
2023-12-23 17:07:23 +04:00
alice ##> " /_group_profile #1 { \ " displayName \ " : \ " team \ " , \ " fullName \ " : \ " \ " , \ " groupPreferences \ " : { \ " timedMessages \ " : { \ " enable \ " : \ " on \ " , \ " ttl \ " : 1}, \ " directMessages \ " : { \ " enable \ " : \ " on \ " }, \ " history \ " : { \ " enable \ " : \ " on \ " }}} "
2023-02-01 17:21:13 +00:00
alice <## " updated group preferences: "
alice <## " Disappearing messages: on (1 sec) "
bob <## " alice updated group #team: "
bob <## " updated group preferences: "
bob <## " Disappearing messages: on (1 sec) "
threadDelay 1000000
alice #> " #team hi "
bob <# " #team alice> hi "
threadDelay 500000
2024-12-03 12:11:38 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , sndGroupFeatures <> [ ( 0 , " connected " ) , ( 1 , " Disappearing messages: on (1 sec) " ) , ( 1 , " hi " ) ] )
2023-02-01 17:21:13 +00:00
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) , ( 0 , " Disappearing messages: on (1 sec) " ) , ( 0 , " hi " ) ] )
threadDelay 1000000
2023-02-08 07:08:53 +00:00
alice <## " timed message deleted: hi "
bob <## " timed message deleted: hi "
2024-12-03 12:11:38 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , sndGroupFeatures <> [ ( 0 , " connected " ) , ( 1 , " Disappearing messages: on (1 sec) " ) ] )
2023-02-01 17:21:13 +00:00
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) , ( 0 , " Disappearing messages: on (1 sec) " ) ] )
-- turn off, messages are not disappearing
alice ##> " /set disappear #team off "
alice <## " updated group preferences: "
alice <## " Disappearing messages: off "
bob <## " alice updated group #team: "
bob <## " updated group preferences: "
bob <## " Disappearing messages: off "
threadDelay 1000000
alice #> " #team hey "
bob <# " #team alice> hey "
threadDelay 1500000
2024-12-03 12:11:38 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , sndGroupFeatures <> [ ( 0 , " connected " ) , ( 1 , " Disappearing messages: on (1 sec) " ) , ( 1 , " Disappearing messages: off " ) , ( 1 , " hey " ) ] )
2023-02-01 17:21:13 +00:00
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) , ( 0 , " Disappearing messages: on (1 sec) " ) , ( 0 , " Disappearing messages: off " ) , ( 0 , " hey " ) ] )
-- test api
alice ##> " /set disappear #team on 30s "
alice <## " updated group preferences: "
alice <## " Disappearing messages: on (30 sec) "
bob <## " alice updated group #team: "
bob <## " updated group preferences: "
bob <## " Disappearing messages: on (30 sec) "
alice ##> " /set disappear #team week " -- "on" is optional
alice <## " updated group preferences: "
alice <## " Disappearing messages: on (1 week) "
bob <## " alice updated group #team: "
bob <## " updated group preferences: "
bob <## " Disappearing messages: on (1 week) "
2025-01-24 09:44:53 +00:00
testTimedMessagesEnabledGlobally :: HasCallStack => TestParams -> IO ()
2023-02-01 17:21:13 +00:00
testTimedMessagesEnabledGlobally =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /set disappear yes "
2023-04-17 19:13:10 +02:00
alice <## " user profile did not change "
2023-02-01 17:21:13 +00:00
connectUsers alice bob
bob ##> " /_set prefs @2 { \ " timedMessages \ " : { \ " allow \ " : \ " yes \ " , \ " ttl \ " : 1}} "
bob <## " you updated preferences for alice: "
bob <## " Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes) "
alice <## " bob updated preferences for you: "
alice <## " Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes (1 sec)) "
alice <##> bob
threadDelay 500000
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 " ) ] )
threadDelay 1000000
2023-02-08 07:08:53 +00:00
alice <## " timed message deleted: hi "
bob <## " timed message deleted: hi "
alice <## " timed message deleted: hey "
bob <## " timed message deleted: hey "
2023-02-01 17:21:13 +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) " ) ] )
2024-01-05 11:35:48 +04:00
2025-01-24 09:44:53 +00:00
testUpdateMultipleUserPrefs :: HasCallStack => TestParams -> IO ()
2024-01-05 11:35:48 +04:00
testUpdateMultipleUserPrefs = testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
connectUsers alice bob
alice #> " @bob hi bob "
bob <# " alice> hi bob "
connectUsers alice cath
alice #> " @cath hi cath "
cath <# " alice> hi cath "
alice ##> " /_profile 1 { \ " displayName \ " : \ " alice \ " , \ " fullName \ " : \ " Alice \ " , \ " preferences \ " : { \ " fullDelete \ " : { \ " allow \ " : \ " always \ " }, \ " reactions \ " : { \ " allow \ " : \ " no \ " }, \ " receipts \ " : { \ " allow \ " : \ " yes \ " , \ " activated \ " : true}}} "
alice <## " updated preferences: "
alice <## " Full deletion allowed: always "
alice <## " Message reactions allowed: no "
bob <## " alice updated preferences for you: "
bob <## " Full deletion: enabled for you (you allow: default (no), contact allows: always) "
bob <## " Message reactions: off (you allow: default (yes), contact allows: no) "
cath <## " alice updated preferences for you: "
cath <## " Full deletion: enabled for you (you allow: default (no), contact allows: always) "
cath <## " Message reactions: off (you allow: default (yes), contact allows: no) "
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " hi bob " ) , ( 1 , " Full deletion: enabled for contact " ) , ( 1 , " Message reactions: off " ) ] )
alice #$> ( " /_get chat @3 count=100 " , chat , chatFeatures <> [ ( 1 , " hi cath " ) , ( 1 , " Full deletion: enabled for contact " ) , ( 1 , " Message reactions: off " ) ] )
2024-04-04 20:41:56 +01:00
2025-01-24 09:44:53 +00:00
testGroupPrefsDirectForRole :: HasCallStack => TestParams -> IO ()
2024-04-04 20:41:56 +01:00
testGroupPrefsDirectForRole = testChat4 aliceProfile bobProfile cathProfile danProfile $
\ alice bob cath dan -> do
createGroup3 " team " alice bob cath
threadDelay 1000000
alice ##> " /set direct #team on owner "
alice <## " updated group preferences: "
alice <## " Direct messages: on for owners "
directForOwners bob
directForOwners cath
threadDelay 1000000
bob ##> " @cath hello again "
bob <## " bad chat command: direct messages not allowed "
( cath </ )
connectUsers cath dan
addMember " team " cath dan GRMember
dan ##> " /j #team "
concurrentlyN_
[ cath <## " #team: dan joined the group " ,
do
dan <## " #team: you joined the group "
dan
<### [ " #team: member alice (Alice) is connected " ,
2024-05-08 15:36:20 +01:00
" #team: member bob (Bob) is connected "
] ,
2024-04-04 20:41:56 +01:00
do
alice <## " #team: cath added dan (Daniel) to the group (connecting...) "
alice <## " #team: new member dan is connected " ,
do
bob <## " #team: cath added dan (Daniel) to the group (connecting...) "
bob <## " #team: new member dan is connected "
]
2024-05-15 11:16:38 +01:00
-- dan cannot send direct messages to alice
2024-04-04 20:41:56 +01:00
dan ##> " @alice hello alice "
dan <## " bad chat command: direct messages not allowed "
2024-05-08 15:36:20 +01:00
( alice </ )
2024-05-15 11:16:38 +01:00
-- alice (owner) can send direct messages to dan
2024-04-04 20:41:56 +01:00
alice ` send ` " @dan hello dan "
2024-05-15 11:16:38 +01:00
alice
<### [ " member #team dan does not have direct connection, creating " ,
" contact for member #team dan is created " ,
" sent invitation to connect directly to member #team dan " ,
WithTime " @dan hello dan "
]
dan
<### [ " #team alice is creating direct contact alice with you " ,
WithTime " alice> hello dan "
]
2024-07-18 20:33:51 +04:00
dan <## " alice (Alice): you can send messages to contact "
2024-05-15 11:16:38 +01:00
concurrently_
( alice <## " dan (Daniel): contact is connected " )
( dan <## " alice (Alice): contact is connected " )
-- now dan can send messages to alice
2024-04-04 20:41:56 +01:00
dan #> " @alice hi alice "
alice <# " dan> hi alice "
where
directForOwners :: HasCallStack => TestCC -> IO ()
directForOwners cc = do
cc <## " alice updated group #team: "
cc <## " updated group preferences: "
cc <## " Direct messages: on for owners "
2025-01-24 09:44:53 +00:00
testGroupPrefsFilesForRole :: HasCallStack => TestParams -> IO ()
2024-04-04 20:41:56 +01:00
testGroupPrefsFilesForRole = testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> withXFTPServer $ do
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/test1.txt "
copyFile " ./tests/fixtures/test.txt " " ./tests/tmp/bob/test2.txt "
createGroup3 " team " alice bob cath
threadDelay 1000000
alice ##> " /set files #team on owner "
alice <## " updated group preferences: "
alice <## " Files and media: on for owners "
filesForOwners bob
filesForOwners cath
threadDelay 1000000
bob ##> " /f #team test2.txt "
bob <## " bad chat command: feature not allowed Files and media "
( alice </ )
( cath </ )
alice #> " /f #team test1.txt "
alice <## " use /fc 1 to cancel sending "
alice <## " completed uploading file 1 (test1.txt) for #team "
bob <# " #team alice> sends file test1.txt (11 bytes / 11 bytes) "
bob <## " use /fr 1 [<dir>/ | <path>] to receive it "
cath <# " #team alice> sends file test1.txt (11 bytes / 11 bytes) "
cath <## " use /fr 1 [<dir>/ | <path>] to receive it "
where
filesForOwners :: HasCallStack => TestCC -> IO ()
filesForOwners cc = do
cc <## " alice updated group #team: "
cc <## " updated group preferences: "
cc <## " Files and media: on for owners "
2025-01-24 09:44:53 +00:00
testGroupPrefsSimplexLinksForRole :: HasCallStack => TestParams -> IO ()
2024-04-04 20:41:56 +01:00
testGroupPrefsSimplexLinksForRole = testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> withXFTPServer $ do
createGroup3 " team " alice bob cath
threadDelay 1000000
alice ##> " /set links #team on owner "
alice <## " updated group preferences: "
alice <## " SimpleX links: on for owners "
linksForOwners bob
linksForOwners cath
threadDelay 1000000
bob ##> " /c "
inv <- getInvitation bob
2024-06-18 23:44:33 +04:00
bob ##> ( " #team \ " " <> inv <> " \ \ ntest \ " " )
bob <## " bad chat command: feature not allowed SimpleX links "
2024-08-22 21:36:35 +04:00
bob ##> ( " /_send #1 json [{ \ " msgContent \ " : { \ " type \ " : \ " text \ " , \ " text \ " : \ " " <> inv <> " \ \ ntest \ " }}] " )
2024-04-04 20:41:56 +01:00
bob <## " bad chat command: feature not allowed SimpleX links "
( alice </ )
( cath </ )
2024-06-18 23:44:33 +04:00
bob ` send ` ( " @alice \ " " <> inv <> " \ \ ntest \ " " )
bob <# ( " @alice " <> inv )
bob <## " test "
alice <# ( " bob> " <> inv )
alice <## " test "
bob ##> " #team <- @alice https://simplex.chat "
bob <## " bad chat command: feature not allowed SimpleX links "
2024-04-04 20:41:56 +01:00
alice #> ( " #team " <> inv )
bob <# ( " #team alice> " <> inv )
cath <# ( " #team alice> " <> inv )
where
linksForOwners :: HasCallStack => TestCC -> IO ()
linksForOwners cc = do
cc <## " alice updated group #team: "
cc <## " updated group preferences: "
cc <## " SimpleX links: on for owners "
2024-05-08 15:36:20 +01:00
2025-01-24 09:44:53 +00:00
testSetUITheme :: HasCallStack => TestParams -> IO ()
2024-05-08 15:36:20 +01:00
testSetUITheme =
testChat2 aliceProfile bobProfile $ \ alice bob -> do
connectUsers alice bob
alice ##> " /g team "
alice <## " group #team is created "
alice <## " to add members use /a team <name> or /create link #team "
alice #$> ( " /_set theme user 1 " <> theme UCMDark , id , " ok " )
alice #$> ( " /_set theme @2 " <> theme UCMDark , id , " ok " )
alice #$> ( " /_set theme #1 " <> theme UCMDark , id , " ok " )
alice ##> " /u "
userInfo alice " alice (Alice) "
alice <## ( " UI themes: " <> theme UCMDark )
alice ##> " /create user alice2 "
userInfo alice " alice2 "
alice ##> " /u alice "
userInfo alice " alice (Alice) "
alice <## ( " UI themes: " <> theme UCMDark )
alice ##> " /i @bob "
contactInfo alice
alice <## ( " UI themes: " <> theme UCMDark )
alice ##> " /i #team "
groupInfo alice
alice <## ( " UI themes: " <> theme UCMDark )
alice #$> ( " /_set theme user 1 " , id , " ok " )
alice #$> ( " /_set theme @2 " , id , " ok " )
alice #$> ( " /_set theme #1 " , id , " ok " )
alice ##> " /u "
userInfo alice " alice (Alice) "
alice ##> " /i @bob "
contactInfo alice
alice ##> " /i #team "
groupInfo alice
where
theme cm = T . unpack $ encodeJSON UIThemeEntityOverrides { light = Nothing , dark = Just $ UIThemeEntityOverride cm Nothing defaultUIColors }
userInfo a name = do
a <## ( " user profile: " <> name )
a <## " use /p <display name> to change it "
a <## " (the updated profile will be sent to all your contacts) "
contactInfo a = do
a <## " contact ID: 2 "
a <## " receiving messages via: localhost "
a <## " sending messages via: localhost "
a <## " you've shared main profile with this contact "
a <## " connection not verified, use /code command to see security code "
a <## " quantum resistant end-to-end encryption "
2025-01-04 18:33:27 +00:00
a <## ( " peer chat protocol version range: (Version 1, " <> show currentChatVersion <> " ) " )
2024-05-08 15:36:20 +01:00
groupInfo a = do
a <## " group ID: 1 "
a <## " current members: 1 "
2025-04-14 21:25:32 +01:00
testShortLinkInvitation :: HasCallStack => TestParams -> IO ()
testShortLinkInvitation =
testChat2 aliceProfile bobProfile $ \ alice bob -> do
alice ##> " /c short "
inv <- getShortInvitation alice
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
concurrently_
( alice <## " bob (Bob): contact is connected " )
( bob <## " alice (Alice): contact is connected " )
alice #> " @bob hi "
bob <# " alice> hi "
bob #> " @alice hey "
alice <# " bob> hey "
testPlanShortLinkInvitation :: HasCallStack => TestParams -> IO ()
testPlanShortLinkInvitation =
testChat3 aliceProfile bobProfile cathProfile $ \ alice bob cath -> do
alice ##> " /c short "
inv <- getShortInvitation alice
alice ##> ( " /_connect plan 1 " <> inv )
alice <## " invitation link: own link "
alice ##> ( " /_connect plan 1 " <> slSimplexScheme inv )
alice <## " invitation link: own link "
bob ##> ( " /_connect plan 1 " <> inv )
bob <## " invitation link: ok to connect "
-- nobody else can connect
cath ##> ( " /_connect plan 1 " <> inv )
cath <##. " error: connection authorization failed "
cath ##> ( " /c " <> inv )
cath <##. " error: connection authorization failed "
-- bob can retry "plan"
bob ##> ( " /_connect plan 1 " <> inv )
bob <## " invitation link: ok to connect "
-- with simplex: scheme too
bob ##> ( " /_connect plan 1 " <> slSimplexScheme inv )
bob <## " invitation link: ok to connect "
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
concurrently_
( alice <## " bob (Bob): contact is connected " )
( bob <## " alice (Alice): contact is connected " )
alice #> " @bob hi "
bob <# " alice> hi "
bob #> " @alice hey "
alice <# " bob> hey "
bob ##> ( " /_connect plan 1 " <> inv )
bob <##. " error: connection authorization failed "
alice ##> ( " /_connect plan 1 " <> inv )
alice <##. " error: connection authorization failed " -- short_link_inv and conn_req_inv are removed after connection
slSimplexScheme :: String -> String
slSimplexScheme sl = T . unpack $ T . replace " https://localhost/ " " simplex:/ " ( T . pack sl ) <> " ?h=localhost "
testShortLinkContactAddress :: HasCallStack => TestParams -> IO ()
testShortLinkContactAddress =
testChat4 aliceProfile bobProfile cathProfile danProfile $ \ alice bob cath dan -> do
alice ##> " /ad short "
( shortLink , fullLink ) <- getShortContactLink alice True
alice ##> ( " /_connect plan 1 " <> shortLink )
alice <## " contact address: own address "
alice ##> ( " /_connect plan 1 " <> slSimplexScheme shortLink )
alice <## " contact address: own address "
alice ##> ( " /_connect plan 1 " <> fullLink )
alice <## " contact address: own address "
( alice , bob ) ` connectVia ` shortLink
bob ##> ( " /_connect plan 1 " <> slSimplexScheme shortLink )
bob <## " contact address: known contact alice "
bob <## " use @alice <message> to send messages "
( alice , cath ) ` connectVia ` slSimplexScheme shortLink
cath ##> ( " /_connect plan 1 " <> shortLink )
cath <## " contact address: known contact alice "
cath <## " use @alice <message> to send messages "
( alice , dan ) ` connectVia ` fullLink
where
( alice , cc ) ` connectVia ` cLink = do
name <- userName cc
sName <- showName cc
cc ##> ( " /_connect plan 1 " <> cLink )
cc <## " contact address: ok to connect "
cc ##> ( " /c " <> cLink )
alice <#? cc
alice ##> ( " /ac " <> name )
alice <## ( sName <> " : accepting contact request, you can send messages to contact " )
concurrently_
( cc <## " alice (Alice): contact is connected " )
( alice <## ( sName <> " : contact is connected " ) )
cc ##> ( " /_connect plan 1 " <> cLink )
cc <## " contact address: known contact alice "
cc <## " use @alice <message> to send messages "
testShortLinkJoinGroup :: HasCallStack => TestParams -> IO ()
testShortLinkJoinGroup =
testChat4 aliceProfile bobProfile cathProfile danProfile $ \ alice bob cath dan -> do
threadDelay 100000
alice ##> " /ad short " -- create the address to test that it can co-exist with group link
_ <- getShortContactLink alice True
alice ##> " /g team "
alice <## " group #team is created "
alice <## " to add members use /a team <name> or /create link #team "
alice ##> " /create link #team short "
( shortLink , fullLink ) <- getShortGroupLink alice " team " GRMember True
alice ##> ( " /_connect plan 1 " <> shortLink )
alice <## " group link: own link for group #team "
alice ##> ( " /_connect plan 1 " <> slSimplexScheme shortLink )
alice <## " group link: own link for group #team "
alice ##> ( " /_connect plan 1 " <> fullLink )
alice <## " group link: own link for group #team "
joinGroup alice bob shortLink
bob ##> ( " /_connect plan 1 " <> shortLink )
bob <## " group link: known group #team "
bob <## " use #team <message> to send messages "
bob ##> ( " /_connect plan 1 " <> slSimplexScheme shortLink )
bob <## " group link: known group #team "
bob <## " use #team <message> to send messages "
joinGroup alice cath $ slSimplexScheme shortLink
concurrentlyN_
[ do
bob <## " #team: alice added cath (Catherine) to the group (connecting...) "
bob <## " #team: new member cath is connected " ,
cath <## " #team: member bob (Bob) is connected "
]
cath ##> ( " /_connect plan 1 " <> slSimplexScheme shortLink )
cath <## " group link: known group #team "
cath <## " use #team <message> to send messages "
cath ##> ( " /_connect plan 1 " <> shortLink )
cath <## " group link: known group #team "
cath <## " use #team <message> to send messages "
joinGroup alice dan fullLink
concurrentlyN_
[ do
bob <## " #team: alice added dan (Daniel) to the group (connecting...) "
bob <## " #team: new member dan is connected " ,
do
cath <## " #team: alice added dan (Daniel) to the group (connecting...) "
cath <## " #team: new member dan is connected " ,
do
dan <## " #team: member bob (Bob) is connected "
dan <## " #team: member cath (Catherine) is connected "
]
dan ##> ( " /_connect plan 1 " <> fullLink )
dan <## " group link: known group #team "
dan <## " use #team <message> to send messages "
where
joinGroup alice cc link = do
name <- userName cc
sName <- showName cc
cc ##> ( " /_connect plan 1 " <> link )
cc <## " group link: ok to connect "
cc ##> ( " /c " <> link )
cc <## " connection request sent! "
alice <## ( sName <> " : accepting request to join group #team... " )
concurrentlyN_
[ alice <## ( " #team: " <> name <> " joined the group " ) ,
do
cc <## " #team: joining the group... "
cc <## " #team: you joined the group "
]