2023-02-01 17:21:13 +00:00
{- # LANGUAGE DuplicateRecordFields # -}
{- # LANGUAGE OverloadedStrings # -}
{- # LANGUAGE PostfixOperators # -}
{- # LANGUAGE RankNTypes # -}
module ChatTests.Direct where
import ChatClient
import ChatTests.Utils
import Control.Concurrent ( threadDelay )
import Control.Concurrent.Async ( concurrently_ )
import Control.Monad ( forM_ )
import Data.Aeson ( ToJSON )
import qualified Data.Aeson as J
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Simplex.Chat.Call
import Simplex.Chat.Controller ( ChatConfig ( .. ) )
import Simplex.Chat.Options ( ChatOpts ( .. ) )
2023-04-16 12:35:45 +02:00
import Simplex.Chat.Store ( agentStoreFile , chatStoreFile )
2023-02-01 17:21:13 +00:00
import Simplex.Chat.Types ( authErrDisableCount , sameVerificationCode , verificationCode )
import qualified Simplex.Messaging.Crypto as C
import System.Directory ( copyFile , doesDirectoryExist , doesFileExist )
2023-04-16 12:35:45 +02:00
import System.FilePath ( ( </> ) )
2023-02-01 17:21:13 +00:00
import Test.Hspec
chatDirectTests :: SpecWith FilePath
chatDirectTests = do
describe " direct messages " $ do
describe " add contact and send/receive message " testAddContact
it " deleting contact deletes profile " testDeleteContactDeletesProfile
it " direct message quoted replies " testDirectMessageQuotedReply
it " direct message update " testDirectMessageUpdate
2023-05-08 20:07:51 +04:00
it " direct message edit history " testDirectMessageEditHistory
2023-02-01 17:21:13 +00:00
it " direct message delete " testDirectMessageDelete
it " direct live message " testDirectLiveMessage
2023-05-11 16:00:01 +04:00
it " direct timed message " testDirectTimedMessage
2023-02-01 17:21:13 +00:00
it " repeat AUTH errors disable contact " testRepeatAuthErrorsDisableContact
2023-02-18 15:16:50 +00:00
it " should send multiline message " testMultilineMessage
2023-02-01 17:21:13 +00:00
describe " SMP servers " $ do
it " get and set SMP servers " testGetSetSMPServers
it " test SMP server connection " testTestSMPServerConnection
2023-04-05 21:59:12 +01:00
describe " XFTP servers " $ do
it " get and set XFTP servers " testGetSetXFTPServers
it " test XFTP server connection " testTestXFTPServer
2023-02-01 17:21:13 +00:00
describe " async connection handshake " $ do
it " connect when initiating client goes offline " testAsyncInitiatingOffline
it " connect when accepting client goes offline " testAsyncAcceptingOffline
describe " connect, fully asynchronous (when clients are never simultaneously online) " $ do
2023-04-04 13:09:07 +01:00
-- fails in CI
xit'' " v2 " testFullAsync
2023-02-01 17:21:13 +00:00
describe " webrtc calls api " $ do
it " negotiate call " testNegotiateCall
describe " maintenance mode " $ do
it " start/stop/export/import chat " testMaintenanceMode
it " export/import chat with files " testMaintenanceModeWithFiles
it " encrypt/decrypt database " testDatabaseEncryption
describe " mute/unmute messages " $ do
it " mute/unmute contact " testMuteContact
it " mute/unmute group " testMuteGroup
describe " multiple users " $ do
it " create second user " testCreateSecondUser
it " multiple users subscribe and receive messages after restart " testUsersSubscribeAfterRestart
it " both users have contact link " testMultipleUserAddresses
it " create user with default servers " testCreateUserDefaultServers
it " create user with same servers " testCreateUserSameServers
it " delete user " testDeleteUser
it " users have different chat item TTL configuration, chat items expire " testUsersDifferentCIExpirationTTL
it " chat items expire after restart for all users according to per user configuration " testUsersRestartCIExpiration
it " chat items only expire for users who configured expiration " testEnableCIExpirationOnlyForOneUser
it " disabling chat item expiration doesn't disable it for other users " testDisableCIExpirationOnlyForOneUser
it " both users have configured timed messages with contacts, messages expire, restart " testUsersTimedMessages
2023-03-22 15:58:01 +00:00
it " user profile privacy: hide profiles and notificaitons " testUserPrivacy
2023-02-01 17:21:13 +00:00
describe " chat item expiration " $ do
it " set chat item TTL " testSetChatItemTTL
describe " queue rotation " $ do
it " switch contact to a different queue " testSwitchContact
it " switch group member to a different queue " testSwitchGroupMember
describe " connection verification code " $ do
it " verificationCode function converts ByteString to series of digits " $ \ _ ->
verificationCode ( C . sha256Hash " abcd " ) ` shouldBe ` " 61889 38426 63934 09576 96390 79389 84124 85253 63658 69469 70853 37788 95900 68296 20156 25 "
it " sameVerificationCode function should ignore spaces " $ \ _ ->
sameVerificationCode " 123 456 789 " " 12345 6789 " ` shouldBe ` True
it " mark contact verified " testMarkContactVerified
it " mark group member verified " testMarkGroupMemberVerified
2023-04-16 12:35:45 +02:00
describe " message errors " $ do
2023-05-17 16:13:35 +04:00
it " show message decryption error and update count " testMsgDecryptError
2023-05-15 12:28:53 +02:00
describe " message reactions " $ do
it " set message reactions " testSetMessageReactions
2023-02-01 17:21:13 +00:00
testAddContact :: HasCallStack => SpecWith FilePath
testAddContact = versionTestMatrix2 runTestAddContact
where
runTestAddContact alice bob = do
alice ##> " /_connect 1 "
inv <- getInvitation alice
bob ##> ( " /_connect 1 " <> inv )
bob <## " confirmation sent! "
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
threadDelay 100000
chatsEmpty alice bob
alice #> " @bob hello there 🙂 "
bob <# " alice> hello there 🙂 "
alice ##> " /_unread chat @2 on "
alice <## " ok "
alice ##> " /_unread chat @2 off "
alice <## " ok "
chatsOneMessage alice bob
bob #> " @alice hello there "
alice <# " bob> hello there "
bob #> " @alice how are you? "
alice <# " bob> how are you? "
chatsManyMessages alice bob
-- test adding the same contact one more time - local name will be different
alice ##> " /c "
inv' <- getInvitation alice
bob ##> ( " /c " <> inv' )
bob <## " confirmation sent! "
concurrently_
( bob <## " alice_1 (Alice): contact is connected " )
( alice <## " bob_1 (Bob): contact is connected " )
alice #> " @bob_1 hello "
bob <# " alice_1> hello "
bob #> " @alice_1 hi "
alice <# " bob_1> hi "
alice @@@ [ ( " @bob_1 " , " hi " ) , ( " @bob " , " how are you? " ) ]
bob @@@ [ ( " @alice_1 " , " hi " ) , ( " @alice " , " how are you? " ) ]
-- test deleting contact
alice ##> " /d bob_1 "
alice <## " bob_1: contact is deleted "
alice ##> " @bob_1 hey "
alice <## " no contact bob_1 "
alice @@@ [ ( " @bob " , " how are you? " ) ]
alice ` hasContactProfiles ` [ " alice " , " bob " ]
bob @@@ [ ( " @alice_1 " , " hi " ) , ( " @alice " , " how are you? " ) ]
bob ` hasContactProfiles ` [ " alice " , " alice " , " bob " ]
-- test clearing chat
alice #$> ( " /clear bob " , id , " bob: all messages are removed locally ONLY " )
alice #$> ( " /_get chat @2 count=100 " , chat , [] )
bob #$> ( " /clear alice " , id , " alice: all messages are removed locally ONLY " )
bob #$> ( " /_get chat @2 count=100 " , chat , [] )
chatsEmpty alice bob = do
2023-04-17 11:18:04 +02:00
alice @@@ [ ( " @bob " , lastChatFeature ) ]
2023-02-01 17:21:13 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures )
2023-04-17 11:18:04 +02:00
bob @@@ [ ( " @alice " , lastChatFeature ) ]
2023-02-01 17:21:13 +00:00
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures )
chatsOneMessage alice bob = do
alice @@@ [ ( " @bob " , " hello there 🙂 " ) ]
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " hello there 🙂 " ) ] )
bob @@@ [ ( " @alice " , " hello there 🙂 " ) ]
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " hello there 🙂 " ) ] )
chatsManyMessages alice bob = do
alice @@@ [ ( " @bob " , " how are you? " ) ]
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " hello there 🙂 " ) , ( 0 , " hello there " ) , ( 0 , " how are you? " ) ] )
bob @@@ [ ( " @alice " , " how are you? " ) ]
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " hello there 🙂 " ) , ( 1 , " hello there " ) , ( 1 , " how are you? " ) ] )
-- pagination
alice #$> ( " /_get chat @2 after= " <> itemId 1 <> " count=100 " , chat , [ ( 0 , " hello there " ) , ( 0 , " how are you? " ) ] )
alice #$> ( " /_get chat @2 before= " <> itemId 2 <> " count=100 " , chat , chatFeatures <> [ ( 1 , " hello there 🙂 " ) ] )
-- search
alice #$> ( " /_get chat @2 count=100 search=ello ther " , chat , [ ( 1 , " hello there 🙂 " ) , ( 0 , " hello there " ) ] )
-- read messages
alice #$> ( " /_read chat @2 from=1 to=100 " , id , " ok " )
bob #$> ( " /_read chat @2 from=1 to=100 " , id , " ok " )
alice #$> ( " /_read chat @2 " , id , " ok " )
bob #$> ( " /_read chat @2 " , id , " ok " )
testDeleteContactDeletesProfile :: HasCallStack => FilePath -> IO ()
testDeleteContactDeletesProfile =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice <##> bob
-- alice deletes contact, profile is deleted
alice ##> " /d bob "
alice <## " bob: contact is deleted "
alice ##> " /_contacts 1 "
( alice </ )
alice ` hasContactProfiles ` [ " alice " ]
-- bob deletes contact, profile is deleted
bob ##> " /d alice "
bob <## " alice: contact is deleted "
bob ##> " /contacts "
( bob </ )
bob ` hasContactProfiles ` [ " bob " ]
testDirectMessageQuotedReply :: HasCallStack => FilePath -> IO ()
testDirectMessageQuotedReply =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice ##> " /_send @2 text hello! how are you? "
alice <# " @bob hello! how are you? "
bob <# " alice> hello! how are you? "
bob #> " @alice hi! "
alice <# " bob> hi! "
bob ` send ` " > @alice (hello) all good - you? "
bob <# " @alice > hello! how are you? "
bob <## " all good - you? "
alice <# " bob> > hello! how are you? "
alice <## " all good - you? "
bob #$> ( " /_get chat @2 count=1 " , chat' , [ ( ( 1 , " all good - you? " ) , Just ( 0 , " hello! how are you? " ) ) ] )
alice #$> ( " /_get chat @2 count=1 " , chat' , [ ( ( 0 , " all good - you? " ) , Just ( 1 , " hello! how are you? " ) ) ] )
bob ` send ` " >> @alice (all good) will tell more "
bob <# " @alice >> all good - you? "
bob <## " will tell more "
alice <# " bob> >> all good - you? "
alice <## " will tell more "
bob #$> ( " /_get chat @2 count=1 " , chat' , [ ( ( 1 , " will tell more " ) , Just ( 1 , " all good - you? " ) ) ] )
alice #$> ( " /_get chat @2 count=1 " , chat' , [ ( ( 0 , " will tell more " ) , Just ( 0 , " all good - you? " ) ) ] )
testDirectMessageUpdate :: HasCallStack => FilePath -> IO ()
testDirectMessageUpdate =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
-- msg id 1
alice #> " @bob hello 🙂 "
bob <# " alice> hello 🙂 "
-- msg id 2
bob ` send ` " > @alice (hello) hi alice "
bob <# " @alice > hello 🙂 "
bob <## " hi alice "
alice <# " bob> > hello 🙂 "
alice <## " hi alice "
alice #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 1 , " hello 🙂 " ) , Nothing ) , ( ( 0 , " hi alice " ) , Just ( 1 , " hello 🙂 " ) ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 0 , " hello 🙂 " ) , Nothing ) , ( ( 1 , " hi alice " ) , Just ( 0 , " hello 🙂 " ) ) ] )
2023-05-11 16:00:01 +04:00
alice ##> ( " /_update item @2 " <> itemId 1 <> " text hello 🙂 " )
alice <## " message didn't change "
2023-02-01 17:21:13 +00:00
alice ##> ( " /_update item @2 " <> itemId 1 <> " text hey 👋 " )
alice <# " @bob [edited] hey 👋 "
bob <# " alice> [edited] hey 👋 "
alice #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 1 , " hey 👋 " ) , Nothing ) , ( ( 0 , " hi alice " ) , Just ( 1 , " hello 🙂 " ) ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 0 , " hey 👋 " ) , Nothing ) , ( ( 1 , " hi alice " ) , Just ( 0 , " hello 🙂 " ) ) ] )
-- msg id 3
bob ` send ` " > @alice (hey) hey alice "
bob <# " @alice > hey 👋 "
bob <## " hey alice "
alice <# " bob> > hey 👋 "
alice <## " hey alice "
alice #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 1 , " hey 👋 " ) , Nothing ) , ( ( 0 , " hi alice " ) , Just ( 1 , " hello 🙂 " ) ) , ( ( 0 , " hey alice " ) , Just ( 1 , " hey 👋 " ) ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 0 , " hey 👋 " ) , Nothing ) , ( ( 1 , " hi alice " ) , Just ( 0 , " hello 🙂 " ) ) , ( ( 1 , " hey alice " ) , Just ( 0 , " hey 👋 " ) ) ] )
alice ##> ( " /_update item @2 " <> itemId 1 <> " text greetings 🤝 " )
alice <# " @bob [edited] greetings 🤝 "
bob <# " alice> [edited] greetings 🤝 "
alice #$> ( " /_update item @2 " <> itemId 2 <> " text updating bob's message " , id , " cannot update this item " )
alice #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 1 , " greetings 🤝 " ) , Nothing ) , ( ( 0 , " hi alice " ) , Just ( 1 , " hello 🙂 " ) ) , ( ( 0 , " hey alice " ) , Just ( 1 , " hey 👋 " ) ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 0 , " greetings 🤝 " ) , Nothing ) , ( ( 1 , " hi alice " ) , Just ( 0 , " hello 🙂 " ) ) , ( ( 1 , " hey alice " ) , Just ( 0 , " hey 👋 " ) ) ] )
bob ##> ( " /_update item @2 " <> itemId 2 <> " text hey Alice " )
bob <# " @alice [edited] > hello 🙂 "
bob <## " hey Alice "
alice <# " bob> [edited] > hello 🙂 "
alice <## " hey Alice "
bob ##> ( " /_update item @2 " <> itemId 3 <> " text greetings Alice " )
bob <# " @alice [edited] > hey 👋 "
bob <## " greetings Alice "
alice <# " bob> [edited] > hey 👋 "
alice <## " greetings Alice "
alice #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 1 , " greetings 🤝 " ) , Nothing ) , ( ( 0 , " hey Alice " ) , Just ( 1 , " hello 🙂 " ) ) , ( ( 0 , " greetings Alice " ) , Just ( 1 , " hey 👋 " ) ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 0 , " greetings 🤝 " ) , Nothing ) , ( ( 1 , " hey Alice " ) , Just ( 0 , " hello 🙂 " ) ) , ( ( 1 , " greetings Alice " ) , Just ( 0 , " hey 👋 " ) ) ] )
2023-05-08 20:07:51 +04:00
testDirectMessageEditHistory :: HasCallStack => FilePath -> IO ()
testDirectMessageEditHistory =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice #> " @bob hello! "
bob <# " alice> hello! "
2023-05-18 17:52:58 +02:00
alice ##> ( " /_get item info @2 " <> itemId 1 )
2023-05-08 20:07:51 +04:00
alice <##. " sent at: "
2023-05-19 14:52:51 +02:00
alice <## " message history: "
alice .<## " : hello! "
2023-05-18 17:52:58 +02:00
bob ##> ( " /_get item info @2 " <> itemId 1 )
2023-05-08 20:07:51 +04:00
bob <##. " sent at: "
bob <##. " received at: "
2023-05-19 14:52:51 +02:00
bob <## " message history: "
bob .<## " : hello! "
2023-05-08 20:07:51 +04:00
alice ##> ( " /_update item @2 " <> itemId 1 <> " text hey 👋 " )
alice <# " @bob [edited] hey 👋 "
bob <# " alice> [edited] hey 👋 "
2023-05-18 17:52:58 +02:00
alice ##> ( " /_get item info @2 " <> itemId 1 )
2023-05-08 20:07:51 +04:00
alice <##. " sent at: "
alice <## " message history: "
alice .<## " : hey 👋 "
alice .<## " : hello! "
2023-05-18 17:52:58 +02:00
bob ##> ( " /_get item info @2 " <> itemId 1 )
2023-05-08 20:07:51 +04:00
bob <##. " sent at: "
bob <##. " received at: "
bob <## " message history: "
bob .<## " : hey 👋 "
bob .<## " : hello! "
alice ##> ( " /_update item @2 " <> itemId 1 <> " text hello there " )
alice <# " @bob [edited] hello there "
bob <# " alice> [edited] hello there "
alice ##> " /item info @bob hello "
alice <##. " sent at: "
alice <## " message history: "
alice .<## " : hello there "
alice .<## " : hey 👋 "
alice .<## " : hello! "
bob ##> " /item info @alice hello "
bob <##. " sent at: "
bob <##. " received at: "
bob <## " message history: "
bob .<## " : hello there "
bob .<## " : hey 👋 "
bob .<## " : hello! "
bob #$> ( " /_delete item @2 " <> itemId 1 <> " internal " , id , " message deleted " )
alice ##> ( " /_update item @2 " <> itemId 1 <> " text hey there " )
alice <# " @bob [edited] hey there "
bob <# " alice> [edited] hey there "
alice ##> " /item info @bob hey "
alice <##. " sent at: "
alice <## " message history: "
alice .<## " : hey there "
alice .<## " : hello there "
alice .<## " : hey 👋 "
alice .<## " : hello! "
bob ##> " /item info @alice hey "
bob <##. " sent at: "
bob <##. " received at: "
bob <## " message history: "
bob .<## " : hey there "
2023-02-01 17:21:13 +00:00
testDirectMessageDelete :: HasCallStack => FilePath -> IO ()
testDirectMessageDelete =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
-- alice, bob: msg id 1
alice #> " @bob hello 🙂 "
bob <# " alice> hello 🙂 "
-- alice, bob: msg id 2
bob ` send ` " > @alice (hello 🙂) hey alic "
bob <# " @alice > hello 🙂 "
bob <## " hey alic "
alice <# " bob> > hello 🙂 "
alice <## " hey alic "
-- alice: deletes msg ids 1,2
alice #$> ( " /_delete item @2 " <> itemId 1 <> " internal " , id , " message deleted " )
alice #$> ( " /_delete item @2 " <> itemId 2 <> " internal " , id , " message deleted " )
2023-04-17 11:18:04 +02:00
alice @@@ [ ( " @bob " , lastChatFeature ) ]
2023-02-01 17:21:13 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures )
-- alice: msg id 1
bob ##> ( " /_update item @2 " <> itemId 2 <> " text hey alice " )
bob <# " @alice [edited] > hello 🙂 "
bob <## " hey alice "
alice <# " bob> [edited] hey alice "
alice @@@ [ ( " @bob " , " hey alice " ) ]
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " hey alice " ) ] )
-- bob: marks deleted msg id 2
bob #$> ( " /_delete item @2 " <> itemId 2 <> " broadcast " , id , " message marked deleted " )
bob @@@ [ ( " @alice " , " hey alice [marked deleted] " ) ]
alice <# " bob> [marked deleted] hey alice "
alice @@@ [ ( " @bob " , " hey alice [marked deleted] " ) ]
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " hey alice [marked deleted] " ) ] )
-- alice: deletes msg id 1 that was broadcast deleted by bob
alice #$> ( " /_delete item @2 " <> itemId 1 <> " internal " , id , " message deleted " )
2023-04-17 11:18:04 +02:00
alice @@@ [ ( " @bob " , lastChatFeature ) ]
2023-02-01 17:21:13 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures )
-- alice: msg id 1, bob: msg id 3 (quoting message alice deleted locally)
bob ` send ` " > @alice (hello 🙂) do you receive my messages? "
bob <# " @alice > hello 🙂 "
bob <## " do you receive my messages? "
alice <# " bob> > hello 🙂 "
alice <## " do you receive my messages? "
alice @@@ [ ( " @bob " , " do you receive my messages? " ) ]
alice #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 0 , " do you receive my messages? " ) , Just ( 1 , " hello 🙂 " ) ) ] )
alice #$> ( " /_delete item @2 " <> itemId 1 <> " broadcast " , id , " cannot delete this item " )
-- alice: msg id 2, bob: msg id 4
bob #> " @alice how are you? "
alice <# " bob> how are you? "
-- alice: deletes msg id 2
alice #$> ( " /_delete item @2 " <> itemId 2 <> " internal " , id , " message deleted " )
-- bob: marks deleted msg id 4 (that alice deleted locally)
bob #$> ( " /_delete item @2 " <> itemId 4 <> " broadcast " , id , " message marked deleted " )
alice <## " bob> [deleted - original message not found] "
alice @@@ [ ( " @bob " , " do you receive my messages? " ) ]
alice #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 0 , " do you receive my messages? " ) , Just ( 1 , " hello 🙂 " ) ) ] )
bob @@@ [ ( " @alice " , " how are you? [marked deleted] " ) ]
bob #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 0 , " hello 🙂 " ) , Nothing ) , ( ( 1 , " hey alice [marked deleted] " ) , Just ( 0 , " hello 🙂 " ) ) , ( ( 1 , " do you receive my messages? " ) , Just ( 0 , " hello 🙂 " ) ) , ( ( 1 , " how are you? [marked deleted] " ) , Nothing ) ] )
-- bob: deletes msg ids 2,4 (that he has marked deleted)
bob #$> ( " /_delete item @2 " <> itemId 2 <> " internal " , id , " message deleted " )
bob #$> ( " /_delete item @2 " <> itemId 4 <> " internal " , id , " message deleted " )
bob #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 0 , " hello 🙂 " ) , Nothing ) , ( ( 1 , " do you receive my messages? " ) , Just ( 0 , " hello 🙂 " ) ) ] )
testDirectLiveMessage :: HasCallStack => FilePath -> IO ()
testDirectLiveMessage =
testChat2 aliceProfile bobProfile $ \ alice bob -> do
connectUsers alice bob
-- non-empty live message is sent instantly
alice ` send ` " /live @bob hello "
2023-05-15 12:28:53 +02:00
bob <# " alice> [LIVE started] use /show [on/off/6] hello "
2023-02-01 17:21:13 +00:00
alice ##> ( " /_update item @2 " <> itemId 1 <> " text hello there " )
alice <# " @bob [LIVE] hello there "
bob <# " alice> [LIVE ended] hello there "
-- empty live message is also sent instantly
alice ` send ` " /live @bob "
2023-05-15 12:28:53 +02:00
bob <# " alice> [LIVE started] use /show [on/off/7] "
2023-02-01 17:21:13 +00:00
alice ##> ( " /_update item @2 " <> itemId 2 <> " text hello 2 " )
alice <# " @bob [LIVE] hello 2 "
bob <# " alice> [LIVE ended] hello 2 "
2023-05-08 20:07:51 +04:00
-- live message has edit history
2023-05-18 17:52:58 +02:00
alice ##> ( " /_get item info @2 " <> itemId 2 )
2023-05-08 20:07:51 +04:00
alice <##. " sent at: "
alice <## " message history: "
alice .<## " : hello 2 "
alice .<## " : "
2023-05-18 17:52:58 +02:00
bob ##> ( " /_get item info @2 " <> itemId 2 )
2023-05-08 20:07:51 +04:00
bob <##. " sent at: "
bob <##. " received at: "
bob <## " message history: "
bob .<## " : hello 2 "
bob .<## " : "
2023-02-01 17:21:13 +00:00
2023-05-11 16:00:01 +04:00
testDirectTimedMessage :: HasCallStack => FilePath -> IO ()
testDirectTimedMessage =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice ##> " /_send @2 ttl=1 text hello! "
alice <# " @bob hello! "
bob <# " alice> hello! "
alice <## " timed message deleted: hello! "
bob <## " timed message deleted: hello! "
alice ##> " /_send @2 live=off ttl=1 text hey "
alice <# " @bob hey "
bob <# " alice> hey "
alice <## " timed message deleted: hey "
bob <## " timed message deleted: hey "
alice ##> " /_send @2 ttl=default text hello "
alice <# " @bob hello "
bob <# " alice> hello "
alice ##> " /_send @2 live=off text hi "
alice <# " @bob hi "
bob <# " alice> hi "
2023-02-01 17:21:13 +00:00
testRepeatAuthErrorsDisableContact :: HasCallStack => FilePath -> IO ()
testRepeatAuthErrorsDisableContact =
testChat2 aliceProfile bobProfile $ \ alice bob -> do
connectUsers alice bob
alice <##> bob
bob ##> " /d alice "
bob <## " alice: contact is deleted "
forM_ [ 1 .. authErrDisableCount ] $ \ _ -> sendAuth alice
alice <## " [bob] connection is disabled, to enable: /enable bob, to delete: /d bob "
alice ##> " @bob hey "
alice <## " bob: disabled, to enable: /enable bob, to delete: /d bob "
alice ##> " /enable bob "
alice <## " ok "
sendAuth alice
where
sendAuth alice = do
alice #> " @bob hey "
alice <## " [bob, contactId: 2, connId: 1] error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection "
2023-02-18 15:16:50 +00:00
testMultilineMessage :: HasCallStack => FilePath -> IO ()
testMultilineMessage = testChat3 aliceProfile bobProfile cathProfile $ \ alice bob cath -> do
connectUsers alice bob
connectUsers alice cath
alice ` send ` " @bob \ " hello \ \ nthere \ " " -- @bob "hello\nthere"
alice <# " @bob hello "
alice <## " there "
bob <# " alice> hello "
bob <## " there "
alice ` send ` " /feed \ " hello \ \ nthere \ " " -- /feed "hello\nthere"
alice <##. " /feed (2) "
alice <## " there "
bob <# " alice> hello "
bob <## " there "
cath <# " alice> hello "
cath <## " there "
2023-02-01 17:21:13 +00:00
testGetSetSMPServers :: HasCallStack => FilePath -> IO ()
testGetSetSMPServers =
testChat2 aliceProfile bobProfile $
\ alice _ -> do
2023-04-05 21:59:12 +01:00
alice #$> ( " /_servers 1 smp " , id , " smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001 " )
2023-02-01 17:21:13 +00:00
alice #$> ( " /smp smp://1234-w==@smp1.example.im " , id , " ok " )
alice #$> ( " /smp " , id , " smp://1234-w==@smp1.example.im " )
alice #$> ( " /smp smp://1234-w==:password@smp1.example.im " , id , " ok " )
alice #$> ( " /smp " , id , " smp://1234-w==:password@smp1.example.im " )
alice #$> ( " /smp smp://2345-w==@smp2.example.im;smp://3456-w==@smp3.example.im:5224 " , id , " ok " )
2023-05-16 19:37:45 +02:00
alice #$> ( " /smp " , id , " smp://2345-w==@smp2.example.im " )
alice <## " smp://3456-w==@smp3.example.im:5224 "
2023-02-01 17:21:13 +00:00
alice #$> ( " /smp default " , id , " ok " )
alice #$> ( " /smp " , id , " smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001 " )
testTestSMPServerConnection :: HasCallStack => FilePath -> IO ()
testTestSMPServerConnection =
testChat2 aliceProfile bobProfile $
\ alice _ -> do
2023-03-04 22:33:17 +00:00
alice ##> " /smp test smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7001 "
2023-02-01 17:21:13 +00:00
alice <## " SMP server test passed "
-- to test with password:
-- alice <## "SMP server test failed at CreateQueue, error: SMP AUTH"
-- alice <## "Server requires authorization to create queues, check password"
2023-03-04 22:33:17 +00:00
alice ##> " /smp test smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001 "
2023-02-01 17:21:13 +00:00
alice <## " SMP server test passed "
2023-03-04 22:33:17 +00:00
alice ##> " /smp test smp://LcJU@localhost:7001 "
2023-02-01 17:21:13 +00:00
alice <## " SMP server test failed at Connect, error: BROKER smp://LcJU@localhost:7001 NETWORK "
2023-04-05 21:59:12 +01:00
alice <## " Possibly, certificate fingerprint in SMP server address is incorrect "
testGetSetXFTPServers :: HasCallStack => FilePath -> IO ()
testGetSetXFTPServers =
testChat2 aliceProfile bobProfile $
\ alice _ -> withXFTPServer $ do
alice #$> ( " /_servers 1 xftp " , id , " xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002 " )
alice #$> ( " /xftp xftp://1234-w==@xftp1.example.im " , id , " ok " )
alice #$> ( " /xftp " , id , " xftp://1234-w==@xftp1.example.im " )
alice #$> ( " /xftp xftp://1234-w==:password@xftp1.example.im " , id , " ok " )
alice #$> ( " /xftp " , id , " xftp://1234-w==:password@xftp1.example.im " )
alice #$> ( " /xftp xftp://2345-w==@xftp2.example.im;xftp://3456-w==@xftp3.example.im:5224 " , id , " ok " )
2023-05-16 19:37:45 +02:00
alice #$> ( " /xftp " , id , " xftp://2345-w==@xftp2.example.im " )
alice <## " xftp://3456-w==@xftp3.example.im:5224 "
2023-04-05 21:59:12 +01:00
alice #$> ( " /xftp default " , id , " ok " )
alice #$> ( " /xftp " , id , " xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002 " )
testTestXFTPServer :: HasCallStack => FilePath -> IO ()
testTestXFTPServer =
testChat2 aliceProfile bobProfile $
\ alice _ -> withXFTPServer $ do
alice ##> " /xftp test xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7002 "
alice <## " XFTP server test passed "
-- to test with password:
-- alice <## "XFTP server test failed at CreateFile, error: XFTP AUTH"
-- alice <## "Server requires authorization to upload files, check password"
alice ##> " /xftp test xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002 "
alice <## " XFTP server test passed "
alice ##> " /xftp test xftp://LcJU@localhost:7002 "
alice <## " XFTP server test failed at Connect, error: BROKER xftp://LcJU@localhost:7002 NETWORK "
alice <## " Possibly, certificate fingerprint in XFTP server address is incorrect "
2023-02-01 17:21:13 +00:00
testAsyncInitiatingOffline :: HasCallStack => FilePath -> IO ()
testAsyncInitiatingOffline tmp = do
putStrLn " testAsyncInitiatingOffline "
inv <- withNewTestChat tmp " alice " aliceProfile $ \ alice -> do
threadDelay 250000
alice ##> " /c "
getInvitation alice
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
threadDelay 250000
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
withTestChat tmp " alice " $ \ alice -> do
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
testAsyncAcceptingOffline :: HasCallStack => FilePath -> IO ()
testAsyncAcceptingOffline tmp = do
putStrLn " testAsyncAcceptingOffline "
inv <- withNewTestChat tmp " alice " aliceProfile $ \ alice -> do
alice ##> " /c "
getInvitation alice
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
threadDelay 250000
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
withTestChat tmp " alice " $ \ alice -> do
withTestChat tmp " bob " $ \ bob -> do
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
testFullAsync :: HasCallStack => FilePath -> IO ()
testFullAsync tmp = do
putStrLn " testFullAsync "
inv <- withNewTestChat tmp " alice " aliceProfile $ \ alice -> do
threadDelay 250000
alice ##> " /c "
getInvitation alice
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
threadDelay 250000
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
withTestChat tmp " alice " $ \ _ -> pure () -- connecting... notification in UI
withTestChat tmp " bob " $ \ _ -> pure () -- connecting... notification in UI
withTestChat tmp " alice " $ \ alice -> do
alice <## " 1 contacts connected (use /cs for the list) "
alice <## " bob (Bob): contact is connected "
withTestChat tmp " bob " $ \ bob -> do
bob <## " 1 contacts connected (use /cs for the list) "
bob <## " alice (Alice): contact is connected "
testFullAsyncV1 :: HasCallStack => FilePath -> IO ()
testFullAsyncV1 tmp = do
putStrLn " testFullAsyncV1 "
inv <- withNewAlice $ \ alice -> do
putStrLn " 1 "
alice ##> " /c "
putStrLn " 2 "
getInvitation alice
putStrLn " 3 "
withNewBob $ \ bob -> do
putStrLn " 4 "
bob ##> ( " /c " <> inv )
putStrLn " 5 "
bob <## " confirmation sent! "
putStrLn " 6 "
withAlice $ \ _ -> pure ()
putStrLn " 7 "
withBob $ \ _ -> pure ()
putStrLn " 8 "
withAlice $ \ alice -> do
putStrLn " 9 "
alice <## " 1 contacts connected (use /cs for the list) "
putStrLn " 10 "
withBob $ \ _ -> pure ()
putStrLn " 11 "
withAlice $ \ alice -> do
putStrLn " 12 "
alice <## " 1 contacts connected (use /cs for the list) "
putStrLn " 13 "
alice <## " bob (Bob): contact is connected "
putStrLn " 14 "
withBob $ \ bob -> do
putStrLn " 15 "
bob <## " 1 contacts connected (use /cs for the list) "
putStrLn " 16 "
bob <## " alice (Alice): contact is connected "
where
withNewAlice = withNewTestChatV1 tmp " alice " aliceProfile
withAlice = withTestChatV1 tmp " alice "
withNewBob = withNewTestChatV1 tmp " bob " bobProfile
withBob = withTestChatV1 tmp " bob "
testFullAsyncV1toV2 :: HasCallStack => FilePath -> IO ()
testFullAsyncV1toV2 tmp = do
putStrLn " testFullAsyncV1toV2 "
inv <- withNewAlice $ \ alice -> do
putStrLn " 1 "
alice ##> " /c "
putStrLn " 2 "
getInvitation alice
putStrLn " 3 "
withNewBob $ \ bob -> do
putStrLn " 4 "
bob ##> ( " /c " <> inv )
putStrLn " 5 "
bob <## " confirmation sent! "
withAlice $ \ _ -> pure ()
putStrLn " 6 "
withBob $ \ _ -> pure ()
putStrLn " 7 "
withAlice $ \ alice -> do
putStrLn " 8 "
alice <## " 1 contacts connected (use /cs for the list) "
putStrLn " 9 "
withBob $ \ _ -> pure ()
putStrLn " 10 "
withAlice $ \ alice -> do
putStrLn " 11 "
alice <## " 1 contacts connected (use /cs for the list) "
putStrLn " 12 "
alice <## " bob (Bob): contact is connected "
putStrLn " 13 "
withBob $ \ bob -> do
putStrLn " 14 "
bob <## " 1 contacts connected (use /cs for the list) "
putStrLn " 15 "
bob <## " alice (Alice): contact is connected "
where
withNewAlice = withNewTestChat tmp " alice " aliceProfile
withAlice = withTestChat tmp " alice "
withNewBob = withNewTestChatV1 tmp " bob " bobProfile
withBob = withTestChatV1 tmp " bob "
testFullAsyncV2toV1 :: HasCallStack => FilePath -> IO ()
testFullAsyncV2toV1 tmp = do
putStrLn " testFullAsyncV2toV1 "
inv <- withNewAlice $ \ alice -> do
putStrLn " 1 "
alice ##> " /c "
putStrLn " 2 "
getInvitation alice
putStrLn " 3 "
withNewBob $ \ bob -> do
putStrLn " 4 "
bob ##> ( " /c " <> inv )
putStrLn " 5 "
bob <## " confirmation sent! "
putStrLn " 6 "
withAlice $ \ _ -> pure ()
putStrLn " 7 "
withBob $ \ _ -> pure ()
putStrLn " 8 "
withAlice $ \ alice -> do
putStrLn " 9 "
alice <## " 1 contacts connected (use /cs for the list) "
putStrLn " 10 "
withBob $ \ _ -> pure ()
putStrLn " 11 "
withAlice $ \ alice -> do
putStrLn " 12 "
alice <## " 1 contacts connected (use /cs for the list) "
putStrLn " 13 "
alice <## " bob (Bob): contact is connected "
putStrLn " 14 "
withBob $ \ bob -> do
putStrLn " 15 "
bob <## " 1 contacts connected (use /cs for the list) "
putStrLn " 16 "
bob <## " alice (Alice): contact is connected "
where
withNewAlice = withNewTestChatV1 tmp " alice " aliceProfile
{- # INLINE withNewAlice # -}
withAlice = withTestChatV1 tmp " alice "
{- # INLINE withAlice # -}
withNewBob = withNewTestChat tmp " bob " bobProfile
{- # INLINE withNewBob # -}
withBob = withTestChat tmp " bob "
{- # INLINE withBob # -}
testCallType :: CallType
testCallType = CallType { media = CMVideo , capabilities = CallCapabilities { encryption = True } }
testWebRTCSession :: WebRTCSession
testWebRTCSession =
WebRTCSession
{ rtcSession = " {} " ,
rtcIceCandidates = " [] "
}
testWebRTCCallOffer :: WebRTCCallOffer
testWebRTCCallOffer =
WebRTCCallOffer
{ callType = testCallType ,
rtcSession = testWebRTCSession
}
serialize :: ToJSON a => a -> String
serialize = B . unpack . LB . toStrict . J . encode
repeatM_ :: Int -> IO a -> IO ()
repeatM_ n a = forM_ [ 1 .. n ] $ const a
testNegotiateCall :: HasCallStack => FilePath -> IO ()
testNegotiateCall =
testChat2 aliceProfile bobProfile $ \ alice bob -> do
connectUsers alice bob
-- just for testing db query
alice ##> " /_call get "
-- alice invite bob to call
alice ##> ( " /_call invite @2 " <> serialize testCallType )
alice <## " ok "
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " outgoing call: calling... " ) ] )
bob <## " alice wants to connect with you via WebRTC video call (e2e encrypted) "
repeatM_ 3 $ getTermLine bob
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " incoming call: calling... " ) ] )
-- bob accepts call by sending WebRTC offer
bob ##> ( " /_call offer @2 " <> serialize testWebRTCCallOffer )
bob <## " ok "
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " incoming call: accepted " ) ] )
alice <## " bob accepted your WebRTC video call (e2e encrypted) "
repeatM_ 3 $ getTermLine alice
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " outgoing call: accepted " ) ] )
-- alice confirms call by sending WebRTC answer
alice ##> ( " /_call answer @2 " <> serialize testWebRTCSession )
alice <## " ok "
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " outgoing call: connecting... " ) ] )
bob <## " alice continued the WebRTC call "
repeatM_ 3 $ getTermLine bob
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " incoming call: connecting... " ) ] )
-- participants can update calls as connected
alice ##> " /_call status @2 connected "
alice <## " ok "
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " outgoing call: in progress (00:00) " ) ] )
bob ##> " /_call status @2 connected "
bob <## " ok "
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " incoming call: in progress (00:00) " ) ] )
-- either party can end the call
bob ##> " /_call end @2 "
bob <## " ok "
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " incoming call: ended (00:00) " ) ] )
alice <## " call with bob ended "
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " outgoing call: ended (00:00) " ) ] )
testMaintenanceMode :: HasCallStack => FilePath -> IO ()
testMaintenanceMode tmp = do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
withNewTestChatOpts tmp testOpts { maintenance = True } " alice " aliceProfile $ \ alice -> do
alice ##> " /c "
alice <## " error: chat not started "
alice ##> " /_start "
alice <## " chat started "
connectUsers alice bob
alice #> " @bob hi "
bob <# " alice> hi "
alice ##> " /_db export { \ " archivePath \ " : \ " ./tests/tmp/alice-chat.zip \ " } "
alice <## " error: chat not stopped "
alice ##> " /_stop "
alice <## " chat stopped "
alice ##> " /_start "
alice <## " chat started "
-- chat works after start
alice <## " 1 contacts connected (use /cs for the list) "
alice #> " @bob hi again "
bob <# " alice> hi again "
bob #> " @alice hello "
alice <# " bob> hello "
-- export / delete / import
alice ##> " /_stop "
alice <## " chat stopped "
alice ##> " /_db export { \ " archivePath \ " : \ " ./tests/tmp/alice-chat.zip \ " } "
alice <## " ok "
doesFileExist " ./tests/tmp/alice-chat.zip " ` shouldReturn ` True
alice ##> " /_db import { \ " archivePath \ " : \ " ./tests/tmp/alice-chat.zip \ " } "
alice <## " ok "
-- cannot start chat after import
alice ##> " /_start "
alice <## " error: chat store changed, please restart chat "
-- works after full restart
withTestChat tmp " alice " $ \ alice -> testChatWorking alice bob
testChatWorking :: HasCallStack => TestCC -> TestCC -> IO ()
testChatWorking alice bob = do
alice <## " 1 contacts connected (use /cs for the list) "
alice #> " @bob hello again "
bob <# " alice> hello again "
bob #> " @alice hello too "
alice <# " bob> hello too "
testMaintenanceModeWithFiles :: HasCallStack => FilePath -> IO ()
testMaintenanceModeWithFiles tmp = do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
withNewTestChatOpts tmp testOpts { maintenance = True } " alice " aliceProfile $ \ alice -> do
alice ##> " /_start "
alice <## " chat started "
alice ##> " /_files_folder ./tests/tmp/alice_files "
alice <## " ok "
connectUsers alice bob
startFileTransferWithDest' bob alice " test.jpg " " 136.5 KiB / 139737 bytes " Nothing
bob <## " completed sending file 1 (test.jpg) to alice "
alice <## " completed receiving file 1 (test.jpg) from bob "
src <- B . readFile " ./tests/fixtures/test.jpg "
B . readFile " ./tests/tmp/alice_files/test.jpg " ` shouldReturn ` src
threadDelay 500000
alice ##> " /_stop "
alice <## " chat stopped "
alice ##> " /_db export { \ " archivePath \ " : \ " ./tests/tmp/alice-chat.zip \ " } "
alice <## " ok "
alice ##> " /_db delete "
alice <## " ok "
-- cannot start chat after delete
alice ##> " /_start "
alice <## " error: chat store changed, please restart chat "
doesDirectoryExist " ./tests/tmp/alice_files " ` shouldReturn ` False
alice ##> " /_db import { \ " archivePath \ " : \ " ./tests/tmp/alice-chat.zip \ " } "
alice <## " ok "
B . readFile " ./tests/tmp/alice_files/test.jpg " ` shouldReturn ` src
-- works after full restart
withTestChat tmp " alice " $ \ alice -> testChatWorking alice bob
testDatabaseEncryption :: HasCallStack => FilePath -> IO ()
testDatabaseEncryption tmp = do
2023-05-24 16:14:41 +04:00
withNewTestChat tmp " bob " bobProfile $ \ b -> withTestOutput b $ \ bob -> do
withNewTestChatOpts tmp testOpts { maintenance = True } " alice " aliceProfile $ \ a -> withTestOutput a $ \ alice -> do
2023-02-01 17:21:13 +00:00
alice ##> " /_start "
alice <## " chat started "
connectUsers alice bob
alice #> " @bob hi "
bob <# " alice> hi "
alice ##> " /db encrypt mykey "
alice <## " error: chat not stopped "
alice ##> " /db decrypt mykey "
alice <## " error: chat not stopped "
alice ##> " /_stop "
alice <## " chat stopped "
alice ##> " /db decrypt mykey "
alice <## " error: chat database is not encrypted "
alice ##> " /db encrypt mykey "
alice <## " ok "
alice ##> " /_start "
alice <## " error: chat store changed, please restart chat "
2023-05-24 16:14:41 +04:00
withTestChatOpts tmp ( getTestOpts True " mykey " ) " alice " $ \ a -> withTestOutput a $ \ alice -> do
2023-02-01 17:21:13 +00:00
alice ##> " /_start "
alice <## " chat started "
testChatWorking alice bob
alice ##> " /_stop "
alice <## " chat stopped "
alice ##> " /db key wrongkey nextkey "
alice <## " error encrypting database: wrong passphrase or invalid database file "
alice ##> " /db key mykey nextkey "
alice <## " ok "
alice ##> " /_db encryption { \ " currentKey \ " : \ " nextkey \ " , \ " newKey \ " : \ " anotherkey \ " } "
alice <## " ok "
2023-05-24 16:14:41 +04:00
withTestChatOpts tmp ( getTestOpts True " anotherkey " ) " alice " $ \ a -> withTestOutput a $ \ alice -> do
2023-02-01 17:21:13 +00:00
alice ##> " /_start "
alice <## " chat started "
testChatWorking alice bob
alice ##> " /_stop "
alice <## " chat stopped "
alice ##> " /db decrypt anotherkey "
alice <## " ok "
2023-05-24 16:14:41 +04:00
withTestChat tmp " alice " $ \ a -> withTestOutput a $ \ alice -> do
testChatWorking alice bob
2023-02-01 17:21:13 +00:00
testMuteContact :: HasCallStack => FilePath -> IO ()
testMuteContact =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice #> " @bob hello "
bob <# " alice> hello "
2023-03-22 15:58:01 +00:00
bob ##> " /mute @alice "
2023-02-01 17:21:13 +00:00
bob <## " ok "
alice #> " @bob hi "
( bob </ )
bob ##> " /contacts "
bob <## " alice (Alice) (muted, you can /unmute @alice) "
2023-03-22 15:58:01 +00:00
bob ##> " /unmute @alice "
2023-02-01 17:21:13 +00:00
bob <## " ok "
bob ##> " /contacts "
bob <## " alice (Alice) "
alice #> " @bob hi again "
bob <# " alice> hi again "
testMuteGroup :: HasCallStack => FilePath -> IO ()
testMuteGroup =
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
createGroup3 " team " alice bob cath
threadDelay 1000000
alice #> " #team hello! "
concurrently_
( bob <# " #team alice> hello! " )
( cath <# " #team alice> hello! " )
bob ##> " /mute #team "
bob <## " ok "
alice #> " #team hi "
concurrently_
( bob </ )
( cath <# " #team alice> hi " )
bob ##> " /gs "
bob <## " #team (muted, you can /unmute #team) "
bob ##> " /unmute #team "
bob <## " ok "
alice #> " #team hi again "
concurrently_
( bob <# " #team alice> hi again " )
( cath <# " #team alice> hi again " )
bob ##> " /gs "
bob <## " #team "
testCreateSecondUser :: HasCallStack => FilePath -> IO ()
testCreateSecondUser =
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
connectUsers alice bob
alice ##> " /create user alisa "
showActiveUser alice " alisa "
-- connect using second user
connectUsers alice bob
alice #> " @bob hello "
bob <# " alisa> hello "
bob #> " @alisa hey "
alice <# " bob> hey "
alice ##> " /user "
showActiveUser alice " alisa "
alice ##> " /users "
alice <## " alice (Alice) "
alice <## " alisa (active) "
-- receive message to first user
bob #> " @alice hey alice "
( alice , " alice " ) $<# " bob> hey alice "
connectUsers alice cath
-- set active user to first user
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice ##> " /user "
showActiveUser alice " alice (Alice) "
alice ##> " /users "
alice <## " alice (Alice) (active) "
alice <## " alisa "
alice <##> bob
cath #> " @alisa hey alisa "
( alice , " alisa " ) $<# " cath> hey alisa "
alice ##> " @cath hi cath "
alice <## " no contact cath "
-- set active user to second user
alice ##> " /_user 2 "
showActiveUser alice " alisa "
testUsersSubscribeAfterRestart :: HasCallStack => FilePath -> IO ()
testUsersSubscribeAfterRestart tmp = do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
withNewTestChat tmp " alice " aliceProfile $ \ alice -> do
connectUsers alice bob
alice <##> bob
alice ##> " /create user alisa "
showActiveUser alice " alisa "
connectUsers alice bob
alice <##> bob
withTestChat tmp " alice " $ \ alice -> do
-- second user is active
alice <## " 1 contacts connected (use /cs for the list) "
alice <## " [user: alice] 1 contacts connected (use /cs for the list) "
-- second user receives message
alice <##> bob
-- first user receives message
bob #> " @alice hey alice "
( alice , " alice " ) $<# " bob> hey alice "
testMultipleUserAddresses :: HasCallStack => FilePath -> IO ()
testMultipleUserAddresses =
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
alice ##> " /ad "
cLinkAlice <- getContactLink alice True
bob ##> ( " /c " <> cLinkAlice )
alice <#? bob
alice @@@ [ ( " <@bob " , " " ) ]
alice ##> " /ac bob "
alice <## " bob (Bob): accepting contact request... "
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
threadDelay 100000
2023-04-17 11:18:04 +02:00
alice @@@ [ ( " @bob " , lastChatFeature ) ]
2023-02-01 17:21:13 +00:00
alice <##> bob
alice ##> " /create user alisa "
showActiveUser alice " alisa "
-- connect using second user address
alice ##> " /ad "
cLinkAlisa <- getContactLink alice True
bob ##> ( " /c " <> cLinkAlisa )
alice <#? bob
alice #$> ( " /_get chats 2 pcc=on " , chats , [ ( " <@bob " , " " ) ] )
alice ##> " /ac bob "
alice <## " bob (Bob): accepting contact request... "
concurrently_
( bob <## " alisa: contact is connected " )
( alice <## " bob (Bob): contact is connected " )
threadDelay 100000
2023-04-17 11:18:04 +02:00
alice #$> ( " /_get chats 2 pcc=on " , chats , [ ( " @bob " , lastChatFeature ) ] )
2023-02-01 17:21:13 +00:00
alice <##> bob
bob #> " @alice hey alice "
( alice , " alice " ) $<# " bob> hey alice "
-- delete first user address
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice ##> " /da "
alice <## " Your chat address is deleted - accepted contacts will remain connected. "
alice <## " To create a new chat address use /ad "
-- second user receives request when not active
cath ##> ( " /c " <> cLinkAlisa )
cath <## " connection request sent! "
alice <## " [user: alisa] cath (Catherine) wants to connect to you! "
alice <## " to accept: /ac cath "
alice <## " to reject: /rc cath (the sender will NOT be notified) "
-- accept request
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice ##> " /ac cath "
alice <## " cath (Catherine): accepting contact request... "
concurrently_
( cath <## " alisa: contact is connected " )
( alice <## " cath (Catherine): contact is connected " )
threadDelay 100000
2023-04-17 11:18:04 +02:00
alice #$> ( " /_get chats 2 pcc=on " , chats , [ ( " @cath " , lastChatFeature ) , ( " @bob " , " hey " ) ] )
2023-02-01 17:21:13 +00:00
alice <##> cath
-- first user doesn't have cath as contact
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice @@@ [ ( " @bob " , " hey alice " ) ]
testCreateUserDefaultServers :: HasCallStack => FilePath -> IO ()
testCreateUserDefaultServers =
testChat2 aliceProfile bobProfile $
\ alice _ -> do
alice #$> ( " /smp smp://2345-w==@smp2.example.im;smp://3456-w==@smp3.example.im:5224 " , id , " ok " )
2023-05-16 19:37:45 +02:00
alice #$> ( " /smp " , id , " smp://2345-w==@smp2.example.im " )
alice <## " smp://3456-w==@smp3.example.im:5224 "
2023-02-01 17:21:13 +00:00
alice ##> " /create user alisa "
showActiveUser alice " alisa "
alice #$> ( " /smp " , id , " smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001 " )
-- with same_smp=off
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
2023-05-16 19:37:45 +02:00
alice #$> ( " /smp " , id , " smp://2345-w==@smp2.example.im " )
alice <## " smp://3456-w==@smp3.example.im:5224 "
2023-02-01 17:21:13 +00:00
alice ##> " /create user same_smp=off alisa2 "
showActiveUser alice " alisa2 "
alice #$> ( " /smp " , id , " smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001 " )
testCreateUserSameServers :: HasCallStack => FilePath -> IO ()
testCreateUserSameServers =
testChat2 aliceProfile bobProfile $
\ alice _ -> do
alice #$> ( " /smp smp://2345-w==@smp2.example.im;smp://3456-w==@smp3.example.im:5224 " , id , " ok " )
2023-05-16 19:37:45 +02:00
alice #$> ( " /smp " , id , " smp://2345-w==@smp2.example.im " )
alice <## " smp://3456-w==@smp3.example.im:5224 "
2023-02-01 17:21:13 +00:00
alice ##> " /create user same_smp=on alisa "
showActiveUser alice " alisa "
2023-05-16 19:37:45 +02:00
alice #$> ( " /smp " , id , " smp://2345-w==@smp2.example.im " )
alice <## " smp://3456-w==@smp3.example.im:5224 "
2023-02-01 17:21:13 +00:00
testDeleteUser :: HasCallStack => FilePath -> IO ()
testDeleteUser =
testChat4 aliceProfile bobProfile cathProfile danProfile $
\ alice bob cath dan -> do
connectUsers alice bob
-- cannot delete active user
alice ##> " /_delete user 1 del_smp=off "
alice <## " cannot delete active user "
-- delete user without deleting SMP queues
alice ##> " /create user alisa "
showActiveUser alice " alisa "
connectUsers alice cath
alice <##> cath
alice ##> " /users "
alice <## " alice (Alice) "
alice <## " alisa (active) "
alice ##> " /_delete user 1 del_smp=off "
alice <## " ok "
alice ##> " /users "
alice <## " alisa (active) "
bob #> " @alice hey "
-- no connection authorization error - connection wasn't deleted
( alice </ )
-- cannot delete new active user
alice ##> " /delete user alisa "
alice <## " cannot delete active user "
alice ##> " /users "
alice <## " alisa (active) "
alice <##> cath
-- delete user deleting SMP queues
alice ##> " /create user alisa2 "
showActiveUser alice " alisa2 "
connectUsers alice dan
alice <##> dan
alice ##> " /users "
alice <## " alisa "
alice <## " alisa2 (active) "
alice ##> " /delete user alisa "
alice <### [ " ok " , " completed deleting user " ]
alice ##> " /users "
alice <## " alisa2 (active) "
cath #> " @alisa hey "
cath <## " [alisa, contactId: 2, connId: 1] error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection "
( alice </ )
alice <##> dan
testUsersDifferentCIExpirationTTL :: HasCallStack => FilePath -> IO ()
testUsersDifferentCIExpirationTTL tmp = do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
withNewTestChatCfg tmp cfg " alice " aliceProfile $ \ alice -> do
-- first user messages
connectUsers alice bob
alice #> " @bob alice 1 "
bob <# " alice> alice 1 "
bob #> " @alice alice 2 "
alice <# " bob> alice 2 "
-- second user messages
alice ##> " /create user alisa "
showActiveUser alice " alisa "
connectUsers alice bob
alice #> " @bob alisa 1 "
bob <# " alisa> alisa 1 "
bob #> " @alisa alisa 2 "
alice <# " bob> alisa 2 "
-- set ttl for first user
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /_ttl 1 1 " , id , " ok " )
-- set ttl for second user
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /_ttl 2 3 " , id , " ok " )
-- first user messages
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /ttl " , id , " old messages are set to be deleted after: 1 second(s) " )
alice #> " @bob alice 3 "
bob <# " alice> alice 3 "
bob #> " @alice alice 4 "
alice <# " bob> alice 4 "
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " alice 1 " ) , ( 0 , " alice 2 " ) , ( 1 , " alice 3 " ) , ( 0 , " alice 4 " ) ] )
-- second user messages
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /ttl " , id , " old messages are set to be deleted after: 3 second(s) " )
alice #> " @bob alisa 3 "
bob <# " alisa> alisa 3 "
bob #> " @alisa alisa 4 "
alice <# " bob> alisa 4 "
alice #$> ( " /_get chat @4 count=100 " , chat , chatFeatures <> [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) , ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
threadDelay 2000000
-- messages both before and after setting chat item ttl are deleted
-- first user messages
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /_get chat @2 count=100 " , chat , [] )
-- second user messages
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /_get chat @4 count=100 " , chat , chatFeatures <> [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) , ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
threadDelay 2000000
alice #$> ( " /_get chat @4 count=100 " , chat , [] )
where
2023-05-29 15:18:22 +04:00
cfg = testCfg { initialCleanupManagerDelay = 0 , ciExpirationInterval = 500000 }
2023-02-01 17:21:13 +00:00
testUsersRestartCIExpiration :: HasCallStack => FilePath -> IO ()
testUsersRestartCIExpiration tmp = do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
withNewTestChatCfg tmp cfg " alice " aliceProfile $ \ alice -> do
-- set ttl for first user
2023-05-24 16:14:41 +04:00
alice #$> ( " /_ttl 1 2 " , id , " ok " )
2023-02-01 17:21:13 +00:00
connectUsers alice bob
-- create second user and set ttl
alice ##> " /create user alisa "
showActiveUser alice " alisa "
2023-05-24 16:14:41 +04:00
alice #$> ( " /_ttl 2 5 " , id , " ok " )
2023-02-01 17:21:13 +00:00
connectUsers alice bob
-- first user messages
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #> " @bob alice 1 "
bob <# " alice> alice 1 "
bob #> " @alice alice 2 "
alice <# " bob> alice 2 "
-- second user messages
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #> " @bob alisa 1 "
bob <# " alisa> alisa 1 "
bob #> " @alisa alisa 2 "
alice <# " bob> alisa 2 "
-- first user will be active on restart
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
withTestChatCfg tmp cfg " alice " $ \ alice -> do
alice <## " 1 contacts connected (use /cs for the list) "
alice <## " [user: alisa] 1 contacts connected (use /cs for the list) "
-- first user messages
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
2023-05-24 16:14:41 +04:00
alice #$> ( " /ttl " , id , " old messages are set to be deleted after: 2 second(s) " )
2023-02-01 17:21:13 +00:00
alice #> " @bob alice 3 "
bob <# " alice> alice 3 "
bob #> " @alice alice 4 "
alice <# " bob> alice 4 "
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " alice 1 " ) , ( 0 , " alice 2 " ) , ( 1 , " alice 3 " ) , ( 0 , " alice 4 " ) ] )
-- second user messages
alice ##> " /user alisa "
showActiveUser alice " alisa "
2023-05-24 16:14:41 +04:00
alice #$> ( " /ttl " , id , " old messages are set to be deleted after: 5 second(s) " )
2023-02-01 17:21:13 +00:00
alice #> " @bob alisa 3 "
bob <# " alisa> alisa 3 "
bob #> " @alisa alisa 4 "
alice <# " bob> alisa 4 "
alice #$> ( " /_get chat @4 count=100 " , chat , chatFeatures <> [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) , ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
2023-05-24 16:14:41 +04:00
threadDelay 3000000
2023-02-01 17:21:13 +00:00
-- messages both before and after restart are deleted
-- first user messages
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /_get chat @2 count=100 " , chat , [] )
-- second user messages
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /_get chat @4 count=100 " , chat , chatFeatures <> [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) , ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
2023-05-24 16:14:41 +04:00
threadDelay 3000000
2023-02-01 17:21:13 +00:00
alice #$> ( " /_get chat @4 count=100 " , chat , [] )
where
2023-05-29 15:18:22 +04:00
cfg = testCfg { initialCleanupManagerDelay = 0 , ciExpirationInterval = 500000 }
2023-02-01 17:21:13 +00:00
testEnableCIExpirationOnlyForOneUser :: HasCallStack => FilePath -> IO ()
testEnableCIExpirationOnlyForOneUser tmp = do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
withNewTestChatCfg tmp cfg " alice " aliceProfile $ \ alice -> do
-- first user messages
connectUsers alice bob
alice #> " @bob alice 1 "
bob <# " alice> alice 1 "
bob #> " @alice alice 2 "
alice <# " bob> alice 2 "
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " alice 1 " ) , ( 0 , " alice 2 " ) ] )
-- second user messages before first user sets ttl
alice ##> " /create user alisa "
showActiveUser alice " alisa "
connectUsers alice bob
alice #> " @bob alisa 1 "
bob <# " alisa> alisa 1 "
bob #> " @alisa alisa 2 "
alice <# " bob> alisa 2 "
-- set ttl for first user
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /_ttl 1 1 " , id , " ok " )
-- second user messages after first user sets ttl
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #> " @bob alisa 3 "
bob <# " alisa> alisa 3 "
bob #> " @alisa alisa 4 "
alice <# " bob> alisa 4 "
alice #$> ( " /_get chat @4 count=100 " , chat , chatFeatures <> [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) , ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
threadDelay 2000000
-- messages are deleted for first user
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /_get chat @2 count=100 " , chat , [] )
-- messages are not deleted for second user
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /_get chat @4 count=100 " , chat , chatFeatures <> [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) , ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
withTestChatCfg tmp cfg " alice " $ \ alice -> do
alice <## " 1 contacts connected (use /cs for the list) "
alice <## " [user: alice] 1 contacts connected (use /cs for the list) "
-- messages are not deleted for second user after restart
alice #$> ( " /_get chat @4 count=100 " , chat , chatFeatures <> [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) , ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
alice #> " @bob alisa 5 "
bob <# " alisa> alisa 5 "
bob #> " @alisa alisa 6 "
alice <# " bob> alisa 6 "
threadDelay 2000000
-- new messages are not deleted for second user
alice #$> ( " /_get chat @4 count=100 " , chat , chatFeatures <> [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) , ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) , ( 1 , " alisa 5 " ) , ( 0 , " alisa 6 " ) ] )
where
2023-05-29 15:18:22 +04:00
cfg = testCfg { initialCleanupManagerDelay = 0 , ciExpirationInterval = 500000 }
2023-02-01 17:21:13 +00:00
testDisableCIExpirationOnlyForOneUser :: HasCallStack => FilePath -> IO ()
testDisableCIExpirationOnlyForOneUser tmp = do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
withNewTestChatCfg tmp cfg " alice " aliceProfile $ \ alice -> do
-- set ttl for first user
alice #$> ( " /_ttl 1 1 " , id , " ok " )
connectUsers alice bob
-- create second user and set ttl
alice ##> " /create user alisa "
showActiveUser alice " alisa "
alice #$> ( " /_ttl 2 1 " , id , " ok " )
connectUsers alice bob
-- first user disables expiration
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /ttl none " , id , " ok " )
alice #$> ( " /ttl " , id , " old messages are not being deleted " )
-- second user still has ttl configured
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /ttl " , id , " old messages are set to be deleted after: 1 second(s) " )
alice #> " @bob alisa 1 "
bob <# " alisa> alisa 1 "
bob #> " @alisa alisa 2 "
alice <# " bob> alisa 2 "
alice #$> ( " /_get chat @4 count=100 " , chat , chatFeatures <> [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) ] )
threadDelay 2000000
-- second user messages are deleted
alice #$> ( " /_get chat @4 count=100 " , chat , [] )
withTestChatCfg tmp cfg " alice " $ \ alice -> do
alice <## " 1 contacts connected (use /cs for the list) "
alice <## " [user: alice] 1 contacts connected (use /cs for the list) "
-- second user still has ttl configured after restart
alice #$> ( " /ttl " , id , " old messages are set to be deleted after: 1 second(s) " )
alice #> " @bob alisa 3 "
bob <# " alisa> alisa 3 "
bob #> " @alisa alisa 4 "
alice <# " bob> alisa 4 "
alice #$> ( " /_get chat @4 count=100 " , chat , [ ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
threadDelay 2000000
-- second user messages are deleted
alice #$> ( " /_get chat @4 count=100 " , chat , [] )
where
2023-05-29 15:18:22 +04:00
cfg = testCfg { initialCleanupManagerDelay = 0 , ciExpirationInterval = 500000 }
2023-02-01 17:21:13 +00:00
testUsersTimedMessages :: HasCallStack => FilePath -> IO ()
testUsersTimedMessages tmp = do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
withNewTestChat tmp " alice " aliceProfile $ \ alice -> do
connectUsers alice bob
configureTimedMessages alice bob " 2 " " 1 "
-- create second user and configure timed messages for contact
alice ##> " /create user alisa "
showActiveUser alice " alisa "
connectUsers alice bob
configureTimedMessages alice bob " 4 " " 2 "
-- first user messages
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #> " @bob alice 1 "
bob <# " alice> alice 1 "
bob #> " @alice alice 2 "
alice <# " bob> alice 2 "
-- second user messages
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #> " @bob alisa 1 "
bob <# " alisa> alisa 1 "
bob #> " @alisa alisa 2 "
alice <# " bob> alisa 2 "
-- messages are deleted after ttl
threadDelay 500000
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /_get chat @2 count=100 " , chat , [ ( 1 , " alice 1 " ) , ( 0 , " alice 2 " ) ] )
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /_get chat @4 count=100 " , chat , [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) ] )
threadDelay 1000000
2023-02-08 07:08:53 +00:00
alice <## " [user: alice] timed message deleted: alice 1 "
alice <## " [user: alice] timed message deleted: alice 2 "
bob <## " timed message deleted: alice 1 "
bob <## " timed message deleted: alice 2 "
2023-02-01 17:21:13 +00:00
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /_get chat @2 count=100 " , chat , [] )
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /_get chat @4 count=100 " , chat , [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) ] )
threadDelay 1000000
2023-02-08 07:08:53 +00:00
alice <## " timed message deleted: alisa 1 "
alice <## " timed message deleted: alisa 2 "
bob <## " timed message deleted: alisa 1 "
bob <## " timed message deleted: alisa 2 "
2023-02-01 17:21:13 +00:00
alice ##> " /user "
showActiveUser alice " alisa "
alice #$> ( " /_get chat @4 count=100 " , chat , [] )
-- first user messages
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #> " @bob alice 3 "
bob <# " alice> alice 3 "
bob #> " @alice alice 4 "
alice <# " bob> alice 4 "
-- second user messages
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #> " @bob alisa 3 "
bob <# " alisa> alisa 3 "
bob #> " @alisa alisa 4 "
alice <# " bob> alisa 4 "
withTestChat tmp " alice " $ \ alice -> do
alice <## " 1 contacts connected (use /cs for the list) "
alice <## " [user: alice] 1 contacts connected (use /cs for the list) "
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /_get chat @2 count=100 " , chat , [ ( 1 , " alice 3 " ) , ( 0 , " alice 4 " ) ] )
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /_get chat @4 count=100 " , chat , [ ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
-- messages are deleted after restart
threadDelay 1000000
2023-02-08 07:08:53 +00:00
alice <## " [user: alice] timed message deleted: alice 3 "
alice <## " [user: alice] timed message deleted: alice 4 "
bob <## " timed message deleted: alice 3 "
bob <## " timed message deleted: alice 4 "
2023-02-01 17:21:13 +00:00
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /_get chat @2 count=100 " , chat , [] )
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /_get chat @4 count=100 " , chat , [ ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
threadDelay 1000000
2023-02-08 07:08:53 +00:00
alice <## " timed message deleted: alisa 3 "
alice <## " timed message deleted: alisa 4 "
bob <## " timed message deleted: alisa 3 "
bob <## " timed message deleted: alisa 4 "
2023-02-01 17:21:13 +00:00
alice ##> " /user "
showActiveUser alice " alisa "
alice #$> ( " /_get chat @4 count=100 " , chat , [] )
where
configureTimedMessages :: HasCallStack => TestCC -> TestCC -> String -> String -> IO ()
configureTimedMessages alice bob bobId ttl = do
aliceName <- userName alice
alice ##> ( " /_set prefs @ " <> bobId <> " { \ " timedMessages \ " : { \ " allow \ " : \ " yes \ " , \ " ttl \ " : " <> ttl <> " }} " )
alice <## " you updated preferences for bob: "
2023-04-17 19:13:10 +02:00
alice <## ( " Disappearing messages: enabled (you allow: yes ( " <> ttl <> " sec), contact allows: yes) " )
2023-02-01 17:21:13 +00:00
bob <## ( aliceName <> " updated preferences for you: " )
bob <## ( " Disappearing messages: enabled (you allow: yes ( " <> ttl <> " sec), contact allows: yes ( " <> ttl <> " sec)) " )
alice #$> ( " /clear bob " , id , " bob: all messages are removed locally ONLY " ) -- to remove feature items
2023-03-22 15:58:01 +00:00
testUserPrivacy :: HasCallStack => FilePath -> IO ()
testUserPrivacy =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice ##> " /create user alisa "
showActiveUser alice " alisa "
-- connect using second user
connectUsers alice bob
2023-04-27 09:12:34 +02:00
threadDelay 1000000
2023-03-22 15:58:01 +00:00
alice #> " @bob hello "
2023-04-27 09:12:34 +02:00
threadDelay 1000000
2023-03-22 15:58:01 +00:00
bob <# " alisa> hello "
bob #> " @alisa hey "
alice <# " bob> hey "
-- hide user profile
alice ##> " /hide user my_password "
2023-03-29 17:39:04 +01:00
userHidden alice " current "
2023-03-22 15:58:01 +00:00
-- shows messages when active
bob #> " @alisa hello again "
alice <# " bob> hello again "
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
-- does not show messages to user
bob #> " @alisa this won't show "
( alice </ )
-- does not show hidden user
alice ##> " /users "
alice <## " alice (Alice) (active) "
( alice </ )
-- requires password to switch to the user
alice ##> " /user alisa "
alice <## " user does not exist or incorrect password "
alice ##> " /user alisa wrong_password "
alice <## " user does not exist or incorrect password "
alice ##> " /user alisa my_password "
showActiveUser alice " alisa "
-- shows hidden user when active
alice ##> " /users "
alice <## " alice (Alice) "
alice <## " alisa (active, hidden, muted) "
-- hidden message is saved
alice ##> " /tail "
2023-04-27 09:12:34 +02:00
alice <##? chatHistory
alice ##> " /_get items count=10 "
alice <##? chatHistory
2023-05-15 12:28:53 +02:00
alice ##> " /_get items before=11 count=10 "
2023-03-22 15:58:01 +00:00
alice
2023-04-17 19:13:10 +02:00
<##? [ " bob> Disappearing messages: allowed " ,
2023-03-22 15:58:01 +00:00
" bob> Full deletion: off " ,
2023-05-15 12:28:53 +02:00
" bob> Message reactions: enabled " ,
2023-03-22 15:58:01 +00:00
" bob> Voice messages: enabled " ,
2023-04-27 09:12:34 +02:00
" bob> Audio/video calls: enabled "
]
2023-05-15 12:28:53 +02:00
alice ##> " /_get items after=10 count=10 "
2023-04-27 09:12:34 +02:00
alice
<##? [ " @bob hello " ,
2023-03-22 15:58:01 +00:00
" bob> hey " ,
" bob> hello again " ,
" bob> this won't show "
]
-- change profile password
alice ##> " /unmute user "
2023-03-29 19:28:06 +01:00
alice <## " hidden user always muted when inactive "
2023-03-22 15:58:01 +00:00
alice ##> " /hide user password "
alice <## " user is already hidden "
2023-03-29 19:28:06 +01:00
alice ##> " /unhide user wrong_password "
alice <## " user does not exist or incorrect password "
alice ##> " /unhide user my_password "
2023-03-29 17:39:04 +01:00
userVisible alice " current "
2023-03-22 15:58:01 +00:00
alice ##> " /hide user new_password "
2023-03-29 17:39:04 +01:00
userHidden alice " current "
2023-03-22 15:58:01 +00:00
alice ##> " /_delete user 1 del_smp=on "
alice <## " cannot delete last user "
alice ##> " /_hide user 1 \ " password \ " "
alice <## " cannot hide the only not hidden user "
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
-- change profile privacy for inactive user via API requires correct password
alice ##> " /_unmute user 2 "
2023-03-29 19:28:06 +01:00
alice <## " hidden user always muted when inactive "
2023-03-22 15:58:01 +00:00
alice ##> " /_hide user 2 \ " password \ " "
alice <## " user is already hidden "
alice ##> " /_unhide user 2 \ " wrong_password \ " "
alice <## " user does not exist or incorrect password "
alice ##> " /_unhide user 2 \ " new_password \ " "
2023-03-29 17:39:04 +01:00
userVisible alice " "
2023-03-22 15:58:01 +00:00
alice ##> " /_hide user 2 \ " another_password \ " "
2023-03-29 17:39:04 +01:00
userHidden alice " "
2023-03-22 15:58:01 +00:00
alice ##> " /user alisa another_password "
showActiveUser alice " alisa "
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice ##> " /_delete user 2 del_smp=on "
alice <## " user does not exist or incorrect password "
alice ##> " /_delete user 2 del_smp=on \ " wrong_password \ " "
alice <## " user does not exist or incorrect password "
alice ##> " /_delete user 2 del_smp=on \ " another_password \ " "
alice <## " ok "
alice <## " completed deleting user "
where
2023-03-29 17:39:04 +01:00
userHidden alice current = do
alice <## ( current <> " user alisa: " )
alice <## " messages are hidden (use /tail to view) "
alice <## " profile is hidden "
userVisible alice current = do
alice <## ( current <> " user alisa: " )
alice <## " messages are shown "
alice <## " profile is visible "
2023-04-27 09:12:34 +02:00
chatHistory =
[ " bob> Disappearing messages: allowed " ,
" bob> Full deletion: off " ,
2023-05-15 12:28:53 +02:00
" bob> Message reactions: enabled " ,
2023-04-27 09:12:34 +02:00
" bob> Voice messages: enabled " ,
" bob> Audio/video calls: enabled " ,
" @bob hello " ,
" bob> hey " ,
" bob> hello again " ,
" bob> this won't show "
]
2023-03-22 15:58:01 +00:00
2023-02-01 17:21:13 +00:00
testSetChatItemTTL :: HasCallStack => FilePath -> IO ()
testSetChatItemTTL =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice #> " @bob 1 "
bob <# " alice> 1 "
bob #> " @alice 2 "
alice <# " bob> 2 "
-- chat item with file
alice #$> ( " /_files_folder ./tests/tmp/app_files " , id , " ok " )
copyFile " ./tests/fixtures/test.jpg " " ./tests/tmp/app_files/test.jpg "
alice ##> " /_send @2 json { \ " filePath \ " : \ " test.jpg \ " , \ " msgContent \ " : { \ " text \ " : \ " \ " , \ " type \ " : \ " image \ " , \ " image \ " : \ " data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII= \ " }} "
alice <# " /f @bob test.jpg "
alice <## " use /fc 1 to cancel sending "
bob <# " alice> sends file test.jpg (136.5 KiB / 139737 bytes) "
bob <## " use /fr 1 [<dir>/ | <path>] to receive it "
-- above items should be deleted after we set ttl
threadDelay 3000000
alice #> " @bob 3 "
bob <# " alice> 3 "
bob #> " @alice 4 "
alice <# " bob> 4 "
alice #$> ( " /_get chat @2 count=100 " , chatF , chatFeaturesF <> [ ( ( 1 , " 1 " ) , Nothing ) , ( ( 0 , " 2 " ) , Nothing ) , ( ( 1 , " " ) , Just " test.jpg " ) , ( ( 1 , " 3 " ) , Nothing ) , ( ( 0 , " 4 " ) , Nothing ) ] )
checkActionDeletesFile " ./tests/tmp/app_files/test.jpg " $
alice #$> ( " /_ttl 1 2 " , id , " ok " )
alice #$> ( " /_get chat @2 count=100 " , chat , [ ( 1 , " 3 " ) , ( 0 , " 4 " ) ] ) -- when expiration is turned on, first cycle is synchronous
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " 1 " ) , ( 1 , " 2 " ) , ( 0 , " " ) , ( 0 , " 3 " ) , ( 1 , " 4 " ) ] )
alice #$> ( " /_ttl 1 " , id , " old messages are set to be deleted after: 2 second(s) " )
alice #$> ( " /ttl week " , id , " ok " )
alice #$> ( " /ttl " , id , " old messages are set to be deleted after: one week " )
alice #$> ( " /ttl none " , id , " ok " )
alice #$> ( " /ttl " , id , " old messages are not being deleted " )
testSwitchContact :: HasCallStack => FilePath -> IO ()
testSwitchContact =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice #$> ( " /switch bob " , id , " ok " )
bob <## " alice started changing address for you "
alice <## " bob: you started changing address "
bob <## " alice changed address for you "
alice <## " bob: you changed address "
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " started changing address... " ) , ( 1 , " you changed address " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " started changing address for you... " ) , ( 0 , " changed address for you " ) ] )
alice <##> bob
testSwitchGroupMember :: HasCallStack => FilePath -> IO ()
testSwitchGroupMember =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
createGroup2 " team " alice bob
alice #$> ( " /switch #team bob " , id , " ok " )
bob <## " #team: alice started changing address for you "
alice <## " #team: you started changing address for bob "
bob <## " #team: alice changed address for you "
alice <## " #team: you changed address for bob "
alice #$> ( " /_get chat #1 count=100 " , chat , [ ( 0 , " connected " ) , ( 1 , " started changing address for bob... " ) , ( 1 , " you changed address for bob " ) ] )
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) , ( 0 , " started changing address for you... " ) , ( 0 , " changed address for you " ) ] )
alice #> " #team hey "
bob <# " #team alice> hey "
bob #> " #team hi "
alice <# " #team bob> hi "
testMarkContactVerified :: HasCallStack => FilePath -> IO ()
testMarkContactVerified =
testChat2 aliceProfile bobProfile $ \ alice bob -> do
connectUsers alice bob
alice ##> " /i bob "
bobInfo alice
alice <## " connection not verified, use /code command to see security code "
alice ##> " /code bob "
bCode <- getTermLine alice
bob ##> " /code alice "
aCode <- getTermLine bob
bCode ` shouldBe ` aCode
alice ##> " /verify bob 123 "
alice <##. " connection not verified, current code is "
alice ##> ( " /verify bob " <> aCode )
alice <## " connection verified "
alice ##> " /i bob "
bobInfo alice
alice <## " connection verified "
alice ##> " /verify bob "
alice <##. " connection not verified, current code is "
alice ##> " /i bob "
bobInfo alice
alice <## " connection not verified, use /code command to see security code "
where
bobInfo :: HasCallStack => TestCC -> IO ()
bobInfo alice = do
alice <## " contact ID: 2 "
alice <## " receiving messages via: localhost "
alice <## " sending messages via: localhost "
alice <## " you've shared main profile with this contact "
testMarkGroupMemberVerified :: HasCallStack => FilePath -> IO ()
testMarkGroupMemberVerified =
testChat2 aliceProfile bobProfile $ \ alice bob -> do
createGroup2 " team " alice bob
alice ##> " /i #team bob "
bobInfo alice
alice <## " connection not verified, use /code command to see security code "
alice ##> " /code #team bob "
bCode <- getTermLine alice
bob ##> " /code #team alice "
aCode <- getTermLine bob
bCode ` shouldBe ` aCode
alice ##> " /verify #team bob 123 "
alice <##. " connection not verified, current code is "
alice ##> ( " /verify #team bob " <> aCode )
alice <## " connection verified "
alice ##> " /i #team bob "
bobInfo alice
alice <## " connection verified "
alice ##> " /verify #team bob "
alice <##. " connection not verified, current code is "
alice ##> " /i #team bob "
bobInfo alice
alice <## " connection not verified, use /code command to see security code "
where
bobInfo :: HasCallStack => TestCC -> IO ()
bobInfo alice = do
alice <## " group ID: 1 "
alice <## " member ID: 2 "
alice <## " receiving messages via: localhost "
alice <## " sending messages via: localhost "
2023-04-16 12:35:45 +02:00
testMsgDecryptError :: HasCallStack => FilePath -> IO ()
testMsgDecryptError tmp =
withNewTestChat tmp " alice " aliceProfile $ \ alice -> do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
connectUsers alice bob
alice #> " @bob hi "
bob <# " alice> hi "
bob #> " @alice hey "
alice <# " bob> hey "
copyDb " bob " " bob_old "
withTestChat tmp " bob " $ \ bob -> do
bob <## " 1 contacts connected (use /cs for the list) "
alice #> " @bob hello "
bob <# " alice> hello "
bob #> " @alice hello too "
alice <# " bob> hello too "
withTestChat tmp " bob_old " $ \ bob -> do
bob <## " 1 contacts connected (use /cs for the list) "
alice #> " @bob 1 "
bob <# " alice> decryption error, possibly due to the device change (header) "
alice #> " @bob 2 "
alice #> " @bob 3 "
( bob </ )
bob ##> " /tail @alice 1 "
bob <# " alice> decryption error, possibly due to the device change (header, 3 messages) "
bob #> " @alice 1 "
alice <# " bob> decryption error, possibly due to the device change (header) "
bob #> " @alice 2 "
bob #> " @alice 3 "
( alice </ )
alice ##> " /tail @bob 1 "
alice <# " bob> decryption error, possibly due to the device change (header, 3 messages) "
alice #> " @bob 4 "
bob <# " alice> decryption error, possibly due to the device change (header) "
withTestChat tmp " bob " $ \ bob -> do
bob <## " 1 contacts connected (use /cs for the list) "
alice #> " @bob hello again "
bob <# " alice> skipped message ID 5..8 "
bob <# " alice> hello again "
bob #> " @alice received! "
alice <# " bob> received! "
where
copyDb from to = do
copyFile ( chatStoreFile $ tmp </> from ) ( chatStoreFile $ tmp </> to )
copyFile ( agentStoreFile $ tmp </> from ) ( agentStoreFile $ tmp </> to )
2023-05-15 12:28:53 +02:00
testSetMessageReactions :: HasCallStack => FilePath -> IO ()
testSetMessageReactions =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice #> " @bob hi "
bob <# " alice> hi "
bob ##> " +1 alice hi "
bob <## " added 👍 "
alice <# " bob> >> hi "
alice <## " + 👍 "
bob ##> " +1 alice hi "
bob <## " bad chat command: reaction already added "
bob ##> " +^ alice hi "
bob <## " added 🚀 "
alice <# " bob> >> hi "
alice <## " + 🚀 "
alice ##> " /tail @bob 1 "
alice <# " @bob hi "
alice <## " 👍 1 🚀 1 "
bob ##> " /tail @alice 1 "
bob <# " alice> hi "
bob <## " 👍 1 🚀 1 "
alice ##> " +1 bob hi "
alice <## " added 👍 "
bob <# " alice> > hi "
bob <## " + 👍 "
alice ##> " /tail @bob 1 "
alice <# " @bob hi "
alice <## " 👍 2 🚀 1 "
bob ##> " /tail @alice 1 "
bob <# " alice> hi "
bob <## " 👍 2 🚀 1 "
bob ##> " -1 alice hi "
bob <## " removed 👍 "
alice <# " bob> >> hi "
alice <## " - 👍 "
bob ##> " -^ alice hi "
bob <## " removed 🚀 "
alice <# " bob> >> hi "
alice <## " - 🚀 "
alice ##> " /tail @bob 1 "
alice <# " @bob hi "
alice <## " 👍 1 "
bob ##> " /tail @alice 1 "
bob <# " alice> hi "
bob <## " 👍 1 "