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