android-apps-mirrors/SimpleX-Chat
0
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2025-06-28 12:19:54 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

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
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 source-repository-package
type: git type: git
location: https://github.com/simplex-chat/simplexmq.git location: https://github.com/simplex-chat/simplexmq.git
tag: 23189753751dc52046865ce2d992335495020e91 tag: 268a1303acbad1644f81cd3b2def5754e5e2c052
source-repository-package source-repository-package
type: git type: git

7
simplex-chat.cabal
View file

@ -446,6 +446,7 @@ test-suite simplex-chat-test
ChatTests ChatTests
ChatTests.ChatList ChatTests.ChatList
ChatTests.Direct ChatTests.Direct
ChatTests.DBUtils
ChatTests.Files ChatTests.Files
ChatTests.Forward ChatTests.Forward
ChatTests.Groups ChatTests.Groups
@ -470,8 +471,12 @@ test-suite simplex-chat-test
Directory.Service Directory.Service
Directory.Store Directory.Store
Paths_simplex_chat Paths_simplex_chat
if !flag(client_postgres) if flag(client_postgres)
other-modules: other-modules:
ChatTests.DBUtils.Postgres
else
other-modules:
ChatTests.DBUtils.SQLite
MobileTests MobileTests
SchemaDump SchemaDump
WebRTCTests 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 as J
import qualified Data.Aeson.TH as JQ import qualified Data.Aeson.TH as JQ
import Data.Bifunctor (first) import Data.Bifunctor (first)
import Data.ByteArray (ScrubbedBytes)
import qualified Data.ByteString.Base64.URL as U import qualified Data.ByteString.Base64.URL as U
import Data.ByteString.Char8 (ByteString) import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Char8 as B
@ -57,8 +56,10 @@ import Simplex.Messaging.Util (catchAll, liftEitherWith, safeDecodeUtf8)
import System.IO (utf8) import System.IO (utf8)
import System.Timeout (timeout) import System.Timeout (timeout)
#if !defined(dbPostgres) #if !defined(dbPostgres)
import Data.ByteArray (ScrubbedBytes)
import Database.SQLite.Simple (SQLError (..)) import Database.SQLite.Simple (SQLError (..))
import qualified Database.SQLite.Simple as DB import qualified Database.SQLite.Simple as DB
import qualified Simplex.Messaging.Agent.Store.DB as DB
#endif #endif
data DBMigrationResult data DBMigrationResult
@ -237,7 +238,7 @@ getActiveUser_ st = find activeUser <$> withTransaction st getUsers
-- only used in tests -- only used in tests
chatMigrateInit :: String -> ScrubbedBytes -> String -> IO (Either DBMigrationResult ChatController) chatMigrateInit :: String -> ScrubbedBytes -> String -> IO (Either DBMigrationResult ChatController)
chatMigrateInit dbFilePrefix dbKey confirm = do 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 chatMigrateInitKey chatDBOpts False confirm False
#endif #endif

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

