lovely-projects/simplex-chat
lovely-projects/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2025-03-14 09:45:42 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

test: track query plans (#5566)

Browse source 
* test: track query plans

* all query plans

* fix postgres build
This commit is contained in:
Evgeny 2025-01-24 09:44:53 +00:00 • committed by GitHub
parent 9ccea0dc50
commit f3664619ec
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
25 changed files with 7009 additions and 897 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
cabal.project
View file

@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
source-repository-package
type: git
location: https://github.com/simplex-chat/simplexmq.git
tag: 23189753751dc52046865ce2d992335495020e91
tag: 268a1303acbad1644f81cd3b2def5754e5e2c052
source-repository-package
type: git

7
simplex-chat.cabal
View file

@ -446,6 +446,7 @@ test-suite simplex-chat-test
ChatTests
ChatTests.ChatList
ChatTests.Direct
ChatTests.DBUtils
ChatTests.Files
ChatTests.Forward
ChatTests.Groups
@ -470,8 +471,12 @@ test-suite simplex-chat-test
Directory.Service
Directory.Store
Paths_simplex_chat
if !flag(client_postgres)
if flag(client_postgres)
other-modules:
ChatTests.DBUtils.Postgres
else
other-modules:
ChatTests.DBUtils.SQLite
MobileTests
SchemaDump
WebRTCTests

5
src/Simplex/Chat/Mobile.hs
View file

@ -16,7 +16,6 @@ import Control.Monad.Reader
import qualified Data.Aeson as J
import qualified Data.Aeson.TH as JQ
import Data.Bifunctor (first)
import Data.ByteArray (ScrubbedBytes)
import qualified Data.ByteString.Base64.URL as U
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
@ -57,8 +56,10 @@ import Simplex.Messaging.Util (catchAll, liftEitherWith, safeDecodeUtf8)
import System.IO (utf8)
import System.Timeout (timeout)
#if !defined(dbPostgres)
import Data.ByteArray (ScrubbedBytes)
import Database.SQLite.Simple (SQLError (..))
import qualified Database.SQLite.Simple as DB
import qualified Simplex.Messaging.Agent.Store.DB as DB
#endif
data DBMigrationResult
@ -237,7 +238,7 @@ getActiveUser_ st = find activeUser <$> withTransaction st getUsers
-- only used in tests
chatMigrateInit :: String -> ScrubbedBytes -> String -> IO (Either DBMigrationResult ChatController)
chatMigrateInit dbFilePrefix dbKey confirm = do
let chatDBOpts = ChatDbOpts {dbFilePrefix, dbKey, vacuumOnMigration = True}
let chatDBOpts = ChatDbOpts {dbFilePrefix, dbKey, trackQueries = DB.TQSlow 5000, vacuumOnMigration = True}
chatMigrateInitKey chatDBOpts False confirm False
#endif

22
src/Simplex/Chat/Options/SQLite.hs
View file

@ -2,6 +2,7 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
module Simplex.Chat.Options.SQLite where
@ -11,11 +12,13 @@ import qualified Data.ByteString.Char8 as B
import Foreign.C.String
import Options.Applicative
import Simplex.Messaging.Agent.Store.Interface (DBOpts (..))
import Simplex.Messaging.Agent.Store.SQLite.DB (TrackQueries (..))
import System.FilePath (combine)
data ChatDbOpts = ChatDbOpts
{ dbFilePrefix :: String,
dbKey :: ScrubbedBytes,
trackQueries :: TrackQueries,
vacuumOnMigration :: Bool
}
@ -43,17 +46,24 @@ chatDbOptsP appDir defaultDbName = do
( long "disable-vacuum"
<> help "Do not vacuum database after migrations"
)
pure ChatDbOpts {dbFilePrefix, dbKey, vacuumOnMigration = not disableVacuum}
pure
ChatDbOpts
{ dbFilePrefix,
dbKey,
trackQueries = TQSlow 5000, -- 5ms
vacuumOnMigration = not disableVacuum
}
dbString :: ChatDbOpts -> String
dbString ChatDbOpts {dbFilePrefix} = dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
toDBOpts :: ChatDbOpts -> String -> Bool -> DBOpts
toDBOpts ChatDbOpts {dbFilePrefix, dbKey, vacuumOnMigration} dbSuffix keepKey = do
toDBOpts ChatDbOpts {dbFilePrefix, dbKey, trackQueries, vacuumOnMigration} dbSuffix keepKey = do
DBOpts
{ dbFilePath = dbFilePrefix <> dbSuffix,
dbKey,
keepKey,
track = trackQueries,
vacuum = vacuumOnMigration
}
@ -71,18 +81,14 @@ mobileDbOpts fp key = do
ChatDbOpts
{ dbFilePrefix,
dbKey,
trackQueries = TQSlow 5000, -- 5ms
vacuumOnMigration = True
}
-- used to create new chat controller,
-- at that point database is already opened, and the key in options is not used
removeDbKey :: ChatDbOpts -> ChatDbOpts
removeDbKey ChatDbOpts {dbFilePrefix, vacuumOnMigration} =
ChatDbOpts
{ dbFilePrefix,
dbKey = "",
vacuumOnMigration
}
removeDbKey opts = opts {dbKey = ""} :: ChatDbOpts
errorDbStr :: DBOpts -> String
errorDbStr DBOpts {dbFilePath} = dbFilePath

5969
src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt Normal file
View file

File diff suppressed because it is too large Load diff

2
src/Simplex/Chat/Terminal.hs
View file

@ -16,7 +16,6 @@ import Simplex.Chat.Help (chatWelcome)
import Simplex.Chat.Library.Commands (_defaultNtfServers)
import Simplex.Chat.Operators
import Simplex.Chat.Options
import Simplex.Chat.Options.DB
import Simplex.Chat.Terminal.Input
import Simplex.Chat.Terminal.Output
import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
@ -29,6 +28,7 @@ import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Database.SQLite.Simple (SQLError (..))
import qualified Database.SQLite.Simple as DB
import Simplex.Chat.Options.DB
import System.IO (hFlush, hSetEcho, stdin, stdout)
#endif

25
tests/Bots/BroadcastTests.hs
View file

@ -8,6 +8,7 @@ module Bots.BroadcastTests where
import Broadcast.Bot
import Broadcast.Options
import ChatClient
import ChatTests.DBUtils
import ChatTests.Utils
import Control.Concurrent (forkIO, killThread, threadDelay)
import Control.Exception (bracket)
@ -21,7 +22,7 @@ import Test.Hspec hiding (it)
import System.FilePath ((</>))
#endif
broadcastBotTests :: SpecWith FilePath
broadcastBotTests :: SpecWith TestParams
broadcastBotTests = do
it "should broadcast message" testBroadcastMessages
@ -34,8 +35,8 @@ withBroadcastBot opts test =
broadcastBotProfile :: Profile
broadcastBotProfile = Profile {displayName = "broadcast_bot", fullName = "Broadcast Bot", image = Nothing, contactLink = Nothing, preferences = Nothing}
mkBotOpts :: FilePath -> [KnownContact] -> BroadcastBotOpts
mkBotOpts tmp publishers =
mkBotOpts :: TestParams -> [KnownContact] -> BroadcastBotOpts
mkBotOpts ps publishers =
BroadcastBotOpts
{ coreOptions =
testCoreOpts
@ -44,7 +45,7 @@ mkBotOpts tmp publishers =
#if defined(dbPostgres)
{dbSchemaPrefix = "client_" <> botDbPrefix}
#else
{dbFilePrefix = tmp </> botDbPrefix}
{dbFilePrefix = tmpPath ps </> botDbPrefix}
#endif
},
@ -56,19 +57,19 @@ mkBotOpts tmp publishers =
botDbPrefix :: FilePath
botDbPrefix = "broadcast_bot"
testBroadcastMessages :: HasCallStack => FilePath -> IO ()
testBroadcastMessages tmp = do
testBroadcastMessages :: HasCallStack => TestParams -> IO ()
testBroadcastMessages ps = do
botLink <-
withNewTestChat tmp botDbPrefix broadcastBotProfile $ \bc_bot ->
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
withNewTestChat ps botDbPrefix broadcastBotProfile $ \bc_bot ->
withNewTestChat ps "alice" aliceProfile $ \alice -> do
connectUsers bc_bot alice
bc_bot ##> "/ad"
getContactLink bc_bot True
let botOpts = mkBotOpts tmp [KnownContact 2 "alice"]
let botOpts = mkBotOpts ps [KnownContact 2 "alice"]
withBroadcastBot botOpts $
withTestChat tmp "alice" $ \alice ->
withNewTestChat tmp "bob" bobProfile $ \bob ->
withNewTestChat tmp "cath" cathProfile $ \cath -> do
withTestChat ps "alice" $ \alice ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
alice <## "1 contacts connected (use /cs for the list)"
bob `connectVia` botLink
bob #> "@broadcast_bot hello"

335
tests/Bots/DirectoryTests.hs
View file

@ -7,6 +7,7 @@
module Bots.DirectoryTests where
import ChatClient
import ChatTests.DBUtils
import ChatTests.Utils
import Control.Concurrent (forkIO, killThread, threadDelay)
import Control.Exception (finally)
@ -27,7 +28,7 @@ import Simplex.Chat.Types.Shared (GroupMemberRole (..))
import System.FilePath ((</>))
import Test.Hspec hiding (it)
directoryServiceTests :: SpecWith FilePath
directoryServiceTests :: SpecWith TestParams
directoryServiceTests = do
it "should register group" testDirectoryService
it "should suspend and resume group, send message to owner" testSuspendResume
@ -68,8 +69,8 @@ directoryServiceTests = do
directoryProfile :: Profile
directoryProfile = Profile {displayName = "SimpleX-Directory", fullName = "", image = Nothing, contactLink = Nothing, preferences = Nothing}
mkDirectoryOpts :: FilePath -> [KnownContact] -> Maybe KnownGroup -> DirectoryOpts
mkDirectoryOpts tmp superUsers ownersGroup =
mkDirectoryOpts :: TestParams -> [KnownContact] -> Maybe KnownGroup -> DirectoryOpts
mkDirectoryOpts TestParams {tmpPath = ps} superUsers ownersGroup =
DirectoryOpts
{ coreOptions =
testCoreOpts
@ -78,14 +79,14 @@ mkDirectoryOpts tmp superUsers ownersGroup =
#if defined(dbPostgres)
{dbSchemaPrefix = "client_" <> serviceDbPrefix}
#else
{dbFilePrefix = tmp </> serviceDbPrefix}
{dbFilePrefix = ps </> serviceDbPrefix}
#endif
},
adminUsers = [],
superUsers,
ownersGroup,
directoryLog = Just $ tmp </> "directory_service.log",
directoryLog = Just $ ps </> "directory_service.log",
serviceName = "SimpleX-Directory",
runCLI = False,
searchResults = 3,
@ -98,11 +99,11 @@ serviceDbPrefix = "directory_service"
viewName :: String -> String
viewName = T.unpack . DE.viewName . T.pack
testDirectoryService :: HasCallStack => FilePath -> IO ()
testDirectoryService tmp =
withDirectoryService tmp $ \superUser dsLink ->
withNewTestChat tmp "bob" bobProfile $ \bob ->
withNewTestChat tmp "cath" cathProfile $ \cath -> do
testDirectoryService :: HasCallStack => TestParams -> IO ()
testDirectoryService ps =
withDirectoryService ps $ \superUser dsLink ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
bob #> "@SimpleX-Directory privacy"
bob <# "SimpleX-Directory> > privacy"
@ -211,10 +212,10 @@ testDirectoryService tmp =
su <## "To approve send:"
su <# ("SimpleX-Directory> /approve 1:PSA " <> show grId)
testSuspendResume :: HasCallStack => FilePath -> IO ()
testSuspendResume tmp =
withDirectoryService tmp $ \superUser dsLink ->
withNewTestChat tmp "bob" bobProfile $ \bob -> do
testSuspendResume :: HasCallStack => TestParams -> IO ()
testSuspendResume ps =
withDirectoryService ps $ \superUser dsLink ->
withNewTestChat ps "bob" bobProfile $ \bob -> do
bob `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
groupFound bob "privacy"
@ -240,10 +241,10 @@ testSuspendResume tmp =
superUser <## " Forwarded to @bob, the owner of the group ID 1 (privacy)"
bob <# "SimpleX-Directory> hello there"
testDeleteGroup :: HasCallStack => FilePath -> IO ()
testDeleteGroup tmp =
withDirectoryService tmp $ \superUser dsLink ->
withNewTestChat tmp "bob" bobProfile $ \bob -> do
testDeleteGroup :: HasCallStack => TestParams -> IO ()
testDeleteGroup ps =
withDirectoryService ps $ \superUser dsLink ->
withNewTestChat ps "bob" bobProfile $ \bob -> do
bob `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
groupFound bob "privacy"
@ -252,11 +253,11 @@ testDeleteGroup tmp =
bob <## " Your group privacy is deleted from the directory"
groupNotFound bob "privacy"
testSetRole :: HasCallStack => FilePath -> IO ()
testSetRole tmp =
withDirectoryService tmp $ \superUser dsLink ->
withNewTestChat tmp "bob" bobProfile $ \bob ->
withNewTestChat tmp "cath" cathProfile $ \cath -> do
testSetRole :: HasCallStack => TestParams -> IO ()
testSetRole ps =
withDirectoryService ps $ \superUser dsLink ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
groupFound bob "privacy"
@ -281,12 +282,12 @@ testSetRole tmp =
cath ##> "#privacy hello"
cath <## "#privacy: you don't have permission to send messages"
testJoinGroup :: HasCallStack => FilePath -> IO ()
testJoinGroup tmp =
withDirectoryServiceCfg tmp testCfgGroupLinkViaContact $ \superUser dsLink ->
withNewTestChatCfg tmp testCfgGroupLinkViaContact "bob" bobProfile $ \bob -> do
withNewTestChatCfg tmp testCfgGroupLinkViaContact "cath" cathProfile $ \cath ->
withNewTestChatCfg tmp testCfgGroupLinkViaContact "dan" danProfile $ \dan -> do
testJoinGroup :: HasCallStack => TestParams -> IO ()
testJoinGroup ps =
withDirectoryServiceCfg ps testCfgGroupLinkViaContact $ \superUser dsLink ->
withNewTestChatCfg ps testCfgGroupLinkViaContact "bob" bobProfile $ \bob -> do
withNewTestChatCfg ps testCfgGroupLinkViaContact "cath" cathProfile $ \cath ->
withNewTestChatCfg ps testCfgGroupLinkViaContact "dan" danProfile $ \dan -> do
bob `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
cath `connectVia` dsLink
@ -331,10 +332,10 @@ testJoinGroup tmp =
cath <## "#privacy: new member dan is connected"
]
testGroupNameWithSpaces :: HasCallStack => FilePath -> IO ()
testGroupNameWithSpaces tmp =
withDirectoryService tmp $ \superUser dsLink ->
withNewTestChat tmp "bob" bobProfile $ \bob -> do
testGroupNameWithSpaces :: HasCallStack => TestParams -> IO ()
testGroupNameWithSpaces ps =
withDirectoryService ps $ \superUser dsLink ->
withNewTestChat ps "bob" bobProfile $ \bob -> do
bob `connectVia` dsLink
registerGroup superUser bob "Privacy & Security" ""
groupFound bob "Privacy & Security"
@ -349,11 +350,11 @@ testGroupNameWithSpaces tmp =
bob <# "SimpleX-Directory> The group ID 1 (Privacy & Security) is listed in the directory again!"
groupFound bob "Privacy & Security"
testSearchGroups :: HasCallStack => FilePath -> IO ()
testSearchGroups tmp =
withDirectoryService tmp $ \superUser dsLink ->
withNewTestChat tmp "bob" bobProfile $ \bob -> do
withNewTestChat tmp "cath" cathProfile $ \cath -> do
testSearchGroups :: HasCallStack => TestParams -> IO ()
testSearchGroups ps =
withDirectoryService ps $ \superUser dsLink ->
withNewTestChat ps "bob" bobProfile $ \bob -> do
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
cath `connectVia` dsLink
forM_ [1..8 :: Int] $ \i -> registerGroupId superUser bob (groups !! (i - 1)) "" i i
@ -435,10 +436,10 @@ testSearchGroups tmp =
u <##. "Link to join the group "
u <## (show count <> " members")
testInviteToOwnersGroup :: HasCallStack => FilePath -> IO ()
testInviteToOwnersGroup tmp =
withDirectoryServiceCfgOwnersGroup tmp testCfg True $ \superUser dsLink ->
withNewTestChatCfg tmp testCfg "bob" bobProfile $ \bob -> do
testInviteToOwnersGroup :: HasCallStack => TestParams -> IO ()
testInviteToOwnersGroup ps =
withDirectoryServiceCfgOwnersGroup ps testCfg True $ \superUser dsLink ->
withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob -> do
bob `connectVia` dsLink
registerGroupId superUser bob "privacy" "Privacy" 2 1
bob <## "#owners: SimpleX-Directory invites you to join the group as member"
@ -453,11 +454,11 @@ testInviteToOwnersGroup tmp =
registerGroupId superUser bob "security" "Security" 3 2
superUser <## "Owner is already a member of owners' group"
testDelistedOwnerLeaves :: HasCallStack => FilePath -> IO ()
testDelistedOwnerLeaves tmp =
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
testDelistedOwnerLeaves :: HasCallStack => TestParams -> IO ()
testDelistedOwnerLeaves ps =
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
addCathAsOwner bob cath
@ -469,11 +470,11 @@ testDelistedOwnerLeaves tmp =
superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (group owner left)."
groupNotFound cath "privacy"
testDelistedOwnerRemoved :: HasCallStack => FilePath -> IO ()
testDelistedOwnerRemoved tmp =
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
testDelistedOwnerRemoved :: HasCallStack => TestParams -> IO ()
testDelistedOwnerRemoved ps =
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
addCathAsOwner bob cath
@ -484,11 +485,11 @@ testDelistedOwnerRemoved tmp =
superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (group owner is removed)."
groupNotFound cath "privacy"
testNotDelistedMemberLeaves :: HasCallStack => FilePath -> IO ()
testNotDelistedMemberLeaves tmp =
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
testNotDelistedMemberLeaves :: HasCallStack => TestParams -> IO ()
testNotDelistedMemberLeaves ps =
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
addCathAsOwner bob cath
@ -497,11 +498,11 @@ testNotDelistedMemberLeaves tmp =
(superUser </)
groupFound cath "privacy"
testNotDelistedMemberRemoved :: HasCallStack => FilePath -> IO ()
testNotDelistedMemberRemoved tmp =
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
testNotDelistedMemberRemoved :: HasCallStack => TestParams -> IO ()
testNotDelistedMemberRemoved ps =
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
addCathAsOwner bob cath
@ -509,11 +510,11 @@ testNotDelistedMemberRemoved tmp =
(superUser </)
groupFound cath "privacy"
testDelistedServiceRemoved :: HasCallStack => FilePath -> IO ()
testDelistedServiceRemoved tmp =
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
testDelistedServiceRemoved :: HasCallStack => TestParams -> IO ()
testDelistedServiceRemoved ps =
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
addCathAsOwner bob cath
@ -526,11 +527,11 @@ testDelistedServiceRemoved tmp =
superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (directory service is removed)."
groupNotFound cath "privacy"
testDelistedGroupDeleted :: HasCallStack => FilePath -> IO ()
testDelistedGroupDeleted tmp =
withDirectoryService tmp $ \superUser dsLink ->
withNewTestChat tmp "bob" bobProfile $ \bob ->
withNewTestChat tmp "cath" cathProfile $ \cath -> do
testDelistedGroupDeleted :: HasCallStack => TestParams -> IO ()
testDelistedGroupDeleted ps =
withDirectoryService ps $ \superUser dsLink ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
cath `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
@ -550,11 +551,11 @@ testDelistedGroupDeleted tmp =
superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (group is deleted)."
groupNotFound cath "privacy"
testDelistedRoleChanges :: HasCallStack => FilePath -> IO ()
testDelistedRoleChanges tmp =
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
testDelistedRoleChanges :: HasCallStack => TestParams -> IO ()
testDelistedRoleChanges ps =
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
addCathAsOwner bob cath
@ -596,11 +597,11 @@ testDelistedRoleChanges tmp =
superUser <# "SimpleX-Directory> The group ID 1 (privacy) is listed (user role is set to owner)."
groupFoundN 3 cath "privacy"
testNotDelistedMemberRoleChanged :: HasCallStack => FilePath -> IO ()
testNotDelistedMemberRoleChanged tmp =
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
testNotDelistedMemberRoleChanged :: HasCallStack => TestParams -> IO ()
testNotDelistedMemberRoleChanged ps =
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
addCathAsOwner bob cath
@ -610,11 +611,11 @@ testNotDelistedMemberRoleChanged tmp =
cath <## "#privacy: bob changed your role from owner to member"
groupFoundN 3 cath "privacy"
testNotSentApprovalBadRoles :: HasCallStack => FilePath -> IO ()
testNotSentApprovalBadRoles tmp =
withDirectoryService tmp $ \superUser dsLink ->
withNewTestChat tmp "bob" bobProfile $ \bob ->
withNewTestChat tmp "cath" cathProfile $ \cath -> do
testNotSentApprovalBadRoles :: HasCallStack => TestParams -> IO ()
testNotSentApprovalBadRoles ps =
withDirectoryService ps $ \superUser dsLink ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
cath `connectVia` dsLink
submitGroup bob "privacy" "Privacy"
@ -633,11 +634,11 @@ testNotSentApprovalBadRoles tmp =
approveRegistration superUser bob "privacy" 1
groupFound cath "privacy"
testNotApprovedBadRoles :: HasCallStack => FilePath -> IO ()
testNotApprovedBadRoles tmp =
withDirectoryService tmp $ \superUser dsLink ->
withNewTestChat tmp "bob" bobProfile $ \bob ->
withNewTestChat tmp "cath" cathProfile $ \cath -> do
testNotApprovedBadRoles :: HasCallStack => TestParams -> IO ()
testNotApprovedBadRoles ps =
withDirectoryService ps $ \superUser dsLink ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
cath `connectVia` dsLink
submitGroup bob "privacy" "Privacy"
@ -660,11 +661,11 @@ testNotApprovedBadRoles tmp =
approveRegistration superUser bob "privacy" 1
groupFound cath "privacy"
testRegOwnerChangedProfile :: HasCallStack => FilePath -> IO ()
testRegOwnerChangedProfile tmp =
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
testRegOwnerChangedProfile :: HasCallStack => TestParams -> IO ()
testRegOwnerChangedProfile ps =
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
addCathAsOwner bob cath
@ -679,11 +680,11 @@ testRegOwnerChangedProfile tmp =
reapproveGroup 3 superUser bob
groupFoundN 3 cath "privacy"
testAnotherOwnerChangedProfile :: HasCallStack => FilePath -> IO ()
testAnotherOwnerChangedProfile tmp =
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
testAnotherOwnerChangedProfile :: HasCallStack => TestParams -> IO ()
testAnotherOwnerChangedProfile ps =
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
addCathAsOwner bob cath
@ -698,11 +699,11 @@ testAnotherOwnerChangedProfile tmp =
reapproveGroup 3 superUser bob
groupFoundN 3 cath "privacy"
testRegOwnerRemovedLink :: HasCallStack => FilePath -> IO ()
testRegOwnerRemovedLink tmp =
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
testRegOwnerRemovedLink :: HasCallStack => TestParams -> IO ()
testRegOwnerRemovedLink ps =
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
addCathAsOwner bob cath
@ -731,11 +732,11 @@ testRegOwnerRemovedLink tmp =
reapproveGroup 3 superUser bob
groupFoundN 3 cath "privacy"
testAnotherOwnerRemovedLink :: HasCallStack => FilePath -> IO ()
testAnotherOwnerRemovedLink tmp =
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
testAnotherOwnerRemovedLink :: HasCallStack => TestParams -> IO ()
testAnotherOwnerRemovedLink ps =
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
addCathAsOwner bob cath
@ -773,11 +774,11 @@ testAnotherOwnerRemovedLink tmp =
reapproveGroup 3 superUser bob
groupFoundN 3 cath "privacy"
testDuplicateAskConfirmation :: HasCallStack => FilePath -> IO ()
testDuplicateAskConfirmation tmp =
withDirectoryService tmp $ \superUser dsLink ->
withNewTestChat tmp "bob" bobProfile $ \bob ->
withNewTestChat tmp "cath" cathProfile $ \cath -> do
testDuplicateAskConfirmation :: HasCallStack => TestParams -> IO ()
testDuplicateAskConfirmation ps =
withDirectoryService ps $ \superUser dsLink ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
submitGroup bob "privacy" "Privacy"
_ <- groupAccepted bob "privacy"
@ -792,11 +793,11 @@ testDuplicateAskConfirmation tmp =
completeRegistration superUser cath "privacy" "Privacy" welcomeWithLink 2
groupFound bob "privacy"
testDuplicateProhibitRegistration :: HasCallStack => FilePath -> IO ()
testDuplicateProhibitRegistration tmp =
withDirectoryService tmp $ \superUser dsLink ->
withNewTestChat tmp "bob" bobProfile $ \bob ->
withNewTestChat tmp "cath" cathProfile $ \cath -> do
testDuplicateProhibitRegistration :: HasCallStack => TestParams -> IO ()
testDuplicateProhibitRegistration ps =
withDirectoryService ps $ \superUser dsLink ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
cath `connectVia` dsLink
@ -804,11 +805,11 @@ testDuplicateProhibitRegistration tmp =
_ <- submitGroup cath "privacy" "Privacy"
cath <# "SimpleX-Directory> The group privacy (Privacy) is already listed in the directory, please choose another name."
testDuplicateProhibitConfirmation :: HasCallStack => FilePath -> IO ()
testDuplicateProhibitConfirmation tmp =
withDirectoryService tmp $ \superUser dsLink ->
withNewTestChat tmp "bob" bobProfile $ \bob ->
withNewTestChat tmp "cath" cathProfile $ \cath -> do
testDuplicateProhibitConfirmation :: HasCallStack => TestParams -> IO ()
testDuplicateProhibitConfirmation ps =
withDirectoryService ps $ \superUser dsLink ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
submitGroup bob "privacy" "Privacy"
welcomeWithLink <- groupAccepted bob "privacy"
@ -823,11 +824,11 @@ testDuplicateProhibitConfirmation tmp =
cath #> "@SimpleX-Directory /confirm 1:privacy"
cath <# "SimpleX-Directory> The group privacy (Privacy) is already listed in the directory, please choose another name."
testDuplicateProhibitWhenUpdated :: HasCallStack => FilePath -> IO ()
testDuplicateProhibitWhenUpdated tmp =
withDirectoryService tmp $ \superUser dsLink ->
withNewTestChat tmp "bob" bobProfile $ \bob ->
withNewTestChat tmp "cath" cathProfile $ \cath -> do
testDuplicateProhibitWhenUpdated :: HasCallStack => TestParams -> IO ()
testDuplicateProhibitWhenUpdated ps =
withDirectoryService ps $ \superUser dsLink ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
submitGroup bob "privacy" "Privacy"
welcomeWithLink <- groupAccepted bob "privacy"
@ -854,11 +855,11 @@ testDuplicateProhibitWhenUpdated tmp =
groupFound bob "security"
groupFound cath "security"
testDuplicateProhibitApproval :: HasCallStack => FilePath -> IO ()
testDuplicateProhibitApproval tmp =
withDirectoryService tmp $ \superUser dsLink ->
withNewTestChat tmp "bob" bobProfile $ \bob ->
withNewTestChat tmp "cath" cathProfile $ \cath -> do
testDuplicateProhibitApproval :: HasCallStack => TestParams -> IO ()
testDuplicateProhibitApproval ps =
withDirectoryService ps $ \superUser dsLink ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
submitGroup bob "privacy" "Privacy"
welcomeWithLink <- groupAccepted bob "privacy"
@ -880,11 +881,11 @@ testDuplicateProhibitApproval tmp =
superUser <# ("SimpleX-Directory> > " <> approve)
superUser <## " The group ID 2 (privacy) is already listed in the directory."
testListUserGroups :: HasCallStack => FilePath -> IO ()
testListUserGroups tmp =
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
testListUserGroups :: HasCallStack => TestParams -> IO ()
testListUserGroups ps =
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
cath `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
@ -915,12 +916,12 @@ testListUserGroups tmp =
groupNotFound cath "anonymity"
listGroups superUser bob cath
testRestoreDirectory :: HasCallStack => FilePath -> IO ()
testRestoreDirectory tmp = do
testListUserGroups tmp
restoreDirectoryService tmp 3 3 $ \superUser _dsLink ->
withTestChat tmp "bob" $ \bob ->
withTestChat tmp "cath" $ \cath -> do
testRestoreDirectory :: HasCallStack => TestParams -> IO ()
testRestoreDirectory ps = do
testListUserGroups ps
restoreDirectoryService ps 3 3 $ \superUser _dsLink ->
withTestChat ps "bob" $ \bob ->
withTestChat ps "cath" $ \cath -> do
bob <## "2 contacts connected (use /cs for the list)"
bob
<### [ "#privacy: connected to server(s)",
@ -1021,17 +1022,17 @@ addCathAsOwner bob cath = do
joinGroup "privacy" cath bob
cath <## "#privacy: member SimpleX-Directory is connected"
withDirectoryService :: HasCallStack => FilePath -> (TestCC -> String -> IO ()) -> IO ()
withDirectoryService tmp = withDirectoryServiceCfg tmp testCfg
withDirectoryService :: HasCallStack => TestParams -> (TestCC -> String -> IO ()) -> IO ()
withDirectoryService ps = withDirectoryServiceCfg ps testCfg
withDirectoryServiceCfg :: HasCallStack => FilePath -> ChatConfig -> (TestCC -> String -> IO ()) -> IO ()
withDirectoryServiceCfg tmp cfg = withDirectoryServiceCfgOwnersGroup tmp cfg False
withDirectoryServiceCfg :: HasCallStack => TestParams -> ChatConfig -> (TestCC -> String -> IO ()) -> IO ()
withDirectoryServiceCfg ps cfg = withDirectoryServiceCfgOwnersGroup ps cfg False
withDirectoryServiceCfgOwnersGroup :: HasCallStack => FilePath -> ChatConfig -> Bool -> (TestCC -> String -> IO ()) -> IO ()
withDirectoryServiceCfgOwnersGroup tmp cfg createOwnersGroup test = do
withDirectoryServiceCfgOwnersGroup :: HasCallStack => TestParams -> ChatConfig -> Bool -> (TestCC -> String -> IO ()) -> IO ()
withDirectoryServiceCfgOwnersGroup ps cfg createOwnersGroup test = do
dsLink <-
withNewTestChatCfg tmp cfg serviceDbPrefix directoryProfile $ \ds ->
withNewTestChatCfg tmp cfg "super_user" aliceProfile $ \superUser -> do
withNewTestChatCfg ps cfg serviceDbPrefix directoryProfile $ \ds ->
withNewTestChatCfg ps cfg "super_user" aliceProfile $ \superUser -> do
connectUsers ds superUser
when createOwnersGroup $ do
superUser ##> "/g owners"
@ -1046,12 +1047,12 @@ withDirectoryServiceCfgOwnersGroup tmp cfg createOwnersGroup test = do
superUser <## "#owners: SimpleX-Directory joined the group"
ds ##> "/ad"
getContactLink ds True
withDirectoryOwnersGroup tmp cfg dsLink createOwnersGroup test
withDirectoryOwnersGroup ps cfg dsLink createOwnersGroup test
restoreDirectoryService :: HasCallStack => FilePath -> Int -> Int -> (TestCC -> String -> IO ()) -> IO ()
restoreDirectoryService tmp ctCount grCount test = do
restoreDirectoryService :: HasCallStack => TestParams -> Int -> Int -> (TestCC -> String -> IO ()) -> IO ()
restoreDirectoryService ps ctCount grCount test = do
dsLink <-
withTestChat tmp serviceDbPrefix $ \ds -> do
withTestChat ps serviceDbPrefix $ \ds -> do
ds <## (show ctCount <> " contacts connected (use /cs for the list)")
ds <## "Your address is active! To show: /sa"
ds <## (show grCount <> " group links active")
@ -1060,16 +1061,16 @@ restoreDirectoryService tmp ctCount grCount test = do
dsLink <- getContactLink ds False
ds <## "auto_accept on"
pure dsLink
withDirectory tmp testCfg dsLink test
withDirectory ps testCfg dsLink test
withDirectory :: HasCallStack => FilePath -> ChatConfig -> String -> (TestCC -> String -> IO ()) -> IO ()
withDirectory tmp cfg dsLink = withDirectoryOwnersGroup tmp cfg dsLink False
withDirectory :: HasCallStack => TestParams -> ChatConfig -> String -> (TestCC -> String -> IO ()) -> IO ()
withDirectory ps cfg dsLink = withDirectoryOwnersGroup ps cfg dsLink False
withDirectoryOwnersGroup :: HasCallStack => FilePath -> ChatConfig -> String -> Bool -> (TestCC -> String -> IO ()) -> IO ()
withDirectoryOwnersGroup tmp cfg dsLink createOwnersGroup test = do
let opts = mkDirectoryOpts tmp [KnownContact 2 "alice"] $ if createOwnersGroup then Just $ KnownGroup 1 "owners" else Nothing
withDirectoryOwnersGroup :: HasCallStack => TestParams -> ChatConfig -> String -> Bool -> (TestCC -> String -> IO ()) -> IO ()
withDirectoryOwnersGroup ps cfg dsLink createOwnersGroup test = do
let opts = mkDirectoryOpts ps [KnownContact 2 "alice"] $ if createOwnersGroup then Just $ KnownGroup 1 "owners" else Nothing
runDirectory cfg opts $
withTestChatCfg tmp cfg "super_user" $ \superUser -> do
withTestChatCfg ps cfg "super_user" $ \superUser -> do
superUser <## "1 contacts connected (use /cs for the list)"
when createOwnersGroup $
superUser <## "#owners: connected to server(s)"

118
tests/ChatClient.hs
View file

@ -12,6 +12,7 @@
module ChatClient where
import ChatTests.DBUtils
import Control.Concurrent (forkIOWithUnmask, killThread, threadDelay)
import Control.Concurrent.Async
import Control.Concurrent.STM
@ -68,6 +69,8 @@ import Test.Hspec (Expectation, HasCallStack, shouldReturn)
import Database.PostgreSQL.Simple (ConnectInfo (..), defaultConnectInfo)
#else
import Data.ByteArray (ScrubbedBytes)
import qualified Data.Map.Strict as M
import Simplex.Messaging.Agent.Store.Common (withConnection)
import System.FilePath ((</>))
#endif
@ -118,6 +121,7 @@ testCoreOpts =
#else
{ dbFilePrefix = "./simplex_v1", -- dbFilePrefix is not used in tests (except bot tests where it's redefined)
dbKey = "", -- dbKey = "this is a pass-phrase to encrypt the database",
trackQueries = DB.TQAll,
vacuumOnMigration = True
#endif
},
@ -273,29 +277,29 @@ mkCfgGroupLinkViaContact cfg = cfg {chatVRange = groupLinkViaContactVRange}
groupLinkViaContactVRange :: VersionRangeChat
groupLinkViaContactVRange = mkVersionRange (VersionChat 1) (VersionChat 2)
createTestChat :: FilePath -> ChatConfig -> ChatOpts -> String -> Profile -> IO TestCC
createTestChat tmp cfg opts@ChatOpts {coreOptions} dbPrefix profile = do
Right db@ChatDatabase {chatStore, agentStore} <- createDatabase tmp coreOptions dbPrefix
createTestChat :: TestParams -> ChatConfig -> ChatOpts -> String -> Profile -> IO TestCC
createTestChat ps cfg opts@ChatOpts {coreOptions} dbPrefix profile = do
Right db@ChatDatabase {chatStore, agentStore} <- createDatabase ps coreOptions dbPrefix
insertUser agentStore
Right user <- withTransaction chatStore $ \db' -> runExceptT $ createUserRecord db' (AgentUserId 1) profile True
startTestChat_ db cfg opts user
startTestChat :: FilePath -> ChatConfig -> ChatOpts -> String -> IO TestCC
startTestChat tmp cfg opts@ChatOpts {coreOptions} dbPrefix = do
Right db@ChatDatabase {chatStore} <- createDatabase tmp coreOptions dbPrefix
startTestChat :: TestParams -> ChatConfig -> ChatOpts -> String -> IO TestCC
startTestChat ps cfg opts@ChatOpts {coreOptions} dbPrefix = do
Right db@ChatDatabase {chatStore} <- createDatabase ps coreOptions dbPrefix
Just user <- find activeUser <$> withTransaction chatStore getUsers
startTestChat_ db cfg opts user
createDatabase :: FilePath -> CoreChatOpts -> String -> IO (Either MigrationError ChatDatabase)
createDatabase :: TestParams -> CoreChatOpts -> String -> IO (Either MigrationError ChatDatabase)
#if defined(dbPostgres)
createDatabase _tmp CoreChatOpts {dbOptions} dbPrefix = do
createDatabase _params CoreChatOpts {dbOptions} dbPrefix = do
createChatDatabase dbOptions {dbSchemaPrefix = "client_" <> dbPrefix} MCError
insertUser :: DBStore -> IO ()
insertUser st = withTransaction st (`DB.execute_` "INSERT INTO users DEFAULT VALUES")
#else
createDatabase tmp CoreChatOpts {dbOptions} dbPrefix = do
createChatDatabase dbOptions {dbFilePrefix = tmp </> dbPrefix} MCError
createDatabase TestParams {tmpPath} CoreChatOpts {dbOptions} dbPrefix = do
createChatDatabase dbOptions {dbFilePrefix = tmpPath </> dbPrefix} MCError
insertUser :: DBStore -> IO ()
insertUser st = withTransaction st (`DB.execute_` "INSERT INTO users (user_id) VALUES (1)")
@ -313,48 +317,64 @@ startTestChat_ db cfg opts user = do
termAsync <- async $ readTerminalOutput t termQ
pure TestCC {chatController = cc, virtualTerminal = t, chatAsync, termAsync, termQ, printOutput = False}
stopTestChat :: TestCC -> IO ()
stopTestChat TestCC {chatController = cc@ChatController {smpAgent, chatStore}, chatAsync, termAsync} = do
stopTestChat :: TestParams -> TestCC -> IO ()
stopTestChat ps TestCC {chatController = cc@ChatController {smpAgent, chatStore}, chatAsync, termAsync} = do
stopChatController cc
uninterruptibleCancel termAsync
uninterruptibleCancel chatAsync
liftIO $ disposeAgentClient smpAgent
#if !defined(dbPostgres)
stats <- withConnection chatStore $ readTVarIO . DB.slow
atomically $ modifyTVar' (queryStats ps) $ M.unionWith combineStats stats
#endif
closeDBStore chatStore
threadDelay 200000
#if !defined(dbPostgres)
where
combineStats
DB.SlowQueryStats {count, timeMax, timeAvg, errs}
DB.SlowQueryStats {count = count', timeMax = timeMax', timeAvg = timeAvg', errs = errs'} =
DB.SlowQueryStats
{ count = count + count',
timeMax = max timeMax timeMax',
timeAvg = (timeAvg * count + timeAvg' * count') `div` (count + count'),
errs = M.unionWith (+) errs errs'
}
#endif
withNewTestChat :: HasCallStack => FilePath -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
withNewTestChat tmp = withNewTestChatCfgOpts tmp testCfg testOpts
withNewTestChat :: HasCallStack => TestParams -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
withNewTestChat ps = withNewTestChatCfgOpts ps testCfg testOpts
withNewTestChatV1 :: HasCallStack => FilePath -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
withNewTestChatV1 tmp = withNewTestChatCfg tmp testCfgV1
withNewTestChatV1 :: HasCallStack => TestParams -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
withNewTestChatV1 ps = withNewTestChatCfg ps testCfgV1
withNewTestChatCfg :: HasCallStack => FilePath -> ChatConfig -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
withNewTestChatCfg tmp cfg = withNewTestChatCfgOpts tmp cfg testOpts
withNewTestChatCfg :: HasCallStack => TestParams -> ChatConfig -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
withNewTestChatCfg ps cfg = withNewTestChatCfgOpts ps cfg testOpts
withNewTestChatOpts :: HasCallStack => FilePath -> ChatOpts -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
withNewTestChatOpts tmp = withNewTestChatCfgOpts tmp testCfg
withNewTestChatOpts :: HasCallStack => TestParams -> ChatOpts -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
withNewTestChatOpts ps = withNewTestChatCfgOpts ps testCfg
withNewTestChatCfgOpts :: HasCallStack => FilePath -> ChatConfig -> ChatOpts -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
withNewTestChatCfgOpts tmp cfg opts dbPrefix profile runTest =
withNewTestChatCfgOpts :: HasCallStack => TestParams -> ChatConfig -> ChatOpts -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
withNewTestChatCfgOpts ps cfg opts dbPrefix profile runTest =
bracket
(createTestChat tmp cfg opts dbPrefix profile)
stopTestChat
(createTestChat ps cfg opts dbPrefix profile)
(stopTestChat ps)
(\cc -> runTest cc >>= ((cc <// 100000) $>))
withTestChatV1 :: HasCallStack => FilePath -> String -> (HasCallStack => TestCC -> IO a) -> IO a
withTestChatV1 tmp = withTestChatCfg tmp testCfgV1
withTestChatV1 :: HasCallStack => TestParams -> String -> (HasCallStack => TestCC -> IO a) -> IO a
withTestChatV1 ps = withTestChatCfg ps testCfgV1
withTestChat :: HasCallStack => FilePath -> String -> (HasCallStack => TestCC -> IO a) -> IO a
withTestChat tmp = withTestChatCfgOpts tmp testCfg testOpts
withTestChat :: HasCallStack => TestParams -> String -> (HasCallStack => TestCC -> IO a) -> IO a
withTestChat ps = withTestChatCfgOpts ps testCfg testOpts
withTestChatCfg :: HasCallStack => FilePath -> ChatConfig -> String -> (HasCallStack => TestCC -> IO a) -> IO a
withTestChatCfg tmp cfg = withTestChatCfgOpts tmp cfg testOpts
withTestChatCfg :: HasCallStack => TestParams -> ChatConfig -> String -> (HasCallStack => TestCC -> IO a) -> IO a
withTestChatCfg ps cfg = withTestChatCfgOpts ps cfg testOpts
withTestChatOpts :: HasCallStack => FilePath -> ChatOpts -> String -> (HasCallStack => TestCC -> IO a) -> IO a
withTestChatOpts tmp = withTestChatCfgOpts tmp testCfg
withTestChatOpts :: HasCallStack => TestParams -> ChatOpts -> String -> (HasCallStack => TestCC -> IO a) -> IO a
withTestChatOpts ps = withTestChatCfgOpts ps testCfg
withTestChatCfgOpts :: HasCallStack => FilePath -> ChatConfig -> ChatOpts -> String -> (HasCallStack => TestCC -> IO a) -> IO a
withTestChatCfgOpts tmp cfg opts dbPrefix = bracket (startTestChat tmp cfg opts dbPrefix) (\cc -> cc <// 100000 >> stopTestChat cc)
withTestChatCfgOpts :: HasCallStack => TestParams -> ChatConfig -> ChatOpts -> String -> (HasCallStack => TestCC -> IO a) -> IO a
withTestChatCfgOpts ps cfg opts dbPrefix = bracket (startTestChat ps cfg opts dbPrefix) (\cc -> cc <// 100000 >> stopTestChat ps cc)
-- enable output for specific chat controller, use like this:
-- withNewTestChat tmp "alice" aliceProfile $ \a -> withTestOutput a $ \alice -> do ...
@ -390,16 +410,16 @@ withTmpFiles =
(createDirectoryIfMissing False "tests/tmp")
(removeDirectoryRecursive "tests/tmp")
testChatN :: HasCallStack => ChatConfig -> ChatOpts -> [Profile] -> (HasCallStack => [TestCC] -> IO ()) -> FilePath -> IO ()
testChatN cfg opts ps test tmp = do
testChatN :: HasCallStack => ChatConfig -> ChatOpts -> [Profile] -> (HasCallStack => [TestCC] -> IO ()) -> TestParams -> IO ()
testChatN cfg opts ps test params = do
tcs <- getTestCCs (zip ps [1 ..]) []
test tcs
concurrentlyN_ $ map (<// 100000) tcs
concurrentlyN_ $ map stopTestChat tcs
concurrentlyN_ $ map (stopTestChat params) tcs
where
getTestCCs :: [(Profile, Int)] -> [TestCC] -> IO [TestCC]
getTestCCs [] tcs = pure tcs
getTestCCs ((p, db) : envs') tcs = (:) <$> createTestChat tmp cfg opts (show db) p <*> getTestCCs envs' tcs
getTestCCs ((p, db) : envs') tcs = (:) <$> createTestChat params cfg opts (show db) p <*> getTestCCs envs' tcs
(<//) :: HasCallStack => TestCC -> Int -> Expectation
(<//) cc t = timeout t (getTermLine cc) `shouldReturn` Nothing
@ -420,49 +440,49 @@ userName :: TestCC -> IO [Char]
userName (TestCC ChatController {currentUser} _ _ _ _ _) =
maybe "no current user" (\User {localDisplayName} -> T.unpack localDisplayName) <$> readTVarIO currentUser
testChat :: HasCallStack => Profile -> (HasCallStack => TestCC -> IO ()) -> FilePath -> IO ()
testChat :: HasCallStack => Profile -> (HasCallStack => TestCC -> IO ()) -> TestParams -> IO ()
testChat = testChatCfgOpts testCfg testOpts
testChatCfgOpts :: HasCallStack => ChatConfig -> ChatOpts -> Profile -> (HasCallStack => TestCC -> IO ()) -> FilePath -> IO ()
testChatCfgOpts :: HasCallStack => ChatConfig -> ChatOpts -> Profile -> (HasCallStack => TestCC -> IO ()) -> TestParams -> IO ()
testChatCfgOpts cfg opts p test = testChatN cfg opts [p] test_
where
test_ :: HasCallStack => [TestCC] -> IO ()
test_ [tc] = test tc
test_ _ = error "expected 1 chat client"
testChat2 :: HasCallStack => Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
testChat2 :: HasCallStack => Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
testChat2 = testChatCfgOpts2 testCfg testOpts
testChatCfg2 :: HasCallStack => ChatConfig -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
testChatCfg2 :: HasCallStack => ChatConfig -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
testChatCfg2 cfg = testChatCfgOpts2 cfg testOpts
testChatOpts2 :: HasCallStack => ChatOpts -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
testChatOpts2 :: HasCallStack => ChatOpts -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
testChatOpts2 = testChatCfgOpts2 testCfg
testChatCfgOpts2 :: HasCallStack => ChatConfig -> ChatOpts -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
testChatCfgOpts2 :: HasCallStack => ChatConfig -> ChatOpts -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
testChatCfgOpts2 cfg opts p1 p2 test = testChatN cfg opts [p1, p2] test_
where
test_ :: HasCallStack => [TestCC] -> IO ()
test_ [tc1, tc2] = test tc1 tc2
test_ _ = error "expected 2 chat clients"
testChat3 :: HasCallStack => Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
testChat3 :: HasCallStack => Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
testChat3 = testChatCfgOpts3 testCfg testOpts
testChatCfg3 :: HasCallStack => ChatConfig -> Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
testChatCfg3 :: HasCallStack => ChatConfig -> Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
testChatCfg3 cfg = testChatCfgOpts3 cfg testOpts
testChatCfgOpts3 :: HasCallStack => ChatConfig -> ChatOpts -> Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
testChatCfgOpts3 :: HasCallStack => ChatConfig -> ChatOpts -> Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
testChatCfgOpts3 cfg opts p1 p2 p3 test = testChatN cfg opts [p1, p2, p3] test_
where
test_ :: HasCallStack => [TestCC] -> IO ()
test_ [tc1, tc2, tc3] = test tc1 tc2 tc3
test_ _ = error "expected 3 chat clients"
testChat4 :: HasCallStack => Profile -> Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
testChat4 :: HasCallStack => Profile -> Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
testChat4 = testChatCfg4 testCfg
testChatCfg4 :: HasCallStack => ChatConfig -> Profile -> Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
testChatCfg4 :: HasCallStack => ChatConfig -> Profile -> Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
testChatCfg4 cfg p1 p2 p3 p4 test = testChatN cfg testOpts [p1, p2, p3, p4] test_
where
test_ :: HasCallStack => [TestCC] -> IO ()

3
tests/ChatTests.hs
View file

@ -1,6 +1,7 @@
module ChatTests where
import ChatTests.ChatList
import ChatTests.DBUtils
import ChatTests.Direct
import ChatTests.Files
import ChatTests.Forward
@ -9,7 +10,7 @@ import ChatTests.Local
import ChatTests.Profiles
import Test.Hspec hiding (it)
chatTests :: SpecWith FilePath
chatTests :: SpecWith TestParams
chatTests = do
describe "direct tests" chatDirectTests
describe "forward tests" chatForwardTests

17
tests/ChatTests/ChatList.hs
View file

@ -1,12 +1,13 @@
module ChatTests.ChatList where
import ChatClient
import ChatTests.DBUtils
import ChatTests.Utils
import Data.Time.Clock (getCurrentTime)
import Data.Time.Format.ISO8601 (iso8601Show)
import Test.Hspec hiding (it)
chatListTests :: SpecWith FilePath
chatListTests :: SpecWith TestParams
chatListTests = do
it "get last chats" testPaginationLast
it "get chats before/after timestamp" testPaginationTs
@ -16,7 +17,7 @@ chatListTests = do
it "filter favorite or unread" testFilterFavoriteOrUnread
it "sort and filter chats of all types" testPaginationAllChatTypes
testPaginationLast :: HasCallStack => FilePath -> IO ()
testPaginationLast :: HasCallStack => TestParams -> IO ()
testPaginationLast =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
@ -32,7 +33,7 @@ testPaginationLast =
alice <# "bob> hey"
alice <# "@cath hey"
testPaginationTs :: HasCallStack => FilePath -> IO ()
testPaginationTs :: HasCallStack => TestParams -> IO ()
testPaginationTs =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
@ -59,7 +60,7 @@ getChats_ :: HasCallStack => TestCC -> String -> [(String, String)] -> Expectati
getChats_ cc query expected = do
cc #$> ("/_get chats 1 pcc=on " <> query, chats, expected)
testFilterSearch :: HasCallStack => FilePath -> IO ()
testFilterSearch :: HasCallStack => TestParams -> IO ()
testFilterSearch =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
@ -75,7 +76,7 @@ testFilterSearch =
getChats_ alice (query "bob") [("@bob", "hey")]
getChats_ alice (query "Bob") [("@bob", "hey")]
testFilterFavorite :: HasCallStack => FilePath -> IO ()
testFilterFavorite :: HasCallStack => TestParams -> IO ()
testFilterFavorite =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
@ -99,7 +100,7 @@ testFilterFavorite =
alice <## "ok"
getChats_ alice query [("@bob", "hey")]
testFilterUnread :: HasCallStack => FilePath -> IO ()
testFilterUnread :: HasCallStack => TestParams -> IO ()
testFilterUnread =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
@ -123,7 +124,7 @@ testFilterUnread =
alice <## "ok"
getChats_ alice query [("@bob", "hey")]
testFilterFavoriteOrUnread :: HasCallStack => FilePath -> IO ()
testFilterFavoriteOrUnread :: HasCallStack => TestParams -> IO ()
testFilterFavoriteOrUnread =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
@ -154,7 +155,7 @@ testFilterFavoriteOrUnread =
alice <## "ok"
getChats_ alice query [("@cath", "hey"), ("@bob", "hey")]
testPaginationAllChatTypes :: HasCallStack => FilePath -> IO ()
testPaginationAllChatTypes :: HasCallStack => TestParams -> IO ()
testPaginationAllChatTypes =
testChat4 aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do

15
tests/ChatTests/DBUtils.hs Normal file
View file

@ -0,0 +1,15 @@
{-# LANGUAGE CPP #-}
module ChatTests.DBUtils
#if defined(dbPostgres)
( module ChatTests.DBUtils.Postgres,
)
where
import ChatTests.DBUtils.Postgres
#else
( module ChatTests.DBUtils.SQLite,
)
where
import ChatTests.DBUtils.SQLite
#endif

5
tests/ChatTests/DBUtils/Postgres.hs Normal file
View file

@ -0,0 +1,5 @@
module ChatTests.DBUtils.Postgres where
data TestParams = TestParams
{ tmpPath :: FilePath
}

10
tests/ChatTests/DBUtils/SQLite.hs Normal file
View file

@ -0,0 +1,10 @@
module ChatTests.DBUtils.SQLite where
import Database.SQLite.Simple (Query)
import Simplex.Messaging.Agent.Store.SQLite.DB
import Simplex.Messaging.TMap (TMap)
data TestParams = TestParams
{ tmpPath :: FilePath,
queryStats :: TMap Query SlowQueryStats
}

406
tests/ChatTests/Direct.hs
View file

File diff suppressed because it is too large Load diff

83
tests/ChatTests/Files.hs
View file

@ -6,6 +6,7 @@
module ChatTests.Files where
import ChatClient
import ChatTests.DBUtils
import ChatTests.Utils
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_)
@ -24,7 +25,7 @@ import Simplex.Messaging.Encoding.String
import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist, getFileSize)
import Test.Hspec hiding (it)
chatFileTests :: SpecWith FilePath
chatFileTests :: SpecWith TestParams
chatFileTests = do
describe "messages with files" $ do
it "send and receive message with file" runTestMessageWithFile
@ -63,7 +64,7 @@ chatFileTests = do
xit "removes sent file from server" testXFTPStandaloneCancelSnd -- no error shown in tests
it "removes received temporary files" testXFTPStandaloneCancelRcv
runTestMessageWithFile :: HasCallStack => FilePath -> IO ()
runTestMessageWithFile :: HasCallStack => TestParams -> IO ()
runTestMessageWithFile = testChat2 aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do
connectUsers alice bob
@ -89,7 +90,7 @@ runTestMessageWithFile = testChat2 aliceProfile bobProfile $ \alice bob -> withX
alice #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((1, "hi, sending a file"), Just "./tests/fixtures/test.jpg")])
bob #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((0, "hi, sending a file"), Just "./tests/tmp/test.jpg")])
testSendImage :: HasCallStack => FilePath -> IO ()
testSendImage :: HasCallStack => TestParams -> IO ()
testSendImage =
testChat2 aliceProfile bobProfile $
\alice bob -> withXFTPServer $ do
@ -120,7 +121,7 @@ testSendImage =
fileExists <- doesFileExist "./tests/tmp/test.jpg"
fileExists `shouldBe` True
testSenderMarkItemDeleted :: HasCallStack => FilePath -> IO ()
testSenderMarkItemDeleted :: HasCallStack => TestParams -> IO ()
testSenderMarkItemDeleted =
testChat2 aliceProfile bobProfile $
\alice bob -> withXFTPServer $ do
@ -143,7 +144,7 @@ testSenderMarkItemDeleted =
bob ##> "/fs 1"
bob <## "receiving file 1 (test_1MB.pdf) cancelled"
testFilesFoldersSendImage :: HasCallStack => FilePath -> IO ()
testFilesFoldersSendImage :: HasCallStack => TestParams -> IO ()
testFilesFoldersSendImage =
testChat2 aliceProfile bobProfile $
\alice bob -> withXFTPServer $ do
@ -175,7 +176,7 @@ testFilesFoldersSendImage =
bob <## "alice: contact is deleted"
alice <## "bob (Bob) deleted contact with you"
testFilesFoldersImageSndDelete :: HasCallStack => FilePath -> IO ()
testFilesFoldersImageSndDelete :: HasCallStack => TestParams -> IO ()
testFilesFoldersImageSndDelete =
testChat2 aliceProfile bobProfile $
\alice bob -> withXFTPServer $ do
@ -208,7 +209,7 @@ testFilesFoldersImageSndDelete =
bob ##> "/d alice"
bob <## "alice: contact is deleted"
testFilesFoldersImageRcvDelete :: HasCallStack => FilePath -> IO ()
testFilesFoldersImageRcvDelete :: HasCallStack => TestParams -> IO ()
testFilesFoldersImageRcvDelete =
testChat2 aliceProfile bobProfile $
\alice bob -> withXFTPServer $ do
@ -235,7 +236,7 @@ testFilesFoldersImageRcvDelete =
bob <## "alice: contact is deleted"
alice <## "bob (Bob) deleted contact with you"
testSendImageWithTextAndQuote :: HasCallStack => FilePath -> IO ()
testSendImageWithTextAndQuote :: HasCallStack => TestParams -> IO ()
testSendImageWithTextAndQuote =
testChat2 aliceProfile bobProfile $
\alice bob -> withXFTPServer $ do
@ -310,7 +311,7 @@ testSendImageWithTextAndQuote =
B.readFile "./tests/tmp/test_1.jpg" `shouldReturn` src
testGroupSendImage :: HasCallStack => FilePath -> IO ()
testGroupSendImage :: HasCallStack => TestParams -> IO ()
testGroupSendImage =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do
@ -352,7 +353,7 @@ testGroupSendImage =
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 :: HasCallStack => FilePath -> IO ()
testGroupSendImageWithTextAndQuote :: HasCallStack => TestParams -> IO ()
testGroupSendImageWithTextAndQuote =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do
@ -409,7 +410,7 @@ testGroupSendImageWithTextAndQuote =
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")]
testSendMultiFilesDirect :: HasCallStack => FilePath -> IO ()
testSendMultiFilesDirect :: HasCallStack => TestParams -> IO ()
testSendMultiFilesDirect =
testChat2 aliceProfile bobProfile $ \alice bob -> do
withXFTPServer $ do
@ -473,7 +474,7 @@ testSendMultiFilesDirect =
alice #$> ("/_get chat @2 count=3", chatF, [((1, "message without file"), Nothing), ((1, "sending file 1"), Just "test.jpg"), ((1, "sending file 2"), Just "test.pdf")])
bob #$> ("/_get chat @2 count=3", chatF, [((0, "message without file"), Nothing), ((0, "sending file 1"), Just "test.jpg"), ((0, "sending file 2"), Just "test.pdf")])
testSendMultiFilesGroup :: HasCallStack => FilePath -> IO ()
testSendMultiFilesGroup :: HasCallStack => TestParams -> IO ()
testSendMultiFilesGroup =
testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
withXFTPServer $ do
@ -582,7 +583,7 @@ testXFTPRoundFDCount = do
roundedFDCount 128 `shouldBe` 128
roundedFDCount 500 `shouldBe` 512
testXFTPFileTransfer :: HasCallStack => FilePath -> IO ()
testXFTPFileTransfer :: HasCallStack => TestParams -> IO ()
testXFTPFileTransfer =
testChat2 aliceProfile bobProfile $ \alice bob -> do
withXFTPServer $ do
@ -611,7 +612,7 @@ testXFTPFileTransfer =
dest <- B.readFile "./tests/tmp/test.pdf"
dest `shouldBe` src
testXFTPFileTransferEncrypted :: HasCallStack => FilePath -> IO ()
testXFTPFileTransferEncrypted :: HasCallStack => TestParams -> IO ()
testXFTPFileTransferEncrypted =
testChat2 aliceProfile bobProfile $ \alice bob -> do
src <- B.readFile "./tests/fixtures/test.pdf"
@ -638,7 +639,7 @@ testXFTPFileTransferEncrypted =
LB.length dest `shouldBe` fromIntegral srcLen
LB.toStrict dest `shouldBe` src
testXFTPAcceptAfterUpload :: HasCallStack => FilePath -> IO ()
testXFTPAcceptAfterUpload :: HasCallStack => TestParams -> IO ()
testXFTPAcceptAfterUpload =
testChat2 aliceProfile bobProfile $ \alice bob -> do
withXFTPServer $ do
@ -663,7 +664,7 @@ testXFTPAcceptAfterUpload =
dest <- B.readFile "./tests/tmp/test.pdf"
dest `shouldBe` src
testXFTPGroupFileTransfer :: HasCallStack => FilePath -> IO ()
testXFTPGroupFileTransfer :: HasCallStack => TestParams -> IO ()
testXFTPGroupFileTransfer =
testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
withXFTPServer $ do
@ -701,7 +702,7 @@ testXFTPGroupFileTransfer =
dest1 `shouldBe` src
dest2 `shouldBe` src
testXFTPDeleteUploadedFile :: HasCallStack => FilePath -> IO ()
testXFTPDeleteUploadedFile :: HasCallStack => TestParams -> IO ()
testXFTPDeleteUploadedFile =
testChat2 aliceProfile bobProfile $ \alice bob -> do
withXFTPServer $ do
@ -722,7 +723,7 @@ testXFTPDeleteUploadedFile =
bob ##> "/fr 1 ./tests/tmp"
bob <## "file cancelled: test.pdf"
testXFTPDeleteUploadedFileGroup :: HasCallStack => FilePath -> IO ()
testXFTPDeleteUploadedFileGroup :: HasCallStack => TestParams -> IO ()
testXFTPDeleteUploadedFileGroup =
testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
withXFTPServer $ do
@ -774,7 +775,7 @@ testXFTPDeleteUploadedFileGroup =
cath ##> "/fr 1 ./tests/tmp"
cath <## "file cancelled: test.pdf"
testXFTPWithRelativePaths :: HasCallStack => FilePath -> IO ()
testXFTPWithRelativePaths :: HasCallStack => TestParams -> IO ()
testXFTPWithRelativePaths =
testChat2 aliceProfile bobProfile $ \alice bob -> do
withXFTPServer $ do
@ -802,11 +803,11 @@ testXFTPWithRelativePaths =
dest <- B.readFile "./tests/tmp/bob_files/test.pdf"
dest `shouldBe` src
testXFTPContinueRcv :: HasCallStack => FilePath -> IO ()
testXFTPContinueRcv tmp = do
testXFTPContinueRcv :: HasCallStack => TestParams -> IO ()
testXFTPContinueRcv ps = do
withXFTPServer $ do
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
withNewTestChat tmp "bob" bobProfile $ \bob -> do
withNewTestChat ps "alice" aliceProfile $ \alice -> do
withNewTestChat ps "bob" bobProfile $ \bob -> do
connectUsers alice bob
alice #> "/f @bob ./tests/fixtures/test.pdf"
@ -816,7 +817,7 @@ testXFTPContinueRcv tmp = do
alice <## "completed uploading file 1 (test.pdf) for bob"
-- server is down - file is not received
withTestChat tmp "bob" $ \bob -> do
withTestChat ps "bob" $ \bob -> do
bob <## "1 contacts connected (use /cs for the list)"
bob ##> "/fr 1 ./tests/tmp"
bob
@ -831,14 +832,14 @@ testXFTPContinueRcv tmp = do
withXFTPServer $ do
-- server is up - file reception is continued
withTestChat tmp "bob" $ \bob -> do
withTestChat ps "bob" $ \bob -> do
bob <## "1 contacts connected (use /cs for the list)"
bob <## "completed receiving file 1 (test.pdf) from alice"
src <- B.readFile "./tests/fixtures/test.pdf"
dest <- B.readFile "./tests/tmp/test.pdf"
dest `shouldBe` src
testXFTPMarkToReceive :: HasCallStack => FilePath -> IO ()
testXFTPMarkToReceive :: HasCallStack => TestParams -> IO ()
testXFTPMarkToReceive = do
testChat2 aliceProfile bobProfile $ \alice bob -> do
withXFTPServer $ do
@ -875,11 +876,11 @@ testXFTPMarkToReceive = do
dest <- B.readFile "./tests/tmp/bob_files/test.pdf"
dest `shouldBe` src
testXFTPRcvError :: HasCallStack => FilePath -> IO ()
testXFTPRcvError tmp = do
testXFTPRcvError :: HasCallStack => TestParams -> IO ()
testXFTPRcvError ps = do
withXFTPServer $ do
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
withNewTestChat tmp "bob" bobProfile $ \bob -> do
withNewTestChat ps "alice" aliceProfile $ \alice -> do
withNewTestChat ps "bob" bobProfile $ \bob -> do
connectUsers alice bob
alice #> "/f @bob ./tests/fixtures/test.pdf"
@ -890,7 +891,7 @@ testXFTPRcvError tmp = do
-- server is up w/t store log - file reception should fail
withXFTPServer' xftpServerConfig {storeLogFile = Nothing} $ do
withTestChat tmp "bob" $ \bob -> do
withTestChat ps "bob" $ \bob -> do
bob <## "1 contacts connected (use /cs for the list)"
bob ##> "/fr 1 ./tests/tmp"
bob
@ -903,7 +904,7 @@ testXFTPRcvError tmp = do
bob ##> "/fs 1"
bob <## "receiving file 1 (test.pdf) error: FileErrAuth"
testXFTPCancelRcvRepeat :: HasCallStack => FilePath -> IO ()
testXFTPCancelRcvRepeat :: HasCallStack => TestParams -> IO ()
testXFTPCancelRcvRepeat =
testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do
withXFTPServer $ do
@ -952,7 +953,7 @@ testXFTPCancelRcvRepeat =
where
cfg = testCfg {xftpDescrPartSize = 200}
testAutoAcceptFile :: HasCallStack => FilePath -> IO ()
testAutoAcceptFile :: HasCallStack => TestParams -> IO ()
testAutoAcceptFile =
testChatOpts2 opts aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do
connectUsers alice bob
@ -977,7 +978,7 @@ testAutoAcceptFile =
where
opts = (testOpts :: ChatOpts) {autoAcceptFileSize = 200000}
testProhibitFiles :: HasCallStack => FilePath -> IO ()
testProhibitFiles :: HasCallStack => TestParams -> IO ()
testProhibitFiles =
testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> withXFTPServer $ do
createGroup3 "team" alice bob cath
@ -999,7 +1000,7 @@ testProhibitFiles =
(bob </)
(cath </)
testXFTPStandaloneSmall :: HasCallStack => FilePath -> IO ()
testXFTPStandaloneSmall :: HasCallStack => TestParams -> IO ()
testXFTPStandaloneSmall = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
withXFTPServer $ do
logNote "sending"
@ -1024,7 +1025,7 @@ testXFTPStandaloneSmall = testChat2 aliceProfile aliceDesktopProfile $ \src dst
srcBody <- B.readFile "./tests/fixtures/logo.jpg"
B.readFile dstFile `shouldReturn` srcBody
testXFTPStandaloneSmallInfo :: HasCallStack => FilePath -> IO ()
testXFTPStandaloneSmallInfo :: HasCallStack => TestParams -> IO ()
testXFTPStandaloneSmallInfo = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
withXFTPServer $ do
logNote "sending"
@ -1054,7 +1055,7 @@ testXFTPStandaloneSmallInfo = testChat2 aliceProfile aliceDesktopProfile $ \src
srcBody <- B.readFile "./tests/fixtures/logo.jpg"
B.readFile dstFile `shouldReturn` srcBody
testXFTPStandaloneLarge :: HasCallStack => FilePath -> IO ()
testXFTPStandaloneLarge :: HasCallStack => TestParams -> IO ()
testXFTPStandaloneLarge = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
withXFTPServer $ do
xftpCLI ["rand", "./tests/tmp/testfile.in", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile.in"]
@ -1081,7 +1082,7 @@ testXFTPStandaloneLarge = testChat2 aliceProfile aliceDesktopProfile $ \src dst
srcBody <- B.readFile "./tests/tmp/testfile.in"
B.readFile dstFile `shouldReturn` srcBody
testXFTPStandaloneLargeInfo :: HasCallStack => FilePath -> IO ()
testXFTPStandaloneLargeInfo :: HasCallStack => TestParams -> IO ()
testXFTPStandaloneLargeInfo = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
withXFTPServer $ do
xftpCLI ["rand", "./tests/tmp/testfile.in", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile.in"]
@ -1114,7 +1115,7 @@ testXFTPStandaloneLargeInfo = testChat2 aliceProfile aliceDesktopProfile $ \src
srcBody <- B.readFile "./tests/tmp/testfile.in"
B.readFile dstFile `shouldReturn` srcBody
testXFTPStandaloneCancelSnd :: HasCallStack => FilePath -> IO ()
testXFTPStandaloneCancelSnd :: HasCallStack => TestParams -> IO ()
testXFTPStandaloneCancelSnd = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
withXFTPServer $ do
xftpCLI ["rand", "./tests/tmp/testfile.in", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile.in"]
@ -1144,7 +1145,7 @@ testXFTPStandaloneCancelSnd = testChat2 aliceProfile aliceDesktopProfile $ \src
dst <## "error receiving file 1 (should.not.extist)"
dst <## "INTERNAL {internalErr = \"XFTP {xftpErr = AUTH}\"}"
testXFTPStandaloneRelativePaths :: HasCallStack => FilePath -> IO ()
testXFTPStandaloneRelativePaths :: HasCallStack => TestParams -> IO ()
testXFTPStandaloneRelativePaths = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
withXFTPServer $ do
logNote "sending"
@ -1175,7 +1176,7 @@ testXFTPStandaloneRelativePaths = testChat2 aliceProfile aliceDesktopProfile $ \
srcBody <- B.readFile "./tests/tmp/src_files/testfile.in"
B.readFile "./tests/tmp/dst_files/testfile.out" `shouldReturn` srcBody
testXFTPStandaloneCancelRcv :: HasCallStack => FilePath -> IO ()
testXFTPStandaloneCancelRcv :: HasCallStack => TestParams -> IO ()
testXFTPStandaloneCancelRcv = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
withXFTPServer $ do
xftpCLI ["rand", "./tests/tmp/testfile.in", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile.in"]

49
tests/ChatTests/Forward.hs
View file

@ -4,6 +4,7 @@
module ChatTests.Forward where
import ChatClient
import ChatTests.DBUtils
import ChatTests.Utils
import Control.Concurrent (threadDelay)
import qualified Data.ByteString.Char8 as B
@ -14,7 +15,7 @@ import Simplex.Chat.Types (ImageData (..))
import System.Directory (copyFile, doesFileExist, removeFile)
import Test.Hspec hiding (it)
chatForwardTests :: SpecWith FilePath
chatForwardTests :: SpecWith TestParams
chatForwardTests = do
describe "forward messages" $ do
it "from contact to contact" testForwardContactToContact
@ -42,7 +43,7 @@ chatForwardTests = do
it "from group to group" testForwardGroupToGroupMulti
it "with relative paths: multiple files from contact to contact" testMultiForwardFiles
testForwardContactToContact :: HasCallStack => FilePath -> IO ()
testForwardContactToContact :: HasCallStack => TestParams -> IO ()
testForwardContactToContact =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
@ -88,7 +89,7 @@ testForwardContactToContact =
alice .<## ": hey"
alice <##. "forwarded from: @bob, chat item id:"
testForwardContactToGroup :: HasCallStack => FilePath -> IO ()
testForwardContactToGroup :: HasCallStack => TestParams -> IO ()
testForwardContactToGroup =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
@ -112,7 +113,7 @@ testForwardContactToGroup =
cath <# "#team alice> -> forwarded"
cath <## " hey"
testForwardContactToNotes :: HasCallStack => FilePath -> IO ()
testForwardContactToNotes :: HasCallStack => TestParams -> IO ()
testForwardContactToNotes =
testChat2 aliceProfile bobProfile $
\alice bob -> do
@ -132,7 +133,7 @@ testForwardContactToNotes =
alice <# "* <- @bob"
alice <## " hey"
testForwardGroupToContact :: HasCallStack => FilePath -> IO ()
testForwardGroupToContact :: HasCallStack => TestParams -> IO ()
testForwardGroupToContact =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
@ -156,7 +157,7 @@ testForwardGroupToContact =
cath <# "alice> -> forwarded"
cath <## " hey"
testForwardGroupToGroup :: HasCallStack => FilePath -> IO ()
testForwardGroupToGroup :: HasCallStack => TestParams -> IO ()
testForwardGroupToGroup =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
@ -197,7 +198,7 @@ testForwardGroupToGroup =
cath <# "#club alice> -> forwarded"
cath <## " hey"
testForwardGroupToNotes :: HasCallStack => FilePath -> IO ()
testForwardGroupToNotes :: HasCallStack => TestParams -> IO ()
testForwardGroupToNotes =
testChat2 aliceProfile bobProfile $
\alice bob -> do
@ -217,7 +218,7 @@ testForwardGroupToNotes =
alice <# "* <- #team"
alice <## " hey"
testForwardNotesToContact :: HasCallStack => FilePath -> IO ()
testForwardNotesToContact :: HasCallStack => TestParams -> IO ()
testForwardNotesToContact =
testChat2 aliceProfile cathProfile $
\alice cath -> do
@ -230,7 +231,7 @@ testForwardNotesToContact =
alice <# "@cath hi"
cath <# "alice> hi"
testForwardNotesToGroup :: HasCallStack => FilePath -> IO ()
testForwardNotesToGroup :: HasCallStack => TestParams -> IO ()
testForwardNotesToGroup =
testChat2 aliceProfile cathProfile $
\alice cath -> do
@ -243,9 +244,9 @@ testForwardNotesToGroup =
alice <# "#team hi"
cath <# "#team alice> hi"
testForwardNotesToNotes :: HasCallStack => FilePath -> IO ()
testForwardNotesToNotes tmp =
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
testForwardNotesToNotes :: HasCallStack => TestParams -> IO ()
testForwardNotesToNotes ps =
withNewTestChat ps "alice" aliceProfile $ \alice -> do
createCCNoteFolder alice
alice >* "hi"
@ -257,7 +258,7 @@ testForwardNotesToNotes tmp =
alice <# "* hi"
alice <# "* hi"
testForwardPreserveInfo :: HasCallStack => FilePath -> IO ()
testForwardPreserveInfo :: HasCallStack => TestParams -> IO ()
testForwardPreserveInfo =
testChat4 aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do
@ -285,7 +286,7 @@ testForwardPreserveInfo =
dan <# "#team alice> -> forwarded"
dan <## " hey"
testForwardRcvMsgNewInfo :: HasCallStack => FilePath -> IO ()
testForwardRcvMsgNewInfo :: HasCallStack => TestParams -> IO ()
testForwardRcvMsgNewInfo =
testChat4 aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do
@ -313,7 +314,7 @@ testForwardRcvMsgNewInfo =
cath <# "alice> -> forwarded"
cath <## " hey"
testForwardQuotedMsg :: HasCallStack => FilePath -> IO ()
testForwardQuotedMsg :: HasCallStack => TestParams -> IO ()
testForwardQuotedMsg =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
@ -343,7 +344,7 @@ testForwardQuotedMsg =
cath <# "alice> -> forwarded"
cath <## " hey"
testForwardEditProhibited :: HasCallStack => FilePath -> IO ()
testForwardEditProhibited :: HasCallStack => TestParams -> IO ()
testForwardEditProhibited =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
@ -363,7 +364,7 @@ testForwardEditProhibited =
alice ##> ("/_update item @3 " <> msgId <> " text hey edited")
alice <## "cannot update this item"
testForwardDeleteForOther :: HasCallStack => FilePath -> IO ()
testForwardDeleteForOther :: HasCallStack => TestParams -> IO ()
testForwardDeleteForOther =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
@ -384,7 +385,7 @@ testForwardDeleteForOther =
alice <## "message marked deleted"
cath <# "alice> [marked deleted] hey"
testForwardFileNoFilesFolder :: HasCallStack => FilePath -> IO ()
testForwardFileNoFilesFolder :: HasCallStack => TestParams -> IO ()
testForwardFileNoFilesFolder =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do
@ -438,7 +439,7 @@ testForwardFileNoFilesFolder =
dest2 <- B.readFile "./tests/tmp/test_1.pdf"
dest2 `shouldBe` src
testForwardFileContactToContact :: HasCallStack => FilePath -> IO ()
testForwardFileContactToContact :: HasCallStack => TestParams -> IO ()
testForwardFileContactToContact =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do
@ -504,7 +505,7 @@ testForwardFileContactToContact =
fwdFileExists <- doesFileExist "./tests/tmp/bob_files/test_1.pdf"
fwdFileExists `shouldBe` True
testForwardFileGroupToNotes :: HasCallStack => FilePath -> IO ()
testForwardFileGroupToNotes :: HasCallStack => TestParams -> IO ()
testForwardFileGroupToNotes =
testChat2 aliceProfile cathProfile $
\alice cath -> withXFTPServer $ do
@ -552,7 +553,7 @@ testForwardFileGroupToNotes =
fwdFileExists <- doesFileExist "./tests/tmp/cath_files/test_1.pdf"
fwdFileExists `shouldBe` True
testForwardFileNotesToGroup :: HasCallStack => FilePath -> IO ()
testForwardFileNotesToGroup :: HasCallStack => TestParams -> IO ()
testForwardFileNotesToGroup =
testChat2 aliceProfile cathProfile $
\alice cath -> withXFTPServer $ do
@ -599,7 +600,7 @@ testForwardFileNotesToGroup =
fwdFileExists <- doesFileExist "./tests/tmp/alice_files/test_1.pdf"
fwdFileExists `shouldBe` True
testForwardContactToContactMulti :: HasCallStack => FilePath -> IO ()
testForwardContactToContactMulti :: HasCallStack => TestParams -> IO ()
testForwardContactToContactMulti =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
@ -629,7 +630,7 @@ testForwardContactToContactMulti =
cath <# "alice> -> forwarded"
cath <## " hey"
testForwardGroupToGroupMulti :: HasCallStack => FilePath -> IO ()
testForwardGroupToGroupMulti :: HasCallStack => TestParams -> IO ()
testForwardGroupToGroupMulti =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
@ -673,7 +674,7 @@ testForwardGroupToGroupMulti =
cath <# "#club alice> -> forwarded"
cath <## " hey"
testMultiForwardFiles :: HasCallStack => FilePath -> IO ()
testMultiForwardFiles :: HasCallStack => TestParams -> IO ()
testMultiForwardFiles =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do

428
tests/ChatTests/Groups.hs
View file

File diff suppressed because it is too large Load diff

33
tests/ChatTests/Local.hs
View file

@ -5,6 +5,7 @@ module ChatTests.Local where
import ChatClient
import ChatTests.ChatList (getChats_)
import ChatTests.DBUtils
import ChatTests.Utils
import Data.Time (getCurrentTime)
import Data.Time.Format.ISO8601 (iso8601Show)
@ -13,7 +14,7 @@ import System.Directory (copyFile, doesFileExist)
import System.FilePath ((</>))
import Test.Hspec hiding (it)
chatLocalChatsTests :: SpecWith FilePath
chatLocalChatsTests :: SpecWith TestParams
chatLocalChatsTests = do
describe "note folders" $ do
it "create folders, add notes, read, search" testNotes
@ -26,8 +27,8 @@ chatLocalChatsTests = do
it "create multiple messages api" testCreateMulti
it "create multiple messages with files" testCreateMultiFiles
testNotes :: FilePath -> IO ()
testNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
testNotes :: TestParams -> IO ()
testNotes ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
createCCNoteFolder alice
alice ##> "/contacts"
@ -55,8 +56,8 @@ testNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
alice ##> "/tail *"
alice <# "* Greetings."
testUserNotes :: FilePath -> IO ()
testUserNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
testUserNotes :: TestParams -> IO ()
testUserNotes ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
createCCNoteFolder alice
alice >* "keep in mind"
@ -73,8 +74,8 @@ testUserNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
alice ##> "/_delete item *1 1 internal"
alice <## "chat db error: SENoteFolderNotFound {noteFolderId = 1}"
testPreviewsPagination :: FilePath -> IO ()
testPreviewsPagination tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
testPreviewsPagination :: TestParams -> IO ()
testPreviewsPagination ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
createCCNoteFolder alice
tsS <- iso8601Show <$> getCurrentTime
@ -91,8 +92,8 @@ testPreviewsPagination tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -
getChats_ alice ("before=" <> tsE <> " count=10") [("*", "last")]
getChats_ alice ("before=" <> tsS <> " count=10") []
testChatPagination :: FilePath -> IO ()
testChatPagination tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
testChatPagination :: TestParams -> IO ()
testChatPagination ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
createCCNoteFolder alice
alice >* "hello world"
@ -115,8 +116,8 @@ testChatPagination tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
alice #$> ("/_get chat *1 count=10 search=k-k", chat, [(1, "knock-knock")])
testFiles :: FilePath -> IO ()
testFiles tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
testFiles :: TestParams -> IO ()
testFiles ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
-- setup
createCCNoteFolder alice
let files = "./tests/tmp/app_files"
@ -163,7 +164,7 @@ testFiles tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
alice ##> "/tail"
doesFileExist stored `shouldReturn` False
testOtherFiles :: FilePath -> IO ()
testOtherFiles :: TestParams -> IO ()
testOtherFiles =
testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do
connectUsers alice bob
@ -196,16 +197,16 @@ testOtherFiles =
where
cfg = testCfg {inlineFiles = defaultInlineFilesConfig {offerChunks = 100, sendChunks = 100, receiveChunks = 100}}
testCreateMulti :: FilePath -> IO ()
testCreateMulti tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
testCreateMulti :: TestParams -> IO ()
testCreateMulti ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
createCCNoteFolder alice
alice ##> "/_create *1 json [{\"msgContent\": {\"type\": \"text\", \"text\": \"test 1\"}}, {\"msgContent\": {\"type\": \"text\", \"text\": \"test 2\"}}]"
alice <# "* test 1"
alice <# "* test 2"
testCreateMultiFiles :: FilePath -> IO ()
testCreateMultiFiles tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
testCreateMultiFiles :: TestParams -> IO ()
testCreateMultiFiles ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
createCCNoteFolder alice
alice #$> ("/_files_folder ./tests/tmp/alice_app_files", id, "ok")
copyFile "./tests/fixtures/test.jpg" "./tests/tmp/alice_app_files/test.jpg"

168
tests/ChatTests/Profiles.hs
View file

@ -8,6 +8,7 @@
module ChatTests.Profiles where
import ChatClient
import ChatTests.DBUtils
import ChatTests.Utils
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_)
@ -32,7 +33,7 @@ import Simplex.Messaging.Util (encodeJSON)
import System.Directory (copyFile, createDirectoryIfMissing)
import Test.Hspec hiding (it)
chatProfileTests :: SpecWith FilePath
chatProfileTests :: SpecWith TestParams
chatProfileTests = do
describe "user profiles" $ do
it "update user profile and notify contacts" testUpdateProfile
@ -101,7 +102,7 @@ chatProfileTests = do
it "SimpleX links" testGroupPrefsSimplexLinksForRole
it "set user, contact and group UI theme" testSetUITheme
testUpdateProfile :: HasCallStack => FilePath -> IO ()
testUpdateProfile :: HasCallStack => TestParams -> IO ()
testUpdateProfile =
testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $
\alice bob cath -> do
@ -143,7 +144,7 @@ testUpdateProfile =
bob <## "use @cat <message> to send messages"
]
testUpdateProfileImage :: HasCallStack => FilePath -> IO ()
testUpdateProfileImage :: HasCallStack => TestParams -> IO ()
testUpdateProfileImage =
testChat2 aliceProfile bobProfile $
\alice bob -> do
@ -163,7 +164,7 @@ testUpdateProfileImage =
bob <## "use @alice2 <message> to send messages"
(bob </)
testMultiWordProfileNames :: HasCallStack => FilePath -> IO ()
testMultiWordProfileNames :: HasCallStack => TestParams -> IO ()
testMultiWordProfileNames =
testChat3 aliceProfile' bobProfile' cathProfile' $
\alice bob cath -> do
@ -236,7 +237,7 @@ testMultiWordProfileNames =
cathProfile' = baseProfile {displayName = "Cath Johnson"}
baseProfile = Profile {displayName = "", fullName = "", image = Nothing, contactLink = Nothing, preferences = defaultPrefs}
testUserContactLink :: HasCallStack => FilePath -> IO ()
testUserContactLink :: HasCallStack => TestParams -> IO ()
testUserContactLink =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
@ -266,9 +267,10 @@ testUserContactLink =
alice @@@ [("@cath", lastChatFeature), ("@bob", "hey")]
alice <##> cath
testRetryAcceptingViaContactLink :: HasCallStack => FilePath -> IO ()
testRetryAcceptingViaContactLink tmp = testChatCfgOpts2 cfg' opts' aliceProfile bobProfile test tmp
testRetryAcceptingViaContactLink :: HasCallStack => TestParams -> IO ()
testRetryAcceptingViaContactLink ps = testChatCfgOpts2 cfg' opts' aliceProfile bobProfile test ps
where
tmp = tmpPath ps
test alice bob = do
cLink <- withSmpServer' serverCfg' $ do
alice ##> "/ad"
@ -327,7 +329,7 @@ testRetryAcceptingViaContactLink tmp = testChatCfgOpts2 cfg' opts' aliceProfile
}
}
testProfileLink :: HasCallStack => FilePath -> IO ()
testProfileLink :: HasCallStack => TestParams -> IO ()
testProfileLink =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
@ -408,7 +410,7 @@ testProfileLink =
cc <## "quantum resistant end-to-end encryption"
cc <## currentChatVRangeInfo
testUserContactLinkAutoAccept :: HasCallStack => FilePath -> IO ()
testUserContactLinkAutoAccept :: HasCallStack => TestParams -> IO ()
testUserContactLinkAutoAccept =
testChat4 aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do
@ -456,7 +458,7 @@ testUserContactLinkAutoAccept =
alice @@@ [("@dan", lastChatFeature), ("@cath", "hey"), ("@bob", "hey")]
alice <##> dan
testDeduplicateContactRequests :: HasCallStack => FilePath -> IO ()
testDeduplicateContactRequests :: HasCallStack => TestParams -> IO ()
testDeduplicateContactRequests = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
alice ##> "/ad"
@ -515,7 +517,7 @@ testDeduplicateContactRequests = testChat3 aliceProfile bobProfile cathProfile $
alice @@@ [("@cath", lastChatFeature), ("@bob", "hey")]
alice <##> cath
testDeduplicateContactRequestsProfileChange :: HasCallStack => FilePath -> IO ()
testDeduplicateContactRequestsProfileChange :: HasCallStack => TestParams -> IO ()
testDeduplicateContactRequestsProfileChange = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
alice ##> "/ad"
@ -592,7 +594,7 @@ testDeduplicateContactRequestsProfileChange = testChat3 aliceProfile bobProfile
alice @@@ [("@cath", lastChatFeature), ("@robert", "hey")]
alice <##> cath
testRejectContactAndDeleteUserContact :: HasCallStack => FilePath -> IO ()
testRejectContactAndDeleteUserContact :: HasCallStack => TestParams -> IO ()
testRejectContactAndDeleteUserContact = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
alice ##> "/_address 1"
@ -615,7 +617,7 @@ testRejectContactAndDeleteUserContact = testChat3 aliceProfile bobProfile cathPr
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 :: HasCallStack => FilePath -> IO ()
testDeleteConnectionRequests :: HasCallStack => TestParams -> IO ()
testDeleteConnectionRequests = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
alice ##> "/ad"
@ -637,7 +639,7 @@ testDeleteConnectionRequests = testChat3 aliceProfile bobProfile cathProfile $
cath ##> ("/c " <> cLink')
alice <#? cath
testAutoReplyMessage :: HasCallStack => FilePath -> IO ()
testAutoReplyMessage :: HasCallStack => TestParams -> IO ()
testAutoReplyMessage = testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/ad"
@ -659,7 +661,7 @@ testAutoReplyMessage = testChat2 aliceProfile bobProfile $
alice <## "bob (Bob): contact is connected"
]
testAutoReplyMessageInIncognito :: HasCallStack => FilePath -> IO ()
testAutoReplyMessageInIncognito :: HasCallStack => TestParams -> IO ()
testAutoReplyMessageInIncognito = testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/ad"
@ -684,7 +686,7 @@ testAutoReplyMessageInIncognito = testChat2 aliceProfile bobProfile $
alice <## "use /i bob to print out this incognito profile again"
]
testBusinessAddress :: HasCallStack => FilePath -> IO ()
testBusinessAddress :: HasCallStack => TestParams -> IO ()
testBusinessAddress = testChat3 businessProfile aliceProfile {fullName = "Alice @ Biz"} bobProfile $
\biz alice bob -> do
biz ##> "/ad"
@ -737,7 +739,7 @@ testBusinessAddress = testChat3 businessProfile aliceProfile {fullName = "Alice
(alice <# "#bob bob_1> hey there")
(biz <# "#bob bob_1> hey there")
testBusinessUpdateProfiles :: HasCallStack => FilePath -> IO ()
testBusinessUpdateProfiles :: HasCallStack => TestParams -> IO ()
testBusinessUpdateProfiles = testChat4 businessProfile aliceProfile bobProfile cathProfile $
\biz alice bob cath -> do
biz ##> "/ad"
@ -866,7 +868,7 @@ testBusinessUpdateProfiles = testChat4 businessProfile aliceProfile bobProfile c
bob #$> ("/_get chat #1 count=1", chat, [(0, "Voice messages: on")])
cath #$> ("/_get chat #1 count=1", chat, [(0, "Voice messages: on")])
testPlanAddressOkKnown :: HasCallStack => FilePath -> IO ()
testPlanAddressOkKnown :: HasCallStack => TestParams -> IO ()
testPlanAddressOkKnown =
testChat2 aliceProfile bobProfile $
\alice bob -> do
@ -899,9 +901,9 @@ testPlanAddressOkKnown =
bob <## "contact address: known contact alice"
bob <## "use @alice <message> to send messages"
testPlanAddressOwn :: HasCallStack => FilePath -> IO ()
testPlanAddressOwn tmp =
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
testPlanAddressOwn :: HasCallStack => TestParams -> IO ()
testPlanAddressOwn ps =
withNewTestChat ps "alice" aliceProfile $ \alice -> do
alice ##> "/ad"
cLink <- getContactLink alice True
@ -945,12 +947,12 @@ testPlanAddressOwn tmp =
alice ##> ("/c " <> cLink)
alice <## "alice_2 (Alice): contact already exists"
testPlanAddressConnecting :: HasCallStack => FilePath -> IO ()
testPlanAddressConnecting tmp = do
cLink <- withNewTestChat tmp "alice" aliceProfile $ \alice -> do
testPlanAddressConnecting :: HasCallStack => TestParams -> IO ()
testPlanAddressConnecting ps = do
cLink <- withNewTestChat ps "alice" aliceProfile $ \alice -> do
alice ##> "/ad"
getContactLink alice True
withNewTestChat tmp "bob" bobProfile $ \bob -> do
withNewTestChat ps "bob" bobProfile $ \bob -> do
threadDelay 100000
bob ##> ("/c " <> cLink)
@ -964,14 +966,14 @@ testPlanAddressConnecting tmp = do
bob <## "contact address: connecting, allowed to reconnect"
threadDelay 100000
withTestChat tmp "alice" $ \alice -> do
withTestChat ps "alice" $ \alice -> do
alice <## "Your address is active! To show: /sa"
alice <## "bob (Bob) wants to connect to you!"
alice <## "to accept: /ac bob"
alice <## "to reject: /rc bob (the sender will NOT be notified)"
alice ##> "/ac bob"
alice <## "bob (Bob): accepting contact request, you can send messages to contact"
withTestChat tmp "bob" $ \bob -> do
withTestChat ps "bob" $ \bob -> do
threadDelay 500000
bob <## "alice (Alice): contact is connected"
bob @@@ [("@alice", "Audio/video calls: enabled")]
@ -988,12 +990,12 @@ testPlanAddressConnecting tmp = do
bob <## "contact address: known contact alice"
bob <## "use @alice <message> to send messages"
testPlanAddressConnectingSlow :: HasCallStack => FilePath -> IO ()
testPlanAddressConnectingSlow tmp = do
cLink <- withNewTestChatCfg tmp testCfgSlow "alice" aliceProfile $ \alice -> do
testPlanAddressConnectingSlow :: HasCallStack => TestParams -> IO ()
testPlanAddressConnectingSlow ps = do
cLink <- withNewTestChatCfg ps testCfgSlow "alice" aliceProfile $ \alice -> do
alice ##> "/ad"
getContactLink alice True
withNewTestChatCfg tmp testCfgSlow "bob" bobProfile $ \bob -> do
withNewTestChatCfg ps testCfgSlow "bob" bobProfile $ \bob -> do
threadDelay 100000
bob ##> ("/c " <> cLink)
@ -1007,14 +1009,14 @@ testPlanAddressConnectingSlow tmp = do
bob <## "contact address: connecting, allowed to reconnect"
threadDelay 100000
withTestChatCfg tmp testCfgSlow "alice" $ \alice -> do
withTestChatCfg ps testCfgSlow "alice" $ \alice -> do
alice <## "Your address is active! To show: /sa"
alice <## "bob (Bob) wants to connect to you!"
alice <## "to accept: /ac bob"
alice <## "to reject: /rc bob (the sender will NOT be notified)"
alice ##> "/ac bob"
alice <## "bob (Bob): accepting contact request..."
withTestChatCfg tmp testCfgSlow "bob" $ \bob -> do
withTestChatCfg ps testCfgSlow "bob" $ \bob -> do
threadDelay 500000
bob @@@ [("@alice", "")]
bob ##> ("/_connect plan 1 " <> cLink)
@ -1027,7 +1029,7 @@ testPlanAddressConnectingSlow tmp = do
bob ##> ("/c " <> cLink)
bob <## "contact address: connecting to contact alice"
testPlanAddressContactDeletedReconnected :: HasCallStack => FilePath -> IO ()
testPlanAddressContactDeletedReconnected :: HasCallStack => TestParams -> IO ()
testPlanAddressContactDeletedReconnected =
testChat2 aliceProfile bobProfile $
\alice bob -> do
@ -1090,7 +1092,7 @@ testPlanAddressContactDeletedReconnected =
bob <## "contact address: known contact alice_1"
bob <## "use @alice_1 <message> to send messages"
testPlanAddressContactViaAddress :: HasCallStack => FilePath -> IO ()
testPlanAddressContactViaAddress :: HasCallStack => TestParams -> IO ()
testPlanAddressContactViaAddress =
testChat2 aliceProfile bobProfile $
\alice bob -> do
@ -1154,7 +1156,7 @@ testPlanAddressContactViaAddress =
alice <##> bob
bob @@@ [("@alice", "hey")]
testConnectIncognitoInvitationLink :: HasCallStack => FilePath -> IO ()
testConnectIncognitoInvitationLink :: HasCallStack => TestParams -> IO ()
testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
alice ##> "/connect incognito"
@ -1228,7 +1230,7 @@ testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfi
(bob </)
bob `hasContactProfiles` ["bob"]
testConnectIncognitoContactAddress :: HasCallStack => FilePath -> IO ()
testConnectIncognitoContactAddress :: HasCallStack => TestParams -> IO ()
testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/ad"
@ -1266,7 +1268,7 @@ testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $
(bob </)
bob `hasContactProfiles` ["bob"]
testAcceptContactRequestIncognito :: HasCallStack => FilePath -> IO ()
testAcceptContactRequestIncognito :: HasCallStack => TestParams -> IO ()
testAcceptContactRequestIncognito = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
alice ##> "/ad"
@ -1314,7 +1316,7 @@ testAcceptContactRequestIncognito = testChat3 aliceProfile bobProfile cathProfil
alice `hasContactProfiles` ["alice", "cath", T.pack aliceIncognitoCath]
cath `hasContactProfiles` ["cath", T.pack aliceIncognitoCath]
testSetConnectionIncognito :: HasCallStack => FilePath -> IO ()
testSetConnectionIncognito :: HasCallStack => TestParams -> IO ()
testSetConnectionIncognito = testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/connect"
@ -1337,7 +1339,7 @@ testSetConnectionIncognito = testChat2 aliceProfile bobProfile $
alice `hasContactProfiles` ["alice", "bob", T.pack aliceIncognito]
bob `hasContactProfiles` ["bob", T.pack aliceIncognito]
testResetConnectionIncognito :: HasCallStack => FilePath -> IO ()
testResetConnectionIncognito :: HasCallStack => TestParams -> IO ()
testResetConnectionIncognito = testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/_connect 1 incognito=on"
@ -1353,42 +1355,42 @@ testResetConnectionIncognito = testChat2 aliceProfile bobProfile $
alice `hasContactProfiles` ["alice", "bob"]
bob `hasContactProfiles` ["alice", "bob"]
testSetConnectionIncognitoProhibitedDuringNegotiation :: HasCallStack => FilePath -> IO ()
testSetConnectionIncognitoProhibitedDuringNegotiation tmp = do
inv <- withNewTestChat tmp "alice" aliceProfile $ \alice -> do
testSetConnectionIncognitoProhibitedDuringNegotiation :: HasCallStack => TestParams -> IO ()
testSetConnectionIncognitoProhibitedDuringNegotiation ps = do
inv <- withNewTestChat ps "alice" aliceProfile $ \alice -> do
threadDelay 250000
alice ##> "/connect"
getInvitation alice
withNewTestChat tmp "bob" bobProfile $ \bob -> do
withNewTestChat ps "bob" bobProfile $ \bob -> do
threadDelay 250000
bob ##> ("/c " <> inv)
bob <## "confirmation sent!"
withTestChat tmp "alice" $ \alice -> do
withTestChat ps "alice" $ \alice -> do
threadDelay 250000
alice <## "bob (Bob): contact is connected"
alice ##> "/_set incognito :1 on"
alice <## "chat db error: SEPendingConnectionNotFound {connId = 1}"
withTestChat tmp "bob" $ \bob -> do
withTestChat ps "bob" $ \bob -> do
bob <## "alice (Alice): contact is connected"
alice <##> bob
alice `hasContactProfiles` ["alice", "bob"]
bob `hasContactProfiles` ["alice", "bob"]
testSetConnectionIncognitoProhibitedDuringNegotiationSlow :: HasCallStack => FilePath -> IO ()
testSetConnectionIncognitoProhibitedDuringNegotiationSlow tmp = do
inv <- withNewTestChatCfg tmp testCfgSlow "alice" aliceProfile $ \alice -> do
testSetConnectionIncognitoProhibitedDuringNegotiationSlow :: HasCallStack => TestParams -> IO ()
testSetConnectionIncognitoProhibitedDuringNegotiationSlow ps = do
inv <- withNewTestChatCfg ps testCfgSlow "alice" aliceProfile $ \alice -> do
threadDelay 250000
alice ##> "/connect"
getInvitation alice
withNewTestChatCfg tmp testCfgSlow "bob" bobProfile $ \bob -> do
withNewTestChatCfg ps testCfgSlow "bob" bobProfile $ \bob -> do
threadDelay 250000
bob ##> ("/c " <> inv)
bob <## "confirmation sent!"
withTestChatCfg tmp testCfgSlow "alice" $ \alice -> do
withTestChatCfg ps testCfgSlow "alice" $ \alice -> do
threadDelay 250000
alice ##> "/_set incognito :1 on"
alice <## "chat db error: SEPendingConnectionNotFound {connId = 1}"
withTestChatCfg tmp testCfgSlow "bob" $ \bob -> do
withTestChatCfg ps testCfgSlow "bob" $ \bob -> do
concurrently_
(bob <## "alice (Alice): contact is connected")
(alice <## "bob (Bob): contact is connected")
@ -1396,7 +1398,7 @@ testSetConnectionIncognitoProhibitedDuringNegotiationSlow tmp = do
alice `hasContactProfiles` ["alice", "bob"]
bob `hasContactProfiles` ["alice", "bob"]
testConnectionIncognitoUnchangedErrors :: HasCallStack => FilePath -> IO ()
testConnectionIncognitoUnchangedErrors :: HasCallStack => TestParams -> IO ()
testConnectionIncognitoUnchangedErrors = testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/connect"
@ -1420,7 +1422,7 @@ testConnectionIncognitoUnchangedErrors = testChat2 aliceProfile bobProfile $
alice `hasContactProfiles` ["alice", "bob"]
bob `hasContactProfiles` ["alice", "bob"]
testSetResetSetConnectionIncognito :: HasCallStack => FilePath -> IO ()
testSetResetSetConnectionIncognito :: HasCallStack => TestParams -> IO ()
testSetResetSetConnectionIncognito = testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/_connect 1 incognito=off"
@ -1447,7 +1449,7 @@ testSetResetSetConnectionIncognito = testChat2 aliceProfile bobProfile $
alice `hasContactProfiles` ["alice", "bob", T.pack aliceIncognito]
bob `hasContactProfiles` ["bob", T.pack aliceIncognito]
testJoinGroupIncognito :: HasCallStack => FilePath -> IO ()
testJoinGroupIncognito :: HasCallStack => TestParams -> IO ()
testJoinGroupIncognito =
testChatCfg4 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do
@ -1636,7 +1638,7 @@ testJoinGroupIncognito =
cath ?#> "@bob_1 ok"
bob <# (cathIncognito <> "> ok")
testCantInviteContactIncognito :: HasCallStack => FilePath -> IO ()
testCantInviteContactIncognito :: HasCallStack => TestParams -> IO ()
testCantInviteContactIncognito = testChat2 aliceProfile bobProfile $
\alice bob -> do
-- alice connected incognito to bob
@ -1660,7 +1662,7 @@ testCantInviteContactIncognito = testChat2 aliceProfile bobProfile $
-- bob doesn't receive invitation
(bob </)
testCantSeeGlobalPrefsUpdateIncognito :: HasCallStack => FilePath -> IO ()
testCantSeeGlobalPrefsUpdateIncognito :: HasCallStack => TestParams -> IO ()
testCantSeeGlobalPrefsUpdateIncognito = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
alice ##> "/c i"
@ -1711,7 +1713,7 @@ testCantSeeGlobalPrefsUpdateIncognito = testChat3 aliceProfile bobProfile cathPr
cath <## "alice updated preferences for you:"
cath <## "Full deletion: off (you allow: default (no), contact allows: yes)"
testDeleteContactThenGroupDeletesIncognitoProfile :: HasCallStack => FilePath -> IO ()
testDeleteContactThenGroupDeletesIncognitoProfile :: HasCallStack => TestParams -> IO ()
testDeleteContactThenGroupDeletesIncognitoProfile = testChat2 aliceProfile bobProfile $
\alice bob -> do
-- bob connects incognito to alice
@ -1763,7 +1765,7 @@ testDeleteContactThenGroupDeletesIncognitoProfile = testChat2 aliceProfile bobPr
bob <## "#team: you deleted the group"
bob `hasContactProfiles` ["bob"]
testDeleteGroupThenContactDeletesIncognitoProfile :: HasCallStack => FilePath -> IO ()
testDeleteGroupThenContactDeletesIncognitoProfile :: HasCallStack => TestParams -> IO ()
testDeleteGroupThenContactDeletesIncognitoProfile = testChat2 aliceProfile bobProfile $
\alice bob -> do
-- bob connects incognito to alice
@ -1815,7 +1817,7 @@ testDeleteGroupThenContactDeletesIncognitoProfile = testChat2 aliceProfile bobPr
(bob </)
bob `hasContactProfiles` ["bob"]
testSetAlias :: HasCallStack => FilePath -> IO ()
testSetAlias :: HasCallStack => TestParams -> IO ()
testSetAlias = testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
@ -1826,7 +1828,7 @@ testSetAlias = testChat2 aliceProfile bobProfile $
alice ##> "/contacts"
alice <## "bob (Bob)"
testChangePCCUser :: HasCallStack => FilePath -> IO ()
testChangePCCUser :: HasCallStack => TestParams -> IO ()
testChangePCCUser = testChat2 aliceProfile bobProfile $
\alice bob -> do
-- Create a new invite
@ -1856,7 +1858,7 @@ testChangePCCUser = testChat2 aliceProfile bobProfile $
(alice <## "bob (Bob): contact is connected")
(bob <## "alisa2: contact is connected")
testChangePCCUserFromIncognito :: HasCallStack => FilePath -> IO ()
testChangePCCUserFromIncognito :: HasCallStack => TestParams -> IO ()
testChangePCCUserFromIncognito = testChat2 aliceProfile bobProfile $
\alice bob -> do
-- Create a new invite and set as incognito
@ -1887,7 +1889,7 @@ testChangePCCUserFromIncognito = testChat2 aliceProfile bobProfile $
(alice <## "bob (Bob): contact is connected")
(bob <## "alice (Alice): contact is connected")
testChangePCCUserAndThenIncognito :: HasCallStack => FilePath -> IO ()
testChangePCCUserAndThenIncognito :: HasCallStack => TestParams -> IO ()
testChangePCCUserAndThenIncognito = testChat2 aliceProfile bobProfile $
\alice bob -> do
-- Create a new invite and set as incognito
@ -1916,11 +1918,11 @@ testChangePCCUserAndThenIncognito = testChat2 aliceProfile bobProfile $
alice <## ("use /i bob to print out this incognito profile again")
]
testChangePCCUserDiffSrv :: HasCallStack => FilePath -> IO ()
testChangePCCUserDiffSrv tmp = do
testChangePCCUserDiffSrv :: HasCallStack => TestParams -> IO ()
testChangePCCUserDiffSrv ps = do
withSmpServer' serverCfg' $ do
withNewTestChatCfgOpts tmp testCfg testOpts "alice" aliceProfile $ \alice -> do
withNewTestChatCfgOpts tmp testCfg testOpts "bob" bobProfile $ \bob -> do
withNewTestChatCfgOpts ps testCfg testOpts "alice" aliceProfile $ \alice -> do
withNewTestChatCfgOpts ps testCfg testOpts "bob" bobProfile $ \bob -> do
-- Create a new invite
alice ##> "/connect"
_ <- getInvitation alice
@ -1962,7 +1964,7 @@ testChangePCCUserDiffSrv tmp = do
msgQueueQuota = 2
}
testSetConnectionAlias :: HasCallStack => FilePath -> IO ()
testSetConnectionAlias :: HasCallStack => TestParams -> IO ()
testSetConnectionAlias = testChat2 aliceProfile bobProfile $
\alice bob -> do
alice ##> "/c"
@ -1980,7 +1982,7 @@ testSetConnectionAlias = testChat2 aliceProfile bobProfile $
alice ##> "/contacts"
alice <## "bob (Bob) (alias: friend)"
testSetGroupAlias :: HasCallStack => FilePath -> IO ()
testSetGroupAlias :: HasCallStack => TestParams -> IO ()
testSetGroupAlias = testChat2 aliceProfile bobProfile $
\alice bob -> do
createGroup2 "team" alice bob
@ -1994,7 +1996,7 @@ testSetGroupAlias = testChat2 aliceProfile bobProfile $
alice ##> "/groups"
alice <## "#team (2 members)"
testSetContactPrefs :: HasCallStack => FilePath -> IO ()
testSetContactPrefs :: HasCallStack => TestParams -> IO ()
testSetContactPrefs = testChat2 aliceProfile bobProfile $
\alice bob -> withXFTPServer $ do
alice #$> ("/_files_folder ./tests/tmp/alice", id, "ok")
@ -2087,7 +2089,7 @@ testSetContactPrefs = testChat2 aliceProfile bobProfile $
bob <## "Voice messages: off (you allow: default (yes), contact allows: no)"
bob #$> ("/_get chat @2 count=100", chat, startFeatures <> [(0, "Voice messages: enabled for you"), (1, "voice message (00:10)"), (0, "Voice messages: off"), (1, "Voice messages: enabled"), (0, "Voice messages: off")])
testFeatureOffers :: HasCallStack => FilePath -> IO ()
testFeatureOffers :: HasCallStack => TestParams -> IO ()
testFeatureOffers = testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
@ -2106,7 +2108,7 @@ testFeatureOffers = testChat2 aliceProfile bobProfile $
bob <## "Full deletion: off (you allow: default (no), contact allows: no)"
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "offered Full deletion"), (0, "cancelled Full deletion")])
testUpdateGroupPrefs :: HasCallStack => FilePath -> IO ()
testUpdateGroupPrefs :: HasCallStack => TestParams -> IO ()
testUpdateGroupPrefs =
testChat2 aliceProfile bobProfile $
\alice bob -> do
@ -2157,7 +2159,7 @@ testUpdateGroupPrefs =
alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "Full deletion: on"), (1, "Full deletion: off"), (1, "Voice messages: off"), (1, "Voice messages: on"), (1, "hey"), (0, "hi")])
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Full deletion: on"), (0, "Full deletion: off"), (0, "Voice messages: off"), (0, "Voice messages: on"), (0, "hey"), (1, "hi")])
testAllowFullDeletionContact :: HasCallStack => FilePath -> IO ()
testAllowFullDeletionContact :: HasCallStack => TestParams -> IO ()
testAllowFullDeletionContact =
testChat2 aliceProfile bobProfile $
\alice bob -> do
@ -2175,7 +2177,7 @@ testAllowFullDeletionContact =
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "hi"), (1, "Full deletion: enabled for contact")])
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "hi"), (0, "Full deletion: enabled for you")])
testAllowFullDeletionGroup :: HasCallStack => FilePath -> IO ()
testAllowFullDeletionGroup :: HasCallStack => TestParams -> IO ()
testAllowFullDeletionGroup =
testChat2 aliceProfile bobProfile $
\alice bob -> do
@ -2201,7 +2203,7 @@ testAllowFullDeletionGroup =
alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "hi"), (1, "Full deletion: on")])
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "hi"), (0, "Full deletion: on")])
testProhibitDirectMessages :: HasCallStack => FilePath -> IO ()
testProhibitDirectMessages :: HasCallStack => TestParams -> IO ()
testProhibitDirectMessages =
testChatCfg4 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do
@ -2259,7 +2261,7 @@ testProhibitDirectMessages =
cc <## "updated group preferences:"
cc <## "Direct messages: off"
testEnableTimedMessagesContact :: HasCallStack => FilePath -> IO ()
testEnableTimedMessagesContact :: HasCallStack => TestParams -> IO ()
testEnableTimedMessagesContact =
testChat2 aliceProfile bobProfile $
\alice bob -> do
@ -2304,7 +2306,7 @@ testEnableTimedMessagesContact =
alice <## "bob updated preferences for you:"
alice <## "Disappearing messages: enabled (you allow: yes (1 week), contact allows: yes (1 week))"
testEnableTimedMessagesGroup :: HasCallStack => FilePath -> IO ()
testEnableTimedMessagesGroup :: HasCallStack => TestParams -> IO ()
testEnableTimedMessagesGroup =
testChat2 aliceProfile bobProfile $
\alice bob -> do
@ -2354,7 +2356,7 @@ testEnableTimedMessagesGroup =
bob <## "updated group preferences:"
bob <## "Disappearing messages: on (1 week)"
testTimedMessagesEnabledGlobally :: HasCallStack => FilePath -> IO ()
testTimedMessagesEnabledGlobally :: HasCallStack => TestParams -> IO ()
testTimedMessagesEnabledGlobally =
testChat2 aliceProfile bobProfile $
\alice bob -> do
@ -2378,7 +2380,7 @@ testTimedMessagesEnabledGlobally =
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (1 sec)")])
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (1 sec)")])
testUpdateMultipleUserPrefs :: HasCallStack => FilePath -> IO ()
testUpdateMultipleUserPrefs :: HasCallStack => TestParams -> IO ()
testUpdateMultipleUserPrefs = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
connectUsers alice bob
@ -2405,7 +2407,7 @@ testUpdateMultipleUserPrefs = testChat3 aliceProfile bobProfile cathProfile $
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "hi bob"), (1, "Full deletion: enabled for contact"), (1, "Message reactions: off")])
alice #$> ("/_get chat @3 count=100", chat, chatFeatures <> [(1, "hi cath"), (1, "Full deletion: enabled for contact"), (1, "Message reactions: off")])
testGroupPrefsDirectForRole :: HasCallStack => FilePath -> IO ()
testGroupPrefsDirectForRole :: HasCallStack => TestParams -> IO ()
testGroupPrefsDirectForRole = testChat4 aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do
createGroup3 "team" alice bob cath
@ -2471,7 +2473,7 @@ testGroupPrefsDirectForRole = testChat4 aliceProfile bobProfile cathProfile danP
cc <## "updated group preferences:"
cc <## "Direct messages: on for owners"
testGroupPrefsFilesForRole :: HasCallStack => FilePath -> IO ()
testGroupPrefsFilesForRole :: HasCallStack => TestParams -> IO ()
testGroupPrefsFilesForRole = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do
alice #$> ("/_files_folder ./tests/tmp/alice", id, "ok")
@ -2506,7 +2508,7 @@ testGroupPrefsFilesForRole = testChat3 aliceProfile bobProfile cathProfile $
cc <## "updated group preferences:"
cc <## "Files and media: on for owners"
testGroupPrefsSimplexLinksForRole :: HasCallStack => FilePath -> IO ()
testGroupPrefsSimplexLinksForRole :: HasCallStack => TestParams -> IO ()
testGroupPrefsSimplexLinksForRole = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do
createGroup3 "team" alice bob cath
@ -2542,7 +2544,7 @@ testGroupPrefsSimplexLinksForRole = testChat3 aliceProfile bobProfile cathProfil
cc <## "updated group preferences:"
cc <## "SimpleX links: on for owners"
testSetUITheme :: HasCallStack => FilePath -> IO ()
testSetUITheme :: HasCallStack => TestParams -> IO ()
testSetUITheme =
testChat2 aliceProfile bobProfile $ \alice bob -> do
connectUsers alice bob

57
tests/ChatTests/Utils.hs
View file

@ -9,6 +9,7 @@
module ChatTests.Utils where
import ChatClient
import ChatTests.DBUtils
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_)
import Control.Concurrent.STM
@ -72,13 +73,13 @@ danProfile = Profile {displayName = "dan", fullName = "Daniel", image = Nothing,
businessProfile :: Profile
businessProfile = Profile {displayName = "biz", fullName = "Biz Inc", image = Nothing, contactLink = Nothing, preferences = defaultPrefs}
it :: HasCallStack => String -> (FilePath -> Expectation) -> SpecWith (Arg (FilePath -> Expectation))
it :: HasCallStack => String -> (TestParams -> Expectation) -> SpecWith (Arg (TestParams -> Expectation))
it name test =
Hspec.it name $ \tmp -> timeout t (test tmp) >>= maybe (error "test timed out") pure
where
t = 90 * 1000000
xit' :: HasCallStack => String -> (FilePath -> Expectation) -> SpecWith (Arg (FilePath -> Expectation))
xit' :: HasCallStack => String -> (TestParams -> Expectation) -> SpecWith (Arg (TestParams -> Expectation))
xit' = if os == "linux" then xit else it
xit'' :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
@ -96,7 +97,7 @@ skip :: String -> SpecWith a -> SpecWith a
skip = before_ . pendingWith
-- Bool is pqExpected - see testAddContact
versionTestMatrix2 :: (HasCallStack => Bool -> TestCC -> TestCC -> IO ()) -> SpecWith FilePath
versionTestMatrix2 :: (HasCallStack => Bool -> TestCC -> TestCC -> IO ()) -> SpecWith TestParams
versionTestMatrix2 runTest = do
it "current" $ testChat2 aliceProfile bobProfile (runTest True)
it "prev" $ testChatCfg2 testCfgVPrev aliceProfile bobProfile (runTest False)
@ -106,7 +107,7 @@ versionTestMatrix2 runTest = do
it "old to curr" $ runTestCfg2 testCfg testCfgV1 (runTest False)
it "curr to old" $ runTestCfg2 testCfgV1 testCfg (runTest False)
versionTestMatrix3 :: (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> SpecWith FilePath
versionTestMatrix3 :: (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> SpecWith TestParams
versionTestMatrix3 runTest = do
it "current" $ testChat3 aliceProfile bobProfile cathProfile runTest
it "prev" $ testChatCfg3 testCfgVPrev aliceProfile bobProfile cathProfile runTest
@ -115,46 +116,46 @@ versionTestMatrix3 runTest = do
it "curr to prev" $ runTestCfg3 testCfgVPrev testCfg testCfg runTest
it "curr+prev to prev" $ runTestCfg3 testCfgVPrev testCfg testCfgVPrev runTest
runTestCfg2 :: ChatConfig -> ChatConfig -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
runTestCfg2 aliceCfg bobCfg runTest tmp =
withNewTestChatCfg tmp aliceCfg "alice" aliceProfile $ \alice ->
withNewTestChatCfg tmp bobCfg "bob" bobProfile $ \bob ->
runTestCfg2 :: ChatConfig -> ChatConfig -> (HasCallStack => TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
runTestCfg2 aliceCfg bobCfg runTest ps =
withNewTestChatCfg ps aliceCfg "alice" aliceProfile $ \alice ->
withNewTestChatCfg ps bobCfg "bob" bobProfile $ \bob ->
runTest alice bob
runTestCfg3 :: ChatConfig -> ChatConfig -> ChatConfig -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
runTestCfg3 aliceCfg bobCfg cathCfg runTest tmp =
withNewTestChatCfg tmp aliceCfg "alice" aliceProfile $ \alice ->
withNewTestChatCfg tmp bobCfg "bob" bobProfile $ \bob ->
withNewTestChatCfg tmp cathCfg "cath" cathProfile $ \cath ->
runTestCfg3 :: ChatConfig -> ChatConfig -> ChatConfig -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
runTestCfg3 aliceCfg bobCfg cathCfg runTest ps =
withNewTestChatCfg ps aliceCfg "alice" aliceProfile $ \alice ->
withNewTestChatCfg ps bobCfg "bob" bobProfile $ \bob ->
withNewTestChatCfg ps cathCfg "cath" cathProfile $ \cath ->
runTest alice bob cath
withTestChatGroup3Connected :: HasCallStack => FilePath -> String -> (HasCallStack => TestCC -> IO a) -> IO a
withTestChatGroup3Connected tmp dbPrefix action = do
withTestChat tmp dbPrefix $ \cc -> do
withTestChatGroup3Connected :: HasCallStack => TestParams -> String -> (HasCallStack => TestCC -> IO a) -> IO a
withTestChatGroup3Connected ps dbPrefix action = do
withTestChat ps dbPrefix $ \cc -> do
cc <## "2 contacts connected (use /cs for the list)"
cc <## "#team: connected to server(s)"
action cc
withTestChatGroup3Connected' :: HasCallStack => FilePath -> String -> IO ()
withTestChatGroup3Connected' tmp dbPrefix = withTestChatGroup3Connected tmp dbPrefix $ \_ -> pure ()
withTestChatGroup3Connected' :: HasCallStack => TestParams -> String -> IO ()
withTestChatGroup3Connected' ps dbPrefix = withTestChatGroup3Connected ps dbPrefix $ \_ -> pure ()
withTestChatContactConnected :: HasCallStack => FilePath -> String -> (HasCallStack => TestCC -> IO a) -> IO a
withTestChatContactConnected tmp dbPrefix action =
withTestChat tmp dbPrefix $ \cc -> do
withTestChatContactConnected :: HasCallStack => TestParams -> String -> (HasCallStack => TestCC -> IO a) -> IO a
withTestChatContactConnected ps dbPrefix action =
withTestChat ps dbPrefix $ \cc -> do
cc <## "1 contacts connected (use /cs for the list)"
action cc
withTestChatContactConnected' :: HasCallStack => FilePath -> String -> IO ()
withTestChatContactConnected' tmp dbPrefix = withTestChatContactConnected tmp dbPrefix $ \_ -> pure ()
withTestChatContactConnected' :: HasCallStack => TestParams -> String -> IO ()
withTestChatContactConnected' ps dbPrefix = withTestChatContactConnected ps dbPrefix $ \_ -> pure ()
withTestChatContactConnectedV1 :: HasCallStack => FilePath -> String -> (HasCallStack => TestCC -> IO a) -> IO a
withTestChatContactConnectedV1 tmp dbPrefix action =
withTestChatV1 tmp dbPrefix $ \cc -> do
withTestChatContactConnectedV1 :: HasCallStack => TestParams -> String -> (HasCallStack => TestCC -> IO a) -> IO a
withTestChatContactConnectedV1 ps dbPrefix action =
withTestChatV1 ps dbPrefix $ \cc -> do
cc <## "1 contacts connected (use /cs for the list)"
action cc
withTestChatContactConnectedV1' :: HasCallStack => FilePath -> String -> IO ()
withTestChatContactConnectedV1' tmp dbPrefix = withTestChatContactConnectedV1 tmp dbPrefix $ \_ -> pure ()
withTestChatContactConnectedV1' :: HasCallStack => TestParams -> String -> IO ()
withTestChatContactConnectedV1' ps dbPrefix = withTestChatContactConnectedV1 ps dbPrefix $ \_ -> pure ()
-- | test sending direct messages
(<##>) :: HasCallStack => TestCC -> TestCC -> IO ()

54
tests/MobileTests.hs
View file

@ -7,6 +7,7 @@
module MobileTests where
import ChatTests.DBUtils
import ChatTests.Utils
import Control.Concurrent.STM
import Control.Monad.Except
@ -38,6 +39,7 @@ import Simplex.Chat.Store.Profiles
import Simplex.Chat.Types (AgentUserId (..), Profile (..))
import Simplex.Messaging.Agent.Store.Interface
import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile(..), CryptoFileArgs (..))
import qualified Simplex.Messaging.Crypto.File as CF
@ -48,7 +50,7 @@ import System.FilePath ((</>))
import System.IO (utf8)
import Test.Hspec hiding (it)
mobileTests :: HasCallStack => SpecWith FilePath
mobileTests :: HasCallStack => SpecWith TestParams
mobileTests = do
describe "mobile API" $ do
runIO $ do
@ -146,9 +148,10 @@ parsedMarkdown =
parsedMarkdownTagged
#endif
testChatApiNoUser :: FilePath -> IO ()
testChatApiNoUser tmp = do
let dbPrefix = tmp </> "1"
testChatApiNoUser :: TestParams -> IO ()
testChatApiNoUser ps = do
let tmp = tmpPath ps
dbPrefix = tmp </> "1"
Right cc <- chatMigrateInit dbPrefix "" "yesUp"
Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "myKey" "yesUp"
chatSendCmd cc "/u" `shouldReturn` noActiveUser
@ -156,11 +159,12 @@ testChatApiNoUser tmp = do
chatSendCmd cc "/create user alice Alice" `shouldReturn` activeUser
chatSendCmd cc "/_start" `shouldReturn` chatStarted
testChatApi :: FilePath -> IO ()
testChatApi tmp = do
let dbPrefix = tmp </> "1"
testChatApi :: TestParams -> IO ()
testChatApi ps = do
let tmp = tmpPath ps
dbPrefix = tmp </> "1"
f = dbPrefix <> chatSuffix
Right st <- createChatStore (DBOpts f "myKey" False True) MCYesUp
Right st <- createChatStore (DBOpts f "myKey" False True DB.TQOff) MCYesUp
Right _ <- withTransaction st $ \db -> runExceptT $ createUserRecord db (AgentUserId 1) aliceProfile {preferences = Nothing} True
Right cc <- chatMigrateInit dbPrefix "myKey" "yesUp"
Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "" "yesUp"
@ -173,8 +177,9 @@ testChatApi tmp = do
chatParseMarkdown "hello" `shouldBe` "{}"
chatParseMarkdown "*hello*" `shouldBe` parsedMarkdown
testMediaApi :: HasCallStack => FilePath -> IO ()
testMediaApi tmp = do
testMediaApi :: HasCallStack => TestParams -> IO ()
testMediaApi ps = do
let tmp = tmpPath ps
Right c@ChatController {random = g} <- chatMigrateInit (tmp </> "1") "" "yesUp"
cc <- newStablePtr c
key <- atomically $ C.randomBytes 32 g
@ -187,8 +192,9 @@ testMediaApi tmp = do
B.length encrypted `shouldBe` B.length frame'
runExceptT (chatDecryptMedia keyStr encrypted) `shouldReturn` Right frame'
testMediaCApi :: HasCallStack => FilePath -> IO ()
testMediaCApi tmp = do
testMediaCApi :: HasCallStack => TestParams -> IO ()
testMediaCApi ps = do
let tmp = tmpPath ps
Right c@ChatController {random = g} <- chatMigrateInit (tmp </> "1") "" "yesUp"
cc <- newStablePtr c
key <- atomically $ C.randomBytes 32 g
@ -216,8 +222,9 @@ instance FromJSON WriteFileResult where
instance FromJSON ReadFileResult where
parseJSON = $(JQ.mkParseJSON (sumTypeJSON $ dropPrefix "RF") ''ReadFileResult)
testFileCApi :: FilePath -> FilePath -> IO ()
testFileCApi fileName tmp = do
testFileCApi :: FilePath -> TestParams -> IO ()
testFileCApi fileName ps = do
let tmp = tmpPath ps
cc <- mkCCPtr tmp
src <- B.readFile "./tests/fixtures/test.pdf"
let path = tmp </> (fileName <> ".pdf")
@ -241,8 +248,9 @@ testFileCApi fileName tmp = do
contents `shouldBe` src
sz' `shouldBe` len
testMissingFileCApi :: FilePath -> IO ()
testMissingFileCApi tmp = do
testMissingFileCApi :: TestParams -> IO ()
testMissingFileCApi ps = do
let tmp = tmpPath ps
let path = tmp </> "missing_file"
cPath <- newCString path
CFArgs key nonce <- atomically . CF.randomArgs =<< C.newRandom
@ -253,8 +261,9 @@ testMissingFileCApi tmp = do
err <- peekCAString (ptr `plusPtr` 1)
err `shouldContain` "missing_file: openBinaryFile: does not exist"
testFileEncryptionCApi :: FilePath -> FilePath -> IO ()
testFileEncryptionCApi fileName tmp = do
testFileEncryptionCApi :: FilePath -> TestParams -> IO ()
testFileEncryptionCApi fileName ps = do
let tmp = tmpPath ps
cc <- mkCCPtr tmp
let fromPath = tmp </> (fileName <> ".source.pdf")
copyFile "./tests/fixtures/test.pdf" fromPath
@ -272,8 +281,9 @@ testFileEncryptionCApi fileName tmp = do
"" <- peekCAString =<< cChatDecryptFile cToPath cKey cNonce cToPath'
B.readFile toPath' `shouldReturn` src
testMissingFileEncryptionCApi :: FilePath -> IO ()
testMissingFileEncryptionCApi tmp = do
testMissingFileEncryptionCApi :: TestParams -> IO ()
testMissingFileEncryptionCApi ps = do
let tmp = tmpPath ps
cc <- mkCCPtr tmp
let fromPath = tmp </> "missing_file.source.pdf"
toPath = tmp </> "missing_file.encrypted.pdf"
@ -293,7 +303,7 @@ testMissingFileEncryptionCApi tmp = do
mkCCPtr :: FilePath -> IO (StablePtr ChatController)
mkCCPtr tmp = either (error . show) newStablePtr =<< chatMigrateInit (tmp </> "1") "" "yesUp"
testValidNameCApi :: FilePath -> IO ()
testValidNameCApi :: TestParams -> IO ()
testValidNameCApi _ = do
let goodName = "Джон Доу 👍"
cName1 <- cChatValidName =<< newCString goodName
@ -301,7 +311,7 @@ testValidNameCApi _ = do
cName2 <- cChatValidName =<< newCString " @'Джон' Доу 👍 "
peekCString cName2 `shouldReturn` goodName
testChatJsonLengthCApi :: FilePath -> IO ()
testChatJsonLengthCApi :: TestParams -> IO ()
testChatJsonLengthCApi _ = do
cInt1 <- cChatJsonLength =<< newCString "Hello!"
cInt1 `shouldBe` 6

25
tests/RemoteTests.hs
View file

@ -6,6 +6,7 @@
module RemoteTests where
import ChatClient
import ChatTests.DBUtils
import ChatTests.Utils
import Control.Logger.Simple
import qualified Data.Aeson as J
@ -26,7 +27,7 @@ import UnliftIO
import UnliftIO.Concurrent
import UnliftIO.Directory
remoteTests :: SpecWith FilePath
remoteTests :: SpecWith TestParams
remoteTests = describe "Remote" $ do
describe "protocol handshake" $ do
it "connects with new pairing (stops mobile)" $ remoteHandshakeTest False
@ -45,7 +46,7 @@ remoteTests = describe "Remote" $ do
-- * Chat commands
remoteHandshakeTest :: HasCallStack => Bool -> FilePath -> IO ()
remoteHandshakeTest :: HasCallStack => Bool -> TestParams -> IO ()
remoteHandshakeTest viaDesktop = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do
desktop ##> "/list remote hosts"
desktop <## "No remote hosts"
@ -74,7 +75,7 @@ remoteHandshakeTest viaDesktop = testChat2 aliceProfile aliceDesktopProfile $ \m
mobile ##> "/list remote ctrls"
mobile <## "No remote controllers"
remoteHandshakeStoredTest :: HasCallStack => FilePath -> IO ()
remoteHandshakeStoredTest :: HasCallStack => TestParams -> IO ()
remoteHandshakeStoredTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do
logNote "Starting new session"
startRemote mobile desktop
@ -95,7 +96,7 @@ remoteHandshakeStoredTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile
startRemoteStored mobile desktop
stopMobile mobile desktop `catchAny` (logError . tshow)
remoteHandshakeDiscoverTest :: HasCallStack => FilePath -> IO ()
remoteHandshakeDiscoverTest :: HasCallStack => TestParams -> IO ()
remoteHandshakeDiscoverTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do
logNote "Preparing new session"
startRemote mobile desktop
@ -105,7 +106,7 @@ remoteHandshakeDiscoverTest = testChat2 aliceProfile aliceDesktopProfile $ \mobi
startRemoteDiscover mobile desktop
stopMobile mobile desktop `catchAny` (logError . tshow)
remoteHandshakeRejectTest :: HasCallStack => FilePath -> IO ()
remoteHandshakeRejectTest :: HasCallStack => TestParams -> IO ()
remoteHandshakeRejectTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop mobileBob -> do
logNote "Starting new session"
startRemote mobile desktop
@ -135,7 +136,7 @@ remoteHandshakeRejectTest = testChat3 aliceProfile aliceDesktopProfile bobProfil
desktop <## "remote host 1 connected"
stopMobile mobile desktop
storedBindingsTest :: HasCallStack => FilePath -> IO ()
storedBindingsTest :: HasCallStack => TestParams -> IO ()
storedBindingsTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do
desktop ##> "/set device name My desktop"
desktop <## "ok"
@ -166,7 +167,7 @@ storedBindingsTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile deskto
-- TODO: more parser tests
remoteMessageTest :: HasCallStack => FilePath -> IO ()
remoteMessageTest :: HasCallStack => TestParams -> IO ()
remoteMessageTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do
startRemote mobile desktop
contactBob desktop bob
@ -192,7 +193,7 @@ remoteMessageTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mob
threadDelay 1000000
logNote "done"
remoteStoreFileTest :: HasCallStack => FilePath -> IO ()
remoteStoreFileTest :: HasCallStack => TestParams -> IO ()
remoteStoreFileTest =
testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob ->
withXFTPServer $ do
@ -322,7 +323,7 @@ remoteStoreFileTest =
r `shouldStartWith` "remote host 1 error"
r `shouldContain` err
remoteCLIFileTest :: HasCallStack => FilePath -> IO ()
remoteCLIFileTest :: HasCallStack => TestParams -> IO ()
remoteCLIFileTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> withXFTPServer $ do
let mobileFiles = "./tests/tmp/mobile_files"
mobile ##> ("/_files_folder " <> mobileFiles)
@ -391,7 +392,7 @@ remoteCLIFileTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mob
stopMobile mobile desktop
switchRemoteHostTest :: FilePath -> IO ()
switchRemoteHostTest :: TestParams -> IO ()
switchRemoteHostTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do
startRemote mobile desktop
contactBob desktop bob
@ -417,7 +418,7 @@ switchRemoteHostTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \
desktop <## "remote host 1 error: RHEInactive"
desktop ##> "/contacts"
indicateRemoteHostTest :: FilePath -> IO ()
indicateRemoteHostTest :: TestParams -> IO ()
indicateRemoteHostTest = testChat4 aliceProfile aliceDesktopProfile bobProfile cathProfile $ \mobile desktop bob cath -> do
connectUsers desktop cath
startRemote mobile desktop
@ -441,7 +442,7 @@ indicateRemoteHostTest = testChat4 aliceProfile aliceDesktopProfile bobProfile c
desktop <##> cath
cath <##> desktop
multipleProfilesTest :: FilePath -> IO ()
multipleProfilesTest :: TestParams -> IO ()
multipleProfilesTest = testChat4 aliceProfile aliceDesktopProfile bobProfile cathProfile $ \mobile desktop bob cath -> do
connectUsers desktop cath

48
tests/SchemaDump.hs
View file

@ -1,19 +1,32 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module SchemaDump where
import ChatClient (withTmpFiles)
import ChatTests.DBUtils
import Control.Concurrent.STM
import Control.DeepSeq
import qualified Control.Exception as E
import Control.Monad (unless, void)
import Data.List (dropWhileEnd)
import Data.List (dropWhileEnd, sort)
import qualified Data.Map.Strict as M
import Data.Maybe (fromJust, isJust)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Database.SQLite.Simple (Query (..))
import Simplex.Chat.Store (createChatStore)
import qualified Simplex.Chat.Store as Store
import Simplex.Messaging.Agent.Store.Common (withConnection)
import Simplex.Messaging.Agent.Store.Interface
import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfirmation (..), MigrationsToRun (..), toDownMigration)
import Simplex.Messaging.Agent.Store.DB (TrackQueries (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
import Simplex.Messaging.Util (ifM, whenM)
import Simplex.Messaging.Util (ifM, tshow, whenM)
import System.Directory (doesFileExist, removeFile)
import System.Process (readCreateProcess, shell)
import Test.Hspec
@ -40,6 +53,9 @@ appSchema = "src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql"
appLint :: FilePath
appLint = "src/Simplex/Chat/Store/SQLite/Migrations/chat_lint.sql"
appQueryPlans :: FilePath
appQueryPlans = "src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt"
testSchema :: FilePath
testSchema = "tests/tmp/test_agent_schema.sql"
@ -53,7 +69,7 @@ testVerifySchemaDump :: IO ()
testVerifySchemaDump = withTmpFiles $ do
savedSchema <- ifM (doesFileExist appSchema) (readFile appSchema) (pure "")
savedSchema `deepseq` pure ()
void $ createChatStore (DBOpts testDB "" False True) MCError
void $ createChatStore (DBOpts testDB "" False True TQOff) MCError
getSchema testDB appSchema `shouldReturn` savedSchema
removeFile testDB
@ -61,14 +77,14 @@ testVerifyLintFKeyIndexes :: IO ()
testVerifyLintFKeyIndexes = withTmpFiles $ do
savedLint <- ifM (doesFileExist appLint) (readFile appLint) (pure "")
savedLint `deepseq` pure ()
void $ createChatStore (DBOpts testDB "" False True) MCError
void $ createChatStore (DBOpts testDB "" False True TQOff) MCError
getLintFKeyIndexes testDB "tests/tmp/chat_lint.sql" `shouldReturn` savedLint
removeFile testDB
testSchemaMigrations :: IO ()
testSchemaMigrations = withTmpFiles $ do
let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) Store.migrations
Right st <- createDBStore (DBOpts testDB "" False True) noDownMigrations MCError
Right st <- createDBStore (DBOpts testDB "" False True TQOff) noDownMigrations MCError
mapM_ (testDownMigration st) $ drop (length noDownMigrations) Store.migrations
closeDBStore st
removeFile testDB
@ -120,3 +136,25 @@ getLintFKeyIndexes dbPath lintPath = do
void $ readCreateProcess (shell $ "sqlite3 " <> dbPath <> " '.lint fkey-indexes' > " <> lintPath) ""
lint <- readFile lintPath
lint `deepseq` pure lint
saveQueryPlans :: SpecWith TestParams
saveQueryPlans = it "verify and overwrite query plans" $ \TestParams {queryStats} -> do
savedPlans <- ifM (doesFileExist appQueryPlans) (T.readFile appQueryPlans) (pure "")
savedPlans `deepseq` pure ()
queries <- sort . M.keys <$> readTVarIO queryStats
Right st <- createChatStore (DBOpts testDB "" False True TQOff) MCError
plans' <- withConnection st $ \db -> do
DB.execute_ db "CREATE TABLE IF NOT EXISTS temp_conn_ids (conn_id BLOB)"
mapM (getQueryPlan db) queries
let savedPlans' = T.unlines plans'
T.writeFile appQueryPlans savedPlans'
savedPlans' `shouldBe` savedPlans
where
getQueryPlan :: DB.Connection -> Query -> IO Text
getQueryPlan db q =
(("Query: " <> fromQuery q) <>) . result <$> E.try (DB.query_ db $ "explain query plan " <> q)
result = \case
Right r -> "\nPlan:\n" <> T.unlines (map planDetail r)
Left (e :: E.SomeException) -> "\nError: " <> tshow e <> "\n"
planDetail :: (Int, Int, Int, Text) -> Text
planDetail (_, _, _, detail) = detail

20
tests/Test.hs
View file

@ -1,9 +1,12 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TupleSections #-}
import Bots.BroadcastTests
import Bots.DirectoryTests
import ChatClient
import ChatTests
import ChatTests.DBUtils
import ChatTests.Utils (xdescribe'')
import Control.Logger.Simple
import Data.Time.Clock.System
@ -21,6 +24,7 @@ import ViewTests
#if defined(dbPostgres)
import Simplex.Messaging.Agent.Store.Postgres.Util (createDBAndUserIfNotExists, dropAllSchemasExceptSystem, dropDatabaseAndUser)
#else
import qualified Simplex.Messaging.TMap as TM
import MobileTests
import SchemaDump
import WebRTCTests
@ -29,6 +33,9 @@ import WebRTCTests
main :: IO ()
main = do
setLogLevel LogError
#if !defined(dbPostgres)
queryStats <- TM.emptyIO
#endif
withGlobalLogging logCfg . hspec
#if defined(dbPostgres)
. beforeAll_ (dropDatabaseAndUser testDBConnectInfo >> createDBAndUserIfNotExists testDBConnectInfo)
@ -48,9 +55,11 @@ main = do
describe "Message batching" batchingTests
describe "Operators" operatorTests
describe "Random servers" randomServersTests
around testBracket
#if defined(dbPostgres)
around testBracket
. after_ (dropAllSchemasExceptSystem testDBConnectInfo)
#else
around (testBracket queryStats)
#endif
$ do
#if !defined(dbPostgres)
@ -60,8 +69,15 @@ main = do
xdescribe'' "SimpleX Broadcast bot" broadcastBotTests
xdescribe'' "SimpleX Directory service bot" directoryServiceTests
describe "Remote session" remoteTests
#if !defined(dbPostgres)
xdescribe'' "Save query plans" saveQueryPlans
#endif
where
testBracket test = withSmpServer $ tmpBracket test
#if defined(dbPostgres)
testBracket test = withSmpServer $ tmpBracket $ test . TestParams
#else
testBracket queryStats test = withSmpServer $ tmpBracket $ \tmpPath -> test TestParams {tmpPath, queryStats}
#endif
tmpBracket test = do
t <- getSystemTime
let ts = show (systemSeconds t) <> show (systemNanoseconds t)