mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-03-14 09:45:42 +00:00
test: track query plans (#5566)
* test: track query plans * all query plans * fix postgres build
This commit is contained in:
parent
9ccea0dc50
commit
f3664619ec
25 changed files with 7009 additions and 897 deletions
|
@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
|
|||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/simplex-chat/simplexmq.git
|
||||
tag: 23189753751dc52046865ce2d992335495020e91
|
||||
tag: 268a1303acbad1644f81cd3b2def5754e5e2c052
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
|
|
|
@ -446,6 +446,7 @@ test-suite simplex-chat-test
|
|||
ChatTests
|
||||
ChatTests.ChatList
|
||||
ChatTests.Direct
|
||||
ChatTests.DBUtils
|
||||
ChatTests.Files
|
||||
ChatTests.Forward
|
||||
ChatTests.Groups
|
||||
|
@ -470,8 +471,12 @@ test-suite simplex-chat-test
|
|||
Directory.Service
|
||||
Directory.Store
|
||||
Paths_simplex_chat
|
||||
if !flag(client_postgres)
|
||||
if flag(client_postgres)
|
||||
other-modules:
|
||||
ChatTests.DBUtils.Postgres
|
||||
else
|
||||
other-modules:
|
||||
ChatTests.DBUtils.SQLite
|
||||
MobileTests
|
||||
SchemaDump
|
||||
WebRTCTests
|
||||
|
|
|
@ -16,7 +16,6 @@ import Control.Monad.Reader
|
|||
import qualified Data.Aeson as J
|
||||
import qualified Data.Aeson.TH as JQ
|
||||
import Data.Bifunctor (first)
|
||||
import Data.ByteArray (ScrubbedBytes)
|
||||
import qualified Data.ByteString.Base64.URL as U
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
|
@ -57,8 +56,10 @@ import Simplex.Messaging.Util (catchAll, liftEitherWith, safeDecodeUtf8)
|
|||
import System.IO (utf8)
|
||||
import System.Timeout (timeout)
|
||||
#if !defined(dbPostgres)
|
||||
import Data.ByteArray (ScrubbedBytes)
|
||||
import Database.SQLite.Simple (SQLError (..))
|
||||
import qualified Database.SQLite.Simple as DB
|
||||
import qualified Simplex.Messaging.Agent.Store.DB as DB
|
||||
#endif
|
||||
|
||||
data DBMigrationResult
|
||||
|
@ -237,7 +238,7 @@ getActiveUser_ st = find activeUser <$> withTransaction st getUsers
|
|||
-- only used in tests
|
||||
chatMigrateInit :: String -> ScrubbedBytes -> String -> IO (Either DBMigrationResult ChatController)
|
||||
chatMigrateInit dbFilePrefix dbKey confirm = do
|
||||
let chatDBOpts = ChatDbOpts {dbFilePrefix, dbKey, vacuumOnMigration = True}
|
||||
let chatDBOpts = ChatDbOpts {dbFilePrefix, dbKey, trackQueries = DB.TQSlow 5000, vacuumOnMigration = True}
|
||||
chatMigrateInitKey chatDBOpts False confirm False
|
||||
#endif
|
||||
|
||||
|
|
|
@ -2,6 +2,7 @@
|
|||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
||||
|
||||
module Simplex.Chat.Options.SQLite where
|
||||
|
||||
|
@ -11,11 +12,13 @@ import qualified Data.ByteString.Char8 as B
|
|||
import Foreign.C.String
|
||||
import Options.Applicative
|
||||
import Simplex.Messaging.Agent.Store.Interface (DBOpts (..))
|
||||
import Simplex.Messaging.Agent.Store.SQLite.DB (TrackQueries (..))
|
||||
import System.FilePath (combine)
|
||||
|
||||
data ChatDbOpts = ChatDbOpts
|
||||
{ dbFilePrefix :: String,
|
||||
dbKey :: ScrubbedBytes,
|
||||
trackQueries :: TrackQueries,
|
||||
vacuumOnMigration :: Bool
|
||||
}
|
||||
|
||||
|
@ -43,17 +46,24 @@ chatDbOptsP appDir defaultDbName = do
|
|||
( long "disable-vacuum"
|
||||
<> help "Do not vacuum database after migrations"
|
||||
)
|
||||
pure ChatDbOpts {dbFilePrefix, dbKey, vacuumOnMigration = not disableVacuum}
|
||||
pure
|
||||
ChatDbOpts
|
||||
{ dbFilePrefix,
|
||||
dbKey,
|
||||
trackQueries = TQSlow 5000, -- 5ms
|
||||
vacuumOnMigration = not disableVacuum
|
||||
}
|
||||
|
||||
dbString :: ChatDbOpts -> String
|
||||
dbString ChatDbOpts {dbFilePrefix} = dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
|
||||
|
||||
toDBOpts :: ChatDbOpts -> String -> Bool -> DBOpts
|
||||
toDBOpts ChatDbOpts {dbFilePrefix, dbKey, vacuumOnMigration} dbSuffix keepKey = do
|
||||
toDBOpts ChatDbOpts {dbFilePrefix, dbKey, trackQueries, vacuumOnMigration} dbSuffix keepKey = do
|
||||
DBOpts
|
||||
{ dbFilePath = dbFilePrefix <> dbSuffix,
|
||||
dbKey,
|
||||
keepKey,
|
||||
track = trackQueries,
|
||||
vacuum = vacuumOnMigration
|
||||
}
|
||||
|
||||
|
@ -71,18 +81,14 @@ mobileDbOpts fp key = do
|
|||
ChatDbOpts
|
||||
{ dbFilePrefix,
|
||||
dbKey,
|
||||
trackQueries = TQSlow 5000, -- 5ms
|
||||
vacuumOnMigration = True
|
||||
}
|
||||
|
||||
-- used to create new chat controller,
|
||||
-- at that point database is already opened, and the key in options is not used
|
||||
removeDbKey :: ChatDbOpts -> ChatDbOpts
|
||||
removeDbKey ChatDbOpts {dbFilePrefix, vacuumOnMigration} =
|
||||
ChatDbOpts
|
||||
{ dbFilePrefix,
|
||||
dbKey = "",
|
||||
vacuumOnMigration
|
||||
}
|
||||
removeDbKey opts = opts {dbKey = ""} :: ChatDbOpts
|
||||
|
||||
errorDbStr :: DBOpts -> String
|
||||
errorDbStr DBOpts {dbFilePath} = dbFilePath
|
||||
|
|
5969
src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt
Normal file
5969
src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt
Normal file
File diff suppressed because it is too large
Load diff
|
@ -16,7 +16,6 @@ import Simplex.Chat.Help (chatWelcome)
|
|||
import Simplex.Chat.Library.Commands (_defaultNtfServers)
|
||||
import Simplex.Chat.Operators
|
||||
import Simplex.Chat.Options
|
||||
import Simplex.Chat.Options.DB
|
||||
import Simplex.Chat.Terminal.Input
|
||||
import Simplex.Chat.Terminal.Output
|
||||
import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
|
||||
|
@ -29,6 +28,7 @@ import qualified Data.Text as T
|
|||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Database.SQLite.Simple (SQLError (..))
|
||||
import qualified Database.SQLite.Simple as DB
|
||||
import Simplex.Chat.Options.DB
|
||||
import System.IO (hFlush, hSetEcho, stdin, stdout)
|
||||
#endif
|
||||
|
||||
|
|
|
@ -8,6 +8,7 @@ module Bots.BroadcastTests where
|
|||
import Broadcast.Bot
|
||||
import Broadcast.Options
|
||||
import ChatClient
|
||||
import ChatTests.DBUtils
|
||||
import ChatTests.Utils
|
||||
import Control.Concurrent (forkIO, killThread, threadDelay)
|
||||
import Control.Exception (bracket)
|
||||
|
@ -21,7 +22,7 @@ import Test.Hspec hiding (it)
|
|||
import System.FilePath ((</>))
|
||||
#endif
|
||||
|
||||
broadcastBotTests :: SpecWith FilePath
|
||||
broadcastBotTests :: SpecWith TestParams
|
||||
broadcastBotTests = do
|
||||
it "should broadcast message" testBroadcastMessages
|
||||
|
||||
|
@ -34,8 +35,8 @@ withBroadcastBot opts test =
|
|||
broadcastBotProfile :: Profile
|
||||
broadcastBotProfile = Profile {displayName = "broadcast_bot", fullName = "Broadcast Bot", image = Nothing, contactLink = Nothing, preferences = Nothing}
|
||||
|
||||
mkBotOpts :: FilePath -> [KnownContact] -> BroadcastBotOpts
|
||||
mkBotOpts tmp publishers =
|
||||
mkBotOpts :: TestParams -> [KnownContact] -> BroadcastBotOpts
|
||||
mkBotOpts ps publishers =
|
||||
BroadcastBotOpts
|
||||
{ coreOptions =
|
||||
testCoreOpts
|
||||
|
@ -44,7 +45,7 @@ mkBotOpts tmp publishers =
|
|||
#if defined(dbPostgres)
|
||||
{dbSchemaPrefix = "client_" <> botDbPrefix}
|
||||
#else
|
||||
{dbFilePrefix = tmp </> botDbPrefix}
|
||||
{dbFilePrefix = tmpPath ps </> botDbPrefix}
|
||||
#endif
|
||||
|
||||
},
|
||||
|
@ -56,19 +57,19 @@ mkBotOpts tmp publishers =
|
|||
botDbPrefix :: FilePath
|
||||
botDbPrefix = "broadcast_bot"
|
||||
|
||||
testBroadcastMessages :: HasCallStack => FilePath -> IO ()
|
||||
testBroadcastMessages tmp = do
|
||||
testBroadcastMessages :: HasCallStack => TestParams -> IO ()
|
||||
testBroadcastMessages ps = do
|
||||
botLink <-
|
||||
withNewTestChat tmp botDbPrefix broadcastBotProfile $ \bc_bot ->
|
||||
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
||||
withNewTestChat ps botDbPrefix broadcastBotProfile $ \bc_bot ->
|
||||
withNewTestChat ps "alice" aliceProfile $ \alice -> do
|
||||
connectUsers bc_bot alice
|
||||
bc_bot ##> "/ad"
|
||||
getContactLink bc_bot True
|
||||
let botOpts = mkBotOpts tmp [KnownContact 2 "alice"]
|
||||
let botOpts = mkBotOpts ps [KnownContact 2 "alice"]
|
||||
withBroadcastBot botOpts $
|
||||
withTestChat tmp "alice" $ \alice ->
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob ->
|
||||
withNewTestChat tmp "cath" cathProfile $ \cath -> do
|
||||
withTestChat ps "alice" $ \alice ->
|
||||
withNewTestChat ps "bob" bobProfile $ \bob ->
|
||||
withNewTestChat ps "cath" cathProfile $ \cath -> do
|
||||
alice <## "1 contacts connected (use /cs for the list)"
|
||||
bob `connectVia` botLink
|
||||
bob #> "@broadcast_bot hello"
|
||||
|
|
|
@ -7,6 +7,7 @@
|
|||
module Bots.DirectoryTests where
|
||||
|
||||
import ChatClient
|
||||
import ChatTests.DBUtils
|
||||
import ChatTests.Utils
|
||||
import Control.Concurrent (forkIO, killThread, threadDelay)
|
||||
import Control.Exception (finally)
|
||||
|
@ -27,7 +28,7 @@ import Simplex.Chat.Types.Shared (GroupMemberRole (..))
|
|||
import System.FilePath ((</>))
|
||||
import Test.Hspec hiding (it)
|
||||
|
||||
directoryServiceTests :: SpecWith FilePath
|
||||
directoryServiceTests :: SpecWith TestParams
|
||||
directoryServiceTests = do
|
||||
it "should register group" testDirectoryService
|
||||
it "should suspend and resume group, send message to owner" testSuspendResume
|
||||
|
@ -68,8 +69,8 @@ directoryServiceTests = do
|
|||
directoryProfile :: Profile
|
||||
directoryProfile = Profile {displayName = "SimpleX-Directory", fullName = "", image = Nothing, contactLink = Nothing, preferences = Nothing}
|
||||
|
||||
mkDirectoryOpts :: FilePath -> [KnownContact] -> Maybe KnownGroup -> DirectoryOpts
|
||||
mkDirectoryOpts tmp superUsers ownersGroup =
|
||||
mkDirectoryOpts :: TestParams -> [KnownContact] -> Maybe KnownGroup -> DirectoryOpts
|
||||
mkDirectoryOpts TestParams {tmpPath = ps} superUsers ownersGroup =
|
||||
DirectoryOpts
|
||||
{ coreOptions =
|
||||
testCoreOpts
|
||||
|
@ -78,14 +79,14 @@ mkDirectoryOpts tmp superUsers ownersGroup =
|
|||
#if defined(dbPostgres)
|
||||
{dbSchemaPrefix = "client_" <> serviceDbPrefix}
|
||||
#else
|
||||
{dbFilePrefix = tmp </> serviceDbPrefix}
|
||||
{dbFilePrefix = ps </> serviceDbPrefix}
|
||||
#endif
|
||||
|
||||
},
|
||||
adminUsers = [],
|
||||
superUsers,
|
||||
ownersGroup,
|
||||
directoryLog = Just $ tmp </> "directory_service.log",
|
||||
directoryLog = Just $ ps </> "directory_service.log",
|
||||
serviceName = "SimpleX-Directory",
|
||||
runCLI = False,
|
||||
searchResults = 3,
|
||||
|
@ -98,11 +99,11 @@ serviceDbPrefix = "directory_service"
|
|||
viewName :: String -> String
|
||||
viewName = T.unpack . DE.viewName . T.pack
|
||||
|
||||
testDirectoryService :: HasCallStack => FilePath -> IO ()
|
||||
testDirectoryService tmp =
|
||||
withDirectoryService tmp $ \superUser dsLink ->
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob ->
|
||||
withNewTestChat tmp "cath" cathProfile $ \cath -> do
|
||||
testDirectoryService :: HasCallStack => TestParams -> IO ()
|
||||
testDirectoryService ps =
|
||||
withDirectoryService ps $ \superUser dsLink ->
|
||||
withNewTestChat ps "bob" bobProfile $ \bob ->
|
||||
withNewTestChat ps "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
bob #> "@SimpleX-Directory privacy"
|
||||
bob <# "SimpleX-Directory> > privacy"
|
||||
|
@ -211,10 +212,10 @@ testDirectoryService tmp =
|
|||
su <## "To approve send:"
|
||||
su <# ("SimpleX-Directory> /approve 1:PSA " <> show grId)
|
||||
|
||||
testSuspendResume :: HasCallStack => FilePath -> IO ()
|
||||
testSuspendResume tmp =
|
||||
withDirectoryService tmp $ \superUser dsLink ->
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob -> do
|
||||
testSuspendResume :: HasCallStack => TestParams -> IO ()
|
||||
testSuspendResume ps =
|
||||
withDirectoryService ps $ \superUser dsLink ->
|
||||
withNewTestChat ps "bob" bobProfile $ \bob -> do
|
||||
bob `connectVia` dsLink
|
||||
registerGroup superUser bob "privacy" "Privacy"
|
||||
groupFound bob "privacy"
|
||||
|
@ -240,10 +241,10 @@ testSuspendResume tmp =
|
|||
superUser <## " Forwarded to @bob, the owner of the group ID 1 (privacy)"
|
||||
bob <# "SimpleX-Directory> hello there"
|
||||
|
||||
testDeleteGroup :: HasCallStack => FilePath -> IO ()
|
||||
testDeleteGroup tmp =
|
||||
withDirectoryService tmp $ \superUser dsLink ->
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob -> do
|
||||
testDeleteGroup :: HasCallStack => TestParams -> IO ()
|
||||
testDeleteGroup ps =
|
||||
withDirectoryService ps $ \superUser dsLink ->
|
||||
withNewTestChat ps "bob" bobProfile $ \bob -> do
|
||||
bob `connectVia` dsLink
|
||||
registerGroup superUser bob "privacy" "Privacy"
|
||||
groupFound bob "privacy"
|
||||
|
@ -252,11 +253,11 @@ testDeleteGroup tmp =
|
|||
bob <## " Your group privacy is deleted from the directory"
|
||||
groupNotFound bob "privacy"
|
||||
|
||||
testSetRole :: HasCallStack => FilePath -> IO ()
|
||||
testSetRole tmp =
|
||||
withDirectoryService tmp $ \superUser dsLink ->
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob ->
|
||||
withNewTestChat tmp "cath" cathProfile $ \cath -> do
|
||||
testSetRole :: HasCallStack => TestParams -> IO ()
|
||||
testSetRole ps =
|
||||
withDirectoryService ps $ \superUser dsLink ->
|
||||
withNewTestChat ps "bob" bobProfile $ \bob ->
|
||||
withNewTestChat ps "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
registerGroup superUser bob "privacy" "Privacy"
|
||||
groupFound bob "privacy"
|
||||
|
@ -281,12 +282,12 @@ testSetRole tmp =
|
|||
cath ##> "#privacy hello"
|
||||
cath <## "#privacy: you don't have permission to send messages"
|
||||
|
||||
testJoinGroup :: HasCallStack => FilePath -> IO ()
|
||||
testJoinGroup tmp =
|
||||
withDirectoryServiceCfg tmp testCfgGroupLinkViaContact $ \superUser dsLink ->
|
||||
withNewTestChatCfg tmp testCfgGroupLinkViaContact "bob" bobProfile $ \bob -> do
|
||||
withNewTestChatCfg tmp testCfgGroupLinkViaContact "cath" cathProfile $ \cath ->
|
||||
withNewTestChatCfg tmp testCfgGroupLinkViaContact "dan" danProfile $ \dan -> do
|
||||
testJoinGroup :: HasCallStack => TestParams -> IO ()
|
||||
testJoinGroup ps =
|
||||
withDirectoryServiceCfg ps testCfgGroupLinkViaContact $ \superUser dsLink ->
|
||||
withNewTestChatCfg ps testCfgGroupLinkViaContact "bob" bobProfile $ \bob -> do
|
||||
withNewTestChatCfg ps testCfgGroupLinkViaContact "cath" cathProfile $ \cath ->
|
||||
withNewTestChatCfg ps testCfgGroupLinkViaContact "dan" danProfile $ \dan -> do
|
||||
bob `connectVia` dsLink
|
||||
registerGroup superUser bob "privacy" "Privacy"
|
||||
cath `connectVia` dsLink
|
||||
|
@ -331,10 +332,10 @@ testJoinGroup tmp =
|
|||
cath <## "#privacy: new member dan is connected"
|
||||
]
|
||||
|
||||
testGroupNameWithSpaces :: HasCallStack => FilePath -> IO ()
|
||||
testGroupNameWithSpaces tmp =
|
||||
withDirectoryService tmp $ \superUser dsLink ->
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob -> do
|
||||
testGroupNameWithSpaces :: HasCallStack => TestParams -> IO ()
|
||||
testGroupNameWithSpaces ps =
|
||||
withDirectoryService ps $ \superUser dsLink ->
|
||||
withNewTestChat ps "bob" bobProfile $ \bob -> do
|
||||
bob `connectVia` dsLink
|
||||
registerGroup superUser bob "Privacy & Security" ""
|
||||
groupFound bob "Privacy & Security"
|
||||
|
@ -349,11 +350,11 @@ testGroupNameWithSpaces tmp =
|
|||
bob <# "SimpleX-Directory> The group ID 1 (Privacy & Security) is listed in the directory again!"
|
||||
groupFound bob "Privacy & Security"
|
||||
|
||||
testSearchGroups :: HasCallStack => FilePath -> IO ()
|
||||
testSearchGroups tmp =
|
||||
withDirectoryService tmp $ \superUser dsLink ->
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob -> do
|
||||
withNewTestChat tmp "cath" cathProfile $ \cath -> do
|
||||
testSearchGroups :: HasCallStack => TestParams -> IO ()
|
||||
testSearchGroups ps =
|
||||
withDirectoryService ps $ \superUser dsLink ->
|
||||
withNewTestChat ps "bob" bobProfile $ \bob -> do
|
||||
withNewTestChat ps "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
cath `connectVia` dsLink
|
||||
forM_ [1..8 :: Int] $ \i -> registerGroupId superUser bob (groups !! (i - 1)) "" i i
|
||||
|
@ -435,10 +436,10 @@ testSearchGroups tmp =
|
|||
u <##. "Link to join the group "
|
||||
u <## (show count <> " members")
|
||||
|
||||
testInviteToOwnersGroup :: HasCallStack => FilePath -> IO ()
|
||||
testInviteToOwnersGroup tmp =
|
||||
withDirectoryServiceCfgOwnersGroup tmp testCfg True $ \superUser dsLink ->
|
||||
withNewTestChatCfg tmp testCfg "bob" bobProfile $ \bob -> do
|
||||
testInviteToOwnersGroup :: HasCallStack => TestParams -> IO ()
|
||||
testInviteToOwnersGroup ps =
|
||||
withDirectoryServiceCfgOwnersGroup ps testCfg True $ \superUser dsLink ->
|
||||
withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob -> do
|
||||
bob `connectVia` dsLink
|
||||
registerGroupId superUser bob "privacy" "Privacy" 2 1
|
||||
bob <## "#owners: SimpleX-Directory invites you to join the group as member"
|
||||
|
@ -453,11 +454,11 @@ testInviteToOwnersGroup tmp =
|
|||
registerGroupId superUser bob "security" "Security" 3 2
|
||||
superUser <## "Owner is already a member of owners' group"
|
||||
|
||||
testDelistedOwnerLeaves :: HasCallStack => FilePath -> IO ()
|
||||
testDelistedOwnerLeaves tmp =
|
||||
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
testDelistedOwnerLeaves :: HasCallStack => TestParams -> IO ()
|
||||
testDelistedOwnerLeaves ps =
|
||||
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
registerGroup superUser bob "privacy" "Privacy"
|
||||
addCathAsOwner bob cath
|
||||
|
@ -469,11 +470,11 @@ testDelistedOwnerLeaves tmp =
|
|||
superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (group owner left)."
|
||||
groupNotFound cath "privacy"
|
||||
|
||||
testDelistedOwnerRemoved :: HasCallStack => FilePath -> IO ()
|
||||
testDelistedOwnerRemoved tmp =
|
||||
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
testDelistedOwnerRemoved :: HasCallStack => TestParams -> IO ()
|
||||
testDelistedOwnerRemoved ps =
|
||||
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
registerGroup superUser bob "privacy" "Privacy"
|
||||
addCathAsOwner bob cath
|
||||
|
@ -484,11 +485,11 @@ testDelistedOwnerRemoved tmp =
|
|||
superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (group owner is removed)."
|
||||
groupNotFound cath "privacy"
|
||||
|
||||
testNotDelistedMemberLeaves :: HasCallStack => FilePath -> IO ()
|
||||
testNotDelistedMemberLeaves tmp =
|
||||
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
testNotDelistedMemberLeaves :: HasCallStack => TestParams -> IO ()
|
||||
testNotDelistedMemberLeaves ps =
|
||||
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
registerGroup superUser bob "privacy" "Privacy"
|
||||
addCathAsOwner bob cath
|
||||
|
@ -497,11 +498,11 @@ testNotDelistedMemberLeaves tmp =
|
|||
(superUser </)
|
||||
groupFound cath "privacy"
|
||||
|
||||
testNotDelistedMemberRemoved :: HasCallStack => FilePath -> IO ()
|
||||
testNotDelistedMemberRemoved tmp =
|
||||
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
testNotDelistedMemberRemoved :: HasCallStack => TestParams -> IO ()
|
||||
testNotDelistedMemberRemoved ps =
|
||||
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
registerGroup superUser bob "privacy" "Privacy"
|
||||
addCathAsOwner bob cath
|
||||
|
@ -509,11 +510,11 @@ testNotDelistedMemberRemoved tmp =
|
|||
(superUser </)
|
||||
groupFound cath "privacy"
|
||||
|
||||
testDelistedServiceRemoved :: HasCallStack => FilePath -> IO ()
|
||||
testDelistedServiceRemoved tmp =
|
||||
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
testDelistedServiceRemoved :: HasCallStack => TestParams -> IO ()
|
||||
testDelistedServiceRemoved ps =
|
||||
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
registerGroup superUser bob "privacy" "Privacy"
|
||||
addCathAsOwner bob cath
|
||||
|
@ -526,11 +527,11 @@ testDelistedServiceRemoved tmp =
|
|||
superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (directory service is removed)."
|
||||
groupNotFound cath "privacy"
|
||||
|
||||
testDelistedGroupDeleted :: HasCallStack => FilePath -> IO ()
|
||||
testDelistedGroupDeleted tmp =
|
||||
withDirectoryService tmp $ \superUser dsLink ->
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob ->
|
||||
withNewTestChat tmp "cath" cathProfile $ \cath -> do
|
||||
testDelistedGroupDeleted :: HasCallStack => TestParams -> IO ()
|
||||
testDelistedGroupDeleted ps =
|
||||
withDirectoryService ps $ \superUser dsLink ->
|
||||
withNewTestChat ps "bob" bobProfile $ \bob ->
|
||||
withNewTestChat ps "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
cath `connectVia` dsLink
|
||||
registerGroup superUser bob "privacy" "Privacy"
|
||||
|
@ -550,11 +551,11 @@ testDelistedGroupDeleted tmp =
|
|||
superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (group is deleted)."
|
||||
groupNotFound cath "privacy"
|
||||
|
||||
testDelistedRoleChanges :: HasCallStack => FilePath -> IO ()
|
||||
testDelistedRoleChanges tmp =
|
||||
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
testDelistedRoleChanges :: HasCallStack => TestParams -> IO ()
|
||||
testDelistedRoleChanges ps =
|
||||
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
registerGroup superUser bob "privacy" "Privacy"
|
||||
addCathAsOwner bob cath
|
||||
|
@ -596,11 +597,11 @@ testDelistedRoleChanges tmp =
|
|||
superUser <# "SimpleX-Directory> The group ID 1 (privacy) is listed (user role is set to owner)."
|
||||
groupFoundN 3 cath "privacy"
|
||||
|
||||
testNotDelistedMemberRoleChanged :: HasCallStack => FilePath -> IO ()
|
||||
testNotDelistedMemberRoleChanged tmp =
|
||||
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
testNotDelistedMemberRoleChanged :: HasCallStack => TestParams -> IO ()
|
||||
testNotDelistedMemberRoleChanged ps =
|
||||
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
registerGroup superUser bob "privacy" "Privacy"
|
||||
addCathAsOwner bob cath
|
||||
|
@ -610,11 +611,11 @@ testNotDelistedMemberRoleChanged tmp =
|
|||
cath <## "#privacy: bob changed your role from owner to member"
|
||||
groupFoundN 3 cath "privacy"
|
||||
|
||||
testNotSentApprovalBadRoles :: HasCallStack => FilePath -> IO ()
|
||||
testNotSentApprovalBadRoles tmp =
|
||||
withDirectoryService tmp $ \superUser dsLink ->
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob ->
|
||||
withNewTestChat tmp "cath" cathProfile $ \cath -> do
|
||||
testNotSentApprovalBadRoles :: HasCallStack => TestParams -> IO ()
|
||||
testNotSentApprovalBadRoles ps =
|
||||
withDirectoryService ps $ \superUser dsLink ->
|
||||
withNewTestChat ps "bob" bobProfile $ \bob ->
|
||||
withNewTestChat ps "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
cath `connectVia` dsLink
|
||||
submitGroup bob "privacy" "Privacy"
|
||||
|
@ -633,11 +634,11 @@ testNotSentApprovalBadRoles tmp =
|
|||
approveRegistration superUser bob "privacy" 1
|
||||
groupFound cath "privacy"
|
||||
|
||||
testNotApprovedBadRoles :: HasCallStack => FilePath -> IO ()
|
||||
testNotApprovedBadRoles tmp =
|
||||
withDirectoryService tmp $ \superUser dsLink ->
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob ->
|
||||
withNewTestChat tmp "cath" cathProfile $ \cath -> do
|
||||
testNotApprovedBadRoles :: HasCallStack => TestParams -> IO ()
|
||||
testNotApprovedBadRoles ps =
|
||||
withDirectoryService ps $ \superUser dsLink ->
|
||||
withNewTestChat ps "bob" bobProfile $ \bob ->
|
||||
withNewTestChat ps "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
cath `connectVia` dsLink
|
||||
submitGroup bob "privacy" "Privacy"
|
||||
|
@ -660,11 +661,11 @@ testNotApprovedBadRoles tmp =
|
|||
approveRegistration superUser bob "privacy" 1
|
||||
groupFound cath "privacy"
|
||||
|
||||
testRegOwnerChangedProfile :: HasCallStack => FilePath -> IO ()
|
||||
testRegOwnerChangedProfile tmp =
|
||||
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
testRegOwnerChangedProfile :: HasCallStack => TestParams -> IO ()
|
||||
testRegOwnerChangedProfile ps =
|
||||
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
registerGroup superUser bob "privacy" "Privacy"
|
||||
addCathAsOwner bob cath
|
||||
|
@ -679,11 +680,11 @@ testRegOwnerChangedProfile tmp =
|
|||
reapproveGroup 3 superUser bob
|
||||
groupFoundN 3 cath "privacy"
|
||||
|
||||
testAnotherOwnerChangedProfile :: HasCallStack => FilePath -> IO ()
|
||||
testAnotherOwnerChangedProfile tmp =
|
||||
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
testAnotherOwnerChangedProfile :: HasCallStack => TestParams -> IO ()
|
||||
testAnotherOwnerChangedProfile ps =
|
||||
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
registerGroup superUser bob "privacy" "Privacy"
|
||||
addCathAsOwner bob cath
|
||||
|
@ -698,11 +699,11 @@ testAnotherOwnerChangedProfile tmp =
|
|||
reapproveGroup 3 superUser bob
|
||||
groupFoundN 3 cath "privacy"
|
||||
|
||||
testRegOwnerRemovedLink :: HasCallStack => FilePath -> IO ()
|
||||
testRegOwnerRemovedLink tmp =
|
||||
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
testRegOwnerRemovedLink :: HasCallStack => TestParams -> IO ()
|
||||
testRegOwnerRemovedLink ps =
|
||||
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
registerGroup superUser bob "privacy" "Privacy"
|
||||
addCathAsOwner bob cath
|
||||
|
@ -731,11 +732,11 @@ testRegOwnerRemovedLink tmp =
|
|||
reapproveGroup 3 superUser bob
|
||||
groupFoundN 3 cath "privacy"
|
||||
|
||||
testAnotherOwnerRemovedLink :: HasCallStack => FilePath -> IO ()
|
||||
testAnotherOwnerRemovedLink tmp =
|
||||
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
testAnotherOwnerRemovedLink :: HasCallStack => TestParams -> IO ()
|
||||
testAnotherOwnerRemovedLink ps =
|
||||
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
registerGroup superUser bob "privacy" "Privacy"
|
||||
addCathAsOwner bob cath
|
||||
|
@ -773,11 +774,11 @@ testAnotherOwnerRemovedLink tmp =
|
|||
reapproveGroup 3 superUser bob
|
||||
groupFoundN 3 cath "privacy"
|
||||
|
||||
testDuplicateAskConfirmation :: HasCallStack => FilePath -> IO ()
|
||||
testDuplicateAskConfirmation tmp =
|
||||
withDirectoryService tmp $ \superUser dsLink ->
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob ->
|
||||
withNewTestChat tmp "cath" cathProfile $ \cath -> do
|
||||
testDuplicateAskConfirmation :: HasCallStack => TestParams -> IO ()
|
||||
testDuplicateAskConfirmation ps =
|
||||
withDirectoryService ps $ \superUser dsLink ->
|
||||
withNewTestChat ps "bob" bobProfile $ \bob ->
|
||||
withNewTestChat ps "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
submitGroup bob "privacy" "Privacy"
|
||||
_ <- groupAccepted bob "privacy"
|
||||
|
@ -792,11 +793,11 @@ testDuplicateAskConfirmation tmp =
|
|||
completeRegistration superUser cath "privacy" "Privacy" welcomeWithLink 2
|
||||
groupFound bob "privacy"
|
||||
|
||||
testDuplicateProhibitRegistration :: HasCallStack => FilePath -> IO ()
|
||||
testDuplicateProhibitRegistration tmp =
|
||||
withDirectoryService tmp $ \superUser dsLink ->
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob ->
|
||||
withNewTestChat tmp "cath" cathProfile $ \cath -> do
|
||||
testDuplicateProhibitRegistration :: HasCallStack => TestParams -> IO ()
|
||||
testDuplicateProhibitRegistration ps =
|
||||
withDirectoryService ps $ \superUser dsLink ->
|
||||
withNewTestChat ps "bob" bobProfile $ \bob ->
|
||||
withNewTestChat ps "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
registerGroup superUser bob "privacy" "Privacy"
|
||||
cath `connectVia` dsLink
|
||||
|
@ -804,11 +805,11 @@ testDuplicateProhibitRegistration tmp =
|
|||
_ <- submitGroup cath "privacy" "Privacy"
|
||||
cath <# "SimpleX-Directory> The group privacy (Privacy) is already listed in the directory, please choose another name."
|
||||
|
||||
testDuplicateProhibitConfirmation :: HasCallStack => FilePath -> IO ()
|
||||
testDuplicateProhibitConfirmation tmp =
|
||||
withDirectoryService tmp $ \superUser dsLink ->
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob ->
|
||||
withNewTestChat tmp "cath" cathProfile $ \cath -> do
|
||||
testDuplicateProhibitConfirmation :: HasCallStack => TestParams -> IO ()
|
||||
testDuplicateProhibitConfirmation ps =
|
||||
withDirectoryService ps $ \superUser dsLink ->
|
||||
withNewTestChat ps "bob" bobProfile $ \bob ->
|
||||
withNewTestChat ps "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
submitGroup bob "privacy" "Privacy"
|
||||
welcomeWithLink <- groupAccepted bob "privacy"
|
||||
|
@ -823,11 +824,11 @@ testDuplicateProhibitConfirmation tmp =
|
|||
cath #> "@SimpleX-Directory /confirm 1:privacy"
|
||||
cath <# "SimpleX-Directory> The group privacy (Privacy) is already listed in the directory, please choose another name."
|
||||
|
||||
testDuplicateProhibitWhenUpdated :: HasCallStack => FilePath -> IO ()
|
||||
testDuplicateProhibitWhenUpdated tmp =
|
||||
withDirectoryService tmp $ \superUser dsLink ->
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob ->
|
||||
withNewTestChat tmp "cath" cathProfile $ \cath -> do
|
||||
testDuplicateProhibitWhenUpdated :: HasCallStack => TestParams -> IO ()
|
||||
testDuplicateProhibitWhenUpdated ps =
|
||||
withDirectoryService ps $ \superUser dsLink ->
|
||||
withNewTestChat ps "bob" bobProfile $ \bob ->
|
||||
withNewTestChat ps "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
submitGroup bob "privacy" "Privacy"
|
||||
welcomeWithLink <- groupAccepted bob "privacy"
|
||||
|
@ -854,11 +855,11 @@ testDuplicateProhibitWhenUpdated tmp =
|
|||
groupFound bob "security"
|
||||
groupFound cath "security"
|
||||
|
||||
testDuplicateProhibitApproval :: HasCallStack => FilePath -> IO ()
|
||||
testDuplicateProhibitApproval tmp =
|
||||
withDirectoryService tmp $ \superUser dsLink ->
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob ->
|
||||
withNewTestChat tmp "cath" cathProfile $ \cath -> do
|
||||
testDuplicateProhibitApproval :: HasCallStack => TestParams -> IO ()
|
||||
testDuplicateProhibitApproval ps =
|
||||
withDirectoryService ps $ \superUser dsLink ->
|
||||
withNewTestChat ps "bob" bobProfile $ \bob ->
|
||||
withNewTestChat ps "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
submitGroup bob "privacy" "Privacy"
|
||||
welcomeWithLink <- groupAccepted bob "privacy"
|
||||
|
@ -880,11 +881,11 @@ testDuplicateProhibitApproval tmp =
|
|||
superUser <# ("SimpleX-Directory> > " <> approve)
|
||||
superUser <## " The group ID 2 (privacy) is already listed in the directory."
|
||||
|
||||
testListUserGroups :: HasCallStack => FilePath -> IO ()
|
||||
testListUserGroups tmp =
|
||||
withDirectoryServiceCfg tmp testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg tmp testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
testListUserGroups :: HasCallStack => TestParams -> IO ()
|
||||
testListUserGroups ps =
|
||||
withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do
|
||||
bob `connectVia` dsLink
|
||||
cath `connectVia` dsLink
|
||||
registerGroup superUser bob "privacy" "Privacy"
|
||||
|
@ -915,12 +916,12 @@ testListUserGroups tmp =
|
|||
groupNotFound cath "anonymity"
|
||||
listGroups superUser bob cath
|
||||
|
||||
testRestoreDirectory :: HasCallStack => FilePath -> IO ()
|
||||
testRestoreDirectory tmp = do
|
||||
testListUserGroups tmp
|
||||
restoreDirectoryService tmp 3 3 $ \superUser _dsLink ->
|
||||
withTestChat tmp "bob" $ \bob ->
|
||||
withTestChat tmp "cath" $ \cath -> do
|
||||
testRestoreDirectory :: HasCallStack => TestParams -> IO ()
|
||||
testRestoreDirectory ps = do
|
||||
testListUserGroups ps
|
||||
restoreDirectoryService ps 3 3 $ \superUser _dsLink ->
|
||||
withTestChat ps "bob" $ \bob ->
|
||||
withTestChat ps "cath" $ \cath -> do
|
||||
bob <## "2 contacts connected (use /cs for the list)"
|
||||
bob
|
||||
<### [ "#privacy: connected to server(s)",
|
||||
|
@ -1021,17 +1022,17 @@ addCathAsOwner bob cath = do
|
|||
joinGroup "privacy" cath bob
|
||||
cath <## "#privacy: member SimpleX-Directory is connected"
|
||||
|
||||
withDirectoryService :: HasCallStack => FilePath -> (TestCC -> String -> IO ()) -> IO ()
|
||||
withDirectoryService tmp = withDirectoryServiceCfg tmp testCfg
|
||||
withDirectoryService :: HasCallStack => TestParams -> (TestCC -> String -> IO ()) -> IO ()
|
||||
withDirectoryService ps = withDirectoryServiceCfg ps testCfg
|
||||
|
||||
withDirectoryServiceCfg :: HasCallStack => FilePath -> ChatConfig -> (TestCC -> String -> IO ()) -> IO ()
|
||||
withDirectoryServiceCfg tmp cfg = withDirectoryServiceCfgOwnersGroup tmp cfg False
|
||||
withDirectoryServiceCfg :: HasCallStack => TestParams -> ChatConfig -> (TestCC -> String -> IO ()) -> IO ()
|
||||
withDirectoryServiceCfg ps cfg = withDirectoryServiceCfgOwnersGroup ps cfg False
|
||||
|
||||
withDirectoryServiceCfgOwnersGroup :: HasCallStack => FilePath -> ChatConfig -> Bool -> (TestCC -> String -> IO ()) -> IO ()
|
||||
withDirectoryServiceCfgOwnersGroup tmp cfg createOwnersGroup test = do
|
||||
withDirectoryServiceCfgOwnersGroup :: HasCallStack => TestParams -> ChatConfig -> Bool -> (TestCC -> String -> IO ()) -> IO ()
|
||||
withDirectoryServiceCfgOwnersGroup ps cfg createOwnersGroup test = do
|
||||
dsLink <-
|
||||
withNewTestChatCfg tmp cfg serviceDbPrefix directoryProfile $ \ds ->
|
||||
withNewTestChatCfg tmp cfg "super_user" aliceProfile $ \superUser -> do
|
||||
withNewTestChatCfg ps cfg serviceDbPrefix directoryProfile $ \ds ->
|
||||
withNewTestChatCfg ps cfg "super_user" aliceProfile $ \superUser -> do
|
||||
connectUsers ds superUser
|
||||
when createOwnersGroup $ do
|
||||
superUser ##> "/g owners"
|
||||
|
@ -1046,12 +1047,12 @@ withDirectoryServiceCfgOwnersGroup tmp cfg createOwnersGroup test = do
|
|||
superUser <## "#owners: SimpleX-Directory joined the group"
|
||||
ds ##> "/ad"
|
||||
getContactLink ds True
|
||||
withDirectoryOwnersGroup tmp cfg dsLink createOwnersGroup test
|
||||
withDirectoryOwnersGroup ps cfg dsLink createOwnersGroup test
|
||||
|
||||
restoreDirectoryService :: HasCallStack => FilePath -> Int -> Int -> (TestCC -> String -> IO ()) -> IO ()
|
||||
restoreDirectoryService tmp ctCount grCount test = do
|
||||
restoreDirectoryService :: HasCallStack => TestParams -> Int -> Int -> (TestCC -> String -> IO ()) -> IO ()
|
||||
restoreDirectoryService ps ctCount grCount test = do
|
||||
dsLink <-
|
||||
withTestChat tmp serviceDbPrefix $ \ds -> do
|
||||
withTestChat ps serviceDbPrefix $ \ds -> do
|
||||
ds <## (show ctCount <> " contacts connected (use /cs for the list)")
|
||||
ds <## "Your address is active! To show: /sa"
|
||||
ds <## (show grCount <> " group links active")
|
||||
|
@ -1060,16 +1061,16 @@ restoreDirectoryService tmp ctCount grCount test = do
|
|||
dsLink <- getContactLink ds False
|
||||
ds <## "auto_accept on"
|
||||
pure dsLink
|
||||
withDirectory tmp testCfg dsLink test
|
||||
withDirectory ps testCfg dsLink test
|
||||
|
||||
withDirectory :: HasCallStack => FilePath -> ChatConfig -> String -> (TestCC -> String -> IO ()) -> IO ()
|
||||
withDirectory tmp cfg dsLink = withDirectoryOwnersGroup tmp cfg dsLink False
|
||||
withDirectory :: HasCallStack => TestParams -> ChatConfig -> String -> (TestCC -> String -> IO ()) -> IO ()
|
||||
withDirectory ps cfg dsLink = withDirectoryOwnersGroup ps cfg dsLink False
|
||||
|
||||
withDirectoryOwnersGroup :: HasCallStack => FilePath -> ChatConfig -> String -> Bool -> (TestCC -> String -> IO ()) -> IO ()
|
||||
withDirectoryOwnersGroup tmp cfg dsLink createOwnersGroup test = do
|
||||
let opts = mkDirectoryOpts tmp [KnownContact 2 "alice"] $ if createOwnersGroup then Just $ KnownGroup 1 "owners" else Nothing
|
||||
withDirectoryOwnersGroup :: HasCallStack => TestParams -> ChatConfig -> String -> Bool -> (TestCC -> String -> IO ()) -> IO ()
|
||||
withDirectoryOwnersGroup ps cfg dsLink createOwnersGroup test = do
|
||||
let opts = mkDirectoryOpts ps [KnownContact 2 "alice"] $ if createOwnersGroup then Just $ KnownGroup 1 "owners" else Nothing
|
||||
runDirectory cfg opts $
|
||||
withTestChatCfg tmp cfg "super_user" $ \superUser -> do
|
||||
withTestChatCfg ps cfg "super_user" $ \superUser -> do
|
||||
superUser <## "1 contacts connected (use /cs for the list)"
|
||||
when createOwnersGroup $
|
||||
superUser <## "#owners: connected to server(s)"
|
||||
|
|
|
@ -12,6 +12,7 @@
|
|||
|
||||
module ChatClient where
|
||||
|
||||
import ChatTests.DBUtils
|
||||
import Control.Concurrent (forkIOWithUnmask, killThread, threadDelay)
|
||||
import Control.Concurrent.Async
|
||||
import Control.Concurrent.STM
|
||||
|
@ -68,6 +69,8 @@ import Test.Hspec (Expectation, HasCallStack, shouldReturn)
|
|||
import Database.PostgreSQL.Simple (ConnectInfo (..), defaultConnectInfo)
|
||||
#else
|
||||
import Data.ByteArray (ScrubbedBytes)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Simplex.Messaging.Agent.Store.Common (withConnection)
|
||||
import System.FilePath ((</>))
|
||||
#endif
|
||||
|
||||
|
@ -118,6 +121,7 @@ testCoreOpts =
|
|||
#else
|
||||
{ dbFilePrefix = "./simplex_v1", -- dbFilePrefix is not used in tests (except bot tests where it's redefined)
|
||||
dbKey = "", -- dbKey = "this is a pass-phrase to encrypt the database",
|
||||
trackQueries = DB.TQAll,
|
||||
vacuumOnMigration = True
|
||||
#endif
|
||||
},
|
||||
|
@ -273,29 +277,29 @@ mkCfgGroupLinkViaContact cfg = cfg {chatVRange = groupLinkViaContactVRange}
|
|||
groupLinkViaContactVRange :: VersionRangeChat
|
||||
groupLinkViaContactVRange = mkVersionRange (VersionChat 1) (VersionChat 2)
|
||||
|
||||
createTestChat :: FilePath -> ChatConfig -> ChatOpts -> String -> Profile -> IO TestCC
|
||||
createTestChat tmp cfg opts@ChatOpts {coreOptions} dbPrefix profile = do
|
||||
Right db@ChatDatabase {chatStore, agentStore} <- createDatabase tmp coreOptions dbPrefix
|
||||
createTestChat :: TestParams -> ChatConfig -> ChatOpts -> String -> Profile -> IO TestCC
|
||||
createTestChat ps cfg opts@ChatOpts {coreOptions} dbPrefix profile = do
|
||||
Right db@ChatDatabase {chatStore, agentStore} <- createDatabase ps coreOptions dbPrefix
|
||||
insertUser agentStore
|
||||
Right user <- withTransaction chatStore $ \db' -> runExceptT $ createUserRecord db' (AgentUserId 1) profile True
|
||||
startTestChat_ db cfg opts user
|
||||
|
||||
startTestChat :: FilePath -> ChatConfig -> ChatOpts -> String -> IO TestCC
|
||||
startTestChat tmp cfg opts@ChatOpts {coreOptions} dbPrefix = do
|
||||
Right db@ChatDatabase {chatStore} <- createDatabase tmp coreOptions dbPrefix
|
||||
startTestChat :: TestParams -> ChatConfig -> ChatOpts -> String -> IO TestCC
|
||||
startTestChat ps cfg opts@ChatOpts {coreOptions} dbPrefix = do
|
||||
Right db@ChatDatabase {chatStore} <- createDatabase ps coreOptions dbPrefix
|
||||
Just user <- find activeUser <$> withTransaction chatStore getUsers
|
||||
startTestChat_ db cfg opts user
|
||||
|
||||
createDatabase :: FilePath -> CoreChatOpts -> String -> IO (Either MigrationError ChatDatabase)
|
||||
createDatabase :: TestParams -> CoreChatOpts -> String -> IO (Either MigrationError ChatDatabase)
|
||||
#if defined(dbPostgres)
|
||||
createDatabase _tmp CoreChatOpts {dbOptions} dbPrefix = do
|
||||
createDatabase _params CoreChatOpts {dbOptions} dbPrefix = do
|
||||
createChatDatabase dbOptions {dbSchemaPrefix = "client_" <> dbPrefix} MCError
|
||||
|
||||
insertUser :: DBStore -> IO ()
|
||||
insertUser st = withTransaction st (`DB.execute_` "INSERT INTO users DEFAULT VALUES")
|
||||
#else
|
||||
createDatabase tmp CoreChatOpts {dbOptions} dbPrefix = do
|
||||
createChatDatabase dbOptions {dbFilePrefix = tmp </> dbPrefix} MCError
|
||||
createDatabase TestParams {tmpPath} CoreChatOpts {dbOptions} dbPrefix = do
|
||||
createChatDatabase dbOptions {dbFilePrefix = tmpPath </> dbPrefix} MCError
|
||||
|
||||
insertUser :: DBStore -> IO ()
|
||||
insertUser st = withTransaction st (`DB.execute_` "INSERT INTO users (user_id) VALUES (1)")
|
||||
|
@ -313,48 +317,64 @@ startTestChat_ db cfg opts user = do
|
|||
termAsync <- async $ readTerminalOutput t termQ
|
||||
pure TestCC {chatController = cc, virtualTerminal = t, chatAsync, termAsync, termQ, printOutput = False}
|
||||
|
||||
stopTestChat :: TestCC -> IO ()
|
||||
stopTestChat TestCC {chatController = cc@ChatController {smpAgent, chatStore}, chatAsync, termAsync} = do
|
||||
stopTestChat :: TestParams -> TestCC -> IO ()
|
||||
stopTestChat ps TestCC {chatController = cc@ChatController {smpAgent, chatStore}, chatAsync, termAsync} = do
|
||||
stopChatController cc
|
||||
uninterruptibleCancel termAsync
|
||||
uninterruptibleCancel chatAsync
|
||||
liftIO $ disposeAgentClient smpAgent
|
||||
#if !defined(dbPostgres)
|
||||
stats <- withConnection chatStore $ readTVarIO . DB.slow
|
||||
atomically $ modifyTVar' (queryStats ps) $ M.unionWith combineStats stats
|
||||
#endif
|
||||
closeDBStore chatStore
|
||||
threadDelay 200000
|
||||
#if !defined(dbPostgres)
|
||||
where
|
||||
combineStats
|
||||
DB.SlowQueryStats {count, timeMax, timeAvg, errs}
|
||||
DB.SlowQueryStats {count = count', timeMax = timeMax', timeAvg = timeAvg', errs = errs'} =
|
||||
DB.SlowQueryStats
|
||||
{ count = count + count',
|
||||
timeMax = max timeMax timeMax',
|
||||
timeAvg = (timeAvg * count + timeAvg' * count') `div` (count + count'),
|
||||
errs = M.unionWith (+) errs errs'
|
||||
}
|
||||
#endif
|
||||
|
||||
withNewTestChat :: HasCallStack => FilePath -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withNewTestChat tmp = withNewTestChatCfgOpts tmp testCfg testOpts
|
||||
withNewTestChat :: HasCallStack => TestParams -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withNewTestChat ps = withNewTestChatCfgOpts ps testCfg testOpts
|
||||
|
||||
withNewTestChatV1 :: HasCallStack => FilePath -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withNewTestChatV1 tmp = withNewTestChatCfg tmp testCfgV1
|
||||
withNewTestChatV1 :: HasCallStack => TestParams -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withNewTestChatV1 ps = withNewTestChatCfg ps testCfgV1
|
||||
|
||||
withNewTestChatCfg :: HasCallStack => FilePath -> ChatConfig -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withNewTestChatCfg tmp cfg = withNewTestChatCfgOpts tmp cfg testOpts
|
||||
withNewTestChatCfg :: HasCallStack => TestParams -> ChatConfig -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withNewTestChatCfg ps cfg = withNewTestChatCfgOpts ps cfg testOpts
|
||||
|
||||
withNewTestChatOpts :: HasCallStack => FilePath -> ChatOpts -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withNewTestChatOpts tmp = withNewTestChatCfgOpts tmp testCfg
|
||||
withNewTestChatOpts :: HasCallStack => TestParams -> ChatOpts -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withNewTestChatOpts ps = withNewTestChatCfgOpts ps testCfg
|
||||
|
||||
withNewTestChatCfgOpts :: HasCallStack => FilePath -> ChatConfig -> ChatOpts -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withNewTestChatCfgOpts tmp cfg opts dbPrefix profile runTest =
|
||||
withNewTestChatCfgOpts :: HasCallStack => TestParams -> ChatConfig -> ChatOpts -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withNewTestChatCfgOpts ps cfg opts dbPrefix profile runTest =
|
||||
bracket
|
||||
(createTestChat tmp cfg opts dbPrefix profile)
|
||||
stopTestChat
|
||||
(createTestChat ps cfg opts dbPrefix profile)
|
||||
(stopTestChat ps)
|
||||
(\cc -> runTest cc >>= ((cc <// 100000) $>))
|
||||
|
||||
withTestChatV1 :: HasCallStack => FilePath -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChatV1 tmp = withTestChatCfg tmp testCfgV1
|
||||
withTestChatV1 :: HasCallStack => TestParams -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChatV1 ps = withTestChatCfg ps testCfgV1
|
||||
|
||||
withTestChat :: HasCallStack => FilePath -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChat tmp = withTestChatCfgOpts tmp testCfg testOpts
|
||||
withTestChat :: HasCallStack => TestParams -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChat ps = withTestChatCfgOpts ps testCfg testOpts
|
||||
|
||||
withTestChatCfg :: HasCallStack => FilePath -> ChatConfig -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChatCfg tmp cfg = withTestChatCfgOpts tmp cfg testOpts
|
||||
withTestChatCfg :: HasCallStack => TestParams -> ChatConfig -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChatCfg ps cfg = withTestChatCfgOpts ps cfg testOpts
|
||||
|
||||
withTestChatOpts :: HasCallStack => FilePath -> ChatOpts -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChatOpts tmp = withTestChatCfgOpts tmp testCfg
|
||||
withTestChatOpts :: HasCallStack => TestParams -> ChatOpts -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChatOpts ps = withTestChatCfgOpts ps testCfg
|
||||
|
||||
withTestChatCfgOpts :: HasCallStack => FilePath -> ChatConfig -> ChatOpts -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChatCfgOpts tmp cfg opts dbPrefix = bracket (startTestChat tmp cfg opts dbPrefix) (\cc -> cc <// 100000 >> stopTestChat cc)
|
||||
withTestChatCfgOpts :: HasCallStack => TestParams -> ChatConfig -> ChatOpts -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChatCfgOpts ps cfg opts dbPrefix = bracket (startTestChat ps cfg opts dbPrefix) (\cc -> cc <// 100000 >> stopTestChat ps cc)
|
||||
|
||||
-- enable output for specific chat controller, use like this:
|
||||
-- withNewTestChat tmp "alice" aliceProfile $ \a -> withTestOutput a $ \alice -> do ...
|
||||
|
@ -390,16 +410,16 @@ withTmpFiles =
|
|||
(createDirectoryIfMissing False "tests/tmp")
|
||||
(removeDirectoryRecursive "tests/tmp")
|
||||
|
||||
testChatN :: HasCallStack => ChatConfig -> ChatOpts -> [Profile] -> (HasCallStack => [TestCC] -> IO ()) -> FilePath -> IO ()
|
||||
testChatN cfg opts ps test tmp = do
|
||||
testChatN :: HasCallStack => ChatConfig -> ChatOpts -> [Profile] -> (HasCallStack => [TestCC] -> IO ()) -> TestParams -> IO ()
|
||||
testChatN cfg opts ps test params = do
|
||||
tcs <- getTestCCs (zip ps [1 ..]) []
|
||||
test tcs
|
||||
concurrentlyN_ $ map (<// 100000) tcs
|
||||
concurrentlyN_ $ map stopTestChat tcs
|
||||
concurrentlyN_ $ map (stopTestChat params) tcs
|
||||
where
|
||||
getTestCCs :: [(Profile, Int)] -> [TestCC] -> IO [TestCC]
|
||||
getTestCCs [] tcs = pure tcs
|
||||
getTestCCs ((p, db) : envs') tcs = (:) <$> createTestChat tmp cfg opts (show db) p <*> getTestCCs envs' tcs
|
||||
getTestCCs ((p, db) : envs') tcs = (:) <$> createTestChat params cfg opts (show db) p <*> getTestCCs envs' tcs
|
||||
|
||||
(<//) :: HasCallStack => TestCC -> Int -> Expectation
|
||||
(<//) cc t = timeout t (getTermLine cc) `shouldReturn` Nothing
|
||||
|
@ -420,49 +440,49 @@ userName :: TestCC -> IO [Char]
|
|||
userName (TestCC ChatController {currentUser} _ _ _ _ _) =
|
||||
maybe "no current user" (\User {localDisplayName} -> T.unpack localDisplayName) <$> readTVarIO currentUser
|
||||
|
||||
testChat :: HasCallStack => Profile -> (HasCallStack => TestCC -> IO ()) -> FilePath -> IO ()
|
||||
testChat :: HasCallStack => Profile -> (HasCallStack => TestCC -> IO ()) -> TestParams -> IO ()
|
||||
testChat = testChatCfgOpts testCfg testOpts
|
||||
|
||||
testChatCfgOpts :: HasCallStack => ChatConfig -> ChatOpts -> Profile -> (HasCallStack => TestCC -> IO ()) -> FilePath -> IO ()
|
||||
testChatCfgOpts :: HasCallStack => ChatConfig -> ChatOpts -> Profile -> (HasCallStack => TestCC -> IO ()) -> TestParams -> IO ()
|
||||
testChatCfgOpts cfg opts p test = testChatN cfg opts [p] test_
|
||||
where
|
||||
test_ :: HasCallStack => [TestCC] -> IO ()
|
||||
test_ [tc] = test tc
|
||||
test_ _ = error "expected 1 chat client"
|
||||
|
||||
testChat2 :: HasCallStack => Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
testChat2 :: HasCallStack => Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
|
||||
testChat2 = testChatCfgOpts2 testCfg testOpts
|
||||
|
||||
testChatCfg2 :: HasCallStack => ChatConfig -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
testChatCfg2 :: HasCallStack => ChatConfig -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
|
||||
testChatCfg2 cfg = testChatCfgOpts2 cfg testOpts
|
||||
|
||||
testChatOpts2 :: HasCallStack => ChatOpts -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
testChatOpts2 :: HasCallStack => ChatOpts -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
|
||||
testChatOpts2 = testChatCfgOpts2 testCfg
|
||||
|
||||
testChatCfgOpts2 :: HasCallStack => ChatConfig -> ChatOpts -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
testChatCfgOpts2 :: HasCallStack => ChatConfig -> ChatOpts -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
|
||||
testChatCfgOpts2 cfg opts p1 p2 test = testChatN cfg opts [p1, p2] test_
|
||||
where
|
||||
test_ :: HasCallStack => [TestCC] -> IO ()
|
||||
test_ [tc1, tc2] = test tc1 tc2
|
||||
test_ _ = error "expected 2 chat clients"
|
||||
|
||||
testChat3 :: HasCallStack => Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
testChat3 :: HasCallStack => Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
|
||||
testChat3 = testChatCfgOpts3 testCfg testOpts
|
||||
|
||||
testChatCfg3 :: HasCallStack => ChatConfig -> Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
testChatCfg3 :: HasCallStack => ChatConfig -> Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
|
||||
testChatCfg3 cfg = testChatCfgOpts3 cfg testOpts
|
||||
|
||||
testChatCfgOpts3 :: HasCallStack => ChatConfig -> ChatOpts -> Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
testChatCfgOpts3 :: HasCallStack => ChatConfig -> ChatOpts -> Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
|
||||
testChatCfgOpts3 cfg opts p1 p2 p3 test = testChatN cfg opts [p1, p2, p3] test_
|
||||
where
|
||||
test_ :: HasCallStack => [TestCC] -> IO ()
|
||||
test_ [tc1, tc2, tc3] = test tc1 tc2 tc3
|
||||
test_ _ = error "expected 3 chat clients"
|
||||
|
||||
testChat4 :: HasCallStack => Profile -> Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
testChat4 :: HasCallStack => Profile -> Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
|
||||
testChat4 = testChatCfg4 testCfg
|
||||
|
||||
testChatCfg4 :: HasCallStack => ChatConfig -> Profile -> Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
testChatCfg4 :: HasCallStack => ChatConfig -> Profile -> Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
|
||||
testChatCfg4 cfg p1 p2 p3 p4 test = testChatN cfg testOpts [p1, p2, p3, p4] test_
|
||||
where
|
||||
test_ :: HasCallStack => [TestCC] -> IO ()
|
||||
|
|
|
@ -1,6 +1,7 @@
|
|||
module ChatTests where
|
||||
|
||||
import ChatTests.ChatList
|
||||
import ChatTests.DBUtils
|
||||
import ChatTests.Direct
|
||||
import ChatTests.Files
|
||||
import ChatTests.Forward
|
||||
|
@ -9,7 +10,7 @@ import ChatTests.Local
|
|||
import ChatTests.Profiles
|
||||
import Test.Hspec hiding (it)
|
||||
|
||||
chatTests :: SpecWith FilePath
|
||||
chatTests :: SpecWith TestParams
|
||||
chatTests = do
|
||||
describe "direct tests" chatDirectTests
|
||||
describe "forward tests" chatForwardTests
|
||||
|
|
|
@ -1,12 +1,13 @@
|
|||
module ChatTests.ChatList where
|
||||
|
||||
import ChatClient
|
||||
import ChatTests.DBUtils
|
||||
import ChatTests.Utils
|
||||
import Data.Time.Clock (getCurrentTime)
|
||||
import Data.Time.Format.ISO8601 (iso8601Show)
|
||||
import Test.Hspec hiding (it)
|
||||
|
||||
chatListTests :: SpecWith FilePath
|
||||
chatListTests :: SpecWith TestParams
|
||||
chatListTests = do
|
||||
it "get last chats" testPaginationLast
|
||||
it "get chats before/after timestamp" testPaginationTs
|
||||
|
@ -16,7 +17,7 @@ chatListTests = do
|
|||
it "filter favorite or unread" testFilterFavoriteOrUnread
|
||||
it "sort and filter chats of all types" testPaginationAllChatTypes
|
||||
|
||||
testPaginationLast :: HasCallStack => FilePath -> IO ()
|
||||
testPaginationLast :: HasCallStack => TestParams -> IO ()
|
||||
testPaginationLast =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
|
@ -32,7 +33,7 @@ testPaginationLast =
|
|||
alice <# "bob> hey"
|
||||
alice <# "@cath hey"
|
||||
|
||||
testPaginationTs :: HasCallStack => FilePath -> IO ()
|
||||
testPaginationTs :: HasCallStack => TestParams -> IO ()
|
||||
testPaginationTs =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
|
@ -59,7 +60,7 @@ getChats_ :: HasCallStack => TestCC -> String -> [(String, String)] -> Expectati
|
|||
getChats_ cc query expected = do
|
||||
cc #$> ("/_get chats 1 pcc=on " <> query, chats, expected)
|
||||
|
||||
testFilterSearch :: HasCallStack => FilePath -> IO ()
|
||||
testFilterSearch :: HasCallStack => TestParams -> IO ()
|
||||
testFilterSearch =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
|
@ -75,7 +76,7 @@ testFilterSearch =
|
|||
getChats_ alice (query "bob") [("@bob", "hey")]
|
||||
getChats_ alice (query "Bob") [("@bob", "hey")]
|
||||
|
||||
testFilterFavorite :: HasCallStack => FilePath -> IO ()
|
||||
testFilterFavorite :: HasCallStack => TestParams -> IO ()
|
||||
testFilterFavorite =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
|
@ -99,7 +100,7 @@ testFilterFavorite =
|
|||
alice <## "ok"
|
||||
getChats_ alice query [("@bob", "hey")]
|
||||
|
||||
testFilterUnread :: HasCallStack => FilePath -> IO ()
|
||||
testFilterUnread :: HasCallStack => TestParams -> IO ()
|
||||
testFilterUnread =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
|
@ -123,7 +124,7 @@ testFilterUnread =
|
|||
alice <## "ok"
|
||||
getChats_ alice query [("@bob", "hey")]
|
||||
|
||||
testFilterFavoriteOrUnread :: HasCallStack => FilePath -> IO ()
|
||||
testFilterFavoriteOrUnread :: HasCallStack => TestParams -> IO ()
|
||||
testFilterFavoriteOrUnread =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
|
@ -154,7 +155,7 @@ testFilterFavoriteOrUnread =
|
|||
alice <## "ok"
|
||||
getChats_ alice query [("@cath", "hey"), ("@bob", "hey")]
|
||||
|
||||
testPaginationAllChatTypes :: HasCallStack => FilePath -> IO ()
|
||||
testPaginationAllChatTypes :: HasCallStack => TestParams -> IO ()
|
||||
testPaginationAllChatTypes =
|
||||
testChat4 aliceProfile bobProfile cathProfile danProfile $
|
||||
\alice bob cath dan -> do
|
||||
|
|
15
tests/ChatTests/DBUtils.hs
Normal file
15
tests/ChatTests/DBUtils.hs
Normal 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
5
tests/ChatTests/DBUtils/Postgres.hs
Normal file
|
@ -0,0 +1,5 @@
|
|||
module ChatTests.DBUtils.Postgres where
|
||||
|
||||
data TestParams = TestParams
|
||||
{ tmpPath :: FilePath
|
||||
}
|
10
tests/ChatTests/DBUtils/SQLite.hs
Normal file
10
tests/ChatTests/DBUtils/SQLite.hs
Normal 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
|
||||
}
|
File diff suppressed because it is too large
Load diff
|
@ -6,6 +6,7 @@
|
|||
module ChatTests.Files where
|
||||
|
||||
import ChatClient
|
||||
import ChatTests.DBUtils
|
||||
import ChatTests.Utils
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Concurrent.Async (concurrently_)
|
||||
|
@ -24,7 +25,7 @@ import Simplex.Messaging.Encoding.String
|
|||
import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist, getFileSize)
|
||||
import Test.Hspec hiding (it)
|
||||
|
||||
chatFileTests :: SpecWith FilePath
|
||||
chatFileTests :: SpecWith TestParams
|
||||
chatFileTests = do
|
||||
describe "messages with files" $ do
|
||||
it "send and receive message with file" runTestMessageWithFile
|
||||
|
@ -63,7 +64,7 @@ chatFileTests = do
|
|||
xit "removes sent file from server" testXFTPStandaloneCancelSnd -- no error shown in tests
|
||||
it "removes received temporary files" testXFTPStandaloneCancelRcv
|
||||
|
||||
runTestMessageWithFile :: HasCallStack => FilePath -> IO ()
|
||||
runTestMessageWithFile :: HasCallStack => TestParams -> IO ()
|
||||
runTestMessageWithFile = testChat2 aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do
|
||||
connectUsers alice bob
|
||||
|
||||
|
@ -89,7 +90,7 @@ runTestMessageWithFile = testChat2 aliceProfile bobProfile $ \alice bob -> withX
|
|||
alice #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((1, "hi, sending a file"), Just "./tests/fixtures/test.jpg")])
|
||||
bob #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((0, "hi, sending a file"), Just "./tests/tmp/test.jpg")])
|
||||
|
||||
testSendImage :: HasCallStack => FilePath -> IO ()
|
||||
testSendImage :: HasCallStack => TestParams -> IO ()
|
||||
testSendImage =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> withXFTPServer $ do
|
||||
|
@ -120,7 +121,7 @@ testSendImage =
|
|||
fileExists <- doesFileExist "./tests/tmp/test.jpg"
|
||||
fileExists `shouldBe` True
|
||||
|
||||
testSenderMarkItemDeleted :: HasCallStack => FilePath -> IO ()
|
||||
testSenderMarkItemDeleted :: HasCallStack => TestParams -> IO ()
|
||||
testSenderMarkItemDeleted =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> withXFTPServer $ do
|
||||
|
@ -143,7 +144,7 @@ testSenderMarkItemDeleted =
|
|||
bob ##> "/fs 1"
|
||||
bob <## "receiving file 1 (test_1MB.pdf) cancelled"
|
||||
|
||||
testFilesFoldersSendImage :: HasCallStack => FilePath -> IO ()
|
||||
testFilesFoldersSendImage :: HasCallStack => TestParams -> IO ()
|
||||
testFilesFoldersSendImage =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> withXFTPServer $ do
|
||||
|
@ -175,7 +176,7 @@ testFilesFoldersSendImage =
|
|||
bob <## "alice: contact is deleted"
|
||||
alice <## "bob (Bob) deleted contact with you"
|
||||
|
||||
testFilesFoldersImageSndDelete :: HasCallStack => FilePath -> IO ()
|
||||
testFilesFoldersImageSndDelete :: HasCallStack => TestParams -> IO ()
|
||||
testFilesFoldersImageSndDelete =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> withXFTPServer $ do
|
||||
|
@ -208,7 +209,7 @@ testFilesFoldersImageSndDelete =
|
|||
bob ##> "/d alice"
|
||||
bob <## "alice: contact is deleted"
|
||||
|
||||
testFilesFoldersImageRcvDelete :: HasCallStack => FilePath -> IO ()
|
||||
testFilesFoldersImageRcvDelete :: HasCallStack => TestParams -> IO ()
|
||||
testFilesFoldersImageRcvDelete =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> withXFTPServer $ do
|
||||
|
@ -235,7 +236,7 @@ testFilesFoldersImageRcvDelete =
|
|||
bob <## "alice: contact is deleted"
|
||||
alice <## "bob (Bob) deleted contact with you"
|
||||
|
||||
testSendImageWithTextAndQuote :: HasCallStack => FilePath -> IO ()
|
||||
testSendImageWithTextAndQuote :: HasCallStack => TestParams -> IO ()
|
||||
testSendImageWithTextAndQuote =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> withXFTPServer $ do
|
||||
|
@ -310,7 +311,7 @@ testSendImageWithTextAndQuote =
|
|||
|
||||
B.readFile "./tests/tmp/test_1.jpg" `shouldReturn` src
|
||||
|
||||
testGroupSendImage :: HasCallStack => FilePath -> IO ()
|
||||
testGroupSendImage :: HasCallStack => TestParams -> IO ()
|
||||
testGroupSendImage =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> withXFTPServer $ do
|
||||
|
@ -352,7 +353,7 @@ testGroupSendImage =
|
|||
bob #$> ("/_get chat #1 count=1", chatF, [((0, ""), Just "./tests/tmp/test.jpg")])
|
||||
cath #$> ("/_get chat #1 count=1", chatF, [((0, ""), Just "./tests/tmp/test_1.jpg")])
|
||||
|
||||
testGroupSendImageWithTextAndQuote :: HasCallStack => FilePath -> IO ()
|
||||
testGroupSendImageWithTextAndQuote :: HasCallStack => TestParams -> IO ()
|
||||
testGroupSendImageWithTextAndQuote =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> withXFTPServer $ do
|
||||
|
@ -409,7 +410,7 @@ testGroupSendImageWithTextAndQuote =
|
|||
cath #$> ("/_get chat #1 count=2", chat'', [((0, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (0, "hi team"), Just "./tests/tmp/test_1.jpg")])
|
||||
cath @@@ [("#team", "hey bob"), ("@alice", "received invitation to join group team as admin")]
|
||||
|
||||
testSendMultiFilesDirect :: HasCallStack => FilePath -> IO ()
|
||||
testSendMultiFilesDirect :: HasCallStack => TestParams -> IO ()
|
||||
testSendMultiFilesDirect =
|
||||
testChat2 aliceProfile bobProfile $ \alice bob -> do
|
||||
withXFTPServer $ do
|
||||
|
@ -473,7 +474,7 @@ testSendMultiFilesDirect =
|
|||
alice #$> ("/_get chat @2 count=3", chatF, [((1, "message without file"), Nothing), ((1, "sending file 1"), Just "test.jpg"), ((1, "sending file 2"), Just "test.pdf")])
|
||||
bob #$> ("/_get chat @2 count=3", chatF, [((0, "message without file"), Nothing), ((0, "sending file 1"), Just "test.jpg"), ((0, "sending file 2"), Just "test.pdf")])
|
||||
|
||||
testSendMultiFilesGroup :: HasCallStack => FilePath -> IO ()
|
||||
testSendMultiFilesGroup :: HasCallStack => TestParams -> IO ()
|
||||
testSendMultiFilesGroup =
|
||||
testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
|
||||
withXFTPServer $ do
|
||||
|
@ -582,7 +583,7 @@ testXFTPRoundFDCount = do
|
|||
roundedFDCount 128 `shouldBe` 128
|
||||
roundedFDCount 500 `shouldBe` 512
|
||||
|
||||
testXFTPFileTransfer :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPFileTransfer :: HasCallStack => TestParams -> IO ()
|
||||
testXFTPFileTransfer =
|
||||
testChat2 aliceProfile bobProfile $ \alice bob -> do
|
||||
withXFTPServer $ do
|
||||
|
@ -611,7 +612,7 @@ testXFTPFileTransfer =
|
|||
dest <- B.readFile "./tests/tmp/test.pdf"
|
||||
dest `shouldBe` src
|
||||
|
||||
testXFTPFileTransferEncrypted :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPFileTransferEncrypted :: HasCallStack => TestParams -> IO ()
|
||||
testXFTPFileTransferEncrypted =
|
||||
testChat2 aliceProfile bobProfile $ \alice bob -> do
|
||||
src <- B.readFile "./tests/fixtures/test.pdf"
|
||||
|
@ -638,7 +639,7 @@ testXFTPFileTransferEncrypted =
|
|||
LB.length dest `shouldBe` fromIntegral srcLen
|
||||
LB.toStrict dest `shouldBe` src
|
||||
|
||||
testXFTPAcceptAfterUpload :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPAcceptAfterUpload :: HasCallStack => TestParams -> IO ()
|
||||
testXFTPAcceptAfterUpload =
|
||||
testChat2 aliceProfile bobProfile $ \alice bob -> do
|
||||
withXFTPServer $ do
|
||||
|
@ -663,7 +664,7 @@ testXFTPAcceptAfterUpload =
|
|||
dest <- B.readFile "./tests/tmp/test.pdf"
|
||||
dest `shouldBe` src
|
||||
|
||||
testXFTPGroupFileTransfer :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPGroupFileTransfer :: HasCallStack => TestParams -> IO ()
|
||||
testXFTPGroupFileTransfer =
|
||||
testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
|
||||
withXFTPServer $ do
|
||||
|
@ -701,7 +702,7 @@ testXFTPGroupFileTransfer =
|
|||
dest1 `shouldBe` src
|
||||
dest2 `shouldBe` src
|
||||
|
||||
testXFTPDeleteUploadedFile :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPDeleteUploadedFile :: HasCallStack => TestParams -> IO ()
|
||||
testXFTPDeleteUploadedFile =
|
||||
testChat2 aliceProfile bobProfile $ \alice bob -> do
|
||||
withXFTPServer $ do
|
||||
|
@ -722,7 +723,7 @@ testXFTPDeleteUploadedFile =
|
|||
bob ##> "/fr 1 ./tests/tmp"
|
||||
bob <## "file cancelled: test.pdf"
|
||||
|
||||
testXFTPDeleteUploadedFileGroup :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPDeleteUploadedFileGroup :: HasCallStack => TestParams -> IO ()
|
||||
testXFTPDeleteUploadedFileGroup =
|
||||
testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
|
||||
withXFTPServer $ do
|
||||
|
@ -774,7 +775,7 @@ testXFTPDeleteUploadedFileGroup =
|
|||
cath ##> "/fr 1 ./tests/tmp"
|
||||
cath <## "file cancelled: test.pdf"
|
||||
|
||||
testXFTPWithRelativePaths :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPWithRelativePaths :: HasCallStack => TestParams -> IO ()
|
||||
testXFTPWithRelativePaths =
|
||||
testChat2 aliceProfile bobProfile $ \alice bob -> do
|
||||
withXFTPServer $ do
|
||||
|
@ -802,11 +803,11 @@ testXFTPWithRelativePaths =
|
|||
dest <- B.readFile "./tests/tmp/bob_files/test.pdf"
|
||||
dest `shouldBe` src
|
||||
|
||||
testXFTPContinueRcv :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPContinueRcv tmp = do
|
||||
testXFTPContinueRcv :: HasCallStack => TestParams -> IO ()
|
||||
testXFTPContinueRcv ps = do
|
||||
withXFTPServer $ do
|
||||
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob -> do
|
||||
withNewTestChat ps "alice" aliceProfile $ \alice -> do
|
||||
withNewTestChat ps "bob" bobProfile $ \bob -> do
|
||||
connectUsers alice bob
|
||||
|
||||
alice #> "/f @bob ./tests/fixtures/test.pdf"
|
||||
|
@ -816,7 +817,7 @@ testXFTPContinueRcv tmp = do
|
|||
alice <## "completed uploading file 1 (test.pdf) for bob"
|
||||
|
||||
-- server is down - file is not received
|
||||
withTestChat tmp "bob" $ \bob -> do
|
||||
withTestChat ps "bob" $ \bob -> do
|
||||
bob <## "1 contacts connected (use /cs for the list)"
|
||||
bob ##> "/fr 1 ./tests/tmp"
|
||||
bob
|
||||
|
@ -831,14 +832,14 @@ testXFTPContinueRcv tmp = do
|
|||
|
||||
withXFTPServer $ do
|
||||
-- server is up - file reception is continued
|
||||
withTestChat tmp "bob" $ \bob -> do
|
||||
withTestChat ps "bob" $ \bob -> do
|
||||
bob <## "1 contacts connected (use /cs for the list)"
|
||||
bob <## "completed receiving file 1 (test.pdf) from alice"
|
||||
src <- B.readFile "./tests/fixtures/test.pdf"
|
||||
dest <- B.readFile "./tests/tmp/test.pdf"
|
||||
dest `shouldBe` src
|
||||
|
||||
testXFTPMarkToReceive :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPMarkToReceive :: HasCallStack => TestParams -> IO ()
|
||||
testXFTPMarkToReceive = do
|
||||
testChat2 aliceProfile bobProfile $ \alice bob -> do
|
||||
withXFTPServer $ do
|
||||
|
@ -875,11 +876,11 @@ testXFTPMarkToReceive = do
|
|||
dest <- B.readFile "./tests/tmp/bob_files/test.pdf"
|
||||
dest `shouldBe` src
|
||||
|
||||
testXFTPRcvError :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPRcvError tmp = do
|
||||
testXFTPRcvError :: HasCallStack => TestParams -> IO ()
|
||||
testXFTPRcvError ps = do
|
||||
withXFTPServer $ do
|
||||
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob -> do
|
||||
withNewTestChat ps "alice" aliceProfile $ \alice -> do
|
||||
withNewTestChat ps "bob" bobProfile $ \bob -> do
|
||||
connectUsers alice bob
|
||||
|
||||
alice #> "/f @bob ./tests/fixtures/test.pdf"
|
||||
|
@ -890,7 +891,7 @@ testXFTPRcvError tmp = do
|
|||
|
||||
-- server is up w/t store log - file reception should fail
|
||||
withXFTPServer' xftpServerConfig {storeLogFile = Nothing} $ do
|
||||
withTestChat tmp "bob" $ \bob -> do
|
||||
withTestChat ps "bob" $ \bob -> do
|
||||
bob <## "1 contacts connected (use /cs for the list)"
|
||||
bob ##> "/fr 1 ./tests/tmp"
|
||||
bob
|
||||
|
@ -903,7 +904,7 @@ testXFTPRcvError tmp = do
|
|||
bob ##> "/fs 1"
|
||||
bob <## "receiving file 1 (test.pdf) error: FileErrAuth"
|
||||
|
||||
testXFTPCancelRcvRepeat :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPCancelRcvRepeat :: HasCallStack => TestParams -> IO ()
|
||||
testXFTPCancelRcvRepeat =
|
||||
testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do
|
||||
withXFTPServer $ do
|
||||
|
@ -952,7 +953,7 @@ testXFTPCancelRcvRepeat =
|
|||
where
|
||||
cfg = testCfg {xftpDescrPartSize = 200}
|
||||
|
||||
testAutoAcceptFile :: HasCallStack => FilePath -> IO ()
|
||||
testAutoAcceptFile :: HasCallStack => TestParams -> IO ()
|
||||
testAutoAcceptFile =
|
||||
testChatOpts2 opts aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do
|
||||
connectUsers alice bob
|
||||
|
@ -977,7 +978,7 @@ testAutoAcceptFile =
|
|||
where
|
||||
opts = (testOpts :: ChatOpts) {autoAcceptFileSize = 200000}
|
||||
|
||||
testProhibitFiles :: HasCallStack => FilePath -> IO ()
|
||||
testProhibitFiles :: HasCallStack => TestParams -> IO ()
|
||||
testProhibitFiles =
|
||||
testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> withXFTPServer $ do
|
||||
createGroup3 "team" alice bob cath
|
||||
|
@ -999,7 +1000,7 @@ testProhibitFiles =
|
|||
(bob </)
|
||||
(cath </)
|
||||
|
||||
testXFTPStandaloneSmall :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPStandaloneSmall :: HasCallStack => TestParams -> IO ()
|
||||
testXFTPStandaloneSmall = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
|
||||
withXFTPServer $ do
|
||||
logNote "sending"
|
||||
|
@ -1024,7 +1025,7 @@ testXFTPStandaloneSmall = testChat2 aliceProfile aliceDesktopProfile $ \src dst
|
|||
srcBody <- B.readFile "./tests/fixtures/logo.jpg"
|
||||
B.readFile dstFile `shouldReturn` srcBody
|
||||
|
||||
testXFTPStandaloneSmallInfo :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPStandaloneSmallInfo :: HasCallStack => TestParams -> IO ()
|
||||
testXFTPStandaloneSmallInfo = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
|
||||
withXFTPServer $ do
|
||||
logNote "sending"
|
||||
|
@ -1054,7 +1055,7 @@ testXFTPStandaloneSmallInfo = testChat2 aliceProfile aliceDesktopProfile $ \src
|
|||
srcBody <- B.readFile "./tests/fixtures/logo.jpg"
|
||||
B.readFile dstFile `shouldReturn` srcBody
|
||||
|
||||
testXFTPStandaloneLarge :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPStandaloneLarge :: HasCallStack => TestParams -> IO ()
|
||||
testXFTPStandaloneLarge = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
|
||||
withXFTPServer $ do
|
||||
xftpCLI ["rand", "./tests/tmp/testfile.in", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile.in"]
|
||||
|
@ -1081,7 +1082,7 @@ testXFTPStandaloneLarge = testChat2 aliceProfile aliceDesktopProfile $ \src dst
|
|||
srcBody <- B.readFile "./tests/tmp/testfile.in"
|
||||
B.readFile dstFile `shouldReturn` srcBody
|
||||
|
||||
testXFTPStandaloneLargeInfo :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPStandaloneLargeInfo :: HasCallStack => TestParams -> IO ()
|
||||
testXFTPStandaloneLargeInfo = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
|
||||
withXFTPServer $ do
|
||||
xftpCLI ["rand", "./tests/tmp/testfile.in", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile.in"]
|
||||
|
@ -1114,7 +1115,7 @@ testXFTPStandaloneLargeInfo = testChat2 aliceProfile aliceDesktopProfile $ \src
|
|||
srcBody <- B.readFile "./tests/tmp/testfile.in"
|
||||
B.readFile dstFile `shouldReturn` srcBody
|
||||
|
||||
testXFTPStandaloneCancelSnd :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPStandaloneCancelSnd :: HasCallStack => TestParams -> IO ()
|
||||
testXFTPStandaloneCancelSnd = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
|
||||
withXFTPServer $ do
|
||||
xftpCLI ["rand", "./tests/tmp/testfile.in", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile.in"]
|
||||
|
@ -1144,7 +1145,7 @@ testXFTPStandaloneCancelSnd = testChat2 aliceProfile aliceDesktopProfile $ \src
|
|||
dst <## "error receiving file 1 (should.not.extist)"
|
||||
dst <## "INTERNAL {internalErr = \"XFTP {xftpErr = AUTH}\"}"
|
||||
|
||||
testXFTPStandaloneRelativePaths :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPStandaloneRelativePaths :: HasCallStack => TestParams -> IO ()
|
||||
testXFTPStandaloneRelativePaths = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
|
||||
withXFTPServer $ do
|
||||
logNote "sending"
|
||||
|
@ -1175,7 +1176,7 @@ testXFTPStandaloneRelativePaths = testChat2 aliceProfile aliceDesktopProfile $ \
|
|||
srcBody <- B.readFile "./tests/tmp/src_files/testfile.in"
|
||||
B.readFile "./tests/tmp/dst_files/testfile.out" `shouldReturn` srcBody
|
||||
|
||||
testXFTPStandaloneCancelRcv :: HasCallStack => FilePath -> IO ()
|
||||
testXFTPStandaloneCancelRcv :: HasCallStack => TestParams -> IO ()
|
||||
testXFTPStandaloneCancelRcv = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
|
||||
withXFTPServer $ do
|
||||
xftpCLI ["rand", "./tests/tmp/testfile.in", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile.in"]
|
||||
|
|
|
@ -4,6 +4,7 @@
|
|||
module ChatTests.Forward where
|
||||
|
||||
import ChatClient
|
||||
import ChatTests.DBUtils
|
||||
import ChatTests.Utils
|
||||
import Control.Concurrent (threadDelay)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
|
@ -14,7 +15,7 @@ import Simplex.Chat.Types (ImageData (..))
|
|||
import System.Directory (copyFile, doesFileExist, removeFile)
|
||||
import Test.Hspec hiding (it)
|
||||
|
||||
chatForwardTests :: SpecWith FilePath
|
||||
chatForwardTests :: SpecWith TestParams
|
||||
chatForwardTests = do
|
||||
describe "forward messages" $ do
|
||||
it "from contact to contact" testForwardContactToContact
|
||||
|
@ -42,7 +43,7 @@ chatForwardTests = do
|
|||
it "from group to group" testForwardGroupToGroupMulti
|
||||
it "with relative paths: multiple files from contact to contact" testMultiForwardFiles
|
||||
|
||||
testForwardContactToContact :: HasCallStack => FilePath -> IO ()
|
||||
testForwardContactToContact :: HasCallStack => TestParams -> IO ()
|
||||
testForwardContactToContact =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
|
@ -88,7 +89,7 @@ testForwardContactToContact =
|
|||
alice .<## ": hey"
|
||||
alice <##. "forwarded from: @bob, chat item id:"
|
||||
|
||||
testForwardContactToGroup :: HasCallStack => FilePath -> IO ()
|
||||
testForwardContactToGroup :: HasCallStack => TestParams -> IO ()
|
||||
testForwardContactToGroup =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
|
@ -112,7 +113,7 @@ testForwardContactToGroup =
|
|||
cath <# "#team alice> -> forwarded"
|
||||
cath <## " hey"
|
||||
|
||||
testForwardContactToNotes :: HasCallStack => FilePath -> IO ()
|
||||
testForwardContactToNotes :: HasCallStack => TestParams -> IO ()
|
||||
testForwardContactToNotes =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
|
@ -132,7 +133,7 @@ testForwardContactToNotes =
|
|||
alice <# "* <- @bob"
|
||||
alice <## " hey"
|
||||
|
||||
testForwardGroupToContact :: HasCallStack => FilePath -> IO ()
|
||||
testForwardGroupToContact :: HasCallStack => TestParams -> IO ()
|
||||
testForwardGroupToContact =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
|
@ -156,7 +157,7 @@ testForwardGroupToContact =
|
|||
cath <# "alice> -> forwarded"
|
||||
cath <## " hey"
|
||||
|
||||
testForwardGroupToGroup :: HasCallStack => FilePath -> IO ()
|
||||
testForwardGroupToGroup :: HasCallStack => TestParams -> IO ()
|
||||
testForwardGroupToGroup =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
|
@ -197,7 +198,7 @@ testForwardGroupToGroup =
|
|||
cath <# "#club alice> -> forwarded"
|
||||
cath <## " hey"
|
||||
|
||||
testForwardGroupToNotes :: HasCallStack => FilePath -> IO ()
|
||||
testForwardGroupToNotes :: HasCallStack => TestParams -> IO ()
|
||||
testForwardGroupToNotes =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
|
@ -217,7 +218,7 @@ testForwardGroupToNotes =
|
|||
alice <# "* <- #team"
|
||||
alice <## " hey"
|
||||
|
||||
testForwardNotesToContact :: HasCallStack => FilePath -> IO ()
|
||||
testForwardNotesToContact :: HasCallStack => TestParams -> IO ()
|
||||
testForwardNotesToContact =
|
||||
testChat2 aliceProfile cathProfile $
|
||||
\alice cath -> do
|
||||
|
@ -230,7 +231,7 @@ testForwardNotesToContact =
|
|||
alice <# "@cath hi"
|
||||
cath <# "alice> hi"
|
||||
|
||||
testForwardNotesToGroup :: HasCallStack => FilePath -> IO ()
|
||||
testForwardNotesToGroup :: HasCallStack => TestParams -> IO ()
|
||||
testForwardNotesToGroup =
|
||||
testChat2 aliceProfile cathProfile $
|
||||
\alice cath -> do
|
||||
|
@ -243,9 +244,9 @@ testForwardNotesToGroup =
|
|||
alice <# "#team hi"
|
||||
cath <# "#team alice> hi"
|
||||
|
||||
testForwardNotesToNotes :: HasCallStack => FilePath -> IO ()
|
||||
testForwardNotesToNotes tmp =
|
||||
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
||||
testForwardNotesToNotes :: HasCallStack => TestParams -> IO ()
|
||||
testForwardNotesToNotes ps =
|
||||
withNewTestChat ps "alice" aliceProfile $ \alice -> do
|
||||
createCCNoteFolder alice
|
||||
|
||||
alice >* "hi"
|
||||
|
@ -257,7 +258,7 @@ testForwardNotesToNotes tmp =
|
|||
alice <# "* hi"
|
||||
alice <# "* hi"
|
||||
|
||||
testForwardPreserveInfo :: HasCallStack => FilePath -> IO ()
|
||||
testForwardPreserveInfo :: HasCallStack => TestParams -> IO ()
|
||||
testForwardPreserveInfo =
|
||||
testChat4 aliceProfile bobProfile cathProfile danProfile $
|
||||
\alice bob cath dan -> do
|
||||
|
@ -285,7 +286,7 @@ testForwardPreserveInfo =
|
|||
dan <# "#team alice> -> forwarded"
|
||||
dan <## " hey"
|
||||
|
||||
testForwardRcvMsgNewInfo :: HasCallStack => FilePath -> IO ()
|
||||
testForwardRcvMsgNewInfo :: HasCallStack => TestParams -> IO ()
|
||||
testForwardRcvMsgNewInfo =
|
||||
testChat4 aliceProfile bobProfile cathProfile danProfile $
|
||||
\alice bob cath dan -> do
|
||||
|
@ -313,7 +314,7 @@ testForwardRcvMsgNewInfo =
|
|||
cath <# "alice> -> forwarded"
|
||||
cath <## " hey"
|
||||
|
||||
testForwardQuotedMsg :: HasCallStack => FilePath -> IO ()
|
||||
testForwardQuotedMsg :: HasCallStack => TestParams -> IO ()
|
||||
testForwardQuotedMsg =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
|
@ -343,7 +344,7 @@ testForwardQuotedMsg =
|
|||
cath <# "alice> -> forwarded"
|
||||
cath <## " hey"
|
||||
|
||||
testForwardEditProhibited :: HasCallStack => FilePath -> IO ()
|
||||
testForwardEditProhibited :: HasCallStack => TestParams -> IO ()
|
||||
testForwardEditProhibited =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
|
@ -363,7 +364,7 @@ testForwardEditProhibited =
|
|||
alice ##> ("/_update item @3 " <> msgId <> " text hey edited")
|
||||
alice <## "cannot update this item"
|
||||
|
||||
testForwardDeleteForOther :: HasCallStack => FilePath -> IO ()
|
||||
testForwardDeleteForOther :: HasCallStack => TestParams -> IO ()
|
||||
testForwardDeleteForOther =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
|
@ -384,7 +385,7 @@ testForwardDeleteForOther =
|
|||
alice <## "message marked deleted"
|
||||
cath <# "alice> [marked deleted] hey"
|
||||
|
||||
testForwardFileNoFilesFolder :: HasCallStack => FilePath -> IO ()
|
||||
testForwardFileNoFilesFolder :: HasCallStack => TestParams -> IO ()
|
||||
testForwardFileNoFilesFolder =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> withXFTPServer $ do
|
||||
|
@ -438,7 +439,7 @@ testForwardFileNoFilesFolder =
|
|||
dest2 <- B.readFile "./tests/tmp/test_1.pdf"
|
||||
dest2 `shouldBe` src
|
||||
|
||||
testForwardFileContactToContact :: HasCallStack => FilePath -> IO ()
|
||||
testForwardFileContactToContact :: HasCallStack => TestParams -> IO ()
|
||||
testForwardFileContactToContact =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> withXFTPServer $ do
|
||||
|
@ -504,7 +505,7 @@ testForwardFileContactToContact =
|
|||
fwdFileExists <- doesFileExist "./tests/tmp/bob_files/test_1.pdf"
|
||||
fwdFileExists `shouldBe` True
|
||||
|
||||
testForwardFileGroupToNotes :: HasCallStack => FilePath -> IO ()
|
||||
testForwardFileGroupToNotes :: HasCallStack => TestParams -> IO ()
|
||||
testForwardFileGroupToNotes =
|
||||
testChat2 aliceProfile cathProfile $
|
||||
\alice cath -> withXFTPServer $ do
|
||||
|
@ -552,7 +553,7 @@ testForwardFileGroupToNotes =
|
|||
fwdFileExists <- doesFileExist "./tests/tmp/cath_files/test_1.pdf"
|
||||
fwdFileExists `shouldBe` True
|
||||
|
||||
testForwardFileNotesToGroup :: HasCallStack => FilePath -> IO ()
|
||||
testForwardFileNotesToGroup :: HasCallStack => TestParams -> IO ()
|
||||
testForwardFileNotesToGroup =
|
||||
testChat2 aliceProfile cathProfile $
|
||||
\alice cath -> withXFTPServer $ do
|
||||
|
@ -599,7 +600,7 @@ testForwardFileNotesToGroup =
|
|||
fwdFileExists <- doesFileExist "./tests/tmp/alice_files/test_1.pdf"
|
||||
fwdFileExists `shouldBe` True
|
||||
|
||||
testForwardContactToContactMulti :: HasCallStack => FilePath -> IO ()
|
||||
testForwardContactToContactMulti :: HasCallStack => TestParams -> IO ()
|
||||
testForwardContactToContactMulti =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
|
@ -629,7 +630,7 @@ testForwardContactToContactMulti =
|
|||
cath <# "alice> -> forwarded"
|
||||
cath <## " hey"
|
||||
|
||||
testForwardGroupToGroupMulti :: HasCallStack => FilePath -> IO ()
|
||||
testForwardGroupToGroupMulti :: HasCallStack => TestParams -> IO ()
|
||||
testForwardGroupToGroupMulti =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
|
@ -673,7 +674,7 @@ testForwardGroupToGroupMulti =
|
|||
cath <# "#club alice> -> forwarded"
|
||||
cath <## " hey"
|
||||
|
||||
testMultiForwardFiles :: HasCallStack => FilePath -> IO ()
|
||||
testMultiForwardFiles :: HasCallStack => TestParams -> IO ()
|
||||
testMultiForwardFiles =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> withXFTPServer $ do
|
||||
|
|
File diff suppressed because it is too large
Load diff
|
@ -5,6 +5,7 @@ module ChatTests.Local where
|
|||
|
||||
import ChatClient
|
||||
import ChatTests.ChatList (getChats_)
|
||||
import ChatTests.DBUtils
|
||||
import ChatTests.Utils
|
||||
import Data.Time (getCurrentTime)
|
||||
import Data.Time.Format.ISO8601 (iso8601Show)
|
||||
|
@ -13,7 +14,7 @@ import System.Directory (copyFile, doesFileExist)
|
|||
import System.FilePath ((</>))
|
||||
import Test.Hspec hiding (it)
|
||||
|
||||
chatLocalChatsTests :: SpecWith FilePath
|
||||
chatLocalChatsTests :: SpecWith TestParams
|
||||
chatLocalChatsTests = do
|
||||
describe "note folders" $ do
|
||||
it "create folders, add notes, read, search" testNotes
|
||||
|
@ -26,8 +27,8 @@ chatLocalChatsTests = do
|
|||
it "create multiple messages api" testCreateMulti
|
||||
it "create multiple messages with files" testCreateMultiFiles
|
||||
|
||||
testNotes :: FilePath -> IO ()
|
||||
testNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
||||
testNotes :: TestParams -> IO ()
|
||||
testNotes ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
|
||||
createCCNoteFolder alice
|
||||
|
||||
alice ##> "/contacts"
|
||||
|
@ -55,8 +56,8 @@ testNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
|||
alice ##> "/tail *"
|
||||
alice <# "* Greetings."
|
||||
|
||||
testUserNotes :: FilePath -> IO ()
|
||||
testUserNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
||||
testUserNotes :: TestParams -> IO ()
|
||||
testUserNotes ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
|
||||
createCCNoteFolder alice
|
||||
|
||||
alice >* "keep in mind"
|
||||
|
@ -73,8 +74,8 @@ testUserNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
|||
alice ##> "/_delete item *1 1 internal"
|
||||
alice <## "chat db error: SENoteFolderNotFound {noteFolderId = 1}"
|
||||
|
||||
testPreviewsPagination :: FilePath -> IO ()
|
||||
testPreviewsPagination tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
||||
testPreviewsPagination :: TestParams -> IO ()
|
||||
testPreviewsPagination ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
|
||||
createCCNoteFolder alice
|
||||
|
||||
tsS <- iso8601Show <$> getCurrentTime
|
||||
|
@ -91,8 +92,8 @@ testPreviewsPagination tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -
|
|||
getChats_ alice ("before=" <> tsE <> " count=10") [("*", "last")]
|
||||
getChats_ alice ("before=" <> tsS <> " count=10") []
|
||||
|
||||
testChatPagination :: FilePath -> IO ()
|
||||
testChatPagination tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
||||
testChatPagination :: TestParams -> IO ()
|
||||
testChatPagination ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
|
||||
createCCNoteFolder alice
|
||||
|
||||
alice >* "hello world"
|
||||
|
@ -115,8 +116,8 @@ testChatPagination tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
|||
|
||||
alice #$> ("/_get chat *1 count=10 search=k-k", chat, [(1, "knock-knock")])
|
||||
|
||||
testFiles :: FilePath -> IO ()
|
||||
testFiles tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
||||
testFiles :: TestParams -> IO ()
|
||||
testFiles ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
|
||||
-- setup
|
||||
createCCNoteFolder alice
|
||||
let files = "./tests/tmp/app_files"
|
||||
|
@ -163,7 +164,7 @@ testFiles tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
|||
alice ##> "/tail"
|
||||
doesFileExist stored `shouldReturn` False
|
||||
|
||||
testOtherFiles :: FilePath -> IO ()
|
||||
testOtherFiles :: TestParams -> IO ()
|
||||
testOtherFiles =
|
||||
testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do
|
||||
connectUsers alice bob
|
||||
|
@ -196,16 +197,16 @@ testOtherFiles =
|
|||
where
|
||||
cfg = testCfg {inlineFiles = defaultInlineFilesConfig {offerChunks = 100, sendChunks = 100, receiveChunks = 100}}
|
||||
|
||||
testCreateMulti :: FilePath -> IO ()
|
||||
testCreateMulti tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
||||
testCreateMulti :: TestParams -> IO ()
|
||||
testCreateMulti ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
|
||||
createCCNoteFolder alice
|
||||
|
||||
alice ##> "/_create *1 json [{\"msgContent\": {\"type\": \"text\", \"text\": \"test 1\"}}, {\"msgContent\": {\"type\": \"text\", \"text\": \"test 2\"}}]"
|
||||
alice <# "* test 1"
|
||||
alice <# "* test 2"
|
||||
|
||||
testCreateMultiFiles :: FilePath -> IO ()
|
||||
testCreateMultiFiles tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
||||
testCreateMultiFiles :: TestParams -> IO ()
|
||||
testCreateMultiFiles ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do
|
||||
createCCNoteFolder alice
|
||||
alice #$> ("/_files_folder ./tests/tmp/alice_app_files", id, "ok")
|
||||
copyFile "./tests/fixtures/test.jpg" "./tests/tmp/alice_app_files/test.jpg"
|
||||
|
|
|
@ -8,6 +8,7 @@
|
|||
module ChatTests.Profiles where
|
||||
|
||||
import ChatClient
|
||||
import ChatTests.DBUtils
|
||||
import ChatTests.Utils
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Concurrent.Async (concurrently_)
|
||||
|
@ -32,7 +33,7 @@ import Simplex.Messaging.Util (encodeJSON)
|
|||
import System.Directory (copyFile, createDirectoryIfMissing)
|
||||
import Test.Hspec hiding (it)
|
||||
|
||||
chatProfileTests :: SpecWith FilePath
|
||||
chatProfileTests :: SpecWith TestParams
|
||||
chatProfileTests = do
|
||||
describe "user profiles" $ do
|
||||
it "update user profile and notify contacts" testUpdateProfile
|
||||
|
@ -101,7 +102,7 @@ chatProfileTests = do
|
|||
it "SimpleX links" testGroupPrefsSimplexLinksForRole
|
||||
it "set user, contact and group UI theme" testSetUITheme
|
||||
|
||||
testUpdateProfile :: HasCallStack => FilePath -> IO ()
|
||||
testUpdateProfile :: HasCallStack => TestParams -> IO ()
|
||||
testUpdateProfile =
|
||||
testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
|
@ -143,7 +144,7 @@ testUpdateProfile =
|
|||
bob <## "use @cat <message> to send messages"
|
||||
]
|
||||
|
||||
testUpdateProfileImage :: HasCallStack => FilePath -> IO ()
|
||||
testUpdateProfileImage :: HasCallStack => TestParams -> IO ()
|
||||
testUpdateProfileImage =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
|
@ -163,7 +164,7 @@ testUpdateProfileImage =
|
|||
bob <## "use @alice2 <message> to send messages"
|
||||
(bob </)
|
||||
|
||||
testMultiWordProfileNames :: HasCallStack => FilePath -> IO ()
|
||||
testMultiWordProfileNames :: HasCallStack => TestParams -> IO ()
|
||||
testMultiWordProfileNames =
|
||||
testChat3 aliceProfile' bobProfile' cathProfile' $
|
||||
\alice bob cath -> do
|
||||
|
@ -236,7 +237,7 @@ testMultiWordProfileNames =
|
|||
cathProfile' = baseProfile {displayName = "Cath Johnson"}
|
||||
baseProfile = Profile {displayName = "", fullName = "", image = Nothing, contactLink = Nothing, preferences = defaultPrefs}
|
||||
|
||||
testUserContactLink :: HasCallStack => FilePath -> IO ()
|
||||
testUserContactLink :: HasCallStack => TestParams -> IO ()
|
||||
testUserContactLink =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
|
@ -266,9 +267,10 @@ testUserContactLink =
|
|||
alice @@@ [("@cath", lastChatFeature), ("@bob", "hey")]
|
||||
alice <##> cath
|
||||
|
||||
testRetryAcceptingViaContactLink :: HasCallStack => FilePath -> IO ()
|
||||
testRetryAcceptingViaContactLink tmp = testChatCfgOpts2 cfg' opts' aliceProfile bobProfile test tmp
|
||||
testRetryAcceptingViaContactLink :: HasCallStack => TestParams -> IO ()
|
||||
testRetryAcceptingViaContactLink ps = testChatCfgOpts2 cfg' opts' aliceProfile bobProfile test ps
|
||||
where
|
||||
tmp = tmpPath ps
|
||||
test alice bob = do
|
||||
cLink <- withSmpServer' serverCfg' $ do
|
||||
alice ##> "/ad"
|
||||
|
@ -327,7 +329,7 @@ testRetryAcceptingViaContactLink tmp = testChatCfgOpts2 cfg' opts' aliceProfile
|
|||
}
|
||||
}
|
||||
|
||||
testProfileLink :: HasCallStack => FilePath -> IO ()
|
||||
testProfileLink :: HasCallStack => TestParams -> IO ()
|
||||
testProfileLink =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
|
@ -408,7 +410,7 @@ testProfileLink =
|
|||
cc <## "quantum resistant end-to-end encryption"
|
||||
cc <## currentChatVRangeInfo
|
||||
|
||||
testUserContactLinkAutoAccept :: HasCallStack => FilePath -> IO ()
|
||||
testUserContactLinkAutoAccept :: HasCallStack => TestParams -> IO ()
|
||||
testUserContactLinkAutoAccept =
|
||||
testChat4 aliceProfile bobProfile cathProfile danProfile $
|
||||
\alice bob cath dan -> do
|
||||
|
@ -456,7 +458,7 @@ testUserContactLinkAutoAccept =
|
|||
alice @@@ [("@dan", lastChatFeature), ("@cath", "hey"), ("@bob", "hey")]
|
||||
alice <##> dan
|
||||
|
||||
testDeduplicateContactRequests :: HasCallStack => FilePath -> IO ()
|
||||
testDeduplicateContactRequests :: HasCallStack => TestParams -> IO ()
|
||||
testDeduplicateContactRequests = testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
alice ##> "/ad"
|
||||
|
@ -515,7 +517,7 @@ testDeduplicateContactRequests = testChat3 aliceProfile bobProfile cathProfile $
|
|||
alice @@@ [("@cath", lastChatFeature), ("@bob", "hey")]
|
||||
alice <##> cath
|
||||
|
||||
testDeduplicateContactRequestsProfileChange :: HasCallStack => FilePath -> IO ()
|
||||
testDeduplicateContactRequestsProfileChange :: HasCallStack => TestParams -> IO ()
|
||||
testDeduplicateContactRequestsProfileChange = testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
alice ##> "/ad"
|
||||
|
@ -592,7 +594,7 @@ testDeduplicateContactRequestsProfileChange = testChat3 aliceProfile bobProfile
|
|||
alice @@@ [("@cath", lastChatFeature), ("@robert", "hey")]
|
||||
alice <##> cath
|
||||
|
||||
testRejectContactAndDeleteUserContact :: HasCallStack => FilePath -> IO ()
|
||||
testRejectContactAndDeleteUserContact :: HasCallStack => TestParams -> IO ()
|
||||
testRejectContactAndDeleteUserContact = testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
alice ##> "/_address 1"
|
||||
|
@ -615,7 +617,7 @@ testRejectContactAndDeleteUserContact = testChat3 aliceProfile bobProfile cathPr
|
|||
cath ##> ("/c " <> cLink)
|
||||
cath <## "error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection"
|
||||
|
||||
testDeleteConnectionRequests :: HasCallStack => FilePath -> IO ()
|
||||
testDeleteConnectionRequests :: HasCallStack => TestParams -> IO ()
|
||||
testDeleteConnectionRequests = testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
alice ##> "/ad"
|
||||
|
@ -637,7 +639,7 @@ testDeleteConnectionRequests = testChat3 aliceProfile bobProfile cathProfile $
|
|||
cath ##> ("/c " <> cLink')
|
||||
alice <#? cath
|
||||
|
||||
testAutoReplyMessage :: HasCallStack => FilePath -> IO ()
|
||||
testAutoReplyMessage :: HasCallStack => TestParams -> IO ()
|
||||
testAutoReplyMessage = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
alice ##> "/ad"
|
||||
|
@ -659,7 +661,7 @@ testAutoReplyMessage = testChat2 aliceProfile bobProfile $
|
|||
alice <## "bob (Bob): contact is connected"
|
||||
]
|
||||
|
||||
testAutoReplyMessageInIncognito :: HasCallStack => FilePath -> IO ()
|
||||
testAutoReplyMessageInIncognito :: HasCallStack => TestParams -> IO ()
|
||||
testAutoReplyMessageInIncognito = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
alice ##> "/ad"
|
||||
|
@ -684,7 +686,7 @@ testAutoReplyMessageInIncognito = testChat2 aliceProfile bobProfile $
|
|||
alice <## "use /i bob to print out this incognito profile again"
|
||||
]
|
||||
|
||||
testBusinessAddress :: HasCallStack => FilePath -> IO ()
|
||||
testBusinessAddress :: HasCallStack => TestParams -> IO ()
|
||||
testBusinessAddress = testChat3 businessProfile aliceProfile {fullName = "Alice @ Biz"} bobProfile $
|
||||
\biz alice bob -> do
|
||||
biz ##> "/ad"
|
||||
|
@ -737,7 +739,7 @@ testBusinessAddress = testChat3 businessProfile aliceProfile {fullName = "Alice
|
|||
(alice <# "#bob bob_1> hey there")
|
||||
(biz <# "#bob bob_1> hey there")
|
||||
|
||||
testBusinessUpdateProfiles :: HasCallStack => FilePath -> IO ()
|
||||
testBusinessUpdateProfiles :: HasCallStack => TestParams -> IO ()
|
||||
testBusinessUpdateProfiles = testChat4 businessProfile aliceProfile bobProfile cathProfile $
|
||||
\biz alice bob cath -> do
|
||||
biz ##> "/ad"
|
||||
|
@ -866,7 +868,7 @@ testBusinessUpdateProfiles = testChat4 businessProfile aliceProfile bobProfile c
|
|||
bob #$> ("/_get chat #1 count=1", chat, [(0, "Voice messages: on")])
|
||||
cath #$> ("/_get chat #1 count=1", chat, [(0, "Voice messages: on")])
|
||||
|
||||
testPlanAddressOkKnown :: HasCallStack => FilePath -> IO ()
|
||||
testPlanAddressOkKnown :: HasCallStack => TestParams -> IO ()
|
||||
testPlanAddressOkKnown =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
|
@ -899,9 +901,9 @@ testPlanAddressOkKnown =
|
|||
bob <## "contact address: known contact alice"
|
||||
bob <## "use @alice <message> to send messages"
|
||||
|
||||
testPlanAddressOwn :: HasCallStack => FilePath -> IO ()
|
||||
testPlanAddressOwn tmp =
|
||||
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
||||
testPlanAddressOwn :: HasCallStack => TestParams -> IO ()
|
||||
testPlanAddressOwn ps =
|
||||
withNewTestChat ps "alice" aliceProfile $ \alice -> do
|
||||
alice ##> "/ad"
|
||||
cLink <- getContactLink alice True
|
||||
|
||||
|
@ -945,12 +947,12 @@ testPlanAddressOwn tmp =
|
|||
alice ##> ("/c " <> cLink)
|
||||
alice <## "alice_2 (Alice): contact already exists"
|
||||
|
||||
testPlanAddressConnecting :: HasCallStack => FilePath -> IO ()
|
||||
testPlanAddressConnecting tmp = do
|
||||
cLink <- withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
||||
testPlanAddressConnecting :: HasCallStack => TestParams -> IO ()
|
||||
testPlanAddressConnecting ps = do
|
||||
cLink <- withNewTestChat ps "alice" aliceProfile $ \alice -> do
|
||||
alice ##> "/ad"
|
||||
getContactLink alice True
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob -> do
|
||||
withNewTestChat ps "bob" bobProfile $ \bob -> do
|
||||
threadDelay 100000
|
||||
|
||||
bob ##> ("/c " <> cLink)
|
||||
|
@ -964,14 +966,14 @@ testPlanAddressConnecting tmp = do
|
|||
bob <## "contact address: connecting, allowed to reconnect"
|
||||
|
||||
threadDelay 100000
|
||||
withTestChat tmp "alice" $ \alice -> do
|
||||
withTestChat ps "alice" $ \alice -> do
|
||||
alice <## "Your address is active! To show: /sa"
|
||||
alice <## "bob (Bob) wants to connect to you!"
|
||||
alice <## "to accept: /ac bob"
|
||||
alice <## "to reject: /rc bob (the sender will NOT be notified)"
|
||||
alice ##> "/ac bob"
|
||||
alice <## "bob (Bob): accepting contact request, you can send messages to contact"
|
||||
withTestChat tmp "bob" $ \bob -> do
|
||||
withTestChat ps "bob" $ \bob -> do
|
||||
threadDelay 500000
|
||||
bob <## "alice (Alice): contact is connected"
|
||||
bob @@@ [("@alice", "Audio/video calls: enabled")]
|
||||
|
@ -988,12 +990,12 @@ testPlanAddressConnecting tmp = do
|
|||
bob <## "contact address: known contact alice"
|
||||
bob <## "use @alice <message> to send messages"
|
||||
|
||||
testPlanAddressConnectingSlow :: HasCallStack => FilePath -> IO ()
|
||||
testPlanAddressConnectingSlow tmp = do
|
||||
cLink <- withNewTestChatCfg tmp testCfgSlow "alice" aliceProfile $ \alice -> do
|
||||
testPlanAddressConnectingSlow :: HasCallStack => TestParams -> IO ()
|
||||
testPlanAddressConnectingSlow ps = do
|
||||
cLink <- withNewTestChatCfg ps testCfgSlow "alice" aliceProfile $ \alice -> do
|
||||
alice ##> "/ad"
|
||||
getContactLink alice True
|
||||
withNewTestChatCfg tmp testCfgSlow "bob" bobProfile $ \bob -> do
|
||||
withNewTestChatCfg ps testCfgSlow "bob" bobProfile $ \bob -> do
|
||||
threadDelay 100000
|
||||
|
||||
bob ##> ("/c " <> cLink)
|
||||
|
@ -1007,14 +1009,14 @@ testPlanAddressConnectingSlow tmp = do
|
|||
bob <## "contact address: connecting, allowed to reconnect"
|
||||
|
||||
threadDelay 100000
|
||||
withTestChatCfg tmp testCfgSlow "alice" $ \alice -> do
|
||||
withTestChatCfg ps testCfgSlow "alice" $ \alice -> do
|
||||
alice <## "Your address is active! To show: /sa"
|
||||
alice <## "bob (Bob) wants to connect to you!"
|
||||
alice <## "to accept: /ac bob"
|
||||
alice <## "to reject: /rc bob (the sender will NOT be notified)"
|
||||
alice ##> "/ac bob"
|
||||
alice <## "bob (Bob): accepting contact request..."
|
||||
withTestChatCfg tmp testCfgSlow "bob" $ \bob -> do
|
||||
withTestChatCfg ps testCfgSlow "bob" $ \bob -> do
|
||||
threadDelay 500000
|
||||
bob @@@ [("@alice", "")]
|
||||
bob ##> ("/_connect plan 1 " <> cLink)
|
||||
|
@ -1027,7 +1029,7 @@ testPlanAddressConnectingSlow tmp = do
|
|||
bob ##> ("/c " <> cLink)
|
||||
bob <## "contact address: connecting to contact alice"
|
||||
|
||||
testPlanAddressContactDeletedReconnected :: HasCallStack => FilePath -> IO ()
|
||||
testPlanAddressContactDeletedReconnected :: HasCallStack => TestParams -> IO ()
|
||||
testPlanAddressContactDeletedReconnected =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
|
@ -1090,7 +1092,7 @@ testPlanAddressContactDeletedReconnected =
|
|||
bob <## "contact address: known contact alice_1"
|
||||
bob <## "use @alice_1 <message> to send messages"
|
||||
|
||||
testPlanAddressContactViaAddress :: HasCallStack => FilePath -> IO ()
|
||||
testPlanAddressContactViaAddress :: HasCallStack => TestParams -> IO ()
|
||||
testPlanAddressContactViaAddress =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
|
@ -1154,7 +1156,7 @@ testPlanAddressContactViaAddress =
|
|||
alice <##> bob
|
||||
bob @@@ [("@alice", "hey")]
|
||||
|
||||
testConnectIncognitoInvitationLink :: HasCallStack => FilePath -> IO ()
|
||||
testConnectIncognitoInvitationLink :: HasCallStack => TestParams -> IO ()
|
||||
testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
alice ##> "/connect incognito"
|
||||
|
@ -1228,7 +1230,7 @@ testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfi
|
|||
(bob </)
|
||||
bob `hasContactProfiles` ["bob"]
|
||||
|
||||
testConnectIncognitoContactAddress :: HasCallStack => FilePath -> IO ()
|
||||
testConnectIncognitoContactAddress :: HasCallStack => TestParams -> IO ()
|
||||
testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
alice ##> "/ad"
|
||||
|
@ -1266,7 +1268,7 @@ testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $
|
|||
(bob </)
|
||||
bob `hasContactProfiles` ["bob"]
|
||||
|
||||
testAcceptContactRequestIncognito :: HasCallStack => FilePath -> IO ()
|
||||
testAcceptContactRequestIncognito :: HasCallStack => TestParams -> IO ()
|
||||
testAcceptContactRequestIncognito = testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
alice ##> "/ad"
|
||||
|
@ -1314,7 +1316,7 @@ testAcceptContactRequestIncognito = testChat3 aliceProfile bobProfile cathProfil
|
|||
alice `hasContactProfiles` ["alice", "cath", T.pack aliceIncognitoCath]
|
||||
cath `hasContactProfiles` ["cath", T.pack aliceIncognitoCath]
|
||||
|
||||
testSetConnectionIncognito :: HasCallStack => FilePath -> IO ()
|
||||
testSetConnectionIncognito :: HasCallStack => TestParams -> IO ()
|
||||
testSetConnectionIncognito = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
alice ##> "/connect"
|
||||
|
@ -1337,7 +1339,7 @@ testSetConnectionIncognito = testChat2 aliceProfile bobProfile $
|
|||
alice `hasContactProfiles` ["alice", "bob", T.pack aliceIncognito]
|
||||
bob `hasContactProfiles` ["bob", T.pack aliceIncognito]
|
||||
|
||||
testResetConnectionIncognito :: HasCallStack => FilePath -> IO ()
|
||||
testResetConnectionIncognito :: HasCallStack => TestParams -> IO ()
|
||||
testResetConnectionIncognito = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
alice ##> "/_connect 1 incognito=on"
|
||||
|
@ -1353,42 +1355,42 @@ testResetConnectionIncognito = testChat2 aliceProfile bobProfile $
|
|||
alice `hasContactProfiles` ["alice", "bob"]
|
||||
bob `hasContactProfiles` ["alice", "bob"]
|
||||
|
||||
testSetConnectionIncognitoProhibitedDuringNegotiation :: HasCallStack => FilePath -> IO ()
|
||||
testSetConnectionIncognitoProhibitedDuringNegotiation tmp = do
|
||||
inv <- withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
||||
testSetConnectionIncognitoProhibitedDuringNegotiation :: HasCallStack => TestParams -> IO ()
|
||||
testSetConnectionIncognitoProhibitedDuringNegotiation ps = do
|
||||
inv <- withNewTestChat ps "alice" aliceProfile $ \alice -> do
|
||||
threadDelay 250000
|
||||
alice ##> "/connect"
|
||||
getInvitation alice
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob -> do
|
||||
withNewTestChat ps "bob" bobProfile $ \bob -> do
|
||||
threadDelay 250000
|
||||
bob ##> ("/c " <> inv)
|
||||
bob <## "confirmation sent!"
|
||||
withTestChat tmp "alice" $ \alice -> do
|
||||
withTestChat ps "alice" $ \alice -> do
|
||||
threadDelay 250000
|
||||
alice <## "bob (Bob): contact is connected"
|
||||
alice ##> "/_set incognito :1 on"
|
||||
alice <## "chat db error: SEPendingConnectionNotFound {connId = 1}"
|
||||
withTestChat tmp "bob" $ \bob -> do
|
||||
withTestChat ps "bob" $ \bob -> do
|
||||
bob <## "alice (Alice): contact is connected"
|
||||
alice <##> bob
|
||||
alice `hasContactProfiles` ["alice", "bob"]
|
||||
bob `hasContactProfiles` ["alice", "bob"]
|
||||
|
||||
testSetConnectionIncognitoProhibitedDuringNegotiationSlow :: HasCallStack => FilePath -> IO ()
|
||||
testSetConnectionIncognitoProhibitedDuringNegotiationSlow tmp = do
|
||||
inv <- withNewTestChatCfg tmp testCfgSlow "alice" aliceProfile $ \alice -> do
|
||||
testSetConnectionIncognitoProhibitedDuringNegotiationSlow :: HasCallStack => TestParams -> IO ()
|
||||
testSetConnectionIncognitoProhibitedDuringNegotiationSlow ps = do
|
||||
inv <- withNewTestChatCfg ps testCfgSlow "alice" aliceProfile $ \alice -> do
|
||||
threadDelay 250000
|
||||
alice ##> "/connect"
|
||||
getInvitation alice
|
||||
withNewTestChatCfg tmp testCfgSlow "bob" bobProfile $ \bob -> do
|
||||
withNewTestChatCfg ps testCfgSlow "bob" bobProfile $ \bob -> do
|
||||
threadDelay 250000
|
||||
bob ##> ("/c " <> inv)
|
||||
bob <## "confirmation sent!"
|
||||
withTestChatCfg tmp testCfgSlow "alice" $ \alice -> do
|
||||
withTestChatCfg ps testCfgSlow "alice" $ \alice -> do
|
||||
threadDelay 250000
|
||||
alice ##> "/_set incognito :1 on"
|
||||
alice <## "chat db error: SEPendingConnectionNotFound {connId = 1}"
|
||||
withTestChatCfg tmp testCfgSlow "bob" $ \bob -> do
|
||||
withTestChatCfg ps testCfgSlow "bob" $ \bob -> do
|
||||
concurrently_
|
||||
(bob <## "alice (Alice): contact is connected")
|
||||
(alice <## "bob (Bob): contact is connected")
|
||||
|
@ -1396,7 +1398,7 @@ testSetConnectionIncognitoProhibitedDuringNegotiationSlow tmp = do
|
|||
alice `hasContactProfiles` ["alice", "bob"]
|
||||
bob `hasContactProfiles` ["alice", "bob"]
|
||||
|
||||
testConnectionIncognitoUnchangedErrors :: HasCallStack => FilePath -> IO ()
|
||||
testConnectionIncognitoUnchangedErrors :: HasCallStack => TestParams -> IO ()
|
||||
testConnectionIncognitoUnchangedErrors = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
alice ##> "/connect"
|
||||
|
@ -1420,7 +1422,7 @@ testConnectionIncognitoUnchangedErrors = testChat2 aliceProfile bobProfile $
|
|||
alice `hasContactProfiles` ["alice", "bob"]
|
||||
bob `hasContactProfiles` ["alice", "bob"]
|
||||
|
||||
testSetResetSetConnectionIncognito :: HasCallStack => FilePath -> IO ()
|
||||
testSetResetSetConnectionIncognito :: HasCallStack => TestParams -> IO ()
|
||||
testSetResetSetConnectionIncognito = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
alice ##> "/_connect 1 incognito=off"
|
||||
|
@ -1447,7 +1449,7 @@ testSetResetSetConnectionIncognito = testChat2 aliceProfile bobProfile $
|
|||
alice `hasContactProfiles` ["alice", "bob", T.pack aliceIncognito]
|
||||
bob `hasContactProfiles` ["bob", T.pack aliceIncognito]
|
||||
|
||||
testJoinGroupIncognito :: HasCallStack => FilePath -> IO ()
|
||||
testJoinGroupIncognito :: HasCallStack => TestParams -> IO ()
|
||||
testJoinGroupIncognito =
|
||||
testChatCfg4 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile danProfile $
|
||||
\alice bob cath dan -> do
|
||||
|
@ -1636,7 +1638,7 @@ testJoinGroupIncognito =
|
|||
cath ?#> "@bob_1 ok"
|
||||
bob <# (cathIncognito <> "> ok")
|
||||
|
||||
testCantInviteContactIncognito :: HasCallStack => FilePath -> IO ()
|
||||
testCantInviteContactIncognito :: HasCallStack => TestParams -> IO ()
|
||||
testCantInviteContactIncognito = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
-- alice connected incognito to bob
|
||||
|
@ -1660,7 +1662,7 @@ testCantInviteContactIncognito = testChat2 aliceProfile bobProfile $
|
|||
-- bob doesn't receive invitation
|
||||
(bob </)
|
||||
|
||||
testCantSeeGlobalPrefsUpdateIncognito :: HasCallStack => FilePath -> IO ()
|
||||
testCantSeeGlobalPrefsUpdateIncognito :: HasCallStack => TestParams -> IO ()
|
||||
testCantSeeGlobalPrefsUpdateIncognito = testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
alice ##> "/c i"
|
||||
|
@ -1711,7 +1713,7 @@ testCantSeeGlobalPrefsUpdateIncognito = testChat3 aliceProfile bobProfile cathPr
|
|||
cath <## "alice updated preferences for you:"
|
||||
cath <## "Full deletion: off (you allow: default (no), contact allows: yes)"
|
||||
|
||||
testDeleteContactThenGroupDeletesIncognitoProfile :: HasCallStack => FilePath -> IO ()
|
||||
testDeleteContactThenGroupDeletesIncognitoProfile :: HasCallStack => TestParams -> IO ()
|
||||
testDeleteContactThenGroupDeletesIncognitoProfile = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
-- bob connects incognito to alice
|
||||
|
@ -1763,7 +1765,7 @@ testDeleteContactThenGroupDeletesIncognitoProfile = testChat2 aliceProfile bobPr
|
|||
bob <## "#team: you deleted the group"
|
||||
bob `hasContactProfiles` ["bob"]
|
||||
|
||||
testDeleteGroupThenContactDeletesIncognitoProfile :: HasCallStack => FilePath -> IO ()
|
||||
testDeleteGroupThenContactDeletesIncognitoProfile :: HasCallStack => TestParams -> IO ()
|
||||
testDeleteGroupThenContactDeletesIncognitoProfile = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
-- bob connects incognito to alice
|
||||
|
@ -1815,7 +1817,7 @@ testDeleteGroupThenContactDeletesIncognitoProfile = testChat2 aliceProfile bobPr
|
|||
(bob </)
|
||||
bob `hasContactProfiles` ["bob"]
|
||||
|
||||
testSetAlias :: HasCallStack => FilePath -> IO ()
|
||||
testSetAlias :: HasCallStack => TestParams -> IO ()
|
||||
testSetAlias = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
connectUsers alice bob
|
||||
|
@ -1826,7 +1828,7 @@ testSetAlias = testChat2 aliceProfile bobProfile $
|
|||
alice ##> "/contacts"
|
||||
alice <## "bob (Bob)"
|
||||
|
||||
testChangePCCUser :: HasCallStack => FilePath -> IO ()
|
||||
testChangePCCUser :: HasCallStack => TestParams -> IO ()
|
||||
testChangePCCUser = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
-- Create a new invite
|
||||
|
@ -1856,7 +1858,7 @@ testChangePCCUser = testChat2 aliceProfile bobProfile $
|
|||
(alice <## "bob (Bob): contact is connected")
|
||||
(bob <## "alisa2: contact is connected")
|
||||
|
||||
testChangePCCUserFromIncognito :: HasCallStack => FilePath -> IO ()
|
||||
testChangePCCUserFromIncognito :: HasCallStack => TestParams -> IO ()
|
||||
testChangePCCUserFromIncognito = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
-- Create a new invite and set as incognito
|
||||
|
@ -1887,7 +1889,7 @@ testChangePCCUserFromIncognito = testChat2 aliceProfile bobProfile $
|
|||
(alice <## "bob (Bob): contact is connected")
|
||||
(bob <## "alice (Alice): contact is connected")
|
||||
|
||||
testChangePCCUserAndThenIncognito :: HasCallStack => FilePath -> IO ()
|
||||
testChangePCCUserAndThenIncognito :: HasCallStack => TestParams -> IO ()
|
||||
testChangePCCUserAndThenIncognito = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
-- Create a new invite and set as incognito
|
||||
|
@ -1916,11 +1918,11 @@ testChangePCCUserAndThenIncognito = testChat2 aliceProfile bobProfile $
|
|||
alice <## ("use /i bob to print out this incognito profile again")
|
||||
]
|
||||
|
||||
testChangePCCUserDiffSrv :: HasCallStack => FilePath -> IO ()
|
||||
testChangePCCUserDiffSrv tmp = do
|
||||
testChangePCCUserDiffSrv :: HasCallStack => TestParams -> IO ()
|
||||
testChangePCCUserDiffSrv ps = do
|
||||
withSmpServer' serverCfg' $ do
|
||||
withNewTestChatCfgOpts tmp testCfg testOpts "alice" aliceProfile $ \alice -> do
|
||||
withNewTestChatCfgOpts tmp testCfg testOpts "bob" bobProfile $ \bob -> do
|
||||
withNewTestChatCfgOpts ps testCfg testOpts "alice" aliceProfile $ \alice -> do
|
||||
withNewTestChatCfgOpts ps testCfg testOpts "bob" bobProfile $ \bob -> do
|
||||
-- Create a new invite
|
||||
alice ##> "/connect"
|
||||
_ <- getInvitation alice
|
||||
|
@ -1962,7 +1964,7 @@ testChangePCCUserDiffSrv tmp = do
|
|||
msgQueueQuota = 2
|
||||
}
|
||||
|
||||
testSetConnectionAlias :: HasCallStack => FilePath -> IO ()
|
||||
testSetConnectionAlias :: HasCallStack => TestParams -> IO ()
|
||||
testSetConnectionAlias = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
alice ##> "/c"
|
||||
|
@ -1980,7 +1982,7 @@ testSetConnectionAlias = testChat2 aliceProfile bobProfile $
|
|||
alice ##> "/contacts"
|
||||
alice <## "bob (Bob) (alias: friend)"
|
||||
|
||||
testSetGroupAlias :: HasCallStack => FilePath -> IO ()
|
||||
testSetGroupAlias :: HasCallStack => TestParams -> IO ()
|
||||
testSetGroupAlias = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
createGroup2 "team" alice bob
|
||||
|
@ -1994,7 +1996,7 @@ testSetGroupAlias = testChat2 aliceProfile bobProfile $
|
|||
alice ##> "/groups"
|
||||
alice <## "#team (2 members)"
|
||||
|
||||
testSetContactPrefs :: HasCallStack => FilePath -> IO ()
|
||||
testSetContactPrefs :: HasCallStack => TestParams -> IO ()
|
||||
testSetContactPrefs = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> withXFTPServer $ do
|
||||
alice #$> ("/_files_folder ./tests/tmp/alice", id, "ok")
|
||||
|
@ -2087,7 +2089,7 @@ testSetContactPrefs = testChat2 aliceProfile bobProfile $
|
|||
bob <## "Voice messages: off (you allow: default (yes), contact allows: no)"
|
||||
bob #$> ("/_get chat @2 count=100", chat, startFeatures <> [(0, "Voice messages: enabled for you"), (1, "voice message (00:10)"), (0, "Voice messages: off"), (1, "Voice messages: enabled"), (0, "Voice messages: off")])
|
||||
|
||||
testFeatureOffers :: HasCallStack => FilePath -> IO ()
|
||||
testFeatureOffers :: HasCallStack => TestParams -> IO ()
|
||||
testFeatureOffers = testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
connectUsers alice bob
|
||||
|
@ -2106,7 +2108,7 @@ testFeatureOffers = testChat2 aliceProfile bobProfile $
|
|||
bob <## "Full deletion: off (you allow: default (no), contact allows: no)"
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "offered Full deletion"), (0, "cancelled Full deletion")])
|
||||
|
||||
testUpdateGroupPrefs :: HasCallStack => FilePath -> IO ()
|
||||
testUpdateGroupPrefs :: HasCallStack => TestParams -> IO ()
|
||||
testUpdateGroupPrefs =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
|
@ -2157,7 +2159,7 @@ testUpdateGroupPrefs =
|
|||
alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "Full deletion: on"), (1, "Full deletion: off"), (1, "Voice messages: off"), (1, "Voice messages: on"), (1, "hey"), (0, "hi")])
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Full deletion: on"), (0, "Full deletion: off"), (0, "Voice messages: off"), (0, "Voice messages: on"), (0, "hey"), (1, "hi")])
|
||||
|
||||
testAllowFullDeletionContact :: HasCallStack => FilePath -> IO ()
|
||||
testAllowFullDeletionContact :: HasCallStack => TestParams -> IO ()
|
||||
testAllowFullDeletionContact =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
|
@ -2175,7 +2177,7 @@ testAllowFullDeletionContact =
|
|||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "hi"), (1, "Full deletion: enabled for contact")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "hi"), (0, "Full deletion: enabled for you")])
|
||||
|
||||
testAllowFullDeletionGroup :: HasCallStack => FilePath -> IO ()
|
||||
testAllowFullDeletionGroup :: HasCallStack => TestParams -> IO ()
|
||||
testAllowFullDeletionGroup =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
|
@ -2201,7 +2203,7 @@ testAllowFullDeletionGroup =
|
|||
alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "hi"), (1, "Full deletion: on")])
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "hi"), (0, "Full deletion: on")])
|
||||
|
||||
testProhibitDirectMessages :: HasCallStack => FilePath -> IO ()
|
||||
testProhibitDirectMessages :: HasCallStack => TestParams -> IO ()
|
||||
testProhibitDirectMessages =
|
||||
testChatCfg4 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile danProfile $
|
||||
\alice bob cath dan -> do
|
||||
|
@ -2259,7 +2261,7 @@ testProhibitDirectMessages =
|
|||
cc <## "updated group preferences:"
|
||||
cc <## "Direct messages: off"
|
||||
|
||||
testEnableTimedMessagesContact :: HasCallStack => FilePath -> IO ()
|
||||
testEnableTimedMessagesContact :: HasCallStack => TestParams -> IO ()
|
||||
testEnableTimedMessagesContact =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
|
@ -2304,7 +2306,7 @@ testEnableTimedMessagesContact =
|
|||
alice <## "bob updated preferences for you:"
|
||||
alice <## "Disappearing messages: enabled (you allow: yes (1 week), contact allows: yes (1 week))"
|
||||
|
||||
testEnableTimedMessagesGroup :: HasCallStack => FilePath -> IO ()
|
||||
testEnableTimedMessagesGroup :: HasCallStack => TestParams -> IO ()
|
||||
testEnableTimedMessagesGroup =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
|
@ -2354,7 +2356,7 @@ testEnableTimedMessagesGroup =
|
|||
bob <## "updated group preferences:"
|
||||
bob <## "Disappearing messages: on (1 week)"
|
||||
|
||||
testTimedMessagesEnabledGlobally :: HasCallStack => FilePath -> IO ()
|
||||
testTimedMessagesEnabledGlobally :: HasCallStack => TestParams -> IO ()
|
||||
testTimedMessagesEnabledGlobally =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
|
@ -2378,7 +2380,7 @@ testTimedMessagesEnabledGlobally =
|
|||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (1 sec)")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (1 sec)")])
|
||||
|
||||
testUpdateMultipleUserPrefs :: HasCallStack => FilePath -> IO ()
|
||||
testUpdateMultipleUserPrefs :: HasCallStack => TestParams -> IO ()
|
||||
testUpdateMultipleUserPrefs = testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
connectUsers alice bob
|
||||
|
@ -2405,7 +2407,7 @@ testUpdateMultipleUserPrefs = testChat3 aliceProfile bobProfile cathProfile $
|
|||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "hi bob"), (1, "Full deletion: enabled for contact"), (1, "Message reactions: off")])
|
||||
alice #$> ("/_get chat @3 count=100", chat, chatFeatures <> [(1, "hi cath"), (1, "Full deletion: enabled for contact"), (1, "Message reactions: off")])
|
||||
|
||||
testGroupPrefsDirectForRole :: HasCallStack => FilePath -> IO ()
|
||||
testGroupPrefsDirectForRole :: HasCallStack => TestParams -> IO ()
|
||||
testGroupPrefsDirectForRole = testChat4 aliceProfile bobProfile cathProfile danProfile $
|
||||
\alice bob cath dan -> do
|
||||
createGroup3 "team" alice bob cath
|
||||
|
@ -2471,7 +2473,7 @@ testGroupPrefsDirectForRole = testChat4 aliceProfile bobProfile cathProfile danP
|
|||
cc <## "updated group preferences:"
|
||||
cc <## "Direct messages: on for owners"
|
||||
|
||||
testGroupPrefsFilesForRole :: HasCallStack => FilePath -> IO ()
|
||||
testGroupPrefsFilesForRole :: HasCallStack => TestParams -> IO ()
|
||||
testGroupPrefsFilesForRole = testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> withXFTPServer $ do
|
||||
alice #$> ("/_files_folder ./tests/tmp/alice", id, "ok")
|
||||
|
@ -2506,7 +2508,7 @@ testGroupPrefsFilesForRole = testChat3 aliceProfile bobProfile cathProfile $
|
|||
cc <## "updated group preferences:"
|
||||
cc <## "Files and media: on for owners"
|
||||
|
||||
testGroupPrefsSimplexLinksForRole :: HasCallStack => FilePath -> IO ()
|
||||
testGroupPrefsSimplexLinksForRole :: HasCallStack => TestParams -> IO ()
|
||||
testGroupPrefsSimplexLinksForRole = testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> withXFTPServer $ do
|
||||
createGroup3 "team" alice bob cath
|
||||
|
@ -2542,7 +2544,7 @@ testGroupPrefsSimplexLinksForRole = testChat3 aliceProfile bobProfile cathProfil
|
|||
cc <## "updated group preferences:"
|
||||
cc <## "SimpleX links: on for owners"
|
||||
|
||||
testSetUITheme :: HasCallStack => FilePath -> IO ()
|
||||
testSetUITheme :: HasCallStack => TestParams -> IO ()
|
||||
testSetUITheme =
|
||||
testChat2 aliceProfile bobProfile $ \alice bob -> do
|
||||
connectUsers alice bob
|
||||
|
|
|
@ -9,6 +9,7 @@
|
|||
module ChatTests.Utils where
|
||||
|
||||
import ChatClient
|
||||
import ChatTests.DBUtils
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Concurrent.Async (concurrently_)
|
||||
import Control.Concurrent.STM
|
||||
|
@ -72,13 +73,13 @@ danProfile = Profile {displayName = "dan", fullName = "Daniel", image = Nothing,
|
|||
businessProfile :: Profile
|
||||
businessProfile = Profile {displayName = "biz", fullName = "Biz Inc", image = Nothing, contactLink = Nothing, preferences = defaultPrefs}
|
||||
|
||||
it :: HasCallStack => String -> (FilePath -> Expectation) -> SpecWith (Arg (FilePath -> Expectation))
|
||||
it :: HasCallStack => String -> (TestParams -> Expectation) -> SpecWith (Arg (TestParams -> Expectation))
|
||||
it name test =
|
||||
Hspec.it name $ \tmp -> timeout t (test tmp) >>= maybe (error "test timed out") pure
|
||||
where
|
||||
t = 90 * 1000000
|
||||
|
||||
xit' :: HasCallStack => String -> (FilePath -> Expectation) -> SpecWith (Arg (FilePath -> Expectation))
|
||||
xit' :: HasCallStack => String -> (TestParams -> Expectation) -> SpecWith (Arg (TestParams -> Expectation))
|
||||
xit' = if os == "linux" then xit else it
|
||||
|
||||
xit'' :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
|
||||
|
@ -96,7 +97,7 @@ skip :: String -> SpecWith a -> SpecWith a
|
|||
skip = before_ . pendingWith
|
||||
|
||||
-- Bool is pqExpected - see testAddContact
|
||||
versionTestMatrix2 :: (HasCallStack => Bool -> TestCC -> TestCC -> IO ()) -> SpecWith FilePath
|
||||
versionTestMatrix2 :: (HasCallStack => Bool -> TestCC -> TestCC -> IO ()) -> SpecWith TestParams
|
||||
versionTestMatrix2 runTest = do
|
||||
it "current" $ testChat2 aliceProfile bobProfile (runTest True)
|
||||
it "prev" $ testChatCfg2 testCfgVPrev aliceProfile bobProfile (runTest False)
|
||||
|
@ -106,7 +107,7 @@ versionTestMatrix2 runTest = do
|
|||
it "old to curr" $ runTestCfg2 testCfg testCfgV1 (runTest False)
|
||||
it "curr to old" $ runTestCfg2 testCfgV1 testCfg (runTest False)
|
||||
|
||||
versionTestMatrix3 :: (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> SpecWith FilePath
|
||||
versionTestMatrix3 :: (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> SpecWith TestParams
|
||||
versionTestMatrix3 runTest = do
|
||||
it "current" $ testChat3 aliceProfile bobProfile cathProfile runTest
|
||||
it "prev" $ testChatCfg3 testCfgVPrev aliceProfile bobProfile cathProfile runTest
|
||||
|
@ -115,46 +116,46 @@ versionTestMatrix3 runTest = do
|
|||
it "curr to prev" $ runTestCfg3 testCfgVPrev testCfg testCfg runTest
|
||||
it "curr+prev to prev" $ runTestCfg3 testCfgVPrev testCfg testCfgVPrev runTest
|
||||
|
||||
runTestCfg2 :: ChatConfig -> ChatConfig -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
runTestCfg2 aliceCfg bobCfg runTest tmp =
|
||||
withNewTestChatCfg tmp aliceCfg "alice" aliceProfile $ \alice ->
|
||||
withNewTestChatCfg tmp bobCfg "bob" bobProfile $ \bob ->
|
||||
runTestCfg2 :: ChatConfig -> ChatConfig -> (HasCallStack => TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
|
||||
runTestCfg2 aliceCfg bobCfg runTest ps =
|
||||
withNewTestChatCfg ps aliceCfg "alice" aliceProfile $ \alice ->
|
||||
withNewTestChatCfg ps bobCfg "bob" bobProfile $ \bob ->
|
||||
runTest alice bob
|
||||
|
||||
runTestCfg3 :: ChatConfig -> ChatConfig -> ChatConfig -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
runTestCfg3 aliceCfg bobCfg cathCfg runTest tmp =
|
||||
withNewTestChatCfg tmp aliceCfg "alice" aliceProfile $ \alice ->
|
||||
withNewTestChatCfg tmp bobCfg "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg tmp cathCfg "cath" cathProfile $ \cath ->
|
||||
runTestCfg3 :: ChatConfig -> ChatConfig -> ChatConfig -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> TestParams -> IO ()
|
||||
runTestCfg3 aliceCfg bobCfg cathCfg runTest ps =
|
||||
withNewTestChatCfg ps aliceCfg "alice" aliceProfile $ \alice ->
|
||||
withNewTestChatCfg ps bobCfg "bob" bobProfile $ \bob ->
|
||||
withNewTestChatCfg ps cathCfg "cath" cathProfile $ \cath ->
|
||||
runTest alice bob cath
|
||||
|
||||
withTestChatGroup3Connected :: HasCallStack => FilePath -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChatGroup3Connected tmp dbPrefix action = do
|
||||
withTestChat tmp dbPrefix $ \cc -> do
|
||||
withTestChatGroup3Connected :: HasCallStack => TestParams -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChatGroup3Connected ps dbPrefix action = do
|
||||
withTestChat ps dbPrefix $ \cc -> do
|
||||
cc <## "2 contacts connected (use /cs for the list)"
|
||||
cc <## "#team: connected to server(s)"
|
||||
action cc
|
||||
|
||||
withTestChatGroup3Connected' :: HasCallStack => FilePath -> String -> IO ()
|
||||
withTestChatGroup3Connected' tmp dbPrefix = withTestChatGroup3Connected tmp dbPrefix $ \_ -> pure ()
|
||||
withTestChatGroup3Connected' :: HasCallStack => TestParams -> String -> IO ()
|
||||
withTestChatGroup3Connected' ps dbPrefix = withTestChatGroup3Connected ps dbPrefix $ \_ -> pure ()
|
||||
|
||||
withTestChatContactConnected :: HasCallStack => FilePath -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChatContactConnected tmp dbPrefix action =
|
||||
withTestChat tmp dbPrefix $ \cc -> do
|
||||
withTestChatContactConnected :: HasCallStack => TestParams -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChatContactConnected ps dbPrefix action =
|
||||
withTestChat ps dbPrefix $ \cc -> do
|
||||
cc <## "1 contacts connected (use /cs for the list)"
|
||||
action cc
|
||||
|
||||
withTestChatContactConnected' :: HasCallStack => FilePath -> String -> IO ()
|
||||
withTestChatContactConnected' tmp dbPrefix = withTestChatContactConnected tmp dbPrefix $ \_ -> pure ()
|
||||
withTestChatContactConnected' :: HasCallStack => TestParams -> String -> IO ()
|
||||
withTestChatContactConnected' ps dbPrefix = withTestChatContactConnected ps dbPrefix $ \_ -> pure ()
|
||||
|
||||
withTestChatContactConnectedV1 :: HasCallStack => FilePath -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChatContactConnectedV1 tmp dbPrefix action =
|
||||
withTestChatV1 tmp dbPrefix $ \cc -> do
|
||||
withTestChatContactConnectedV1 :: HasCallStack => TestParams -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChatContactConnectedV1 ps dbPrefix action =
|
||||
withTestChatV1 ps dbPrefix $ \cc -> do
|
||||
cc <## "1 contacts connected (use /cs for the list)"
|
||||
action cc
|
||||
|
||||
withTestChatContactConnectedV1' :: HasCallStack => FilePath -> String -> IO ()
|
||||
withTestChatContactConnectedV1' tmp dbPrefix = withTestChatContactConnectedV1 tmp dbPrefix $ \_ -> pure ()
|
||||
withTestChatContactConnectedV1' :: HasCallStack => TestParams -> String -> IO ()
|
||||
withTestChatContactConnectedV1' ps dbPrefix = withTestChatContactConnectedV1 ps dbPrefix $ \_ -> pure ()
|
||||
|
||||
-- | test sending direct messages
|
||||
(<##>) :: HasCallStack => TestCC -> TestCC -> IO ()
|
||||
|
|
|
@ -7,6 +7,7 @@
|
|||
|
||||
module MobileTests where
|
||||
|
||||
import ChatTests.DBUtils
|
||||
import ChatTests.Utils
|
||||
import Control.Concurrent.STM
|
||||
import Control.Monad.Except
|
||||
|
@ -38,6 +39,7 @@ import Simplex.Chat.Store.Profiles
|
|||
import Simplex.Chat.Types (AgentUserId (..), Profile (..))
|
||||
import Simplex.Messaging.Agent.Store.Interface
|
||||
import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile(..), CryptoFileArgs (..))
|
||||
import qualified Simplex.Messaging.Crypto.File as CF
|
||||
|
@ -48,7 +50,7 @@ import System.FilePath ((</>))
|
|||
import System.IO (utf8)
|
||||
import Test.Hspec hiding (it)
|
||||
|
||||
mobileTests :: HasCallStack => SpecWith FilePath
|
||||
mobileTests :: HasCallStack => SpecWith TestParams
|
||||
mobileTests = do
|
||||
describe "mobile API" $ do
|
||||
runIO $ do
|
||||
|
@ -146,9 +148,10 @@ parsedMarkdown =
|
|||
parsedMarkdownTagged
|
||||
#endif
|
||||
|
||||
testChatApiNoUser :: FilePath -> IO ()
|
||||
testChatApiNoUser tmp = do
|
||||
let dbPrefix = tmp </> "1"
|
||||
testChatApiNoUser :: TestParams -> IO ()
|
||||
testChatApiNoUser ps = do
|
||||
let tmp = tmpPath ps
|
||||
dbPrefix = tmp </> "1"
|
||||
Right cc <- chatMigrateInit dbPrefix "" "yesUp"
|
||||
Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "myKey" "yesUp"
|
||||
chatSendCmd cc "/u" `shouldReturn` noActiveUser
|
||||
|
@ -156,11 +159,12 @@ testChatApiNoUser tmp = do
|
|||
chatSendCmd cc "/create user alice Alice" `shouldReturn` activeUser
|
||||
chatSendCmd cc "/_start" `shouldReturn` chatStarted
|
||||
|
||||
testChatApi :: FilePath -> IO ()
|
||||
testChatApi tmp = do
|
||||
let dbPrefix = tmp </> "1"
|
||||
testChatApi :: TestParams -> IO ()
|
||||
testChatApi ps = do
|
||||
let tmp = tmpPath ps
|
||||
dbPrefix = tmp </> "1"
|
||||
f = dbPrefix <> chatSuffix
|
||||
Right st <- createChatStore (DBOpts f "myKey" False True) MCYesUp
|
||||
Right st <- createChatStore (DBOpts f "myKey" False True DB.TQOff) MCYesUp
|
||||
Right _ <- withTransaction st $ \db -> runExceptT $ createUserRecord db (AgentUserId 1) aliceProfile {preferences = Nothing} True
|
||||
Right cc <- chatMigrateInit dbPrefix "myKey" "yesUp"
|
||||
Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "" "yesUp"
|
||||
|
@ -173,8 +177,9 @@ testChatApi tmp = do
|
|||
chatParseMarkdown "hello" `shouldBe` "{}"
|
||||
chatParseMarkdown "*hello*" `shouldBe` parsedMarkdown
|
||||
|
||||
testMediaApi :: HasCallStack => FilePath -> IO ()
|
||||
testMediaApi tmp = do
|
||||
testMediaApi :: HasCallStack => TestParams -> IO ()
|
||||
testMediaApi ps = do
|
||||
let tmp = tmpPath ps
|
||||
Right c@ChatController {random = g} <- chatMigrateInit (tmp </> "1") "" "yesUp"
|
||||
cc <- newStablePtr c
|
||||
key <- atomically $ C.randomBytes 32 g
|
||||
|
@ -187,8 +192,9 @@ testMediaApi tmp = do
|
|||
B.length encrypted `shouldBe` B.length frame'
|
||||
runExceptT (chatDecryptMedia keyStr encrypted) `shouldReturn` Right frame'
|
||||
|
||||
testMediaCApi :: HasCallStack => FilePath -> IO ()
|
||||
testMediaCApi tmp = do
|
||||
testMediaCApi :: HasCallStack => TestParams -> IO ()
|
||||
testMediaCApi ps = do
|
||||
let tmp = tmpPath ps
|
||||
Right c@ChatController {random = g} <- chatMigrateInit (tmp </> "1") "" "yesUp"
|
||||
cc <- newStablePtr c
|
||||
key <- atomically $ C.randomBytes 32 g
|
||||
|
@ -216,8 +222,9 @@ instance FromJSON WriteFileResult where
|
|||
instance FromJSON ReadFileResult where
|
||||
parseJSON = $(JQ.mkParseJSON (sumTypeJSON $ dropPrefix "RF") ''ReadFileResult)
|
||||
|
||||
testFileCApi :: FilePath -> FilePath -> IO ()
|
||||
testFileCApi fileName tmp = do
|
||||
testFileCApi :: FilePath -> TestParams -> IO ()
|
||||
testFileCApi fileName ps = do
|
||||
let tmp = tmpPath ps
|
||||
cc <- mkCCPtr tmp
|
||||
src <- B.readFile "./tests/fixtures/test.pdf"
|
||||
let path = tmp </> (fileName <> ".pdf")
|
||||
|
@ -241,8 +248,9 @@ testFileCApi fileName tmp = do
|
|||
contents `shouldBe` src
|
||||
sz' `shouldBe` len
|
||||
|
||||
testMissingFileCApi :: FilePath -> IO ()
|
||||
testMissingFileCApi tmp = do
|
||||
testMissingFileCApi :: TestParams -> IO ()
|
||||
testMissingFileCApi ps = do
|
||||
let tmp = tmpPath ps
|
||||
let path = tmp </> "missing_file"
|
||||
cPath <- newCString path
|
||||
CFArgs key nonce <- atomically . CF.randomArgs =<< C.newRandom
|
||||
|
@ -253,8 +261,9 @@ testMissingFileCApi tmp = do
|
|||
err <- peekCAString (ptr `plusPtr` 1)
|
||||
err `shouldContain` "missing_file: openBinaryFile: does not exist"
|
||||
|
||||
testFileEncryptionCApi :: FilePath -> FilePath -> IO ()
|
||||
testFileEncryptionCApi fileName tmp = do
|
||||
testFileEncryptionCApi :: FilePath -> TestParams -> IO ()
|
||||
testFileEncryptionCApi fileName ps = do
|
||||
let tmp = tmpPath ps
|
||||
cc <- mkCCPtr tmp
|
||||
let fromPath = tmp </> (fileName <> ".source.pdf")
|
||||
copyFile "./tests/fixtures/test.pdf" fromPath
|
||||
|
@ -272,8 +281,9 @@ testFileEncryptionCApi fileName tmp = do
|
|||
"" <- peekCAString =<< cChatDecryptFile cToPath cKey cNonce cToPath'
|
||||
B.readFile toPath' `shouldReturn` src
|
||||
|
||||
testMissingFileEncryptionCApi :: FilePath -> IO ()
|
||||
testMissingFileEncryptionCApi tmp = do
|
||||
testMissingFileEncryptionCApi :: TestParams -> IO ()
|
||||
testMissingFileEncryptionCApi ps = do
|
||||
let tmp = tmpPath ps
|
||||
cc <- mkCCPtr tmp
|
||||
let fromPath = tmp </> "missing_file.source.pdf"
|
||||
toPath = tmp </> "missing_file.encrypted.pdf"
|
||||
|
@ -293,7 +303,7 @@ testMissingFileEncryptionCApi tmp = do
|
|||
mkCCPtr :: FilePath -> IO (StablePtr ChatController)
|
||||
mkCCPtr tmp = either (error . show) newStablePtr =<< chatMigrateInit (tmp </> "1") "" "yesUp"
|
||||
|
||||
testValidNameCApi :: FilePath -> IO ()
|
||||
testValidNameCApi :: TestParams -> IO ()
|
||||
testValidNameCApi _ = do
|
||||
let goodName = "Джон Доу 👍"
|
||||
cName1 <- cChatValidName =<< newCString goodName
|
||||
|
@ -301,7 +311,7 @@ testValidNameCApi _ = do
|
|||
cName2 <- cChatValidName =<< newCString " @'Джон' Доу 👍 "
|
||||
peekCString cName2 `shouldReturn` goodName
|
||||
|
||||
testChatJsonLengthCApi :: FilePath -> IO ()
|
||||
testChatJsonLengthCApi :: TestParams -> IO ()
|
||||
testChatJsonLengthCApi _ = do
|
||||
cInt1 <- cChatJsonLength =<< newCString "Hello!"
|
||||
cInt1 `shouldBe` 6
|
||||
|
|
|
@ -6,6 +6,7 @@
|
|||
module RemoteTests where
|
||||
|
||||
import ChatClient
|
||||
import ChatTests.DBUtils
|
||||
import ChatTests.Utils
|
||||
import Control.Logger.Simple
|
||||
import qualified Data.Aeson as J
|
||||
|
@ -26,7 +27,7 @@ import UnliftIO
|
|||
import UnliftIO.Concurrent
|
||||
import UnliftIO.Directory
|
||||
|
||||
remoteTests :: SpecWith FilePath
|
||||
remoteTests :: SpecWith TestParams
|
||||
remoteTests = describe "Remote" $ do
|
||||
describe "protocol handshake" $ do
|
||||
it "connects with new pairing (stops mobile)" $ remoteHandshakeTest False
|
||||
|
@ -45,7 +46,7 @@ remoteTests = describe "Remote" $ do
|
|||
|
||||
-- * Chat commands
|
||||
|
||||
remoteHandshakeTest :: HasCallStack => Bool -> FilePath -> IO ()
|
||||
remoteHandshakeTest :: HasCallStack => Bool -> TestParams -> IO ()
|
||||
remoteHandshakeTest viaDesktop = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do
|
||||
desktop ##> "/list remote hosts"
|
||||
desktop <## "No remote hosts"
|
||||
|
@ -74,7 +75,7 @@ remoteHandshakeTest viaDesktop = testChat2 aliceProfile aliceDesktopProfile $ \m
|
|||
mobile ##> "/list remote ctrls"
|
||||
mobile <## "No remote controllers"
|
||||
|
||||
remoteHandshakeStoredTest :: HasCallStack => FilePath -> IO ()
|
||||
remoteHandshakeStoredTest :: HasCallStack => TestParams -> IO ()
|
||||
remoteHandshakeStoredTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do
|
||||
logNote "Starting new session"
|
||||
startRemote mobile desktop
|
||||
|
@ -95,7 +96,7 @@ remoteHandshakeStoredTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile
|
|||
startRemoteStored mobile desktop
|
||||
stopMobile mobile desktop `catchAny` (logError . tshow)
|
||||
|
||||
remoteHandshakeDiscoverTest :: HasCallStack => FilePath -> IO ()
|
||||
remoteHandshakeDiscoverTest :: HasCallStack => TestParams -> IO ()
|
||||
remoteHandshakeDiscoverTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do
|
||||
logNote "Preparing new session"
|
||||
startRemote mobile desktop
|
||||
|
@ -105,7 +106,7 @@ remoteHandshakeDiscoverTest = testChat2 aliceProfile aliceDesktopProfile $ \mobi
|
|||
startRemoteDiscover mobile desktop
|
||||
stopMobile mobile desktop `catchAny` (logError . tshow)
|
||||
|
||||
remoteHandshakeRejectTest :: HasCallStack => FilePath -> IO ()
|
||||
remoteHandshakeRejectTest :: HasCallStack => TestParams -> IO ()
|
||||
remoteHandshakeRejectTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop mobileBob -> do
|
||||
logNote "Starting new session"
|
||||
startRemote mobile desktop
|
||||
|
@ -135,7 +136,7 @@ remoteHandshakeRejectTest = testChat3 aliceProfile aliceDesktopProfile bobProfil
|
|||
desktop <## "remote host 1 connected"
|
||||
stopMobile mobile desktop
|
||||
|
||||
storedBindingsTest :: HasCallStack => FilePath -> IO ()
|
||||
storedBindingsTest :: HasCallStack => TestParams -> IO ()
|
||||
storedBindingsTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile desktop -> do
|
||||
desktop ##> "/set device name My desktop"
|
||||
desktop <## "ok"
|
||||
|
@ -166,7 +167,7 @@ storedBindingsTest = testChat2 aliceProfile aliceDesktopProfile $ \mobile deskto
|
|||
|
||||
-- TODO: more parser tests
|
||||
|
||||
remoteMessageTest :: HasCallStack => FilePath -> IO ()
|
||||
remoteMessageTest :: HasCallStack => TestParams -> IO ()
|
||||
remoteMessageTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do
|
||||
startRemote mobile desktop
|
||||
contactBob desktop bob
|
||||
|
@ -192,7 +193,7 @@ remoteMessageTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mob
|
|||
threadDelay 1000000
|
||||
logNote "done"
|
||||
|
||||
remoteStoreFileTest :: HasCallStack => FilePath -> IO ()
|
||||
remoteStoreFileTest :: HasCallStack => TestParams -> IO ()
|
||||
remoteStoreFileTest =
|
||||
testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob ->
|
||||
withXFTPServer $ do
|
||||
|
@ -322,7 +323,7 @@ remoteStoreFileTest =
|
|||
r `shouldStartWith` "remote host 1 error"
|
||||
r `shouldContain` err
|
||||
|
||||
remoteCLIFileTest :: HasCallStack => FilePath -> IO ()
|
||||
remoteCLIFileTest :: HasCallStack => TestParams -> IO ()
|
||||
remoteCLIFileTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> withXFTPServer $ do
|
||||
let mobileFiles = "./tests/tmp/mobile_files"
|
||||
mobile ##> ("/_files_folder " <> mobileFiles)
|
||||
|
@ -391,7 +392,7 @@ remoteCLIFileTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mob
|
|||
|
||||
stopMobile mobile desktop
|
||||
|
||||
switchRemoteHostTest :: FilePath -> IO ()
|
||||
switchRemoteHostTest :: TestParams -> IO ()
|
||||
switchRemoteHostTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \mobile desktop bob -> do
|
||||
startRemote mobile desktop
|
||||
contactBob desktop bob
|
||||
|
@ -417,7 +418,7 @@ switchRemoteHostTest = testChat3 aliceProfile aliceDesktopProfile bobProfile $ \
|
|||
desktop <## "remote host 1 error: RHEInactive"
|
||||
desktop ##> "/contacts"
|
||||
|
||||
indicateRemoteHostTest :: FilePath -> IO ()
|
||||
indicateRemoteHostTest :: TestParams -> IO ()
|
||||
indicateRemoteHostTest = testChat4 aliceProfile aliceDesktopProfile bobProfile cathProfile $ \mobile desktop bob cath -> do
|
||||
connectUsers desktop cath
|
||||
startRemote mobile desktop
|
||||
|
@ -441,7 +442,7 @@ indicateRemoteHostTest = testChat4 aliceProfile aliceDesktopProfile bobProfile c
|
|||
desktop <##> cath
|
||||
cath <##> desktop
|
||||
|
||||
multipleProfilesTest :: FilePath -> IO ()
|
||||
multipleProfilesTest :: TestParams -> IO ()
|
||||
multipleProfilesTest = testChat4 aliceProfile aliceDesktopProfile bobProfile cathProfile $ \mobile desktop bob cath -> do
|
||||
connectUsers desktop cath
|
||||
|
||||
|
|
|
@ -1,19 +1,32 @@
|
|||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module SchemaDump where
|
||||
|
||||
import ChatClient (withTmpFiles)
|
||||
import ChatTests.DBUtils
|
||||
import Control.Concurrent.STM
|
||||
import Control.DeepSeq
|
||||
import qualified Control.Exception as E
|
||||
import Control.Monad (unless, void)
|
||||
import Data.List (dropWhileEnd)
|
||||
import Data.List (dropWhileEnd, sort)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe (fromJust, isJust)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import Database.SQLite.Simple (Query (..))
|
||||
import Simplex.Chat.Store (createChatStore)
|
||||
import qualified Simplex.Chat.Store as Store
|
||||
import Simplex.Messaging.Agent.Store.Common (withConnection)
|
||||
import Simplex.Messaging.Agent.Store.Interface
|
||||
import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfirmation (..), MigrationsToRun (..), toDownMigration)
|
||||
import Simplex.Messaging.Agent.Store.DB (TrackQueries (..))
|
||||
import qualified Simplex.Messaging.Agent.Store.DB as DB
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
|
||||
import Simplex.Messaging.Util (ifM, whenM)
|
||||
import Simplex.Messaging.Util (ifM, tshow, whenM)
|
||||
import System.Directory (doesFileExist, removeFile)
|
||||
import System.Process (readCreateProcess, shell)
|
||||
import Test.Hspec
|
||||
|
@ -40,6 +53,9 @@ appSchema = "src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql"
|
|||
appLint :: FilePath
|
||||
appLint = "src/Simplex/Chat/Store/SQLite/Migrations/chat_lint.sql"
|
||||
|
||||
appQueryPlans :: FilePath
|
||||
appQueryPlans = "src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt"
|
||||
|
||||
testSchema :: FilePath
|
||||
testSchema = "tests/tmp/test_agent_schema.sql"
|
||||
|
||||
|
@ -53,7 +69,7 @@ testVerifySchemaDump :: IO ()
|
|||
testVerifySchemaDump = withTmpFiles $ do
|
||||
savedSchema <- ifM (doesFileExist appSchema) (readFile appSchema) (pure "")
|
||||
savedSchema `deepseq` pure ()
|
||||
void $ createChatStore (DBOpts testDB "" False True) MCError
|
||||
void $ createChatStore (DBOpts testDB "" False True TQOff) MCError
|
||||
getSchema testDB appSchema `shouldReturn` savedSchema
|
||||
removeFile testDB
|
||||
|
||||
|
@ -61,14 +77,14 @@ testVerifyLintFKeyIndexes :: IO ()
|
|||
testVerifyLintFKeyIndexes = withTmpFiles $ do
|
||||
savedLint <- ifM (doesFileExist appLint) (readFile appLint) (pure "")
|
||||
savedLint `deepseq` pure ()
|
||||
void $ createChatStore (DBOpts testDB "" False True) MCError
|
||||
void $ createChatStore (DBOpts testDB "" False True TQOff) MCError
|
||||
getLintFKeyIndexes testDB "tests/tmp/chat_lint.sql" `shouldReturn` savedLint
|
||||
removeFile testDB
|
||||
|
||||
testSchemaMigrations :: IO ()
|
||||
testSchemaMigrations = withTmpFiles $ do
|
||||
let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) Store.migrations
|
||||
Right st <- createDBStore (DBOpts testDB "" False True) noDownMigrations MCError
|
||||
Right st <- createDBStore (DBOpts testDB "" False True TQOff) noDownMigrations MCError
|
||||
mapM_ (testDownMigration st) $ drop (length noDownMigrations) Store.migrations
|
||||
closeDBStore st
|
||||
removeFile testDB
|
||||
|
@ -120,3 +136,25 @@ getLintFKeyIndexes dbPath lintPath = do
|
|||
void $ readCreateProcess (shell $ "sqlite3 " <> dbPath <> " '.lint fkey-indexes' > " <> lintPath) ""
|
||||
lint <- readFile lintPath
|
||||
lint `deepseq` pure lint
|
||||
|
||||
saveQueryPlans :: SpecWith TestParams
|
||||
saveQueryPlans = it "verify and overwrite query plans" $ \TestParams {queryStats} -> do
|
||||
savedPlans <- ifM (doesFileExist appQueryPlans) (T.readFile appQueryPlans) (pure "")
|
||||
savedPlans `deepseq` pure ()
|
||||
queries <- sort . M.keys <$> readTVarIO queryStats
|
||||
Right st <- createChatStore (DBOpts testDB "" False True TQOff) MCError
|
||||
plans' <- withConnection st $ \db -> do
|
||||
DB.execute_ db "CREATE TABLE IF NOT EXISTS temp_conn_ids (conn_id BLOB)"
|
||||
mapM (getQueryPlan db) queries
|
||||
let savedPlans' = T.unlines plans'
|
||||
T.writeFile appQueryPlans savedPlans'
|
||||
savedPlans' `shouldBe` savedPlans
|
||||
where
|
||||
getQueryPlan :: DB.Connection -> Query -> IO Text
|
||||
getQueryPlan db q =
|
||||
(("Query: " <> fromQuery q) <>) . result <$> E.try (DB.query_ db $ "explain query plan " <> q)
|
||||
result = \case
|
||||
Right r -> "\nPlan:\n" <> T.unlines (map planDetail r)
|
||||
Left (e :: E.SomeException) -> "\nError: " <> tshow e <> "\n"
|
||||
planDetail :: (Int, Int, Int, Text) -> Text
|
||||
planDetail (_, _, _, detail) = detail
|
||||
|
|
|
@ -1,9 +1,12 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
import Bots.BroadcastTests
|
||||
import Bots.DirectoryTests
|
||||
import ChatClient
|
||||
import ChatTests
|
||||
import ChatTests.DBUtils
|
||||
import ChatTests.Utils (xdescribe'')
|
||||
import Control.Logger.Simple
|
||||
import Data.Time.Clock.System
|
||||
|
@ -21,6 +24,7 @@ import ViewTests
|
|||
#if defined(dbPostgres)
|
||||
import Simplex.Messaging.Agent.Store.Postgres.Util (createDBAndUserIfNotExists, dropAllSchemasExceptSystem, dropDatabaseAndUser)
|
||||
#else
|
||||
import qualified Simplex.Messaging.TMap as TM
|
||||
import MobileTests
|
||||
import SchemaDump
|
||||
import WebRTCTests
|
||||
|
@ -29,6 +33,9 @@ import WebRTCTests
|
|||
main :: IO ()
|
||||
main = do
|
||||
setLogLevel LogError
|
||||
#if !defined(dbPostgres)
|
||||
queryStats <- TM.emptyIO
|
||||
#endif
|
||||
withGlobalLogging logCfg . hspec
|
||||
#if defined(dbPostgres)
|
||||
. beforeAll_ (dropDatabaseAndUser testDBConnectInfo >> createDBAndUserIfNotExists testDBConnectInfo)
|
||||
|
@ -48,9 +55,11 @@ main = do
|
|||
describe "Message batching" batchingTests
|
||||
describe "Operators" operatorTests
|
||||
describe "Random servers" randomServersTests
|
||||
around testBracket
|
||||
#if defined(dbPostgres)
|
||||
around testBracket
|
||||
. after_ (dropAllSchemasExceptSystem testDBConnectInfo)
|
||||
#else
|
||||
around (testBracket queryStats)
|
||||
#endif
|
||||
$ do
|
||||
#if !defined(dbPostgres)
|
||||
|
@ -60,8 +69,15 @@ main = do
|
|||
xdescribe'' "SimpleX Broadcast bot" broadcastBotTests
|
||||
xdescribe'' "SimpleX Directory service bot" directoryServiceTests
|
||||
describe "Remote session" remoteTests
|
||||
#if !defined(dbPostgres)
|
||||
xdescribe'' "Save query plans" saveQueryPlans
|
||||
#endif
|
||||
where
|
||||
testBracket test = withSmpServer $ tmpBracket test
|
||||
#if defined(dbPostgres)
|
||||
testBracket test = withSmpServer $ tmpBracket $ test . TestParams
|
||||
#else
|
||||
testBracket queryStats test = withSmpServer $ tmpBracket $ \tmpPath -> test TestParams {tmpPath, queryStats}
|
||||
#endif
|
||||
tmpBracket test = do
|
||||
t <- getSystemTime
|
||||
let ts = show (systemSeconds t) <> show (systemNanoseconds t)
|
||||
|
|
Loading…
Add table
Reference in a new issue