@ -2,6 +2,7 @@
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
module Simplex.Chat.Options.SQLite where module Simplex.Chat.Options.SQLite where
@ -11,11 +12,13 @@ import qualified Data.ByteString.Char8 as B
import Foreign.C.String import Foreign.C.String
import Options.Applicative import Options.Applicative
import Simplex.Messaging.Agent.Store.Interface (DBOpts (..)) import Simplex.Messaging.Agent.Store.Interface (DBOpts (..))
import Simplex.Messaging.Agent.Store.SQLite.DB (TrackQueries (..))
import System.FilePath (combine) import System.FilePath (combine)
data ChatDbOpts = ChatDbOpts data ChatDbOpts = ChatDbOpts
{ dbFilePrefix :: String, { dbFilePrefix :: String,
dbKey :: ScrubbedBytes, dbKey :: ScrubbedBytes,
trackQueries :: TrackQueries,
vacuumOnMigration :: Bool vacuumOnMigration :: Bool
} }
@ -43,17 +46,24 @@ chatDbOptsP appDir defaultDbName = do
( long "disable-vacuum" ( long "disable-vacuum"
<> help "Do not vacuum database after migrations" <> 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 -> String
dbString ChatDbOpts {dbFilePrefix} = dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db" dbString ChatDbOpts {dbFilePrefix} = dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
toDBOpts :: ChatDbOpts -> String -> Bool -> DBOpts toDBOpts :: ChatDbOpts -> String -> Bool -> DBOpts
toDBOpts ChatDbOpts {dbFilePrefix, dbKey, vacuumOnMigration} dbSuffix keepKey = do toDBOpts ChatDbOpts {dbFilePrefix, dbKey, trackQueries, vacuumOnMigration} dbSuffix keepKey = do
DBOpts DBOpts
{ dbFilePath = dbFilePrefix <> dbSuffix, { dbFilePath = dbFilePrefix <> dbSuffix,
dbKey, dbKey,
keepKey, keepKey,
track = trackQueries,
vacuum = vacuumOnMigration vacuum = vacuumOnMigration
} }
@ -71,18 +81,14 @@ mobileDbOpts fp key = do
ChatDbOpts ChatDbOpts
{ dbFilePrefix, { dbFilePrefix,
dbKey, dbKey,
trackQueries = TQSlow 5000, -- 5ms
vacuumOnMigration = True vacuumOnMigration = True
} }
-- used to create new chat controller, -- used to create new chat controller,
-- at that point database is already opened, and the key in options is not used -- at that point database is already opened, and the key in options is not used
removeDbKey :: ChatDbOpts -> ChatDbOpts removeDbKey :: ChatDbOpts -> ChatDbOpts
removeDbKey ChatDbOpts {dbFilePrefix, vacuumOnMigration} = removeDbKey opts = opts {dbKey = ""} :: ChatDbOpts
ChatDbOpts
{ dbFilePrefix,
dbKey = "",
vacuumOnMigration
}
errorDbStr :: DBOpts -> String errorDbStr :: DBOpts -> String
errorDbStr DBOpts {dbFilePath} = dbFilePath 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.Library.Commands (_defaultNtfServers)
import Simplex.Chat.Operators import Simplex.Chat.Operators
import Simplex.Chat.Options import Simplex.Chat.Options
import Simplex.Chat.Options.DB
import Simplex.Chat.Terminal.Input import Simplex.Chat.Terminal.Input
import Simplex.Chat.Terminal.Output import Simplex.Chat.Terminal.Output
import Simplex.FileTransfer.Client.Presets (defaultXFTPServers) import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
@ -29,6 +28,7 @@ import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8) import Data.Text.Encoding (encodeUtf8)
import Database.SQLite.Simple (SQLError (..)) import Database.SQLite.Simple (SQLError (..))
import qualified Database.SQLite.Simple as DB import qualified Database.SQLite.Simple as DB
import Simplex.Chat.Options.DB
import System.IO (hFlush, hSetEcho, stdin, stdout) import System.IO (hFlush, hSetEcho, stdin, stdout)
#endif #endif

25
tests/Bots/BroadcastTests.hs
View file

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

335
tests/Bots/DirectoryTests.hs
View file

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

118
tests/ChatClient.hs
View file

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

3
tests/ChatTests.hs
View file

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

17
tests/ChatTests/ChatList.hs
View file

@ -1,12 +1,13 @@
module ChatTests.ChatList where module ChatTests.ChatList where
import ChatClient import ChatClient
import ChatTests.DBUtils
import ChatTests.Utils import ChatTests.Utils
import Data.Time.Clock (getCurrentTime) import Data.Time.Clock (getCurrentTime)
import Data.Time.Format.ISO8601 (iso8601Show) import Data.Time.Format.ISO8601 (iso8601Show)
import Test.Hspec hiding (it) import Test.Hspec hiding (it)
chatListTests :: SpecWith FilePath chatListTests :: SpecWith TestParams
chatListTests = do chatListTests = do
it "get last chats" testPaginationLast it "get last chats" testPaginationLast
it "get chats before/after timestamp" testPaginationTs it "get chats before/after timestamp" testPaginationTs
@ -16,7 +17,7 @@ chatListTests = do
it "filter favorite or unread" testFilterFavoriteOrUnread it "filter favorite or unread" testFilterFavoriteOrUnread
it "sort and filter chats of all types" testPaginationAllChatTypes it "sort and filter chats of all types" testPaginationAllChatTypes
testPaginationLast :: HasCallStack => FilePath -> IO () testPaginationLast :: HasCallStack => TestParams -> IO ()
testPaginationLast = testPaginationLast =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
@ -32,7 +33,7 @@ testPaginationLast =
alice <# "bob> hey" alice <# "bob> hey"
alice <# "@cath hey" alice <# "@cath hey"
testPaginationTs :: HasCallStack => FilePath -> IO () testPaginationTs :: HasCallStack => TestParams -> IO ()
testPaginationTs = testPaginationTs =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
@ -59,7 +60,7 @@ getChats_ :: HasCallStack => TestCC -> String -> [(String, String)] -> Expectati
getChats_ cc query expected = do getChats_ cc query expected = do
cc #$> ("/_get chats 1 pcc=on " <> query, chats, expected) cc #$> ("/_get chats 1 pcc=on " <> query, chats, expected)
testFilterSearch :: HasCallStack => FilePath -> IO () testFilterSearch :: HasCallStack => TestParams -> IO ()
testFilterSearch = testFilterSearch =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
@ -75,7 +76,7 @@ testFilterSearch =
getChats_ alice (query "bob") [("@bob", "hey")] getChats_ alice (query "bob") [("@bob", "hey")]
getChats_ alice (query "Bob") [("@bob", "hey")] getChats_ alice (query "Bob") [("@bob", "hey")]
testFilterFavorite :: HasCallStack => FilePath -> IO () testFilterFavorite :: HasCallStack => TestParams -> IO ()
testFilterFavorite = testFilterFavorite =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
@ -99,7 +100,7 @@ testFilterFavorite =
alice <## "ok" alice <## "ok"
getChats_ alice query [("@bob", "hey")] getChats_ alice query [("@bob", "hey")]
testFilterUnread :: HasCallStack => FilePath -> IO () testFilterUnread :: HasCallStack => TestParams -> IO ()
testFilterUnread = testFilterUnread =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
@ -123,7 +124,7 @@ testFilterUnread =
alice <## "ok" alice <## "ok"
getChats_ alice query [("@bob", "hey")] getChats_ alice query [("@bob", "hey")]
testFilterFavoriteOrUnread :: HasCallStack => FilePath -> IO () testFilterFavoriteOrUnread :: HasCallStack => TestParams -> IO ()
testFilterFavoriteOrUnread = testFilterFavoriteOrUnread =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
@ -154,7 +155,7 @@ testFilterFavoriteOrUnread =
alice <## "ok" alice <## "ok"
getChats_ alice query [("@cath", "hey"), ("@bob", "hey")] getChats_ alice query [("@cath", "hey"), ("@bob", "hey")]
testPaginationAllChatTypes :: HasCallStack => FilePath -> IO () testPaginationAllChatTypes :: HasCallStack => TestParams -> IO ()
testPaginationAllChatTypes = testPaginationAllChatTypes =
testChat4 aliceProfile bobProfile cathProfile danProfile $ testChat4 aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do \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 module ChatTests.Files where
import ChatClient import ChatClient
import ChatTests.DBUtils
import ChatTests.Utils import ChatTests.Utils
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_) import Control.Concurrent.Async (concurrently_)
@ -24,7 +25,7 @@ import Simplex.Messaging.Encoding.String
import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist, getFileSize) import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist, getFileSize)
import Test.Hspec hiding (it) import Test.Hspec hiding (it)
chatFileTests :: SpecWith FilePath chatFileTests :: SpecWith TestParams
chatFileTests = do chatFileTests = do
describe "messages with files" $ do describe "messages with files" $ do
it "send and receive message with file" runTestMessageWithFile 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 xit "removes sent file from server" testXFTPStandaloneCancelSnd -- no error shown in tests
it "removes received temporary files" testXFTPStandaloneCancelRcv it "removes received temporary files" testXFTPStandaloneCancelRcv
runTestMessageWithFile :: HasCallStack => FilePath -> IO () runTestMessageWithFile :: HasCallStack => TestParams -> IO ()
runTestMessageWithFile = testChat2 aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do runTestMessageWithFile = testChat2 aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do
connectUsers alice bob 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")]) 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")]) 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 = testSendImage =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $
\alice bob -> withXFTPServer $ do \alice bob -> withXFTPServer $ do
@ -120,7 +121,7 @@ testSendImage =
fileExists <- doesFileExist "./tests/tmp/test.jpg" fileExists <- doesFileExist "./tests/tmp/test.jpg"
fileExists `shouldBe` True fileExists `shouldBe` True
testSenderMarkItemDeleted :: HasCallStack => FilePath -> IO () testSenderMarkItemDeleted :: HasCallStack => TestParams -> IO ()
testSenderMarkItemDeleted = testSenderMarkItemDeleted =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $
\alice bob -> withXFTPServer $ do \alice bob -> withXFTPServer $ do
@ -143,7 +144,7 @@ testSenderMarkItemDeleted =
bob ##> "/fs 1" bob ##> "/fs 1"
bob <## "receiving file 1 (test_1MB.pdf) cancelled" bob <## "receiving file 1 (test_1MB.pdf) cancelled"
testFilesFoldersSendImage :: HasCallStack => FilePath -> IO () testFilesFoldersSendImage :: HasCallStack => TestParams -> IO ()
testFilesFoldersSendImage = testFilesFoldersSendImage =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $
\alice bob -> withXFTPServer $ do \alice bob -> withXFTPServer $ do
@ -175,7 +176,7 @@ testFilesFoldersSendImage =
bob <## "alice: contact is deleted" bob <## "alice: contact is deleted"
alice <## "bob (Bob) deleted contact with you" alice <## "bob (Bob) deleted contact with you"
testFilesFoldersImageSndDelete :: HasCallStack => FilePath -> IO () testFilesFoldersImageSndDelete :: HasCallStack => TestParams -> IO ()
testFilesFoldersImageSndDelete = testFilesFoldersImageSndDelete =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $
\alice bob -> withXFTPServer $ do \alice bob -> withXFTPServer $ do
@ -208,7 +209,7 @@ testFilesFoldersImageSndDelete =
bob ##> "/d alice" bob ##> "/d alice"
bob <## "alice: contact is deleted" bob <## "alice: contact is deleted"
testFilesFoldersImageRcvDelete :: HasCallStack => FilePath -> IO () testFilesFoldersImageRcvDelete :: HasCallStack => TestParams -> IO ()
testFilesFoldersImageRcvDelete = testFilesFoldersImageRcvDelete =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $
\alice bob -> withXFTPServer $ do \alice bob -> withXFTPServer $ do
@ -235,7 +236,7 @@ testFilesFoldersImageRcvDelete =
bob <## "alice: contact is deleted" bob <## "alice: contact is deleted"
alice <## "bob (Bob) deleted contact with you" alice <## "bob (Bob) deleted contact with you"
testSendImageWithTextAndQuote :: HasCallStack => FilePath -> IO () testSendImageWithTextAndQuote :: HasCallStack => TestParams -> IO ()
testSendImageWithTextAndQuote = testSendImageWithTextAndQuote =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $
\alice bob -> withXFTPServer $ do \alice bob -> withXFTPServer $ do
@ -310,7 +311,7 @@ testSendImageWithTextAndQuote =
B.readFile "./tests/tmp/test_1.jpg" `shouldReturn` src B.readFile "./tests/tmp/test_1.jpg" `shouldReturn` src
testGroupSendImage :: HasCallStack => FilePath -> IO () testGroupSendImage :: HasCallStack => TestParams -> IO ()
testGroupSendImage = testGroupSendImage =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do \alice bob cath -> withXFTPServer $ do
@ -352,7 +353,7 @@ testGroupSendImage =
bob #$> ("/_get chat #1 count=1", chatF, [((0, ""), Just "./tests/tmp/test.jpg")]) bob #$> ("/_get chat #1 count=1", chatF, [((0, ""), Just "./tests/tmp/test.jpg")])
cath #$> ("/_get chat #1 count=1", chatF, [((0, ""), Just "./tests/tmp/test_1.jpg")]) cath #$> ("/_get chat #1 count=1", chatF, [((0, ""), Just "./tests/tmp/test_1.jpg")])
testGroupSendImageWithTextAndQuote :: HasCallStack => FilePath -> IO () testGroupSendImageWithTextAndQuote :: HasCallStack => TestParams -> IO ()
testGroupSendImageWithTextAndQuote = testGroupSendImageWithTextAndQuote =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do \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 #$> ("/_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")] cath @@@ [("#team", "hey bob"), ("@alice", "received invitation to join group team as admin")]
testSendMultiFilesDirect :: HasCallStack => FilePath -> IO () testSendMultiFilesDirect :: HasCallStack => TestParams -> IO ()
testSendMultiFilesDirect = testSendMultiFilesDirect =
testChat2 aliceProfile bobProfile $ \alice bob -> do testChat2 aliceProfile bobProfile $ \alice bob -> do
withXFTPServer $ 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")]) 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")]) 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 = testSendMultiFilesGroup =
testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
withXFTPServer $ do withXFTPServer $ do
@ -582,7 +583,7 @@ testXFTPRoundFDCount = do
roundedFDCount 128 `shouldBe` 128 roundedFDCount 128 `shouldBe` 128
roundedFDCount 500 `shouldBe` 512 roundedFDCount 500 `shouldBe` 512
testXFTPFileTransfer :: HasCallStack => FilePath -> IO () testXFTPFileTransfer :: HasCallStack => TestParams -> IO ()
testXFTPFileTransfer = testXFTPFileTransfer =
testChat2 aliceProfile bobProfile $ \alice bob -> do testChat2 aliceProfile bobProfile $ \alice bob -> do
withXFTPServer $ do withXFTPServer $ do
@ -611,7 +612,7 @@ testXFTPFileTransfer =
dest <- B.readFile "./tests/tmp/test.pdf" dest <- B.readFile "./tests/tmp/test.pdf"
dest `shouldBe` src dest `shouldBe` src
testXFTPFileTransferEncrypted :: HasCallStack => FilePath -> IO () testXFTPFileTransferEncrypted :: HasCallStack => TestParams -> IO ()
testXFTPFileTransferEncrypted = testXFTPFileTransferEncrypted =
testChat2 aliceProfile bobProfile $ \alice bob -> do testChat2 aliceProfile bobProfile $ \alice bob -> do
src <- B.readFile "./tests/fixtures/test.pdf" src <- B.readFile "./tests/fixtures/test.pdf"
@ -638,7 +639,7 @@ testXFTPFileTransferEncrypted =
LB.length dest `shouldBe` fromIntegral srcLen LB.length dest `shouldBe` fromIntegral srcLen
LB.toStrict dest `shouldBe` src LB.toStrict dest `shouldBe` src
testXFTPAcceptAfterUpload :: HasCallStack => FilePath -> IO () testXFTPAcceptAfterUpload :: HasCallStack => TestParams -> IO ()
testXFTPAcceptAfterUpload = testXFTPAcceptAfterUpload =
testChat2 aliceProfile bobProfile $ \alice bob -> do testChat2 aliceProfile bobProfile $ \alice bob -> do
withXFTPServer $ do withXFTPServer $ do
@ -663,7 +664,7 @@ testXFTPAcceptAfterUpload =
dest <- B.readFile "./tests/tmp/test.pdf" dest <- B.readFile "./tests/tmp/test.pdf"
dest `shouldBe` src dest `shouldBe` src
testXFTPGroupFileTransfer :: HasCallStack => FilePath -> IO () testXFTPGroupFileTransfer :: HasCallStack => TestParams -> IO ()
testXFTPGroupFileTransfer = testXFTPGroupFileTransfer =
testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
withXFTPServer $ do withXFTPServer $ do
@ -701,7 +702,7 @@ testXFTPGroupFileTransfer =
dest1 `shouldBe` src dest1 `shouldBe` src
dest2 `shouldBe` src dest2 `shouldBe` src
testXFTPDeleteUploadedFile :: HasCallStack => FilePath -> IO () testXFTPDeleteUploadedFile :: HasCallStack => TestParams -> IO ()
testXFTPDeleteUploadedFile = testXFTPDeleteUploadedFile =
testChat2 aliceProfile bobProfile $ \alice bob -> do testChat2 aliceProfile bobProfile $ \alice bob -> do
withXFTPServer $ do withXFTPServer $ do
@ -722,7 +723,7 @@ testXFTPDeleteUploadedFile =
bob ##> "/fr 1 ./tests/tmp" bob ##> "/fr 1 ./tests/tmp"
bob <## "file cancelled: test.pdf" bob <## "file cancelled: test.pdf"
testXFTPDeleteUploadedFileGroup :: HasCallStack => FilePath -> IO () testXFTPDeleteUploadedFileGroup :: HasCallStack => TestParams -> IO ()
testXFTPDeleteUploadedFileGroup = testXFTPDeleteUploadedFileGroup =
testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
withXFTPServer $ do withXFTPServer $ do
@ -774,7 +775,7 @@ testXFTPDeleteUploadedFileGroup =
cath ##> "/fr 1 ./tests/tmp" cath ##> "/fr 1 ./tests/tmp"
cath <## "file cancelled: test.pdf" cath <## "file cancelled: test.pdf"
testXFTPWithRelativePaths :: HasCallStack => FilePath -> IO () testXFTPWithRelativePaths :: HasCallStack => TestParams -> IO ()
testXFTPWithRelativePaths = testXFTPWithRelativePaths =
testChat2 aliceProfile bobProfile $ \alice bob -> do testChat2 aliceProfile bobProfile $ \alice bob -> do
withXFTPServer $ do withXFTPServer $ do
@ -802,11 +803,11 @@ testXFTPWithRelativePaths =
dest <- B.readFile "./tests/tmp/bob_files/test.pdf" dest <- B.readFile "./tests/tmp/bob_files/test.pdf"
dest `shouldBe` src dest `shouldBe` src
testXFTPContinueRcv :: HasCallStack => FilePath -> IO () testXFTPContinueRcv :: HasCallStack => TestParams -> IO ()
testXFTPContinueRcv tmp = do testXFTPContinueRcv ps = do
withXFTPServer $ do withXFTPServer $ do
withNewTestChat tmp "alice" aliceProfile $ \alice -> do withNewTestChat ps "alice" aliceProfile $ \alice -> do
withNewTestChat tmp "bob" bobProfile $ \bob -> do withNewTestChat ps "bob" bobProfile $ \bob -> do
connectUsers alice bob connectUsers alice bob
alice #> "/f @bob ./tests/fixtures/test.pdf" alice #> "/f @bob ./tests/fixtures/test.pdf"
@ -816,7 +817,7 @@ testXFTPContinueRcv tmp = do
alice <## "completed uploading file 1 (test.pdf) for bob" alice <## "completed uploading file 1 (test.pdf) for bob"
-- server is down - file is not received -- 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 <## "1 contacts connected (use /cs for the list)"
bob ##> "/fr 1 ./tests/tmp" bob ##> "/fr 1 ./tests/tmp"
bob bob
@ -831,14 +832,14 @@ testXFTPContinueRcv tmp = do
withXFTPServer $ do withXFTPServer $ do
-- server is up - file reception is continued -- 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 <## "1 contacts connected (use /cs for the list)"
bob <## "completed receiving file 1 (test.pdf) from alice" bob <## "completed receiving file 1 (test.pdf) from alice"
src <- B.readFile "./tests/fixtures/test.pdf" src <- B.readFile "./tests/fixtures/test.pdf"
dest <- B.readFile "./tests/tmp/test.pdf" dest <- B.readFile "./tests/tmp/test.pdf"
dest `shouldBe` src dest `shouldBe` src
testXFTPMarkToReceive :: HasCallStack => FilePath -> IO () testXFTPMarkToReceive :: HasCallStack => TestParams -> IO ()
testXFTPMarkToReceive = do testXFTPMarkToReceive = do
testChat2 aliceProfile bobProfile $ \alice bob -> do testChat2 aliceProfile bobProfile $ \alice bob -> do
withXFTPServer $ do withXFTPServer $ do
@ -875,11 +876,11 @@ testXFTPMarkToReceive = do
dest <- B.readFile "./tests/tmp/bob_files/test.pdf" dest <- B.readFile "./tests/tmp/bob_files/test.pdf"
dest `shouldBe` src dest `shouldBe` src
testXFTPRcvError :: HasCallStack => FilePath -> IO () testXFTPRcvError :: HasCallStack => TestParams -> IO ()
testXFTPRcvError tmp = do testXFTPRcvError ps = do
withXFTPServer $ do withXFTPServer $ do
withNewTestChat tmp "alice" aliceProfile $ \alice -> do withNewTestChat ps "alice" aliceProfile $ \alice -> do
withNewTestChat tmp "bob" bobProfile $ \bob -> do withNewTestChat ps "bob" bobProfile $ \bob -> do
connectUsers alice bob connectUsers alice bob
alice #> "/f @bob ./tests/fixtures/test.pdf" 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 -- server is up w/t store log - file reception should fail
withXFTPServer' xftpServerConfig {storeLogFile = Nothing} $ do 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 <## "1 contacts connected (use /cs for the list)"
bob ##> "/fr 1 ./tests/tmp" bob ##> "/fr 1 ./tests/tmp"
bob bob
@ -903,7 +904,7 @@ testXFTPRcvError tmp = do
bob ##> "/fs 1" bob ##> "/fs 1"
bob <## "receiving file 1 (test.pdf) error: FileErrAuth" bob <## "receiving file 1 (test.pdf) error: FileErrAuth"
testXFTPCancelRcvRepeat :: HasCallStack => FilePath -> IO () testXFTPCancelRcvRepeat :: HasCallStack => TestParams -> IO ()
testXFTPCancelRcvRepeat = testXFTPCancelRcvRepeat =
testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do
withXFTPServer $ do withXFTPServer $ do
@ -952,7 +953,7 @@ testXFTPCancelRcvRepeat =
where where
cfg = testCfg {xftpDescrPartSize = 200} cfg = testCfg {xftpDescrPartSize = 200}
testAutoAcceptFile :: HasCallStack => FilePath -> IO () testAutoAcceptFile :: HasCallStack => TestParams -> IO ()
testAutoAcceptFile = testAutoAcceptFile =
testChatOpts2 opts aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do testChatOpts2 opts aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do
connectUsers alice bob connectUsers alice bob
@ -977,7 +978,7 @@ testAutoAcceptFile =
where where
opts = (testOpts :: ChatOpts) {autoAcceptFileSize = 200000} opts = (testOpts :: ChatOpts) {autoAcceptFileSize = 200000}
testProhibitFiles :: HasCallStack => FilePath -> IO () testProhibitFiles :: HasCallStack => TestParams -> IO ()
testProhibitFiles = testProhibitFiles =
testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> withXFTPServer $ do testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> withXFTPServer $ do
createGroup3 "team" alice bob cath createGroup3 "team" alice bob cath
@ -999,7 +1000,7 @@ testProhibitFiles =
(bob </) (bob </)
(cath </) (cath </)
testXFTPStandaloneSmall :: HasCallStack => FilePath -> IO () testXFTPStandaloneSmall :: HasCallStack => TestParams -> IO ()
testXFTPStandaloneSmall = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do testXFTPStandaloneSmall = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
withXFTPServer $ do withXFTPServer $ do
logNote "sending" logNote "sending"
@ -1024,7 +1025,7 @@ testXFTPStandaloneSmall = testChat2 aliceProfile aliceDesktopProfile $ \src dst
srcBody <- B.readFile "./tests/fixtures/logo.jpg" srcBody <- B.readFile "./tests/fixtures/logo.jpg"
B.readFile dstFile `shouldReturn` srcBody B.readFile dstFile `shouldReturn` srcBody
testXFTPStandaloneSmallInfo :: HasCallStack => FilePath -> IO () testXFTPStandaloneSmallInfo :: HasCallStack => TestParams -> IO ()
testXFTPStandaloneSmallInfo = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do testXFTPStandaloneSmallInfo = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
withXFTPServer $ do withXFTPServer $ do
logNote "sending" logNote "sending"
@ -1054,7 +1055,7 @@ testXFTPStandaloneSmallInfo = testChat2 aliceProfile aliceDesktopProfile $ \src
srcBody <- B.readFile "./tests/fixtures/logo.jpg" srcBody <- B.readFile "./tests/fixtures/logo.jpg"
B.readFile dstFile `shouldReturn` srcBody B.readFile dstFile `shouldReturn` srcBody
testXFTPStandaloneLarge :: HasCallStack => FilePath -> IO () testXFTPStandaloneLarge :: HasCallStack => TestParams -> IO ()
testXFTPStandaloneLarge = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do testXFTPStandaloneLarge = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
withXFTPServer $ do withXFTPServer $ do
xftpCLI ["rand", "./tests/tmp/testfile.in", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile.in"] 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" srcBody <- B.readFile "./tests/tmp/testfile.in"
B.readFile dstFile `shouldReturn` srcBody B.readFile dstFile `shouldReturn` srcBody
testXFTPStandaloneLargeInfo :: HasCallStack => FilePath -> IO () testXFTPStandaloneLargeInfo :: HasCallStack => TestParams -> IO ()
testXFTPStandaloneLargeInfo = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do testXFTPStandaloneLargeInfo = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
withXFTPServer $ do withXFTPServer $ do
xftpCLI ["rand", "./tests/tmp/testfile.in", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile.in"] 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" srcBody <- B.readFile "./tests/tmp/testfile.in"
B.readFile dstFile `shouldReturn` srcBody B.readFile dstFile `shouldReturn` srcBody
testXFTPStandaloneCancelSnd :: HasCallStack => FilePath -> IO () testXFTPStandaloneCancelSnd :: HasCallStack => TestParams -> IO ()
testXFTPStandaloneCancelSnd = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do testXFTPStandaloneCancelSnd = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
withXFTPServer $ do withXFTPServer $ do
xftpCLI ["rand", "./tests/tmp/testfile.in", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile.in"] 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 <## "error receiving file 1 (should.not.extist)"
dst <## "INTERNAL {internalErr = \"XFTP {xftpErr = AUTH}\"}" dst <## "INTERNAL {internalErr = \"XFTP {xftpErr = AUTH}\"}"
testXFTPStandaloneRelativePaths :: HasCallStack => FilePath -> IO () testXFTPStandaloneRelativePaths :: HasCallStack => TestParams -> IO ()
testXFTPStandaloneRelativePaths = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do testXFTPStandaloneRelativePaths = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
withXFTPServer $ do withXFTPServer $ do
logNote "sending" logNote "sending"
@ -1175,7 +1176,7 @@ testXFTPStandaloneRelativePaths = testChat2 aliceProfile aliceDesktopProfile $ \
srcBody <- B.readFile "./tests/tmp/src_files/testfile.in" srcBody <- B.readFile "./tests/tmp/src_files/testfile.in"
B.readFile "./tests/tmp/dst_files/testfile.out" `shouldReturn` srcBody 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 testXFTPStandaloneCancelRcv = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
withXFTPServer $ do withXFTPServer $ do
xftpCLI ["rand", "./tests/tmp/testfile.in", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile.in"] 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 module ChatTests.Forward where
import ChatClient import ChatClient
import ChatTests.DBUtils
import ChatTests.Utils import ChatTests.Utils
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Char8 as B
@ -14,7 +15,7 @@ import Simplex.Chat.Types (ImageData (..))
import System.Directory (copyFile, doesFileExist, removeFile) import System.Directory (copyFile, doesFileExist, removeFile)
import Test.Hspec hiding (it) import Test.Hspec hiding (it)
chatForwardTests :: SpecWith FilePath chatForwardTests :: SpecWith TestParams
chatForwardTests = do chatForwardTests = do
describe "forward messages" $ do describe "forward messages" $ do
it "from contact to contact" testForwardContactToContact it "from contact to contact" testForwardContactToContact
@ -42,7 +43,7 @@ chatForwardTests = do
it "from group to group" testForwardGroupToGroupMulti it "from group to group" testForwardGroupToGroupMulti
it "with relative paths: multiple files from contact to contact" testMultiForwardFiles it "with relative paths: multiple files from contact to contact" testMultiForwardFiles
testForwardContactToContact :: HasCallStack => FilePath -> IO () testForwardContactToContact :: HasCallStack => TestParams -> IO ()
testForwardContactToContact = testForwardContactToContact =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
@ -88,7 +89,7 @@ testForwardContactToContact =
alice .<## ": hey" alice .<## ": hey"
alice <##. "forwarded from: @bob, chat item id:" alice <##. "forwarded from: @bob, chat item id:"
testForwardContactToGroup :: HasCallStack => FilePath -> IO () testForwardContactToGroup :: HasCallStack => TestParams -> IO ()
testForwardContactToGroup = testForwardContactToGroup =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
@ -112,7 +113,7 @@ testForwardContactToGroup =
cath <# "#team alice> -> forwarded" cath <# "#team alice> -> forwarded"
cath <## " hey" cath <## " hey"
testForwardContactToNotes :: HasCallStack => FilePath -> IO () testForwardContactToNotes :: HasCallStack => TestParams -> IO ()
testForwardContactToNotes = testForwardContactToNotes =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
@ -132,7 +133,7 @@ testForwardContactToNotes =
alice <# "* <- @bob" alice <# "* <- @bob"
alice <## " hey" alice <## " hey"
testForwardGroupToContact :: HasCallStack => FilePath -> IO () testForwardGroupToContact :: HasCallStack => TestParams -> IO ()
testForwardGroupToContact = testForwardGroupToContact =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
@ -156,7 +157,7 @@ testForwardGroupToContact =
cath <# "alice> -> forwarded" cath <# "alice> -> forwarded"
cath <## " hey" cath <## " hey"
testForwardGroupToGroup :: HasCallStack => FilePath -> IO () testForwardGroupToGroup :: HasCallStack => TestParams -> IO ()
testForwardGroupToGroup = testForwardGroupToGroup =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
@ -197,7 +198,7 @@ testForwardGroupToGroup =
cath <# "#club alice> -> forwarded" cath <# "#club alice> -> forwarded"
cath <## " hey" cath <## " hey"
testForwardGroupToNotes :: HasCallStack => FilePath -> IO () testForwardGroupToNotes :: HasCallStack => TestParams -> IO ()
testForwardGroupToNotes = testForwardGroupToNotes =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
@ -217,7 +218,7 @@ testForwardGroupToNotes =
alice <# "* <- #team" alice <# "* <- #team"
alice <## " hey" alice <## " hey"
testForwardNotesToContact :: HasCallStack => FilePath -> IO () testForwardNotesToContact :: HasCallStack => TestParams -> IO ()
testForwardNotesToContact = testForwardNotesToContact =
testChat2 aliceProfile cathProfile $ testChat2 aliceProfile cathProfile $
\alice cath -> do \alice cath -> do
@ -230,7 +231,7 @@ testForwardNotesToContact =
alice <# "@cath hi" alice <# "@cath hi"
cath <# "alice> hi" cath <# "alice> hi"
testForwardNotesToGroup :: HasCallStack => FilePath -> IO () testForwardNotesToGroup :: HasCallStack => TestParams -> IO ()
testForwardNotesToGroup = testForwardNotesToGroup =
testChat2 aliceProfile cathProfile $ testChat2 aliceProfile cathProfile $
\alice cath -> do \alice cath -> do
@ -243,9 +244,9 @@ testForwardNotesToGroup =
alice <# "#team hi" alice <# "#team hi"
cath <# "#team alice> hi" cath <# "#team alice> hi"
testForwardNotesToNotes :: HasCallStack => FilePath -> IO () testForwardNotesToNotes :: HasCallStack => TestParams -> IO ()
testForwardNotesToNotes tmp = testForwardNotesToNotes ps =
withNewTestChat tmp "alice" aliceProfile $ \alice -> do withNewTestChat ps "alice" aliceProfile $ \alice -> do
createCCNoteFolder alice createCCNoteFolder alice
alice >* "hi" alice >* "hi"
@ -257,7 +258,7 @@ testForwardNotesToNotes tmp =
alice <# "* hi" alice <# "* hi"
alice <# "* hi" alice <# "* hi"
testForwardPreserveInfo :: HasCallStack => FilePath -> IO () testForwardPreserveInfo :: HasCallStack => TestParams -> IO ()
testForwardPreserveInfo = testForwardPreserveInfo =
testChat4 aliceProfile bobProfile cathProfile danProfile $ testChat4 aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do \alice bob cath dan -> do
@ -285,7 +286,7 @@ testForwardPreserveInfo =
dan <# "#team alice> -> forwarded" dan <# "#team alice> -> forwarded"
dan <## " hey" dan <## " hey"
testForwardRcvMsgNewInfo :: HasCallStack => FilePath -> IO () testForwardRcvMsgNewInfo :: HasCallStack => TestParams -> IO ()
testForwardRcvMsgNewInfo = testForwardRcvMsgNewInfo =
testChat4 aliceProfile bobProfile cathProfile danProfile $ testChat4 aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do \alice bob cath dan -> do
@ -313,7 +314,7 @@ testForwardRcvMsgNewInfo =
cath <# "alice> -> forwarded" cath <# "alice> -> forwarded"
cath <## " hey" cath <## " hey"
testForwardQuotedMsg :: HasCallStack => FilePath -> IO () testForwardQuotedMsg :: HasCallStack => TestParams -> IO ()
testForwardQuotedMsg = testForwardQuotedMsg =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
@ -343,7 +344,7 @@ testForwardQuotedMsg =
cath <# "alice> -> forwarded" cath <# "alice> -> forwarded"
cath <## " hey" cath <## " hey"
testForwardEditProhibited :: HasCallStack => FilePath -> IO () testForwardEditProhibited :: HasCallStack => TestParams -> IO ()
testForwardEditProhibited = testForwardEditProhibited =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
@ -363,7 +364,7 @@ testForwardEditProhibited =
alice ##> ("/_update item @3 " <> msgId <> " text hey edited") alice ##> ("/_update item @3 " <> msgId <> " text hey edited")
alice <## "cannot update this item" alice <## "cannot update this item"
testForwardDeleteForOther :: HasCallStack => FilePath -> IO () testForwardDeleteForOther :: HasCallStack => TestParams -> IO ()
testForwardDeleteForOther = testForwardDeleteForOther =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
@ -384,7 +385,7 @@ testForwardDeleteForOther =
alice <## "message marked deleted" alice <## "message marked deleted"
cath <# "alice> [marked deleted] hey" cath <# "alice> [marked deleted] hey"
testForwardFileNoFilesFolder :: HasCallStack => FilePath -> IO () testForwardFileNoFilesFolder :: HasCallStack => TestParams -> IO ()
testForwardFileNoFilesFolder = testForwardFileNoFilesFolder =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do \alice bob cath -> withXFTPServer $ do
@ -438,7 +439,7 @@ testForwardFileNoFilesFolder =
dest2 <- B.readFile "./tests/tmp/test_1.pdf" dest2 <- B.readFile "./tests/tmp/test_1.pdf"
dest2 `shouldBe` src dest2 `shouldBe` src
testForwardFileContactToContact :: HasCallStack => FilePath -> IO () testForwardFileContactToContact :: HasCallStack => TestParams -> IO ()
testForwardFileContactToContact = testForwardFileContactToContact =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do \alice bob cath -> withXFTPServer $ do
@ -504,7 +505,7 @@ testForwardFileContactToContact =
fwdFileExists <- doesFileExist "./tests/tmp/bob_files/test_1.pdf" fwdFileExists <- doesFileExist "./tests/tmp/bob_files/test_1.pdf"
fwdFileExists `shouldBe` True fwdFileExists `shouldBe` True
testForwardFileGroupToNotes :: HasCallStack => FilePath -> IO () testForwardFileGroupToNotes :: HasCallStack => TestParams -> IO ()
testForwardFileGroupToNotes = testForwardFileGroupToNotes =
testChat2 aliceProfile cathProfile $ testChat2 aliceProfile cathProfile $
\alice cath -> withXFTPServer $ do \alice cath -> withXFTPServer $ do
@ -552,7 +553,7 @@ testForwardFileGroupToNotes =
fwdFileExists <- doesFileExist "./tests/tmp/cath_files/test_1.pdf" fwdFileExists <- doesFileExist "./tests/tmp/cath_files/test_1.pdf"
fwdFileExists `shouldBe` True fwdFileExists `shouldBe` True
testForwardFileNotesToGroup :: HasCallStack => FilePath -> IO () testForwardFileNotesToGroup :: HasCallStack => TestParams -> IO ()
testForwardFileNotesToGroup = testForwardFileNotesToGroup =
testChat2 aliceProfile cathProfile $ testChat2 aliceProfile cathProfile $
\alice cath -> withXFTPServer $ do \alice cath -> withXFTPServer $ do
@ -599,7 +600,7 @@ testForwardFileNotesToGroup =
fwdFileExists <- doesFileExist "./tests/tmp/alice_files/test_1.pdf" fwdFileExists <- doesFileExist "./tests/tmp/alice_files/test_1.pdf"
fwdFileExists `shouldBe` True fwdFileExists `shouldBe` True
testForwardContactToContactMulti :: HasCallStack => FilePath -> IO () testForwardContactToContactMulti :: HasCallStack => TestParams -> IO ()
testForwardContactToContactMulti = testForwardContactToContactMulti =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
@ -629,7 +630,7 @@ testForwardContactToContactMulti =
cath <# "alice> -> forwarded" cath <# "alice> -> forwarded"
cath <## " hey" cath <## " hey"
testForwardGroupToGroupMulti :: HasCallStack => FilePath -> IO () testForwardGroupToGroupMulti :: HasCallStack => TestParams -> IO ()
testForwardGroupToGroupMulti = testForwardGroupToGroupMulti =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
@ -673,7 +674,7 @@ testForwardGroupToGroupMulti =
cath <# "#club alice> -> forwarded" cath <# "#club alice> -> forwarded"
cath <## " hey" cath <## " hey"
testMultiForwardFiles :: HasCallStack => FilePath -> IO () testMultiForwardFiles :: HasCallStack => TestParams -> IO ()
testMultiForwardFiles = testMultiForwardFiles =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do \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 ChatClient
import ChatTests.ChatList (getChats_) import ChatTests.ChatList (getChats_)
import ChatTests.DBUtils
import ChatTests.Utils import ChatTests.Utils
import Data.Time (getCurrentTime) import Data.Time (getCurrentTime)
import Data.Time.Format.ISO8601 (iso8601Show) import Data.Time.Format.ISO8601 (iso8601Show)
@ -13,7 +14,7 @@ import System.Directory (copyFile, doesFileExist)
import System.FilePath ((</>)) import System.FilePath ((</>))
import Test.Hspec hiding (it) import Test.Hspec hiding (it)
chatLocalChatsTests :: SpecWith FilePath chatLocalChatsTests :: SpecWith TestParams
chatLocalChatsTests = do chatLocalChatsTests = do
describe "note folders" $ do describe "note folders" $ do
it "create folders, add notes, read, search" testNotes it "create folders, add notes, read, search" testNotes
@ -26,8 +27,8 @@ chatLocalChatsTests = do
it "create multiple messages api" testCreateMulti it "create multiple messages api" testCreateMulti
it "create multiple messages with files" testCreateMultiFiles it "create multiple messages with files" testCreateMultiFiles
testNotes :: FilePath -> IO () testNotes :: TestParams -> IO ()
testNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do testNotes ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
createCCNoteFolder alice createCCNoteFolder alice
alice ##> "/contacts" alice ##> "/contacts"
@ -55,8 +56,8 @@ testNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
alice ##> "/tail *" alice ##> "/tail *"
alice <# "* Greetings." alice <# "* Greetings."
testUserNotes :: FilePath -> IO () testUserNotes :: TestParams -> IO ()
testUserNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do testUserNotes ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
createCCNoteFolder alice createCCNoteFolder alice
alice >* "keep in mind" alice >* "keep in mind"
@ -73,8 +74,8 @@ testUserNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
alice ##> "/_delete item *1 1 internal" alice ##> "/_delete item *1 1 internal"
alice <## "chat db error: SENoteFolderNotFound {noteFolderId = 1}" alice <## "chat db error: SENoteFolderNotFound {noteFolderId = 1}"
testPreviewsPagination :: FilePath -> IO () testPreviewsPagination :: TestParams -> IO ()
testPreviewsPagination tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do testPreviewsPagination ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
createCCNoteFolder alice createCCNoteFolder alice
tsS <- iso8601Show <$> getCurrentTime tsS <- iso8601Show <$> getCurrentTime
@ -91,8 +92,8 @@ testPreviewsPagination tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -
getChats_ alice ("before=" <> tsE <> " count=10") [("*", "last")] getChats_ alice ("before=" <> tsE <> " count=10") [("*", "last")]
getChats_ alice ("before=" <> tsS <> " count=10") [] getChats_ alice ("before=" <> tsS <> " count=10") []
testChatPagination :: FilePath -> IO () testChatPagination :: TestParams -> IO ()
testChatPagination tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do testChatPagination ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
createCCNoteFolder alice createCCNoteFolder alice
alice >* "hello world" 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")]) alice #$> ("/_get chat *1 count=10 search=k-k", chat, [(1, "knock-knock")])
testFiles :: FilePath -> IO () testFiles :: TestParams -> IO ()
testFiles tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do testFiles ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
-- setup -- setup
createCCNoteFolder alice createCCNoteFolder alice
let files = "./tests/tmp/app_files" let files = "./tests/tmp/app_files"
@ -163,7 +164,7 @@ testFiles tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
alice ##> "/tail" alice ##> "/tail"
doesFileExist stored `shouldReturn` False doesFileExist stored `shouldReturn` False
testOtherFiles :: FilePath -> IO () testOtherFiles :: TestParams -> IO ()
testOtherFiles = testOtherFiles =
testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do
connectUsers alice bob connectUsers alice bob
@ -196,16 +197,16 @@ testOtherFiles =
where where
cfg = testCfg {inlineFiles = defaultInlineFilesConfig {offerChunks = 100, sendChunks = 100, receiveChunks = 100}} cfg = testCfg {inlineFiles = defaultInlineFilesConfig {offerChunks = 100, sendChunks = 100, receiveChunks = 100}}
testCreateMulti :: FilePath -> IO () testCreateMulti :: TestParams -> IO ()
testCreateMulti tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do testCreateMulti ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
createCCNoteFolder alice createCCNoteFolder alice
alice ##> "/_create *1 json [{\"msgContent\": {\"type\": \"text\", \"text\": \"test 1\"}}, {\"msgContent\": {\"type\": \"text\", \"text\": \"test 2\"}}]" alice ##> "/_create *1 json [{\"msgContent\": {\"type\": \"text\", \"text\": \"test 1\"}}, {\"msgContent\": {\"type\": \"text\", \"text\": \"test 2\"}}]"
alice <# "* test 1" alice <# "* test 1"
alice <# "* test 2" alice <# "* test 2"
testCreateMultiFiles :: FilePath -> IO () testCreateMultiFiles :: TestParams -> IO ()
testCreateMultiFiles tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do testCreateMultiFiles ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
createCCNoteFolder alice createCCNoteFolder alice
alice #$> ("/_files_folder ./tests/tmp/alice_app_files", id, "ok") alice #$> ("/_files_folder ./tests/tmp/alice_app_files", id, "ok")
copyFile "./tests/fixtures/test.jpg" "./tests/tmp/alice_app_files/test.jpg" 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 module ChatTests.Profiles where
import ChatClient import ChatClient
import ChatTests.DBUtils
import ChatTests.Utils import ChatTests.Utils
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_) import Control.Concurrent.Async (concurrently_)
@ -32,7 +33,7 @@ import Simplex.Messaging.Util (encodeJSON)
import System.Directory (copyFile, createDirectoryIfMissing) import System.Directory (copyFile, createDirectoryIfMissing)
import Test.Hspec hiding (it) import Test.Hspec hiding (it)
chatProfileTests :: SpecWith FilePath chatProfileTests :: SpecWith TestParams
chatProfileTests = do chatProfileTests = do
describe "user profiles" $ do describe "user profiles" $ do
it "update user profile and notify contacts" testUpdateProfile it "update user profile and notify contacts" testUpdateProfile
@ -101,7 +102,7 @@ chatProfileTests = do
it "SimpleX links" testGroupPrefsSimplexLinksForRole it "SimpleX links" testGroupPrefsSimplexLinksForRole
it "set user, contact and group UI theme" testSetUITheme it "set user, contact and group UI theme" testSetUITheme
testUpdateProfile :: HasCallStack => FilePath -> IO () testUpdateProfile :: HasCallStack => TestParams -> IO ()
testUpdateProfile = testUpdateProfile =
testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $ testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
@ -143,7 +144,7 @@ testUpdateProfile =
bob <## "use @cat <message> to send messages" bob <## "use @cat <message> to send messages"
] ]
testUpdateProfileImage :: HasCallStack => FilePath -> IO () testUpdateProfileImage :: HasCallStack => TestParams -> IO ()
testUpdateProfileImage = testUpdateProfileImage =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
@ -163,7 +164,7 @@ testUpdateProfileImage =
bob <## "use @alice2 <message> to send messages" bob <## "use @alice2 <message> to send messages"
(bob </) (bob </)
testMultiWordProfileNames :: HasCallStack => FilePath -> IO () testMultiWordProfileNames :: HasCallStack => TestParams -> IO ()
testMultiWordProfileNames = testMultiWordProfileNames =
testChat3 aliceProfile' bobProfile' cathProfile' $ testChat3 aliceProfile' bobProfile' cathProfile' $
\alice bob cath -> do \alice bob cath -> do
@ -236,7 +237,7 @@ testMultiWordProfileNames =
cathProfile' = baseProfile {displayName = "Cath Johnson"} cathProfile' = baseProfile {displayName = "Cath Johnson"}
baseProfile = Profile {displayName = "", fullName = "", image = Nothing, contactLink = Nothing, preferences = defaultPrefs} baseProfile = Profile {displayName = "", fullName = "", image = Nothing, contactLink = Nothing, preferences = defaultPrefs}
testUserContactLink :: HasCallStack => FilePath -> IO () testUserContactLink :: HasCallStack => TestParams -> IO ()
testUserContactLink = testUserContactLink =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
@ -266,9 +267,10 @@ testUserContactLink =
alice @@@ [("@cath", lastChatFeature), ("@bob", "hey")] alice @@@ [("@cath", lastChatFeature), ("@bob", "hey")]
alice <##> cath alice <##> cath
testRetryAcceptingViaContactLink :: HasCallStack => FilePath -> IO () testRetryAcceptingViaContactLink :: HasCallStack => TestParams -> IO ()
testRetryAcceptingViaContactLink tmp = testChatCfgOpts2 cfg' opts' aliceProfile bobProfile test tmp testRetryAcceptingViaContactLink ps = testChatCfgOpts2 cfg' opts' aliceProfile bobProfile test ps
where where
tmp = tmpPath ps
test alice bob = do test alice bob = do
cLink <- withSmpServer' serverCfg' $ do cLink <- withSmpServer' serverCfg' $ do
alice ##> "/ad" alice ##> "/ad"
@ -327,7 +329,7 @@ testRetryAcceptingViaContactLink tmp = testChatCfgOpts2 cfg' opts' aliceProfile
} }
} }
testProfileLink :: HasCallStack => FilePath -> IO () testProfileLink :: HasCallStack => TestParams -> IO ()
testProfileLink = testProfileLink =
testChat3 aliceProfile bobProfile cathProfile $ testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
@ -408,7 +410,7 @@ testProfileLink =
cc <## "quantum resistant end-to-end encryption" cc <## "quantum resistant end-to-end encryption"
cc <## currentChatVRangeInfo cc <## currentChatVRangeInfo
testUserContactLinkAutoAccept :: HasCallStack => FilePath -> IO () testUserContactLinkAutoAccept :: HasCallStack => TestParams -> IO ()
testUserContactLinkAutoAccept = testUserContactLinkAutoAccept =
testChat4 aliceProfile bobProfile cathProfile danProfile $ testChat4 aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do \alice bob cath dan -> do
@ -456,7 +458,7 @@ testUserContactLinkAutoAccept =
alice @@@ [("@dan", lastChatFeature), ("@cath", "hey"), ("@bob", "hey")] alice @@@ [("@dan", lastChatFeature), ("@cath", "hey"), ("@bob", "hey")]
alice <##> dan alice <##> dan
testDeduplicateContactRequests :: HasCallStack => FilePath -> IO () testDeduplicateContactRequests :: HasCallStack => TestParams -> IO ()
testDeduplicateContactRequests = testChat3 aliceProfile bobProfile cathProfile $ testDeduplicateContactRequests = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
alice ##> "/ad" alice ##> "/ad"
@ -515,7 +517,7 @@ testDeduplicateContactRequests = testChat3 aliceProfile bobProfile cathProfile $
alice @@@ [("@cath", lastChatFeature), ("@bob", "hey")] alice @@@ [("@cath", lastChatFeature), ("@bob", "hey")]
alice <##> cath alice <##> cath
testDeduplicateContactRequestsProfileChange :: HasCallStack => FilePath -> IO () testDeduplicateContactRequestsProfileChange :: HasCallStack => TestParams -> IO ()
testDeduplicateContactRequestsProfileChange = testChat3 aliceProfile bobProfile cathProfile $ testDeduplicateContactRequestsProfileChange = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
alice ##> "/ad" alice ##> "/ad"
@ -592,7 +594,7 @@ testDeduplicateContactRequestsProfileChange = testChat3 aliceProfile bobProfile
alice @@@ [("@cath", lastChatFeature), ("@robert", "hey")] alice @@@ [("@cath", lastChatFeature), ("@robert", "hey")]
alice <##> cath alice <##> cath
testRejectContactAndDeleteUserContact :: HasCallStack => FilePath -> IO () testRejectContactAndDeleteUserContact :: HasCallStack => TestParams -> IO ()
testRejectContactAndDeleteUserContact = testChat3 aliceProfile bobProfile cathProfile $ testRejectContactAndDeleteUserContact = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
alice ##> "/_address 1" alice ##> "/_address 1"
@ -615,7 +617,7 @@ testRejectContactAndDeleteUserContact = testChat3 aliceProfile bobProfile cathPr
cath ##> ("/c " <> cLink) 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" 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 $ testDeleteConnectionRequests = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
alice ##> "/ad" alice ##> "/ad"
@ -637,7 +639,7 @@ testDeleteConnectionRequests = testChat3 aliceProfile bobProfile cathProfile $
cath ##> ("/c " <> cLink') cath ##> ("/c " <> cLink')
alice <#? cath alice <#? cath
testAutoReplyMessage :: HasCallStack => FilePath -> IO () testAutoReplyMessage :: HasCallStack => TestParams -> IO ()
testAutoReplyMessage = testChat2 aliceProfile bobProfile $ testAutoReplyMessage = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
alice ##> "/ad" alice ##> "/ad"
@ -659,7 +661,7 @@ testAutoReplyMessage = testChat2 aliceProfile bobProfile $
alice <## "bob (Bob): contact is connected" alice <## "bob (Bob): contact is connected"
] ]
testAutoReplyMessageInIncognito :: HasCallStack => FilePath -> IO () testAutoReplyMessageInIncognito :: HasCallStack => TestParams -> IO ()
testAutoReplyMessageInIncognito = testChat2 aliceProfile bobProfile $ testAutoReplyMessageInIncognito = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
alice ##> "/ad" alice ##> "/ad"
@ -684,7 +686,7 @@ testAutoReplyMessageInIncognito = testChat2 aliceProfile bobProfile $
alice <## "use /i bob to print out this incognito profile again" 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 $ testBusinessAddress = testChat3 businessProfile aliceProfile {fullName = "Alice @ Biz"} bobProfile $
\biz alice bob -> do \biz alice bob -> do
biz ##> "/ad" biz ##> "/ad"
@ -737,7 +739,7 @@ testBusinessAddress = testChat3 businessProfile aliceProfile {fullName = "Alice
(alice <# "#bob bob_1> hey there") (alice <# "#bob bob_1> hey there")
(biz <# "#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 $ testBusinessUpdateProfiles = testChat4 businessProfile aliceProfile bobProfile cathProfile $
\biz alice bob cath -> do \biz alice bob cath -> do
biz ##> "/ad" biz ##> "/ad"
@ -866,7 +868,7 @@ testBusinessUpdateProfiles = testChat4 businessProfile aliceProfile bobProfile c
bob #$> ("/_get chat #1 count=1", chat, [(0, "Voice messages: on")]) bob #$> ("/_get chat #1 count=1", chat, [(0, "Voice messages: on")])
cath #$> ("/_get chat #1 count=1", chat, [(0, "Voice messages: on")]) cath #$> ("/_get chat #1 count=1", chat, [(0, "Voice messages: on")])
testPlanAddressOkKnown :: HasCallStack => FilePath -> IO () testPlanAddressOkKnown :: HasCallStack => TestParams -> IO ()
testPlanAddressOkKnown = testPlanAddressOkKnown =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
@ -899,9 +901,9 @@ testPlanAddressOkKnown =
bob <## "contact address: known contact alice" bob <## "contact address: known contact alice"
bob <## "use @alice <message> to send messages" bob <## "use @alice <message> to send messages"
testPlanAddressOwn :: HasCallStack => FilePath -> IO () testPlanAddressOwn :: HasCallStack => TestParams -> IO ()
testPlanAddressOwn tmp = testPlanAddressOwn ps =
withNewTestChat tmp "alice" aliceProfile $ \alice -> do withNewTestChat ps "alice" aliceProfile $ \alice -> do
alice ##> "/ad" alice ##> "/ad"
cLink <- getContactLink alice True cLink <- getContactLink alice True
@ -945,12 +947,12 @@ testPlanAddressOwn tmp =
alice ##> ("/c " <> cLink) alice ##> ("/c " <> cLink)
alice <## "alice_2 (Alice): contact already exists" alice <## "alice_2 (Alice): contact already exists"
testPlanAddressConnecting :: HasCallStack => FilePath -> IO () testPlanAddressConnecting :: HasCallStack => TestParams -> IO ()
testPlanAddressConnecting tmp = do testPlanAddressConnecting ps = do
cLink <- withNewTestChat tmp "alice" aliceProfile $ \alice -> do cLink <- withNewTestChat ps "alice" aliceProfile $ \alice -> do
alice ##> "/ad" alice ##> "/ad"
getContactLink alice True getContactLink alice True
withNewTestChat tmp "bob" bobProfile $ \bob -> do withNewTestChat ps "bob" bobProfile $ \bob -> do
threadDelay 100000 threadDelay 100000
bob ##> ("/c " <> cLink) bob ##> ("/c " <> cLink)
@ -964,14 +966,14 @@ testPlanAddressConnecting tmp = do
bob <## "contact address: connecting, allowed to reconnect" bob <## "contact address: connecting, allowed to reconnect"
threadDelay 100000 threadDelay 100000
withTestChat tmp "alice" $ \alice -> do withTestChat ps "alice" $ \alice -> do
alice <## "Your address is active! To show: /sa" alice <## "Your address is active! To show: /sa"
alice <## "bob (Bob) wants to connect to you!" alice <## "bob (Bob) wants to connect to you!"
alice <## "to accept: /ac bob" alice <## "to accept: /ac bob"
alice <## "to reject: /rc bob (the sender will NOT be notified)" alice <## "to reject: /rc bob (the sender will NOT be notified)"
alice ##> "/ac bob" alice ##> "/ac bob"
alice <## "bob (Bob): accepting contact request, you can send messages to contact" alice <## "bob (Bob): accepting contact request, you can send messages to contact"
withTestChat tmp "bob" $ \bob -> do withTestChat ps "bob" $ \bob -> do
threadDelay 500000 threadDelay 500000
bob <## "alice (Alice): contact is connected" bob <## "alice (Alice): contact is connected"
bob @@@ [("@alice", "Audio/video calls: enabled")] bob @@@ [("@alice", "Audio/video calls: enabled")]
@ -988,12 +990,12 @@ testPlanAddressConnecting tmp = do
bob <## "contact address: known contact alice" bob <## "contact address: known contact alice"
bob <## "use @alice <message> to send messages" bob <## "use @alice <message> to send messages"
testPlanAddressConnectingSlow :: HasCallStack => FilePath -> IO () testPlanAddressConnectingSlow :: HasCallStack => TestParams -> IO ()
testPlanAddressConnectingSlow tmp = do testPlanAddressConnectingSlow ps = do
cLink <- withNewTestChatCfg tmp testCfgSlow "alice" aliceProfile $ \alice -> do cLink <- withNewTestChatCfg ps testCfgSlow "alice" aliceProfile $ \alice -> do
alice ##> "/ad" alice ##> "/ad"
getContactLink alice True getContactLink alice True
withNewTestChatCfg tmp testCfgSlow "bob" bobProfile $ \bob -> do withNewTestChatCfg ps testCfgSlow "bob" bobProfile $ \bob -> do
threadDelay 100000 threadDelay 100000
bob ##> ("/c " <> cLink) bob ##> ("/c " <> cLink)
@ -1007,14 +1009,14 @@ testPlanAddressConnectingSlow tmp = do
bob <## "contact address: connecting, allowed to reconnect" bob <## "contact address: connecting, allowed to reconnect"
threadDelay 100000 threadDelay 100000
withTestChatCfg tmp testCfgSlow "alice" $ \alice -> do withTestChatCfg ps testCfgSlow "alice" $ \alice -> do
alice <## "Your address is active! To show: /sa" alice <## "Your address is active! To show: /sa"
alice <## "bob (Bob) wants to connect to you!" alice <## "bob (Bob) wants to connect to you!"
alice <## "to accept: /ac bob" alice <## "to accept: /ac bob"
alice <## "to reject: /rc bob (the sender will NOT be notified)" alice <## "to reject: /rc bob (the sender will NOT be notified)"
alice ##> "/ac bob" alice ##> "/ac bob"
alice <## "bob (Bob): accepting contact request..." alice <## "bob (Bob): accepting contact request..."
withTestChatCfg tmp testCfgSlow "bob" $ \bob -> do withTestChatCfg ps testCfgSlow "bob" $ \bob -> do
threadDelay 500000 threadDelay 500000
bob @@@ [("@alice", "")] bob @@@ [("@alice", "")]
bob ##> ("/_connect plan 1 " <> cLink) bob ##> ("/_connect plan 1 " <> cLink)
@ -1027,7 +1029,7 @@ testPlanAddressConnectingSlow tmp = do
bob ##> ("/c " <> cLink) bob ##> ("/c " <> cLink)
bob <## "contact address: connecting to contact alice" bob <## "contact address: connecting to contact alice"
testPlanAddressContactDeletedReconnected :: HasCallStack => FilePath -> IO () testPlanAddressContactDeletedReconnected :: HasCallStack => TestParams -> IO ()
testPlanAddressContactDeletedReconnected = testPlanAddressContactDeletedReconnected =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
@ -1090,7 +1092,7 @@ testPlanAddressContactDeletedReconnected =
bob <## "contact address: known contact alice_1" bob <## "contact address: known contact alice_1"
bob <## "use @alice_1 <message> to send messages" bob <## "use @alice_1 <message> to send messages"
testPlanAddressContactViaAddress :: HasCallStack => FilePath -> IO () testPlanAddressContactViaAddress :: HasCallStack => TestParams -> IO ()
testPlanAddressContactViaAddress = testPlanAddressContactViaAddress =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
@ -1154,7 +1156,7 @@ testPlanAddressContactViaAddress =
alice <##> bob alice <##> bob
bob @@@ [("@alice", "hey")] bob @@@ [("@alice", "hey")]
testConnectIncognitoInvitationLink :: HasCallStack => FilePath -> IO () testConnectIncognitoInvitationLink :: HasCallStack => TestParams -> IO ()
testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfile $ testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
alice ##> "/connect incognito" alice ##> "/connect incognito"
@ -1228,7 +1230,7 @@ testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfi
(bob </) (bob </)
bob `hasContactProfiles` ["bob"] bob `hasContactProfiles` ["bob"]
testConnectIncognitoContactAddress :: HasCallStack => FilePath -> IO () testConnectIncognitoContactAddress :: HasCallStack => TestParams -> IO ()
testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $ testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
alice ##> "/ad" alice ##> "/ad"
@ -1266,7 +1268,7 @@ testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $
(bob </) (bob </)
bob `hasContactProfiles` ["bob"] bob `hasContactProfiles` ["bob"]
testAcceptContactRequestIncognito :: HasCallStack => FilePath -> IO () testAcceptContactRequestIncognito :: HasCallStack => TestParams -> IO ()
testAcceptContactRequestIncognito = testChat3 aliceProfile bobProfile cathProfile $ testAcceptContactRequestIncognito = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
alice ##> "/ad" alice ##> "/ad"
@ -1314,7 +1316,7 @@ testAcceptContactRequestIncognito = testChat3 aliceProfile bobProfile cathProfil
alice `hasContactProfiles` ["alice", "cath", T.pack aliceIncognitoCath] alice `hasContactProfiles` ["alice", "cath", T.pack aliceIncognitoCath]
cath `hasContactProfiles` ["cath", T.pack aliceIncognitoCath] cath `hasContactProfiles` ["cath", T.pack aliceIncognitoCath]
testSetConnectionIncognito :: HasCallStack => FilePath -> IO () testSetConnectionIncognito :: HasCallStack => TestParams -> IO ()
testSetConnectionIncognito = testChat2 aliceProfile bobProfile $ testSetConnectionIncognito = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
alice ##> "/connect" alice ##> "/connect"
@ -1337,7 +1339,7 @@ testSetConnectionIncognito = testChat2 aliceProfile bobProfile $
alice `hasContactProfiles` ["alice", "bob", T.pack aliceIncognito] alice `hasContactProfiles` ["alice", "bob", T.pack aliceIncognito]
bob `hasContactProfiles` ["bob", T.pack aliceIncognito] bob `hasContactProfiles` ["bob", T.pack aliceIncognito]
testResetConnectionIncognito :: HasCallStack => FilePath -> IO () testResetConnectionIncognito :: HasCallStack => TestParams -> IO ()
testResetConnectionIncognito = testChat2 aliceProfile bobProfile $ testResetConnectionIncognito = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
alice ##> "/_connect 1 incognito=on" alice ##> "/_connect 1 incognito=on"
@ -1353,42 +1355,42 @@ testResetConnectionIncognito = testChat2 aliceProfile bobProfile $
alice `hasContactProfiles` ["alice", "bob"] alice `hasContactProfiles` ["alice", "bob"]
bob `hasContactProfiles` ["alice", "bob"] bob `hasContactProfiles` ["alice", "bob"]
testSetConnectionIncognitoProhibitedDuringNegotiation :: HasCallStack => FilePath -> IO () testSetConnectionIncognitoProhibitedDuringNegotiation :: HasCallStack => TestParams -> IO ()
testSetConnectionIncognitoProhibitedDuringNegotiation tmp = do testSetConnectionIncognitoProhibitedDuringNegotiation ps = do
inv <- withNewTestChat tmp "alice" aliceProfile $ \alice -> do inv <- withNewTestChat ps "alice" aliceProfile $ \alice -> do
threadDelay 250000 threadDelay 250000
alice ##> "/connect" alice ##> "/connect"
getInvitation alice getInvitation alice
withNewTestChat tmp "bob" bobProfile $ \bob -> do withNewTestChat ps "bob" bobProfile $ \bob -> do
threadDelay 250000 threadDelay 250000
bob ##> ("/c " <> inv) bob ##> ("/c " <> inv)
bob <## "confirmation sent!" bob <## "confirmation sent!"
withTestChat tmp "alice" $ \alice -> do withTestChat ps "alice" $ \alice -> do
threadDelay 250000 threadDelay 250000
alice <## "bob (Bob): contact is connected" alice <## "bob (Bob): contact is connected"
alice ##> "/_set incognito :1 on" alice ##> "/_set incognito :1 on"
alice <## "chat db error: SEPendingConnectionNotFound {connId = 1}" alice <## "chat db error: SEPendingConnectionNotFound {connId = 1}"
withTestChat tmp "bob" $ \bob -> do withTestChat ps "bob" $ \bob -> do
bob <## "alice (Alice): contact is connected" bob <## "alice (Alice): contact is connected"
alice <##> bob alice <##> bob
alice `hasContactProfiles` ["alice", "bob"] alice `hasContactProfiles` ["alice", "bob"]
bob `hasContactProfiles` ["alice", "bob"] bob `hasContactProfiles` ["alice", "bob"]
testSetConnectionIncognitoProhibitedDuringNegotiationSlow :: HasCallStack => FilePath -> IO () testSetConnectionIncognitoProhibitedDuringNegotiationSlow :: HasCallStack => TestParams -> IO ()
testSetConnectionIncognitoProhibitedDuringNegotiationSlow tmp = do testSetConnectionIncognitoProhibitedDuringNegotiationSlow ps = do
inv <- withNewTestChatCfg tmp testCfgSlow "alice" aliceProfile $ \alice -> do inv <- withNewTestChatCfg ps testCfgSlow "alice" aliceProfile $ \alice -> do
threadDelay 250000 threadDelay 250000
alice ##> "/connect" alice ##> "/connect"
getInvitation alice getInvitation alice
withNewTestChatCfg tmp testCfgSlow "bob" bobProfile $ \bob -> do withNewTestChatCfg ps testCfgSlow "bob" bobProfile $ \bob -> do
threadDelay 250000 threadDelay 250000
bob ##> ("/c " <> inv) bob ##> ("/c " <> inv)
bob <## "confirmation sent!" bob <## "confirmation sent!"
withTestChatCfg tmp testCfgSlow "alice" $ \alice -> do withTestChatCfg ps testCfgSlow "alice" $ \alice -> do
threadDelay 250000 threadDelay 250000
alice ##> "/_set incognito :1 on" alice ##> "/_set incognito :1 on"
alice <## "chat db error: SEPendingConnectionNotFound {connId = 1}" alice <## "chat db error: SEPendingConnectionNotFound {connId = 1}"
withTestChatCfg tmp testCfgSlow "bob" $ \bob -> do withTestChatCfg ps testCfgSlow "bob" $ \bob -> do
concurrently_ concurrently_
(bob <## "alice (Alice): contact is connected") (bob <## "alice (Alice): contact is connected")
(alice <## "bob (Bob): contact is connected") (alice <## "bob (Bob): contact is connected")
@ -1396,7 +1398,7 @@ testSetConnectionIncognitoProhibitedDuringNegotiationSlow tmp = do
alice `hasContactProfiles` ["alice", "bob"] alice `hasContactProfiles` ["alice", "bob"]
bob `hasContactProfiles` ["alice", "bob"] bob `hasContactProfiles` ["alice", "bob"]
testConnectionIncognitoUnchangedErrors :: HasCallStack => FilePath -> IO () testConnectionIncognitoUnchangedErrors :: HasCallStack => TestParams -> IO ()
testConnectionIncognitoUnchangedErrors = testChat2 aliceProfile bobProfile $ testConnectionIncognitoUnchangedErrors = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
alice ##> "/connect" alice ##> "/connect"
@ -1420,7 +1422,7 @@ testConnectionIncognitoUnchangedErrors = testChat2 aliceProfile bobProfile $
alice `hasContactProfiles` ["alice", "bob"] alice `hasContactProfiles` ["alice", "bob"]
bob `hasContactProfiles` ["alice", "bob"] bob `hasContactProfiles` ["alice", "bob"]
testSetResetSetConnectionIncognito :: HasCallStack => FilePath -> IO () testSetResetSetConnectionIncognito :: HasCallStack => TestParams -> IO ()
testSetResetSetConnectionIncognito = testChat2 aliceProfile bobProfile $ testSetResetSetConnectionIncognito = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
alice ##> "/_connect 1 incognito=off" alice ##> "/_connect 1 incognito=off"
@ -1447,7 +1449,7 @@ testSetResetSetConnectionIncognito = testChat2 aliceProfile bobProfile $
alice `hasContactProfiles` ["alice", "bob", T.pack aliceIncognito] alice `hasContactProfiles` ["alice", "bob", T.pack aliceIncognito]
bob `hasContactProfiles` ["bob", T.pack aliceIncognito] bob `hasContactProfiles` ["bob", T.pack aliceIncognito]
testJoinGroupIncognito :: HasCallStack => FilePath -> IO () testJoinGroupIncognito :: HasCallStack => TestParams -> IO ()
testJoinGroupIncognito = testJoinGroupIncognito =
testChatCfg4 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile danProfile $ testChatCfg4 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do \alice bob cath dan -> do
@ -1636,7 +1638,7 @@ testJoinGroupIncognito =
cath ?#> "@bob_1 ok" cath ?#> "@bob_1 ok"
bob <# (cathIncognito <> "> ok") bob <# (cathIncognito <> "> ok")
testCantInviteContactIncognito :: HasCallStack => FilePath -> IO () testCantInviteContactIncognito :: HasCallStack => TestParams -> IO ()
testCantInviteContactIncognito = testChat2 aliceProfile bobProfile $ testCantInviteContactIncognito = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
-- alice connected incognito to bob -- alice connected incognito to bob
@ -1660,7 +1662,7 @@ testCantInviteContactIncognito = testChat2 aliceProfile bobProfile $
-- bob doesn't receive invitation -- bob doesn't receive invitation
(bob </) (bob </)
testCantSeeGlobalPrefsUpdateIncognito :: HasCallStack => FilePath -> IO () testCantSeeGlobalPrefsUpdateIncognito :: HasCallStack => TestParams -> IO ()
testCantSeeGlobalPrefsUpdateIncognito = testChat3 aliceProfile bobProfile cathProfile $ testCantSeeGlobalPrefsUpdateIncognito = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
alice ##> "/c i" alice ##> "/c i"
@ -1711,7 +1713,7 @@ testCantSeeGlobalPrefsUpdateIncognito = testChat3 aliceProfile bobProfile cathPr
cath <## "alice updated preferences for you:" cath <## "alice updated preferences for you:"
cath <## "Full deletion: off (you allow: default (no), contact allows: yes)" cath <## "Full deletion: off (you allow: default (no), contact allows: yes)"
testDeleteContactThenGroupDeletesIncognitoProfile :: HasCallStack => FilePath -> IO () testDeleteContactThenGroupDeletesIncognitoProfile :: HasCallStack => TestParams -> IO ()
testDeleteContactThenGroupDeletesIncognitoProfile = testChat2 aliceProfile bobProfile $ testDeleteContactThenGroupDeletesIncognitoProfile = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
-- bob connects incognito to alice -- bob connects incognito to alice
@ -1763,7 +1765,7 @@ testDeleteContactThenGroupDeletesIncognitoProfile = testChat2 aliceProfile bobPr
bob <## "#team: you deleted the group" bob <## "#team: you deleted the group"
bob `hasContactProfiles` ["bob"] bob `hasContactProfiles` ["bob"]
testDeleteGroupThenContactDeletesIncognitoProfile :: HasCallStack => FilePath -> IO () testDeleteGroupThenContactDeletesIncognitoProfile :: HasCallStack => TestParams -> IO ()
testDeleteGroupThenContactDeletesIncognitoProfile = testChat2 aliceProfile bobProfile $ testDeleteGroupThenContactDeletesIncognitoProfile = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
-- bob connects incognito to alice -- bob connects incognito to alice
@ -1815,7 +1817,7 @@ testDeleteGroupThenContactDeletesIncognitoProfile = testChat2 aliceProfile bobPr
(bob </) (bob </)
bob `hasContactProfiles` ["bob"] bob `hasContactProfiles` ["bob"]
testSetAlias :: HasCallStack => FilePath -> IO () testSetAlias :: HasCallStack => TestParams -> IO ()
testSetAlias = testChat2 aliceProfile bobProfile $ testSetAlias = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
connectUsers alice bob connectUsers alice bob
@ -1826,7 +1828,7 @@ testSetAlias = testChat2 aliceProfile bobProfile $
alice ##> "/contacts" alice ##> "/contacts"
alice <## "bob (Bob)" alice <## "bob (Bob)"
testChangePCCUser :: HasCallStack => FilePath -> IO () testChangePCCUser :: HasCallStack => TestParams -> IO ()
testChangePCCUser = testChat2 aliceProfile bobProfile $ testChangePCCUser = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
-- Create a new invite -- Create a new invite
@ -1856,7 +1858,7 @@ testChangePCCUser = testChat2 aliceProfile bobProfile $
(alice <## "bob (Bob): contact is connected") (alice <## "bob (Bob): contact is connected")
(bob <## "alisa2: contact is connected") (bob <## "alisa2: contact is connected")
testChangePCCUserFromIncognito :: HasCallStack => FilePath -> IO () testChangePCCUserFromIncognito :: HasCallStack => TestParams -> IO ()
testChangePCCUserFromIncognito = testChat2 aliceProfile bobProfile $ testChangePCCUserFromIncognito = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
-- Create a new invite and set as incognito -- Create a new invite and set as incognito
@ -1887,7 +1889,7 @@ testChangePCCUserFromIncognito = testChat2 aliceProfile bobProfile $
(alice <## "bob (Bob): contact is connected") (alice <## "bob (Bob): contact is connected")
(bob <## "alice (Alice): contact is connected") (bob <## "alice (Alice): contact is connected")
testChangePCCUserAndThenIncognito :: HasCallStack => FilePath -> IO () testChangePCCUserAndThenIncognito :: HasCallStack => TestParams -> IO ()
testChangePCCUserAndThenIncognito = testChat2 aliceProfile bobProfile $ testChangePCCUserAndThenIncognito = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
-- Create a new invite and set as incognito -- 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") alice <## ("use /i bob to print out this incognito profile again")
] ]
testChangePCCUserDiffSrv :: HasCallStack => FilePath -> IO () testChangePCCUserDiffSrv :: HasCallStack => TestParams -> IO ()
testChangePCCUserDiffSrv tmp = do testChangePCCUserDiffSrv ps = do
withSmpServer' serverCfg' $ do withSmpServer' serverCfg' $ do
withNewTestChatCfgOpts tmp testCfg testOpts "alice" aliceProfile $ \alice -> do withNewTestChatCfgOpts ps testCfg testOpts "alice" aliceProfile $ \alice -> do
withNewTestChatCfgOpts tmp testCfg testOpts "bob" bobProfile $ \bob -> do withNewTestChatCfgOpts ps testCfg testOpts "bob" bobProfile $ \bob -> do
-- Create a new invite -- Create a new invite
alice ##> "/connect" alice ##> "/connect"
_ <- getInvitation alice _ <- getInvitation alice
@ -1962,7 +1964,7 @@ testChangePCCUserDiffSrv tmp = do
msgQueueQuota = 2 msgQueueQuota = 2
} }
testSetConnectionAlias :: HasCallStack => FilePath -> IO () testSetConnectionAlias :: HasCallStack => TestParams -> IO ()
testSetConnectionAlias = testChat2 aliceProfile bobProfile $ testSetConnectionAlias = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
alice ##> "/c" alice ##> "/c"
@ -1980,7 +1982,7 @@ testSetConnectionAlias = testChat2 aliceProfile bobProfile $
alice ##> "/contacts" alice ##> "/contacts"
alice <## "bob (Bob) (alias: friend)" alice <## "bob (Bob) (alias: friend)"
testSetGroupAlias :: HasCallStack => FilePath -> IO () testSetGroupAlias :: HasCallStack => TestParams -> IO ()
testSetGroupAlias = testChat2 aliceProfile bobProfile $ testSetGroupAlias = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
createGroup2 "team" alice bob createGroup2 "team" alice bob
@ -1994,7 +1996,7 @@ testSetGroupAlias = testChat2 aliceProfile bobProfile $
alice ##> "/groups" alice ##> "/groups"
alice <## "#team (2 members)" alice <## "#team (2 members)"
testSetContactPrefs :: HasCallStack => FilePath -> IO () testSetContactPrefs :: HasCallStack => TestParams -> IO ()
testSetContactPrefs = testChat2 aliceProfile bobProfile $ testSetContactPrefs = testChat2 aliceProfile bobProfile $
\alice bob -> withXFTPServer $ do \alice bob -> withXFTPServer $ do
alice #$> ("/_files_folder ./tests/tmp/alice", id, "ok") 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 <## "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")]) 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 $ testFeatureOffers = testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
connectUsers alice bob connectUsers alice bob
@ -2106,7 +2108,7 @@ testFeatureOffers = testChat2 aliceProfile bobProfile $
bob <## "Full deletion: off (you allow: default (no), contact allows: no)" 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")]) 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 = testUpdateGroupPrefs =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $
\alice bob -> do \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")]) 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")]) 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 = testAllowFullDeletionContact =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
@ -2175,7 +2177,7 @@ testAllowFullDeletionContact =
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "hi"), (1, "Full deletion: enabled for contact")]) 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")]) 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 = testAllowFullDeletionGroup =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
@ -2201,7 +2203,7 @@ testAllowFullDeletionGroup =
alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "hi"), (1, "Full deletion: on")]) 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")]) 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 = testProhibitDirectMessages =
testChatCfg4 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile danProfile $ testChatCfg4 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do \alice bob cath dan -> do
@ -2259,7 +2261,7 @@ testProhibitDirectMessages =
cc <## "updated group preferences:" cc <## "updated group preferences:"
cc <## "Direct messages: off" cc <## "Direct messages: off"
testEnableTimedMessagesContact :: HasCallStack => FilePath -> IO () testEnableTimedMessagesContact :: HasCallStack => TestParams -> IO ()
testEnableTimedMessagesContact = testEnableTimedMessagesContact =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
@ -2304,7 +2306,7 @@ testEnableTimedMessagesContact =
alice <## "bob updated preferences for you:" alice <## "bob updated preferences for you:"
alice <## "Disappearing messages: enabled (you allow: yes (1 week), contact allows: yes (1 week))" alice <## "Disappearing messages: enabled (you allow: yes (1 week), contact allows: yes (1 week))"
testEnableTimedMessagesGroup :: HasCallStack => FilePath -> IO () testEnableTimedMessagesGroup :: HasCallStack => TestParams -> IO ()
testEnableTimedMessagesGroup = testEnableTimedMessagesGroup =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
@ -2354,7 +2356,7 @@ testEnableTimedMessagesGroup =
bob <## "updated group preferences:" bob <## "updated group preferences:"
bob <## "Disappearing messages: on (1 week)" bob <## "Disappearing messages: on (1 week)"
testTimedMessagesEnabledGlobally :: HasCallStack => FilePath -> IO () testTimedMessagesEnabledGlobally :: HasCallStack => TestParams -> IO ()
testTimedMessagesEnabledGlobally = testTimedMessagesEnabledGlobally =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $
\alice bob -> do \alice bob -> do
@ -2378,7 +2380,7 @@ testTimedMessagesEnabledGlobally =
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (1 sec)")]) 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)")]) 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 $ testUpdateMultipleUserPrefs = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do \alice bob cath -> do
connectUsers alice bob 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 @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")]) 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 $ testGroupPrefsDirectForRole = testChat4 aliceProfile bobProfile cathProfile danProfile $
\alice bob cath dan -> do \alice bob cath dan -> do
createGroup3 "team" alice bob cath createGroup3 "team" alice bob cath
@ -2471,7 +2473,7 @@ testGroupPrefsDirectForRole = testChat4 aliceProfile bobProfile cathProfile danP
cc <## "updated group preferences:" cc <## "updated group preferences:"
cc <## "Direct messages: on for owners" cc <## "Direct messages: on for owners"
testGroupPrefsFilesForRole :: HasCallStack => FilePath -> IO () testGroupPrefsFilesForRole :: HasCallStack => TestParams -> IO ()
testGroupPrefsFilesForRole = testChat3 aliceProfile bobProfile cathProfile $ testGroupPrefsFilesForRole = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do \alice bob cath -> withXFTPServer $ do
alice #$> ("/_files_folder ./tests/tmp/alice", id, "ok") alice #$> ("/_files_folder ./tests/tmp/alice", id, "ok")
@ -2506,7 +2508,7 @@ testGroupPrefsFilesForRole = testChat3 aliceProfile bobProfile cathProfile $
cc <## "updated group preferences:" cc <## "updated group preferences:"
cc <## "Files and media: on for owners" cc <## "Files and media: on for owners"
testGroupPrefsSimplexLinksForRole :: HasCallStack => FilePath -> IO () testGroupPrefsSimplexLinksForRole :: HasCallStack => TestParams -> IO ()
testGroupPrefsSimplexLinksForRole = testChat3 aliceProfile bobProfile cathProfile $ testGroupPrefsSimplexLinksForRole = testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> withXFTPServer $ do \alice bob cath -> withXFTPServer $ do
createGroup3 "team" alice bob cath createGroup3 "team" alice bob cath
@ -2542,7 +2544,7 @@ testGroupPrefsSimplexLinksForRole = testChat3 aliceProfile bobProfile cathProfil
cc <## "updated group preferences:" cc <## "updated group preferences:"
cc <## "SimpleX links: on for owners" cc <## "SimpleX links: on for owners"
testSetUITheme :: HasCallStack => FilePath -> IO () testSetUITheme :: HasCallStack => TestParams -> IO ()
testSetUITheme = testSetUITheme =
testChat2 aliceProfile bobProfile $ \alice bob -> do testChat2 aliceProfile bobProfile $ \alice bob -> do
connectUsers alice bob connectUsers alice bob

57
tests/ChatTests/Utils.hs
View file

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

54
tests/MobileTests.hs
View file

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

25
tests/RemoteTests.hs
View file

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

48
tests/SchemaDump.hs
View file

@ -1,19 +1,32 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module SchemaDump where module SchemaDump where
import ChatClient (withTmpFiles) import ChatClient (withTmpFiles)
import ChatTests.DBUtils
import Control.Concurrent.STM
import Control.DeepSeq import Control.DeepSeq
import qualified Control.Exception as E
import Control.Monad (unless, void) 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.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 Simplex.Chat.Store (createChatStore)
import qualified Simplex.Chat.Store as Store 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.Interface
import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfirmation (..), MigrationsToRun (..), toDownMigration) 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 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.Directory (doesFileExist, removeFile)
import System.Process (readCreateProcess, shell) import System.Process (readCreateProcess, shell)
import Test.Hspec import Test.Hspec
@ -40,6 +53,9 @@ appSchema = "src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql"
appLint :: FilePath appLint :: FilePath
appLint = "src/Simplex/Chat/Store/SQLite/Migrations/chat_lint.sql" 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 :: FilePath
testSchema = "tests/tmp/test_agent_schema.sql" testSchema = "tests/tmp/test_agent_schema.sql"
@ -53,7 +69,7 @@ testVerifySchemaDump :: IO ()
testVerifySchemaDump = withTmpFiles $ do testVerifySchemaDump = withTmpFiles $ do
savedSchema <- ifM (doesFileExist appSchema) (readFile appSchema) (pure "") savedSchema <- ifM (doesFileExist appSchema) (readFile appSchema) (pure "")
savedSchema `deepseq` pure () savedSchema `deepseq` pure ()
void $ createChatStore (DBOpts testDB "" False True) MCError void $ createChatStore (DBOpts testDB "" False True TQOff) MCError
getSchema testDB appSchema `shouldReturn` savedSchema getSchema testDB appSchema `shouldReturn` savedSchema
removeFile testDB removeFile testDB
@ -61,14 +77,14 @@ testVerifyLintFKeyIndexes :: IO ()
testVerifyLintFKeyIndexes = withTmpFiles $ do testVerifyLintFKeyIndexes = withTmpFiles $ do
savedLint <- ifM (doesFileExist appLint) (readFile appLint) (pure "") savedLint <- ifM (doesFileExist appLint) (readFile appLint) (pure "")
savedLint `deepseq` 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 getLintFKeyIndexes testDB "tests/tmp/chat_lint.sql" `shouldReturn` savedLint
removeFile testDB removeFile testDB
testSchemaMigrations :: IO () testSchemaMigrations :: IO ()
testSchemaMigrations = withTmpFiles $ do testSchemaMigrations = withTmpFiles $ do
let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) Store.migrations 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 mapM_ (testDownMigration st) $ drop (length noDownMigrations) Store.migrations
closeDBStore st closeDBStore st
removeFile testDB removeFile testDB
@ -120,3 +136,25 @@ getLintFKeyIndexes dbPath lintPath = do
void $ readCreateProcess (shell $ "sqlite3 " <> dbPath <> " '.lint fkey-indexes' > " <> lintPath) "" void $ readCreateProcess (shell $ "sqlite3 " <> dbPath <> " '.lint fkey-indexes' > " <> lintPath) ""
lint <- readFile lintPath lint <- readFile lintPath
lint `deepseq` pure lint 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 CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TupleSections #-}
import Bots.BroadcastTests import Bots.BroadcastTests
import Bots.DirectoryTests import Bots.DirectoryTests
import ChatClient import ChatClient
import ChatTests import ChatTests
import ChatTests.DBUtils
import ChatTests.Utils (xdescribe'') import ChatTests.Utils (xdescribe'')
import Control.Logger.Simple import Control.Logger.Simple
import Data.Time.Clock.System import Data.Time.Clock.System
@ -21,6 +24,7 @@ import ViewTests
#if defined(dbPostgres) #if defined(dbPostgres)
import Simplex.Messaging.Agent.Store.Postgres.Util (createDBAndUserIfNotExists, dropAllSchemasExceptSystem, dropDatabaseAndUser) import Simplex.Messaging.Agent.Store.Postgres.Util (createDBAndUserIfNotExists, dropAllSchemasExceptSystem, dropDatabaseAndUser)
#else #else
import qualified Simplex.Messaging.TMap as TM
import MobileTests import MobileTests
import SchemaDump import SchemaDump
import WebRTCTests import WebRTCTests
@ -29,6 +33,9 @@ import WebRTCTests
main :: IO () main :: IO ()
main = do main = do
setLogLevel LogError setLogLevel LogError
#if !defined(dbPostgres)
queryStats <- TM.emptyIO
#endif
withGlobalLogging logCfg . hspec withGlobalLogging logCfg . hspec
#if defined(dbPostgres) #if defined(dbPostgres)
. beforeAll_ (dropDatabaseAndUser testDBConnectInfo >> createDBAndUserIfNotExists testDBConnectInfo) . beforeAll_ (dropDatabaseAndUser testDBConnectInfo >> createDBAndUserIfNotExists testDBConnectInfo)
@ -48,9 +55,11 @@ main = do
describe "Message batching" batchingTests describe "Message batching" batchingTests
describe "Operators" operatorTests describe "Operators" operatorTests
describe "Random servers" randomServersTests describe "Random servers" randomServersTests
around testBracket
#if defined(dbPostgres) #if defined(dbPostgres)
around testBracket
. after_ (dropAllSchemasExceptSystem testDBConnectInfo) . after_ (dropAllSchemasExceptSystem testDBConnectInfo)
#else
around (testBracket queryStats)
#endif #endif
$ do $ do
#if !defined(dbPostgres) #if !defined(dbPostgres)
@ -60,8 +69,15 @@ main = do
xdescribe'' "SimpleX Broadcast bot" broadcastBotTests xdescribe'' "SimpleX Broadcast bot" broadcastBotTests
xdescribe'' "SimpleX Directory service bot" directoryServiceTests xdescribe'' "SimpleX Directory service bot" directoryServiceTests
describe "Remote session" remoteTests describe "Remote session" remoteTests
#if !defined(dbPostgres)
xdescribe'' "Save query plans" saveQueryPlans
#endif
where 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 tmpBracket test = do
t <- getSystemTime t <- getSystemTime
let ts = show (systemSeconds t) <> show (systemNanoseconds t) let ts = show (systemSeconds t) <> show (systemNanoseconds t)