From 1e2f0bec796499d0865a16a5b41b20646d2bc3bd Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sun, 13 Sep 2026 11:35:46 +0000 Subject: [PATCH] tests: execute in parallel --- plans/2026-09-13-parallel-tests.md | 71 +++++ simplex-chat.cabal | 3 +- tests/Bots/BroadcastTests.hs | 2 +- tests/Bots/DirectoryTests.hs | 34 +-- tests/ChatClient.hs | 153 ++++++++--- tests/ChatTests/DBUtils/Postgres.hs | 1 + tests/ChatTests/DBUtils/SQLite.hs | 1 + tests/ChatTests/Direct.hs | 73 ++--- tests/ChatTests/Files.hs | 401 +++++++++++++++------------- tests/ChatTests/Forward.hs | 110 ++++---- tests/ChatTests/Groups.hs | 213 ++++++++------- tests/ChatTests/Local.hs | 19 +- tests/ChatTests/Names.hs | 22 +- tests/ChatTests/Profiles.hs | 77 +++--- tests/ChatTests/Utils.hs | 11 +- tests/RemoteTests.hs | 26 +- tests/SchemaDump.hs | 7 +- tests/Test.hs | 56 ++-- 18 files changed, 750 insertions(+), 530 deletions(-) create mode 100644 plans/2026-09-13-parallel-tests.md diff --git a/plans/2026-09-13-parallel-tests.md b/plans/2026-09-13-parallel-tests.md new file mode 100644 index 0000000000..542e8d2016 --- /dev/null +++ b/plans/2026-09-13-parallel-tests.md @@ -0,0 +1,71 @@ +# Parallel test execution + +Every test gets its own ports and its own directory, so hspec runs the tree +concurrently in one process with `parallel` and `--jobs`. + +## Decisions + +- `TestParams` gains `portBase :: Int`. A pool of bases `[7000, 7010 .. 8990]` + is created in `main`; `testBracket` takes a base for the test and returns it + after. Ports of a test: SMP `base + 1`, XFTP `base + 2`, second SMP `base + 3`, + remote host `base + 4`. +- `TestCC` carries `testParams`. `class HasTestParams` with instances for + `TestParams` and `TestCC` lets helpers take either, so closure tests reach + the environment through a client: `tmpFile bob "test.jpg"`, `smpPort alice`, + `withXFTPServer alice`. +- Client configs keep the literal ports 7001, 7002 and 7003 as the logical + layout. `startTestChat_` maps them to the test's ports in `smpServers`, + `xftpServers` and `shortLinkPresetServers`. Expected output uses the real + ports through `smpServerStr`, `xftpServerStr`, `smpPort`, `xftpPort`, + `smpPort2`. +- Servers take the test: `smpServerCfg ps`, `withSmpServer ps`, + `withSmpServerAndNames ps`, `xftpServerConfig ps`, `withXFTPServer ps`. + The XFTP server stays under test control, since tests exercise its restarts. + Its files and store log are under the test directory. +- `tests/tmp` is created once around the whole run (`withTmpFiles` in `main`) + and each test works in `withTempDirectory "tests/tmp"`. Paths in tests are + `tmpDir` and `tmpFile` of the client or params. +- `xftpCLI` runs the test binary as a subprocess with the first argument + `xftp-cli`, because `withArgs` and `capture_` are process-global. +- Test suite `ghc-options` gain `-rtsopts "-with-rtsopts=-N"`. +- `parallel` wraps the tree. Sequential remain: schema dump, API docs, + "Save query plans" (last item, reads the maps after every test). +- Postgres: the database is created once (`beforeAll_`/`afterAll_`); the + client schema prefix includes the test directory name. + +## Status + +Implemented; the suite builds. Runs so far: file tests, 39 examples in 111 s +with `-j 8` on 4 cores at -O0, one timing failure per run, a different test +each time. "error receiving file" (`testXFTPRcvError`) fails intermittently +even alone with `chat db error: SERcvFileInvalidDescrPart`: `appendRcvFD` +receives a description part for a description that is already complete, so +the part arrives twice. The first block stops bob right after alice's upload +completes, without waiting for bob to process the description, which is the +likely source of the duplicate after his restart. The race predates this +change; `-N` and load make it more likely. + +Direct, schema dump, protocol and names groups: 178 examples in 331 s with +`-j 6`, 11 failures. Two are environmental on this machine: the schema dump +cannot overwrite root-owned `chat_schema.sql`, and `encrypt/decrypt database` +needs `direct-sqlcipher +openssl`, which CI sets and the local build lacks. +The rest pass alone and fail under load: expiration and timed-message tests +with second-scale TTLs, the client-timeout retry test, and cases where a +line already consumed reappears at the end of the test, which points at the +window diff in `readTerminalOutput` under batched terminal updates. + +Profile tests at the default job count (4 cores): 105 examples in 439 s, +2 failures, both timed-message tests with second-scale TTLs. + +## Mechanics + +- `tests/ChatTests/DBUtils/*.hs`: `portBase` field. +- `tests/ChatClient.hs`: `HasTestParams`, port and path helpers, server + configs and brackets as functions of the test, port mapping in + `startTestChat_`, `withTmpFiles` without removal per test. +- `tests/Test.hs`: port pool, `xftp-cli` subcommand, `parallel`, `withTmpFiles` + around `hspec`. +- `tests/SchemaDump.hs`: `withTmpFiles` wrappers removed. +- `tests/ChatTests/Utils.hs`: `xftpCLI` subprocess. +- Test modules: literal `tests/tmp` paths, server ports and XFTP brackets + rewritten through the helpers. diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 7d0172ba3d..ab5d10395e 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -660,7 +660,7 @@ test-suite simplex-chat-test default-extensions: StrictData -- add -fhpc to ghc-options below to run tests with coverage - ghc-options: -O2 -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=missing-methods -Werror=incomplete-uni-patterns -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -Werror=name-shadowing -threaded + ghc-options: -O2 -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=missing-methods -Werror=incomplete-uni-patterns -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -Werror=name-shadowing -threaded -rtsopts "-with-rtsopts=-N" build-depends: QuickCheck ==2.14.* , aeson ==2.2.* @@ -682,7 +682,6 @@ test-suite simplex-chat-test , network ==3.1.* , optparse-applicative >=0.15 && <0.17 , random >=1.1 && <1.3 - , silently ==1.2.* , simple-logger ==0.1.* , simplex-chat , simplexmq >=6.3 diff --git a/tests/Bots/BroadcastTests.hs b/tests/Bots/BroadcastTests.hs index 9edbb3cb73..955e7bebb7 100644 --- a/tests/Bots/BroadcastTests.hs +++ b/tests/Bots/BroadcastTests.hs @@ -43,7 +43,7 @@ mkBotOpts ps publishers = { dbOptions = (dbOptions testCoreOpts) #if defined(dbPostgres) - {dbSchemaPrefix = "client_" <> botDbPrefix} + {dbSchemaPrefix = testSchemaPrefix ps botDbPrefix} #else {dbFilePrefix = tmpPath ps botDbPrefix} #endif diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index af92195f79..89ee276dfa 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -112,16 +112,16 @@ directoryProfile :: Profile directoryProfile = Profile {displayName = "SimpleX Directory", fullName = "", shortDescr = Nothing, description = Nothing, image = Nothing, contactLink = Nothing, peerType = Just CPTBot, preferences = Nothing, badge = Nothing, contactDomain = Nothing} mkDirectoryOpts :: TestParams -> [KnownContact] -> Maybe KnownGroup -> Maybe FilePath -> DirectoryOpts -mkDirectoryOpts TestParams {tmpPath = ps} superUsers ownersGroup webFolder = +mkDirectoryOpts ps superUsers ownersGroup webFolder = DirectoryOpts { coreOptions = testCoreOpts { dbOptions = (dbOptions testCoreOpts) #if defined(dbPostgres) - {dbSchemaPrefix = "client_" <> serviceDbPrefix} + {dbSchemaPrefix = testSchemaPrefix ps serviceDbPrefix} #else - {dbFilePrefix = ps serviceDbPrefix} + {dbFilePrefix = tmpPath ps serviceDbPrefix} #endif }, @@ -1155,13 +1155,13 @@ testDuplicateProhibitApproval ps = testListUserGroups :: HasCallStack => Bool -> TestParams -> IO () testListUserGroups promote ps = - withDirectoryServiceCfgOwnersGroup ps testCfg False (Just "./tests/tmp/web") $ \superUser dsLink -> + withDirectoryServiceCfgOwnersGroup ps testCfg False (Just webDir) $ \superUser dsLink -> withNewTestChat ps "bob" bobProfile $ \bob -> withNewTestChat ps "cath" cathProfile $ \cath -> do bob `connectVia` dsLink cath `connectVia` dsLink registerGroup superUser bob "privacy" "Privacy" - checkListings ["privacy"] [] + checkListings webDir ["privacy"] [] connectUsers bob cath fullAddMember "privacy" "Privacy" bob cath GRMember joinGroup "privacy" cath bob @@ -1169,9 +1169,9 @@ testListUserGroups promote ps = cath <## "contact and member are merged: 'SimpleX Directory', #privacy 'SimpleX Directory_1'" cath <## "use @'SimpleX Directory' to send messages" registerGroupId superUser bob "security" "Security" 2 2 - checkListings ["privacy", "security"] [] + checkListings webDir ["privacy", "security"] [] registerGroupId superUser cath "anonymity" "Anonymity" 3 1 - checkListings ["privacy", "security", "anonymity"] [] + checkListings webDir ["privacy", "security", "anonymity"] [] listUserGroup cath "anonymity" "Anonymity" -- with de-listed group groupFound cath "anonymity" @@ -1181,14 +1181,14 @@ testListUserGroups promote ps = cath <## "" cath <## "The group is no longer listed in the directory." superUser <# "'SimpleX Directory'> The group ID 3 (anonymity) is de-listed (SimpleX Directory role is changed to member)." - checkListings ["privacy", "security"] [] + checkListings webDir ["privacy", "security"] [] groupNotFound cath "anonymity" listGroups superUser bob cath when promote $ do superUser #> "@'SimpleX Directory' /promote 1:privacy on" superUser <# "'SimpleX Directory'> > /promote 1:privacy on" superUser <## " Group promotion enabled." - checkListings ["privacy", "security"] ["privacy"] + checkListings webDir ["privacy", "security"] ["privacy"] bob ##> "/gp privacy privacy" bob <## "description removed" cath <## "bob updated group #privacy: (signed)" @@ -1200,21 +1200,23 @@ testListUserGroups promote ps = superUser <## "" superUser <## "To approve send:" superUser <# "'SimpleX Directory'> /approve 1:privacy 1 promote=on" - checkListings ["security"] [] + checkListings webDir ["security"] [] superUser #> "@'SimpleX Directory' /approve 1:privacy 1" superUser <# "'SimpleX Directory'> > /approve 1:privacy 1" superUser <## " Group approved (promoted)!" void $ groupApprovedNotification bob "privacy" 1 - checkListings ["privacy", "security"] ["privacy"] + checkListings webDir ["privacy", "security"] ["privacy"] + where + webDir = tmpFile ps "web" -checkListings :: HasCallStack => [T.Text] -> [T.Text] -> IO () -checkListings listed promoted = do +checkListings :: HasCallStack => FilePath -> [T.Text] -> [T.Text] -> IO () +checkListings webDir listed promoted = do threadDelay 100000 checkListing listingFileName listed checkListing promotedFileName promoted where checkListing f expected = do - Just (DirectoryListing gs) <- J.decodeFileStrict $ "./tests/tmp/web/data" f + Just (DirectoryListing gs) <- J.decodeFileStrict $ webDir "data" f map groupName gs `shouldBe` expected groupName DirectoryEntry {displayName} = displayName @@ -2148,7 +2150,7 @@ testRegisterChannelViaCard ps = -- owner sets a name; directory verifies name<->link consistency and shows the verified name to the admin testDirectoryChannelName :: HasCallStack => TestParams -> IO () -testDirectoryChannelName ps = withSmpServerAndNames $ \reg -> +testDirectoryChannelName ps = withSmpServerAndNames ps $ \reg -> withDirectoryServiceCfg ps testCfg $ \superUser dsLink -> withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob -> withRelay ps $ \relay -> do @@ -2189,7 +2191,7 @@ testDirectoryChannelName ps = withSmpServerAndNames $ \reg -> -- registry re-pointed to a different link after the owner set the name: directory verification fails testDirectoryChannelNameNotVerified :: HasCallStack => TestParams -> IO () -testDirectoryChannelNameNotVerified ps = withSmpServerAndNames $ \reg -> +testDirectoryChannelNameNotVerified ps = withSmpServerAndNames ps $ \reg -> withDirectoryServiceCfg ps testCfg $ \superUser dsLink -> withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob -> withRelay ps $ \relay -> do diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 0a7914d366..a3eb252f2b 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -58,7 +58,7 @@ import Simplex.Messaging.Agent.Store.Shared (MigrationConfig (..), MigrationConf import qualified Simplex.Messaging.Agent.Store.DB as DB import Simplex.Messaging.Client (ProtocolClientConfig (..)) import Simplex.Messaging.Client.Agent (defaultSMPClientAgentConfig) -import Simplex.Messaging.Protocol (ProtocolType (..)) +import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..)) import Simplex.Messaging.Server (runSMPServerBlocking) import Simplex.Messaging.Server.Env.STM (ServerConfig (..), ServerStoreCfg (..), StartOptions (..), StorePaths (..), defaultMessageExpiration, defaultIdleQueueInterval, defaultNtfExpiration, defaultInactiveClientExpiration) import NameResolver (NameRegistry, resolverNamesConfig, withNameResolver) @@ -75,8 +75,11 @@ import System.Timeout (timeout) import Test.Hspec (Expectation, HasCallStack, shouldReturn) #if defined(dbPostgres) import qualified Data.ByteString.Char8 as B +import Data.String (fromString) import Database.PostgreSQL.Simple (ConnectInfo (..), defaultConnectInfo) +import qualified Database.PostgreSQL.Simple as PSQL import Simplex.Messaging.Agent.Store.Interface (DBOpts (..)) +import System.FilePath (takeFileName) #else import Data.ByteArray (ScrubbedBytes) import qualified Data.Map.Strict as M @@ -105,8 +108,68 @@ testDBConnectInfo = } #endif -serverPort :: ServiceName -serverPort = "7001" +class HasTestParams a where + testParams :: a -> TestParams + +instance HasTestParams TestParams where + testParams = id + +instance HasTestParams TestCC where + testParams TestCC {ccParams} = ccParams + +tmpDir :: HasTestParams a => a -> FilePath +tmpDir = tmpPath . testParams + +tmpFile :: HasTestParams a => a -> FilePath -> FilePath +tmpFile p f = tmpDir p f + +testPort :: HasTestParams a => Int -> a -> ServiceName +testPort offset p = show $ portBase (testParams p) + offset + +smpTestPort :: HasTestParams a => a -> ServiceName +smpTestPort = testPort 1 + +xftpTestPort :: HasTestParams a => a -> ServiceName +xftpTestPort = testPort 2 + +smpTestPort2 :: HasTestParams a => a -> ServiceName +smpTestPort2 = testPort 3 + +remoteTestPort :: HasTestParams a => a -> ServiceName +remoteTestPort = testPort 4 + +testServerKeyHash :: String +testServerKeyHash = "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=" + +smpServerStr :: HasTestParams a => a -> String +smpServerStr p = "smp://" <> testServerKeyHash <> ":server_password@localhost:" <> smpTestPort p + +smpServer2Str :: HasTestParams a => a -> String +smpServer2Str p = "smp://" <> testServerKeyHash <> ":server_password@localhost:" <> smpTestPort2 p + +xftpServerStr :: HasTestParams a => a -> String +xftpServerStr p = "xftp://" <> testServerKeyHash <> ":server_password@localhost:" <> xftpTestPort p + +mapTestPort :: TestParams -> ServiceName -> ServiceName +mapTestPort ps = \case + "7001" -> smpTestPort ps + "7002" -> xftpTestPort ps + "7003" -> smpTestPort2 ps + port -> port + +mapServerPort :: (ServiceName -> ServiceName) -> ProtocolServer p -> ProtocolServer p +mapServerPort f srv@ProtocolServer {port} = srv {port = f port} + +mapServerAuthPort :: (ServiceName -> ServiceName) -> ProtoServerWithAuth p -> ProtoServerWithAuth p +mapServerAuthPort f (ProtoServerWithAuth srv auth) = ProtoServerWithAuth (mapServerPort f srv) auth + +testPortsCfg :: TestParams -> ChatConfig -> ChatOpts -> (ChatConfig, ChatOpts) +testPortsCfg ps cfg@ChatConfig {shortLinkPresetServers} opts@ChatOpts {coreOptions = co@CoreChatOpts {smpServers, xftpServers}} = + ( cfg {shortLinkPresetServers = L.map (mapServerPort f) shortLinkPresetServers}, + opts {coreOptions = co {smpServers = map (mapServerAuthPort f) smpServers, xftpServers = map (mapServerAuthPort f) xftpServers}} + ) + where + f = mapTestPort ps testOpts :: ChatOpts testOpts = @@ -201,7 +264,8 @@ data TestCC = TestCC chatAsync :: Async (), termAsync :: Async (), termQ :: TQueue String, - printOutput :: Bool + printOutput :: Bool, + ccParams :: TestParams } aCfg :: AgentConfig @@ -291,8 +355,17 @@ startTestChat ps cfg opts@ChatOpts {coreOptions} dbPrefix = do createDatabase :: TestParams -> CoreChatOpts -> String -> IO (Either MigrationError ChatDatabase) #if defined(dbPostgres) -createDatabase _params CoreChatOpts {dbOptions} dbPrefix = do - createChatDatabase dbOptions {dbSchemaPrefix = "client_" <> dbPrefix} (MigrationConfig MCError Nothing) +createDatabase ps CoreChatOpts {dbOptions} dbPrefix = do + createChatDatabase dbOptions {dbSchemaPrefix = testSchemaPrefix ps dbPrefix} (MigrationConfig MCError Nothing) + +testSchemaPrefix :: HasTestParams a => a -> String -> String +testSchemaPrefix p dbPrefix = "client_" <> takeFileName (tmpDir p) <> "_" <> dbPrefix + +dropTestSchemas :: HasTestParams a => a -> IO () +dropTestSchemas p = + bracket (PSQL.connect testDBConnectInfo) PSQL.close $ \db -> do + schemas <- PSQL.query db "SELECT schema_name FROM information_schema.schemata WHERE schema_name LIKE ?" (PSQL.Only $ testSchemaPrefix p "%") + forM_ schemas $ \(PSQL.Only schema) -> PSQL.execute_ db $ fromString $ "DROP SCHEMA " <> (schema :: String) <> " CASCADE" insertUser :: DBStore -> IO () insertUser st = withTransaction st (`DB.execute_` "INSERT INTO users DEFAULT VALUES") @@ -305,7 +378,8 @@ insertUser st = withTransaction st (`DB.execute_` "INSERT INTO users (user_id) V #endif startTestChat_ :: TestParams -> ChatDatabase -> ChatConfig -> ChatOpts -> String -> User -> IO TestCC -startTestChat_ TestParams {tmpPath, printOutput} db cfg opts@ChatOpts {coreOptions = CoreChatOpts {maintenance}} dbPrefix user = do +startTestChat_ ps@TestParams {tmpPath, printOutput} db cfg_ opts_ dbPrefix user = do + let (cfg, opts@ChatOpts {coreOptions = CoreChatOpts {maintenance}}) = testPortsCfg ps cfg_ opts_ t <- withVirtualTerminal termSettings pure ct <- newChatTerminal t opts Right cc <- newChatController db (Just user) cfg opts False @@ -314,7 +388,7 @@ startTestChat_ TestParams {tmpPath, printOutput} db cfg opts@ChatOpts {coreOptio unless maintenance $ atomically $ readTVar (agentAsync cc) >>= \a -> when (isNothing a) retry termQ <- newTQueueIO termAsync <- async $ readTerminalOutput t termQ - pure TestCC {chatController = cc, virtualTerminal = t, chatAsync, termAsync, termQ, printOutput} + pure TestCC {chatController = cc, virtualTerminal = t, chatAsync, termAsync, termQ, printOutput, ccParams = ps} stopTestChat :: TestParams -> TestCC -> IO () stopTestChat ps TestCC {chatController = cc@ChatController {smpAgent, chatStore}, chatAsync, termAsync} = do @@ -437,6 +511,16 @@ withTmpFiles = (createDirectoryIfMissing False "tests/tmp") (removeDirectoryRecursive "tests/tmp") +newPortBases :: IO (TVar [Int]) +newPortBases = newTVarIO [7000, 7010 .. 8990] + +withPortBase :: TVar [Int] -> (Int -> IO a) -> IO a +withPortBase bases = bracket takeBase (\b -> atomically $ modifyTVar' bases (b :)) + where + takeBase = atomically $ readTVar bases >>= \case + b : bs -> writeTVar bases bs $> b + [] -> retry + testChatN :: HasCallStack => ChatConfig -> ChatOpts -> [Profile] -> (HasCallStack => [TestCC] -> IO ()) -> TestParams -> IO () testChatN cfg opts ps test params = bracket (getTestCCs $ zip ps [1 ..]) endTests test @@ -474,7 +558,7 @@ getTermLine' expected cc@TestCC {printOutput} = error $ name <> ": no output for 5 seconds" <> expectedMsg userName :: TestCC -> IO [Char] -userName (TestCC ChatController {currentUser} _ _ _ _ _) = +userName TestCC {chatController = ChatController {currentUser}} = maybe "no current user" (\User {localDisplayName} -> T.unpack localDisplayName) <$> readTVarIO currentUser testChat :: HasCallStack => Profile -> (HasCallStack => TestCC -> IO ()) -> TestParams -> IO () @@ -548,10 +632,10 @@ testChatCfg5 cfg p1 p2 p3 p4 p5 test = testChatN cfg testOpts [p1, p2, p3, p4, p concurrentlyN_ :: [IO a] -> IO () concurrentlyN_ = mapConcurrently_ id -smpServerCfg :: ServerConfig STMMsgStore -smpServerCfg = +smpServerCfg :: HasTestParams a => a -> ServerConfig STMMsgStore +smpServerCfg p = ServerConfig - { transports = [(serverPort, transport @TLS, False)], + { transports = [(smpTestPort p, transport @TLS, False)], tbqSize = 4, msgQueueQuota = 16, maxJournalMsgCount = 24, @@ -603,33 +687,30 @@ smpServerCfg = persistentServerStoreCfg :: FilePath -> ServerStoreCfg STMMsgStore persistentServerStoreCfg tmp = SSCMemory $ Just StorePaths {storeLogFile = tmp <> "/smp-server-store.log", storeMsgsFile = Just $ tmp <> "/smp-server-messages.log"} -withSmpServer :: IO () -> IO () -withSmpServer = withSmpServer' smpServerCfg +withSmpServer :: HasTestParams a => a -> IO b -> IO b +withSmpServer p = withSmpServer' (smpServerCfg p) withSmpServer' :: ServerConfig STMMsgStore -> IO a -> IO a withSmpServer' cfg = serverBracket (\started -> runSMPServerBlocking started cfg Nothing) -- | SMP server with a local names resolver attached; the action gets the resolver -- registry to map names to the addresses it creates. -withSmpServerAndNames :: (NameRegistry -> IO a) -> IO a -withSmpServerAndNames action = +withSmpServerAndNames :: HasTestParams a => a -> (NameRegistry -> IO b) -> IO b +withSmpServerAndNames p action = withNameResolver $ \port reg -> - withSmpServer' smpServerCfg {namesConfig = Just (resolverNamesConfig port)} (action reg) + withSmpServer' (smpServerCfg p) {namesConfig = Just (resolverNamesConfig port)} (action reg) -xftpTestPort :: ServiceName -xftpTestPort = "7002" +xftpServerFiles :: HasTestParams a => a -> FilePath +xftpServerFiles p = tmpFile p "xftp-server-files" -xftpServerFiles :: FilePath -xftpServerFiles = "tests/tmp/xftp-server-files" - -xftpServerConfig :: XFTPServerConfig STMFileStore -xftpServerConfig = +xftpServerConfig :: HasTestParams a => a -> XFTPServerConfig STMFileStore +xftpServerConfig p = XFTPServerConfig - { xftpPort = xftpTestPort, + { xftpPort = xftpTestPort p, fileIdSize = 16, - serverStoreCfg = XSCMemory $ Just "tests/tmp/xftp-server-store.log", - storeLogFile = Just "tests/tmp/xftp-server-store.log", - filesPath = xftpServerFiles, + serverStoreCfg = XSCMemory $ Just storeLog, + storeLogFile = Just storeLog, + filesPath = xftpServerFiles p, fileSizeQuota = Nothing, allowedChunkSizes = [kb 64, kb 128, kb 256, mb 1, mb 4], allowNewFiles = True, @@ -653,23 +734,25 @@ xftpServerConfig = information = Nothing, logStatsInterval = Nothing, logStatsStartTime = 0, - serverStatsLogFile = "tests/tmp/xftp-server-stats.daily.log", + serverStatsLogFile = tmpFile p "xftp-server-stats.daily.log", serverStatsBackupFile = Nothing, prometheusInterval = Nothing, - prometheusMetricsFile = "tests/xftp-server-metrics.txt", + prometheusMetricsFile = tmpFile p "xftp-server-metrics.txt", controlPort = Nothing, transportConfig = mkTransportServerConfig True (Just alpnSupportedXFTPhandshakes) False, responseDelay = 0 } + where + storeLog = tmpFile p "xftp-server-store.log" -withXFTPServer :: IO () -> IO () -withXFTPServer = withXFTPServer' xftpServerConfig +withXFTPServer :: HasTestParams a => a -> IO b -> IO b +withXFTPServer p = withXFTPServer' (xftpServerConfig p) -withXFTPServer' :: XFTPServerConfig STMFileStore -> IO () -> IO () -withXFTPServer' cfg = +withXFTPServer' :: XFTPServerConfig STMFileStore -> IO a -> IO a +withXFTPServer' cfg@XFTPServerConfig {filesPath} = serverBracket ( \started -> do - createDirectoryIfMissing False xftpServerFiles + createDirectoryIfMissing False filesPath runXFTPServerBlocking started cfg ) diff --git a/tests/ChatTests/DBUtils/Postgres.hs b/tests/ChatTests/DBUtils/Postgres.hs index 2b160379bb..76791c6ce8 100644 --- a/tests/ChatTests/DBUtils/Postgres.hs +++ b/tests/ChatTests/DBUtils/Postgres.hs @@ -2,5 +2,6 @@ module ChatTests.DBUtils.Postgres where data TestParams = TestParams { tmpPath :: FilePath, + portBase :: Int, printOutput :: Bool } diff --git a/tests/ChatTests/DBUtils/SQLite.hs b/tests/ChatTests/DBUtils/SQLite.hs index 2de94882cd..3c71dd8ce9 100644 --- a/tests/ChatTests/DBUtils/SQLite.hs +++ b/tests/ChatTests/DBUtils/SQLite.hs @@ -6,6 +6,7 @@ import Simplex.Messaging.TMap (TMap) data TestParams = TestParams { tmpPath :: FilePath, + portBase :: Int, printOutput :: Bool, chatQueryStats :: TMap Query SlowQueryStats, agentQueryStats :: TMap Query SlowQueryStats diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 732bc465b4..a929bc3a67 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -267,8 +267,8 @@ testRetryConnecting ps = testChatCfgOpts2 cfg' opts' aliceProfile bobProfile tes bob <## "disconnected 1 connections on server localhost" alice <## "disconnected 1 connections on server localhost" serverCfg' = - smpServerCfg - { transports = [("7003", transport @TLS, False)], + (smpServerCfg ps) + { transports = [(smpTestPort2 ps, transport @TLS, False)], msgQueueQuota = 2, serverStoreCfg = persistentServerStoreCfg tmp } @@ -301,7 +301,7 @@ testRetryConnectingClientTimeout ps = do bob <## "invitation link: ok to connect" _sLinkData <- getTermLine bob bob ##> ("/_connect 1 " <> inv) - bob <## "smp agent error: BROKER {brokerAddress = \"smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7003\", brokerErr = TIMEOUT}" + bob <## ("smp agent error: BROKER {brokerAddress = \"smp://" <> testServerKeyHash <> "@localhost:" <> smpTestPort2 ps <> "\", brokerErr = TIMEOUT}") pure inv @@ -330,8 +330,8 @@ testRetryConnectingClientTimeout ps = do where tmp = tmpPath ps serverCfg' = - smpServerCfg - { transports = [("7003", transport @TLS, False)], + (smpServerCfg ps) + { transports = [(smpTestPort2 ps, transport @TLS, False)], msgQueueQuota = 2, serverStoreCfg = persistentServerStoreCfg tmp } @@ -1129,9 +1129,9 @@ testGetSetSMPServers = alice ##> "/_servers 1" alice <## "Your servers" alice <## " SMP servers" - alice <## " smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001" + alice <## (" " <> smpServerStr alice) alice <## " XFTP servers" - alice <## " xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002" + alice <## (" " <> xftpServerStr alice) alice #$> ("/smp smp://1234-w==@smp1.example.im", id, "ok") alice ##> "/smp" alice <## "Your servers" @@ -1154,27 +1154,27 @@ testTestSMPServerConnection :: HasCallStack => TestParams -> IO () testTestSMPServerConnection = testChat aliceProfile $ \alice -> do - alice ##> "/smp test smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7001" + alice ##> ("/smp test smp://" <> testServerKeyHash <> "@localhost:" <> smpTestPort alice) alice <## "SMP server test passed" -- to test with password: -- alice <## "SMP server test failed at CreateQueue, error: SMP AUTH" -- alice <## "Server requires authorization to create queues, check password" - alice ##> "/smp test smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001" + alice ##> ("/smp test " <> smpServerStr alice) alice <## "SMP server test passed" - alice ##> "/smp test smp://LcJU@localhost:7001" - alice <## "SMP server test failed at Connect, error: BROKER {brokerAddress = \"smp://LcJU@localhost:7001\", brokerErr = NETWORK {networkError = NEUnknownCAError}}" + alice ##> ("/smp test smp://LcJU@localhost:" <> smpTestPort alice) + alice <## ("SMP server test failed at Connect, error: BROKER {brokerAddress = \"smp://LcJU@localhost:" <> smpTestPort alice <> "\", brokerErr = NETWORK {networkError = NEUnknownCAError}}") alice <## "Certificate fingerprint in SMP server address does not match server certificate" testGetSetXFTPServers :: HasCallStack => TestParams -> IO () testGetSetXFTPServers = testChat aliceProfile $ - \alice -> withXFTPServer $ do + \alice -> withXFTPServer alice $ do alice ##> "/_servers 1" alice <## "Your servers" alice <## " SMP servers" - alice <## " smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001" + alice <## (" " <> smpServerStr alice) alice <## " XFTP servers" - alice <## " xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002" + alice <## (" " <> xftpServerStr alice) alice #$> ("/xftp xftp://1234-w==@xftp1.example.im", id, "ok") alice ##> "/xftp" alice <## "Your servers" @@ -1195,16 +1195,16 @@ testGetSetXFTPServers = testTestXFTPServer :: HasCallStack => TestParams -> IO () testTestXFTPServer = testChat aliceProfile $ - \alice -> withXFTPServer $ do - alice ##> "/xftp test xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7002" + \alice -> withXFTPServer alice $ do + alice ##> ("/xftp test xftp://" <> testServerKeyHash <> "@localhost:" <> xftpTestPort alice) alice <## "XFTP server test passed" -- to test with password: -- alice <## "XFTP server test failed at CreateFile, error: XFTP AUTH" -- alice <## "Server requires authorization to upload files, check password" - alice ##> "/xftp test xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7002" + alice ##> ("/xftp test " <> xftpServerStr alice) alice <## "XFTP server test passed" - alice ##> "/xftp test xftp://LcJU@localhost:7002" - alice <## "XFTP server test failed at Connect, error: BROKER {brokerAddress = \"xftp://LcJU@localhost:7002\", brokerErr = NETWORK {networkError = NEUnknownCAError}}" + alice ##> ("/xftp test xftp://LcJU@localhost:" <> xftpTestPort alice) + alice <## ("XFTP server test failed at Connect, error: BROKER {brokerAddress = \"xftp://LcJU@localhost:" <> xftpTestPort alice <> "\", brokerErr = NETWORK {networkError = NEUnknownCAError}}") alice <## "Certificate fingerprint in XFTP server address does not match server certificate" testOperators :: HasCallStack => TestParams -> IO () @@ -1369,7 +1369,7 @@ testMaintenanceMode ps = do connectUsers alice bob alice #> "@bob hi" bob <# "alice> hi" - alice ##> "/_db export {\"archivePath\": \"./tests/tmp/alice-chat.zip\"}" + alice ##> ("/_db export {\"archivePath\": \"" <> archive <> "\"}") alice <## "error: chat not stopped" alice ##> "/_stop" alice <## "chat stopped" @@ -1384,16 +1384,18 @@ testMaintenanceMode ps = do -- export / delete / import alice ##> "/_stop" alice <## "chat stopped" - alice ##> "/_db export {\"archivePath\": \"./tests/tmp/alice-chat.zip\"}" + alice ##> ("/_db export {\"archivePath\": \"" <> archive <> "\"}") alice <## "ok" - doesFileExist "./tests/tmp/alice-chat.zip" `shouldReturn` True - alice ##> "/_db import {\"archivePath\": \"./tests/tmp/alice-chat.zip\"}" + doesFileExist archive `shouldReturn` True + alice ##> ("/_db import {\"archivePath\": \"" <> archive <> "\"}") alice <## "ok" -- cannot start chat after import alice ##> "/_start" alice <## "error: chat store changed, please restart chat" -- works after full restart withTestChat ps "alice" $ \alice -> testChatWorking alice bob + where + archive = tmpFile ps "alice-chat.zip" testChatWorking :: HasCallStack => TestCC -> TestCC -> IO () testChatWorking alice bob = do @@ -1404,12 +1406,12 @@ testChatWorking alice bob = do alice <# "bob> hello too" testMaintenanceModeWithFiles :: HasCallStack => TestParams -> IO () -testMaintenanceModeWithFiles ps = withXFTPServer $ do +testMaintenanceModeWithFiles ps = withXFTPServer ps $ do withNewTestChat ps "bob" bobProfile $ \bob -> do withNewTestChatOpts ps testOpts {coreOptions = testCoreOpts {maintenance = True}} "alice" aliceProfile $ \alice -> do alice ##> "/_start" alice <## "chat started" - alice ##> "/_files_folder ./tests/tmp/alice_files" + alice ##> ("/_files_folder " <> aliceFiles) alice <## "ok" connectUsers alice bob @@ -1427,26 +1429,29 @@ testMaintenanceModeWithFiles ps = withXFTPServer $ do alice <## "completed receiving file 1 (test.jpg) from bob" src <- B.readFile "./tests/fixtures/test.jpg" - dest <- B.readFile "./tests/tmp/alice_files/test.jpg" + dest <- B.readFile (aliceFiles "test.jpg") dest `shouldBe` src threadDelay 500000 alice ##> "/_stop" alice <## "chat stopped" - alice ##> "/_db export {\"archivePath\": \"./tests/tmp/alice-chat.zip\"}" + alice ##> ("/_db export {\"archivePath\": \"" <> archive <> "\"}") alice <## "ok" alice ##> "/_db delete" alice <## "ok" -- cannot start chat after delete alice ##> "/_start" alice <## "error: chat store changed, please restart chat" - doesDirectoryExist "./tests/tmp/alice_files" `shouldReturn` False - alice ##> "/_db import {\"archivePath\": \"./tests/tmp/alice-chat.zip\"}" + doesDirectoryExist aliceFiles `shouldReturn` False + alice ##> ("/_db import {\"archivePath\": \"" <> archive <> "\"}") alice <## "ok" - B.readFile "./tests/tmp/alice_files/test.jpg" `shouldReturn` src + B.readFile (aliceFiles "test.jpg") `shouldReturn` src -- works after full restart withTestChat ps "alice" $ \alice -> testChatWorking alice bob + where + aliceFiles = tmpFile ps "alice_files" + archive = tmpFile ps "alice-chat.zip" #if !defined(dbPostgres) testDatabaseEncryption :: HasCallStack => TestParams -> IO () @@ -2755,15 +2760,15 @@ testUserPrivacy = testSetChatItemTTL :: HasCallStack => TestParams -> IO () testSetChatItemTTL = testChat2 aliceProfile bobProfile $ - \alice bob -> withXFTPServer $ do + \alice bob -> withXFTPServer alice $ do connectUsers alice bob alice #> "@bob 1" bob <# "alice> 1" bob #> "@alice 2" alice <# "bob> 2" -- chat item with file - alice #$> ("/_files_folder ./tests/tmp/app_files", id, "ok") - copyFile "./tests/fixtures/test.jpg" "./tests/tmp/app_files/test.jpg" + alice #$> ("/_files_folder " <> tmpFile alice "app_files", id, "ok") + copyFile "./tests/fixtures/test.jpg" $ tmpFile alice "app_files/test.jpg" alice ##> "/_send @2 json [{\"filePath\": \"test.jpg\", \"msgContent\": {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}]" alice <# "/f @bob test.jpg" alice <## "use /fc 1 to cancel sending" @@ -2777,7 +2782,7 @@ testSetChatItemTTL = bob #> "@alice 4" alice <# "bob> 4" alice #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((1, "1"), Nothing), ((0, "2"), Nothing), ((1, ""), Just "test.jpg"), ((1, "3"), Nothing), ((0, "4"), Nothing)]) - checkActionDeletesFile "./tests/tmp/app_files/test.jpg" $ + checkActionDeletesFile (tmpFile alice "app_files/test.jpg") $ alice #$> ("/_ttl 1 2", id, "ok") alice #$> ("/_get chat @2 count=100", chat, [(1, "chat banner"), (1, "3"), (0, "4")]) -- when expiration is turned on, first cycle is synchronous bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "1"), (1, "2"), (0, ""), (0, "3"), (1, "4")]) diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs index 55766e905a..a61fb06d5a 100644 --- a/tests/ChatTests/Files.hs +++ b/tests/ChatTests/Files.hs @@ -29,6 +29,7 @@ import Simplex.Messaging.Crypto.BBS (BBSPublicKey, bbsKeyGen) import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) import Simplex.Messaging.Encoding.String import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist, getFileSize) +import System.FilePath (()) import Test.Hspec hiding (it) chatFileTests :: SpecWith TestParams @@ -79,8 +80,9 @@ chatFileTests = do it "file proof is rejected under another binding, size or expired badge" testFileBadgeProofStatus runTestMessageWithFile :: HasCallStack => TestParams -> IO () -runTestMessageWithFile = testChat2 aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do +runTestMessageWithFile = testChat2 aliceProfile bobProfile $ \alice bob -> withXFTPServer alice $ do connectUsers alice bob + let testJpg = tmpFile bob "test.jpg" alice ##> "/_send @2 json [{\"filePath\": \"./tests/fixtures/test.jpg\", \"msgContent\": {\"type\": \"file\", \"text\": \"hi, sending a file\"}}]" alice <# "@bob hi, sending a file" @@ -91,9 +93,9 @@ runTestMessageWithFile = testChat2 aliceProfile bobProfile $ \alice bob -> withX bob <## "use /fr 1 [/ | ] to receive it" alice <## "completed uploading file 1 (test.jpg) for bob" - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir bob) bob - <### [ "saving file 1 from alice to ./tests/tmp/test.jpg", + <### [ ConsoleString $ "saving file 1 from alice to " <> testJpg, "started receiving file 1 (test.jpg) from alice" ] bob <## "completed receiving file 1 (test.jpg) from alice" @@ -101,7 +103,7 @@ runTestMessageWithFile = testChat2 aliceProfile bobProfile $ \alice bob -> withX alice <# "bob> received" src <- B.readFile "./tests/fixtures/test.jpg" - dest <- B.readFile "./tests/tmp/test.jpg" + dest <- B.readFile testJpg dest `shouldBe` src alice #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((1, "hi, sending a file"), Just "./tests/fixtures/test.jpg"), ((0, "received"), Nothing)]) @@ -109,10 +111,10 @@ runTestMessageWithFile = testChat2 aliceProfile bobProfile $ \alice bob -> withX alice <## "Chat content types: file, text" alice #$> ("/_get chat @2 content=file count=100", chatF, [((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"), ((1, "received"), Nothing)]) + bob #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((0, "hi, sending a file"), Just testJpg), ((1, "received"), Nothing)]) bob ##> "/_get content types @2" bob <## "Chat content types: file, text" - bob #$> ("/_get chat @2 content=file count=100", chatF, [((0, "hi, sending a file"), Just "./tests/tmp/test.jpg")]) + bob #$> ("/_get chat @2 content=file count=100", chatF, [((0, "hi, sending a file"), Just testJpg)]) -- Test file with link in text - should appear in both file and link filters alice ##> "/_send @2 json [{\"filePath\": \"./tests/fixtures/test.pdf\", \"msgContent\": {\"type\": \"file\", \"text\": \"check https://example.com for docs\"}}]" @@ -131,14 +133,15 @@ runTestMessageWithFile = testChat2 aliceProfile bobProfile $ \alice bob -> withX bob ##> "/_get content types @2" bob <## "Chat content types: file, text" - bob #$> ("/_get chat @2 content=file count=100", chatF, [((0, "hi, sending a file"), Just "./tests/tmp/test.jpg"), ((0, "check https://example.com for docs"), Nothing)]) + bob #$> ("/_get chat @2 content=file count=100", chatF, [((0, "hi, sending a file"), Just testJpg), ((0, "check https://example.com for docs"), Nothing)]) bob #$> ("/_get chat @2 content=link count=100", chatF, [((0, "check https://example.com for docs"), Nothing)]) testSendImage :: HasCallStack => TestParams -> IO () testSendImage = testChat2 aliceProfile bobProfile $ - \alice bob -> withXFTPServer $ do + \alice bob -> withXFTPServer alice $ do connectUsers alice bob + let testJpg = tmpFile bob "test.jpg" alice ##> "/_send @2 json [{\"filePath\": \"./tests/fixtures/test.jpg\", \"msgContent\": {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}]" alice <# "/f @bob ./tests/fixtures/test.jpg" alice <## "use /fc 1 to cancel sending" @@ -146,29 +149,29 @@ testSendImage = bob <## "use /fr 1 [/ | ] to receive it" alice <## "completed uploading file 1 (test.jpg) for bob" - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir bob) bob - <### [ "saving file 1 from alice to ./tests/tmp/test.jpg", + <### [ ConsoleString $ "saving file 1 from alice to " <> testJpg, "started receiving file 1 (test.jpg) from alice" ] bob <## "completed receiving file 1 (test.jpg) from alice" src <- B.readFile "./tests/fixtures/test.jpg" - dest <- B.readFile "./tests/tmp/test.jpg" + dest <- B.readFile testJpg dest `shouldBe` src alice #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((1, ""), Just "./tests/fixtures/test.jpg")]) - bob #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((0, ""), Just "./tests/tmp/test.jpg")]) + bob #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((0, ""), Just testJpg)]) -- deleting contact without files folder set should not remove file bob ##> "/d alice" bob <## "alice: contact is deleted" alice <## "bob (Bob) deleted contact with you" - fileExists <- doesFileExist "./tests/tmp/test.jpg" + fileExists <- doesFileExist testJpg fileExists `shouldBe` True testSenderMarkItemDeleted :: HasCallStack => TestParams -> IO () testSenderMarkItemDeleted = testChat2 aliceProfile bobProfile $ - \alice bob -> withXFTPServer $ do + \alice bob -> withXFTPServer alice $ do connectUsers alice bob alice ##> "/_send @2 json [{\"filePath\": \"./tests/fixtures/test_1MB.pdf\", \"msgContent\": {\"type\": \"text\", \"text\": \"hi, sending a file\"}}]" alice <# "@bob hi, sending a file" @@ -182,7 +185,7 @@ testSenderMarkItemDeleted = alice #$> ("/_delete item @2 " <> itemId 1 <> " broadcast", id, "message marked deleted") bob <# "alice> [marked deleted] hi, sending a file" - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir bob) bob <## "file cancelled: test_1MB.pdf" bob ##> "/fs 1" @@ -191,10 +194,11 @@ testSenderMarkItemDeleted = testFilesFoldersSendImage :: HasCallStack => TestParams -> IO () testFilesFoldersSendImage = testChat2 aliceProfile bobProfile $ - \alice bob -> withXFTPServer $ do + \alice bob -> withXFTPServer alice $ do connectUsers alice bob + let bobFiles = tmpFile bob "app_files" alice #$> ("/_files_folder ./tests/fixtures", id, "ok") - bob #$> ("/_files_folder ./tests/tmp/app_files", id, "ok") + bob #$> ("/_files_folder " <> bobFiles, id, "ok") alice ##> "/_send @2 json [{\"filePath\": \"test.jpg\", \"msgContent\": {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}]" alice <# "/f @bob test.jpg" alice <## "use /fc 1 to cancel sending" @@ -210,12 +214,12 @@ testFilesFoldersSendImage = bob <## "completed receiving file 1 (test.jpg) from alice" src <- B.readFile "./tests/fixtures/test.jpg" - dest <- B.readFile "./tests/tmp/app_files/test.jpg" + dest <- B.readFile (bobFiles "test.jpg") dest `shouldBe` src alice #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((1, ""), Just "test.jpg")]) bob #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((0, ""), Just "test.jpg")]) -- deleting contact with files folder set should remove file - checkActionDeletesFile "./tests/tmp/app_files/test.jpg" $ do + checkActionDeletesFile (bobFiles "test.jpg") $ do bob ##> "/d alice" bob <## "alice: contact is deleted" alice <## "bob (Bob) deleted contact with you" @@ -223,11 +227,13 @@ testFilesFoldersSendImage = testFilesFoldersImageSndDelete :: HasCallStack => TestParams -> IO () testFilesFoldersImageSndDelete = testChat2 aliceProfile bobProfile $ - \alice bob -> withXFTPServer $ do + \alice bob -> withXFTPServer alice $ do connectUsers alice bob - alice #$> ("/_files_folder ./tests/tmp/alice_app_files", id, "ok") - copyFile "./tests/fixtures/test_1MB.pdf" "./tests/tmp/alice_app_files/test_1MB.pdf" - bob #$> ("/_files_folder ./tests/tmp/bob_app_files", id, "ok") + let aliceFiles = tmpFile alice "alice_app_files" + bobFiles = tmpFile bob "bob_app_files" + alice #$> ("/_files_folder " <> aliceFiles, id, "ok") + copyFile "./tests/fixtures/test_1MB.pdf" (aliceFiles "test_1MB.pdf") + bob #$> ("/_files_folder " <> bobFiles, id, "ok") alice ##> "/_send @2 json [{\"filePath\": \"test_1MB.pdf\", \"msgContent\": {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}]" alice <# "/f @bob test_1MB.pdf" alice <## "use /fc 1 to cancel sending" @@ -243,23 +249,24 @@ testFilesFoldersImageSndDelete = bob <## "completed receiving file 1 (test_1MB.pdf) from alice" -- deleting contact should remove file - checkActionDeletesFile "./tests/tmp/alice_app_files/test_1MB.pdf" $ do + checkActionDeletesFile (aliceFiles "test_1MB.pdf") $ do alice ##> "/d bob" alice <## "bob: contact is deleted" bob <## "alice (Alice) deleted contact with you" bob ##> "/fs 1" bob <##. "receiving file 1 (test_1MB.pdf) complete" - checkActionDeletesFile "./tests/tmp/bob_app_files/test_1MB.pdf" $ do + checkActionDeletesFile (bobFiles "test_1MB.pdf") $ do bob ##> "/d alice" bob <## "alice: contact is deleted" testFilesFoldersImageRcvDelete :: HasCallStack => TestParams -> IO () testFilesFoldersImageRcvDelete = testChat2 aliceProfile bobProfile $ - \alice bob -> withXFTPServer $ do + \alice bob -> withXFTPServer alice $ do connectUsers alice bob + let bobFiles = tmpFile bob "app_files" alice #$> ("/_files_folder ./tests/fixtures", id, "ok") - bob #$> ("/_files_folder ./tests/tmp/app_files", id, "ok") + bob #$> ("/_files_folder " <> bobFiles, id, "ok") alice ##> "/_send @2 json [{\"filePath\": \"test.jpg\", \"msgContent\": {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}]" alice <# "/f @bob test.jpg" alice <## "use /fc 1 to cancel sending" @@ -275,7 +282,7 @@ testFilesFoldersImageRcvDelete = bob <## "completed receiving file 1 (test.jpg) from alice" -- deleting contact should remove file - checkActionDeletesFile "./tests/tmp/app_files/test.jpg" $ do + checkActionDeletesFile (bobFiles "test.jpg") $ do bob ##> "/d alice" bob <## "alice: contact is deleted" alice <## "bob (Bob) deleted contact with you" @@ -283,7 +290,7 @@ testFilesFoldersImageRcvDelete = testSendImageWithTextAndQuote :: HasCallStack => TestParams -> IO () testSendImageWithTextAndQuote = testChat2 aliceProfile bobProfile $ - \alice bob -> withXFTPServer $ do + \alice bob -> withXFTPServer alice $ do connectUsers alice bob bob #> "@alice hi alice" alice <# "bob> hi alice" @@ -298,18 +305,18 @@ testSendImageWithTextAndQuote = bob <## "use /fr 1 [/ | ] to receive it" alice <## "completed uploading file 1 (test.jpg) for bob" - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir bob) bob - <### [ "saving file 1 from alice to ./tests/tmp/test.jpg", + <### [ ConsoleString $ "saving file 1 from alice to " <> tmpFile bob "test.jpg", "started receiving file 1 (test.jpg) from alice" ] bob <## "completed receiving file 1 (test.jpg) from alice" src <- B.readFile "./tests/fixtures/test.jpg" - B.readFile "./tests/tmp/test.jpg" `shouldReturn` src + B.readFile (tmpFile bob "test.jpg") `shouldReturn` src alice #$> ("/_get chat @2 count=100", chat'', chatFeatures'' <> [((0, "hi alice"), Nothing, Nothing), ((1, "hey bob"), Just (0, "hi alice"), Just "./tests/fixtures/test.jpg")]) alice @@@ [("@bob", "hey bob")] - bob #$> ("/_get chat @2 count=100", chat'', chatFeatures'' <> [((1, "hi alice"), Nothing, Nothing), ((0, "hey bob"), Just (1, "hi alice"), Just "./tests/tmp/test.jpg")]) + bob #$> ("/_get chat @2 count=100", chat'', chatFeatures'' <> [((1, "hi alice"), Nothing, Nothing), ((0, "hey bob"), Just (1, "hi alice"), Just $ tmpFile bob "test.jpg")]) bob @@@ [("@alice", "hey bob")] -- quoting (file + text) with file uses quoted text @@ -324,15 +331,15 @@ testSendImageWithTextAndQuote = alice <## "use /fr 2 [/ | ] to receive it" bob <## "completed uploading file 2 (test.pdf) for alice" - alice ##> "/fr 2 ./tests/tmp" + alice ##> ("/fr 2 " <> tmpDir alice) alice - <### [ "saving file 2 from bob to ./tests/tmp/test.pdf", + <### [ ConsoleString $ "saving file 2 from bob to " <> tmpFile alice "test.pdf", "started receiving file 2 (test.pdf) from bob" ] alice <## "completed receiving file 2 (test.pdf) from bob" txtSrc <- B.readFile "./tests/fixtures/test.pdf" - B.readFile "./tests/tmp/test.pdf" `shouldReturn` txtSrc + B.readFile (tmpFile alice "test.pdf") `shouldReturn` txtSrc -- quoting (file without text) with file uses file name alice ##> ("/_send @2 json [{\"filePath\": \"./tests/fixtures/test.jpg\", \"quotedItemId\": " <> itemId 3 <> ", \"msgContent\": {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}]") @@ -346,20 +353,22 @@ testSendImageWithTextAndQuote = bob <## "use /fr 3 [/ | ] to receive it" alice <## "completed uploading file 3 (test.jpg) for bob" - bob ##> "/fr 3 ./tests/tmp" + bob ##> ("/fr 3 " <> tmpDir bob) bob - <### [ "saving file 3 from alice to ./tests/tmp/test_1.jpg", + <### [ ConsoleString $ "saving file 3 from alice to " <> tmpFile bob "test_1.jpg", "started receiving file 3 (test.jpg) from alice" ] bob <## "completed receiving file 3 (test.jpg) from alice" - B.readFile "./tests/tmp/test_1.jpg" `shouldReturn` src + B.readFile (tmpFile bob "test_1.jpg") `shouldReturn` src testGroupSendImage :: HasCallStack => TestParams -> IO () testGroupSendImage = testChat3 aliceProfile bobProfile cathProfile $ - \alice bob cath -> withXFTPServer $ do + \alice bob cath -> withXFTPServer alice $ do createGroup3 "team" alice bob cath + let bobJpg = tmpFile bob "test.jpg" + cathJpg = tmpFile cath "test_1.jpg" threadDelay 1000000 alice ##> "/_send #1 json [{\"filePath\": \"./tests/fixtures/test.jpg\", \"msgContent\": {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}]" alice <# "/f #team ./tests/fixtures/test.jpg" @@ -374,16 +383,16 @@ testGroupSendImage = ] alice <## "completed uploading file 1 (test.jpg) for #team" - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir bob) bob - <### [ "saving file 1 from alice to ./tests/tmp/test.jpg", + <### [ ConsoleString $ "saving file 1 from alice to " <> bobJpg, "started receiving file 1 (test.jpg) from alice" ] bob <## "completed receiving file 1 (test.jpg) from alice" - cath ##> "/fr 1 ./tests/tmp" + cath ##> ("/fr 1 " <> tmpDir cath) cath - <### [ "saving file 1 from alice to ./tests/tmp/test_1.jpg", + <### [ ConsoleString $ "saving file 1 from alice to " <> cathJpg, "started receiving file 1 (test.jpg) from alice" ] cath <## "completed receiving file 1 (test.jpg) from alice" @@ -395,9 +404,9 @@ testGroupSendImage = [alice, bob] *<# "#team cath> received too" src <- B.readFile "./tests/fixtures/test.jpg" - dest <- B.readFile "./tests/tmp/test.jpg" + dest <- B.readFile bobJpg dest `shouldBe` src - dest2 <- B.readFile "./tests/tmp/test_1.jpg" + dest2 <- B.readFile cathJpg dest2 `shouldBe` src alice #$> ("/_get chat #1 count=3", chatF, [((1, ""), Just "./tests/fixtures/test.jpg"), ((0, "received"), Nothing), ((0, "received too"), Nothing)]) @@ -405,21 +414,23 @@ testGroupSendImage = alice <## "Chat content types: image, text" alice #$> ("/_get chat #1 content=image count=100", chatF, [((1, ""), Just "./tests/fixtures/test.jpg")]) - bob #$> ("/_get chat #1 count=3", chatF, [((0, ""), Just "./tests/tmp/test.jpg"), ((1, "received"), Nothing), ((0, "received too"), Nothing)]) + bob #$> ("/_get chat #1 count=3", chatF, [((0, ""), Just bobJpg), ((1, "received"), Nothing), ((0, "received too"), Nothing)]) bob ##> "/_get content types #1" bob <## "Chat content types: image, text" - bob #$> ("/_get chat #1 content=image count=100", chatF, [((0, ""), Just "./tests/tmp/test.jpg")]) + bob #$> ("/_get chat #1 content=image count=100", chatF, [((0, ""), Just bobJpg)]) - cath #$> ("/_get chat #1 count=3", chatF, [((0, ""), Just "./tests/tmp/test_1.jpg"), ((0, "received"), Nothing), ((1, "received too"), Nothing)]) + cath #$> ("/_get chat #1 count=3", chatF, [((0, ""), Just cathJpg), ((0, "received"), Nothing), ((1, "received too"), Nothing)]) cath ##> "/_get content types #1" cath <## "Chat content types: image, text" - cath #$> ("/_get chat #1 content=image count=100", chatF, [((0, ""), Just "./tests/tmp/test_1.jpg")]) + cath #$> ("/_get chat #1 content=image count=100", chatF, [((0, ""), Just cathJpg)]) testGroupSendImageWithTextAndQuote :: HasCallStack => TestParams -> IO () testGroupSendImageWithTextAndQuote = testChat3 aliceProfile bobProfile cathProfile $ - \alice bob cath -> withXFTPServer $ do + \alice bob cath -> withXFTPServer alice $ do createGroup3 "team" alice bob cath + let bobJpg = tmpFile bob "test.jpg" + cathJpg = tmpFile cath "test_1.jpg" threadDelay 1000000 bob #> "#team hi team" concurrently_ @@ -446,42 +457,44 @@ testGroupSendImageWithTextAndQuote = ] alice <## "completed uploading file 1 (test.jpg) for #team" - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir bob) bob - <### [ "saving file 1 from alice to ./tests/tmp/test.jpg", + <### [ ConsoleString $ "saving file 1 from alice to " <> bobJpg, "started receiving file 1 (test.jpg) from alice" ] bob <## "completed receiving file 1 (test.jpg) from alice" - cath ##> "/fr 1 ./tests/tmp" + cath ##> ("/fr 1 " <> tmpDir cath) cath - <### [ "saving file 1 from alice to ./tests/tmp/test_1.jpg", + <### [ ConsoleString $ "saving file 1 from alice to " <> cathJpg, "started receiving file 1 (test.jpg) from alice" ] cath <## "completed receiving file 1 (test.jpg) from alice" src <- B.readFile "./tests/fixtures/test.jpg" - dest <- B.readFile "./tests/tmp/test.jpg" + dest <- B.readFile bobJpg dest `shouldBe` src - dest2 <- B.readFile "./tests/tmp/test_1.jpg" + dest2 <- B.readFile cathJpg dest2 `shouldBe` src alice #$> ("/_get chat #1 count=2", chat'', [((0, "hi team"), Nothing, Nothing), ((1, "hey bob"), Just (0, "hi team"), Just "./tests/fixtures/test.jpg")]) alice @@@ [("#team", "hey bob"), ("@bob", "sent invitation to join group team as admin"), ("@cath", "sent invitation to join group team as admin")] - bob #$> ("/_get chat #1 count=2", chat'', [((1, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (1, "hi team"), Just "./tests/tmp/test.jpg")]) + bob #$> ("/_get chat #1 count=2", chat'', [((1, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (1, "hi team"), Just bobJpg)]) bob @@@ [("#team", "hey bob"), ("@alice", "received invitation to join group team as admin")] - cath #$> ("/_get chat #1 count=2", chat'', [((0, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (0, "hi team"), Just "./tests/tmp/test_1.jpg")]) + cath #$> ("/_get chat #1 count=2", chat'', [((0, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (0, "hi team"), Just cathJpg)]) cath @@@ [("#team", "hey bob"), ("@alice", "received invitation to join group team as admin")] testSendMultiFilesDirect :: HasCallStack => TestParams -> IO () testSendMultiFilesDirect = testChat2 aliceProfile bobProfile $ \alice bob -> do - withXFTPServer $ do + withXFTPServer alice $ do connectUsers alice bob - alice #$> ("/_files_folder ./tests/tmp/alice_app_files", id, "ok") - copyFile "./tests/fixtures/test.jpg" "./tests/tmp/alice_app_files/test.jpg" - copyFile "./tests/fixtures/test.pdf" "./tests/tmp/alice_app_files/test.pdf" - bob #$> ("/_files_folder ./tests/tmp/bob_app_files", id, "ok") + let aliceFiles = tmpFile alice "alice_app_files" + bobFiles = tmpFile bob "bob_app_files" + alice #$> ("/_files_folder " <> aliceFiles, id, "ok") + copyFile "./tests/fixtures/test.jpg" (aliceFiles "test.jpg") + copyFile "./tests/fixtures/test.pdf" (aliceFiles "test.pdf") + bob #$> ("/_files_folder " <> bobFiles, id, "ok") let cm1 = "{\"msgContent\": {\"type\": \"text\", \"text\": \"message without file\"}}" cm2 = "{\"filePath\": \"test.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"sending file 1\"}}" @@ -525,12 +538,12 @@ testSendMultiFilesDirect = ] bob <## "completed receiving file 2 (test.pdf) from alice" - src1 <- B.readFile "./tests/tmp/alice_app_files/test.jpg" - dest1 <- B.readFile "./tests/tmp/bob_app_files/test.jpg" + src1 <- B.readFile (aliceFiles "test.jpg") + dest1 <- B.readFile (bobFiles "test.jpg") dest1 `shouldBe` src1 - src2 <- B.readFile "./tests/tmp/alice_app_files/test.pdf" - dest2 <- B.readFile "./tests/tmp/bob_app_files/test.pdf" + src2 <- B.readFile (aliceFiles "test.pdf") + dest2 <- B.readFile (bobFiles "test.pdf") dest2 `shouldBe` src2 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")]) @@ -539,16 +552,19 @@ testSendMultiFilesDirect = testSendMultiFilesGroup :: HasCallStack => TestParams -> IO () testSendMultiFilesGroup = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do - withXFTPServer $ do + withXFTPServer alice $ do createGroup3 "team" alice bob cath threadDelay 1000000 - alice #$> ("/_files_folder ./tests/tmp/alice_app_files", id, "ok") - copyFile "./tests/fixtures/test.jpg" "./tests/tmp/alice_app_files/test.jpg" - copyFile "./tests/fixtures/test.pdf" "./tests/tmp/alice_app_files/test.pdf" - bob #$> ("/_files_folder ./tests/tmp/bob_app_files", id, "ok") - cath #$> ("/_files_folder ./tests/tmp/cath_app_files", id, "ok") + let aliceFiles = tmpFile alice "alice_app_files" + bobFiles = tmpFile bob "bob_app_files" + cathFiles = tmpFile cath "cath_app_files" + alice #$> ("/_files_folder " <> aliceFiles, id, "ok") + copyFile "./tests/fixtures/test.jpg" (aliceFiles "test.jpg") + copyFile "./tests/fixtures/test.pdf" (aliceFiles "test.pdf") + bob #$> ("/_files_folder " <> bobFiles, id, "ok") + cath #$> ("/_files_folder " <> cathFiles, id, "ok") let cm1 = "{\"msgContent\": {\"type\": \"text\", \"text\": \"message without file\"}}" cm2 = "{\"filePath\": \"test.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"sending file 1\"}}" @@ -616,15 +632,15 @@ testSendMultiFilesGroup = ] cath <## "completed receiving file 2 (test.pdf) from alice" - src1 <- B.readFile "./tests/tmp/alice_app_files/test.jpg" - dest1_1 <- B.readFile "./tests/tmp/bob_app_files/test.jpg" - dest1_2 <- B.readFile "./tests/tmp/cath_app_files/test.jpg" + src1 <- B.readFile (aliceFiles "test.jpg") + dest1_1 <- B.readFile (bobFiles "test.jpg") + dest1_2 <- B.readFile (cathFiles "test.jpg") dest1_1 `shouldBe` src1 dest1_2 `shouldBe` src1 - src2 <- B.readFile "./tests/tmp/alice_app_files/test.pdf" - dest2_1 <- B.readFile "./tests/tmp/bob_app_files/test.pdf" - dest2_2 <- B.readFile "./tests/tmp/cath_app_files/test.pdf" + src2 <- B.readFile (aliceFiles "test.pdf") + dest2_1 <- B.readFile (bobFiles "test.pdf") + dest2_2 <- B.readFile (cathFiles "test.pdf") dest2_1 `shouldBe` src2 dest2_2 `shouldBe` src2 @@ -648,18 +664,19 @@ testXFTPRoundFDCount = do testXFTPFileTransfer :: HasCallStack => TestParams -> IO () testXFTPFileTransfer = testChat2 aliceProfile bobProfile $ \alice bob -> do - withXFTPServer $ do + withXFTPServer alice $ do connectUsers alice bob + let testPdf = tmpFile bob "test.pdf" alice #> "/f @bob ./tests/fixtures/test.pdf" alice <## "use /fc 1 to cancel sending" bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)" bob <## "use /fr 1 [/ | ] to receive it" - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir bob) concurrentlyN_ [ alice <## "completed uploading file 1 (test.pdf) for bob", bob - <### [ "saving file 1 from alice to ./tests/tmp/test.pdf", + <### [ ConsoleString $ "saving file 1 from alice to " <> testPdf, "started receiving file 1 (test.pdf) from alice" ] ] @@ -668,10 +685,10 @@ testXFTPFileTransfer = alice ##> "/fs 1" alice <## "sending file 1 (test.pdf) complete" bob ##> "/fs 1" - bob <## "receiving file 1 (test.pdf) complete, path: ./tests/tmp/test.pdf" + bob <## ("receiving file 1 (test.pdf) complete, path: " <> testPdf) src <- B.readFile "./tests/fixtures/test.pdf" - dest <- B.readFile "./tests/tmp/test.pdf" + dest <- B.readFile testPdf dest `shouldBe` src testXFTPFileTransferEncrypted :: HasCallStack => TestParams -> IO () @@ -679,32 +696,33 @@ testXFTPFileTransferEncrypted = testChat2 aliceProfile bobProfile $ \alice bob -> do src <- B.readFile "./tests/fixtures/test.pdf" srcLen <- getFileSize "./tests/fixtures/test.pdf" - let srcPath = "./tests/tmp/alice/test.pdf" - createDirectoryIfMissing True "./tests/tmp/alice/" - createDirectoryIfMissing True "./tests/tmp/bob/" + let srcPath = tmpFile alice "alice/test.pdf" + bobDir = tmpFile bob "bob/" + createDirectoryIfMissing True $ tmpFile alice "alice/" + createDirectoryIfMissing True bobDir WFResult cfArgs <- chatWriteFile (chatController alice) srcPath src let fileJSON = LB.unpack $ J.encode $ CryptoFile srcPath $ Just cfArgs - withXFTPServer $ do + withXFTPServer alice $ do connectUsers alice bob alice ##> ("/_send @2 json [{\"msgContent\":{\"type\":\"file\", \"text\":\"\"}, \"fileSource\": " <> fileJSON <> "}]") - alice <# "/f @bob ./tests/tmp/alice/test.pdf" + alice <# ("/f @bob " <> srcPath) alice <## "use /fc 1 to cancel sending" bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)" bob <## "use /fr 1 [/ | ] to receive it" - bob ##> "/fr 1 encrypt=on ./tests/tmp/bob/" - bob <## "saving file 1 from alice to ./tests/tmp/bob/test.pdf" + bob ##> ("/fr 1 encrypt=on " <> bobDir) + bob <## ("saving file 1 from alice to " <> bobDir <> "test.pdf") alice <## "completed uploading file 1 (test.pdf) for bob" bob <## "started receiving file 1 (test.pdf) from alice" bob <## "completed receiving file 1 (test.pdf) from alice" Just (CFArgs key nonce) <- J.decode . LB.pack <$> getTermLine bob - Right dest <- chatReadFile "./tests/tmp/bob/test.pdf" (strEncode key) (strEncode nonce) + Right dest <- chatReadFile (bobDir <> "test.pdf") (strEncode key) (strEncode nonce) LB.length dest `shouldBe` fromIntegral srcLen LB.toStrict dest `shouldBe` src testXFTPAcceptAfterUpload :: HasCallStack => TestParams -> IO () testXFTPAcceptAfterUpload = testChat2 aliceProfile bobProfile $ \alice bob -> do - withXFTPServer $ do + withXFTPServer alice $ do connectUsers alice bob alice #> "/f @bob ./tests/fixtures/test.pdf" @@ -715,21 +733,21 @@ testXFTPAcceptAfterUpload = threadDelay 100000 - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir bob) bob - <### [ "saving file 1 from alice to ./tests/tmp/test.pdf", + <### [ ConsoleString $ "saving file 1 from alice to " <> tmpFile bob "test.pdf", "started receiving file 1 (test.pdf) from alice" ] bob <## "completed receiving file 1 (test.pdf) from alice" src <- B.readFile "./tests/fixtures/test.pdf" - dest <- B.readFile "./tests/tmp/test.pdf" + dest <- B.readFile (tmpFile bob "test.pdf") dest `shouldBe` src testXFTPGroupFileTransfer :: HasCallStack => TestParams -> IO () testXFTPGroupFileTransfer = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do - withXFTPServer $ do + withXFTPServer alice $ do createGroup3 "team" alice bob cath alice #> "/f #team ./tests/fixtures/test.pdf" @@ -744,23 +762,23 @@ testXFTPGroupFileTransfer = ] alice <## "completed uploading file 1 (test.pdf) for #team" - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir bob) bob - <### [ "saving file 1 from alice to ./tests/tmp/test.pdf", + <### [ ConsoleString $ "saving file 1 from alice to " <> tmpFile bob "test.pdf", "started receiving file 1 (test.pdf) from alice" ] bob <## "completed receiving file 1 (test.pdf) from alice" - cath ##> "/fr 1 ./tests/tmp" + cath ##> ("/fr 1 " <> tmpDir cath) cath - <### [ "saving file 1 from alice to ./tests/tmp/test_1.pdf", + <### [ ConsoleString $ "saving file 1 from alice to " <> tmpFile cath "test_1.pdf", "started receiving file 1 (test.pdf) from alice" ] cath <## "completed receiving file 1 (test.pdf) from alice" src <- B.readFile "./tests/fixtures/test.pdf" - dest1 <- B.readFile "./tests/tmp/test.pdf" - dest2 <- B.readFile "./tests/tmp/test_1.pdf" + dest1 <- B.readFile (tmpFile bob "test.pdf") + dest2 <- B.readFile (tmpFile cath "test_1.pdf") dest1 `shouldBe` src dest2 `shouldBe` src @@ -775,7 +793,7 @@ testXFTPFileBadgeProof ps = do Right (pk, sk) <- bbsKeyGen testChatCfg2 (badgeFileCfg pk) aliceProfile bobProfile (test sk) ps where - test sk alice bob = withXFTPServer $ do + test sk alice bob = withXFTPServer ps $ do connectUsers alice bob addTestBadge alice =<< issueTestBadge sk futureDate @@ -783,18 +801,18 @@ testXFTPFileBadgeProof ps = do alice <## "use /fc 1 to cancel sending" bob <# "alice *> sends file test.pdf (266.0 KiB / 272376 bytes)" bob <## "use /fr 1 [/ | ] to receive it" - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir ps) concurrentlyN_ [ alice <## "completed uploading file 1 (test.pdf) for bob", bob - <### [ "saving file 1 from alice to ./tests/tmp/test.pdf", + <### [ ConsoleString $ "saving file 1 from alice to " <> tmpFile ps "test.pdf", "started receiving file 1 (test.pdf) from alice" ] ] bob <## "completed receiving file 1 (test.pdf) from alice" src <- B.readFile "./tests/fixtures/test.pdf" - dest <- B.readFile "./tests/tmp/test.pdf" + dest <- B.readFile (tmpFile ps "test.pdf") dest `shouldBe` src testXFTPGroupFileBadgeProof :: HasCallStack => TestParams -> IO () @@ -802,7 +820,7 @@ testXFTPGroupFileBadgeProof ps = do Right (pk, sk) <- bbsKeyGen testChatCfg3 (badgeFileCfg pk) aliceProfile bobProfile cathProfile (test sk) ps where - test sk alice bob cath = withXFTPServer $ do + test sk alice bob cath = withXFTPServer ps $ do createGroup3 "team" alice bob cath addTestBadge alice =<< issueTestBadge sk futureDate @@ -818,28 +836,28 @@ testXFTPGroupFileBadgeProof ps = do ] alice <## "completed uploading file 1 (test.pdf) for #team" - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir ps) bob - <### [ "saving file 1 from alice to ./tests/tmp/test.pdf", + <### [ ConsoleString $ "saving file 1 from alice to " <> tmpFile ps "test.pdf", "started receiving file 1 (test.pdf) from alice" ] bob <## "completed receiving file 1 (test.pdf) from alice" src <- B.readFile "./tests/fixtures/test.pdf" - dest <- B.readFile "./tests/tmp/test.pdf" + dest <- B.readFile (tmpFile ps "test.pdf") dest `shouldBe` src testXFTPFileNoBadgeProof :: HasCallStack => TestParams -> IO () testXFTPFileNoBadgeProof ps = withNewTestChatCfg ps sndCfg "alice" aliceProfile $ \alice -> - withNewTestChatCfg ps rcvCfg "bob" bobProfile $ \bob -> withXFTPServer $ do + withNewTestChatCfg ps rcvCfg "bob" bobProfile $ \bob -> withXFTPServer ps $ do connectUsers alice bob alice #> "/f @bob ./tests/fixtures/test.pdf" alice <## "use /fc 1 to cancel sending" bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)" bob <## "file is above the limit of 100000 bytes: sender has no badge" - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir ps) concurrentlyN_ [ bob <## "file size exceeds the limit: test.pdf", alice <## "completed uploading file 1 (test.pdf) for bob" @@ -852,7 +870,7 @@ testXFTPFileBadgeAboveLimit :: HasCallStack => TestParams -> IO () testXFTPFileBadgeAboveLimit ps = do Right (pk, sk) <- bbsKeyGen withNewTestChatCfg ps (badgeFileCfg pk) "alice" aliceProfile $ \alice -> - withNewTestChatCfg ps (rcvCfg pk) "bob" bobProfile $ \bob -> withXFTPServer $ do + withNewTestChatCfg ps (rcvCfg pk) "bob" bobProfile $ \bob -> withXFTPServer ps $ do connectUsers alice bob addTestBadge alice =<< issueTestBadge sk futureDate @@ -860,7 +878,7 @@ testXFTPFileBadgeAboveLimit ps = do alice <## "use /fc 1 to cancel sending" bob <# "alice *> sends file test.pdf (266.0 KiB / 272376 bytes)" bob <## "file is above the limit of 150000 bytes: above the limit of the sender badge" - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir ps) concurrentlyN_ [ bob <## "file size exceeds the limit: test.pdf", alice <## "completed uploading file 1 (test.pdf) for bob" @@ -874,7 +892,7 @@ testXFTPSndFileBadgeLimit ps = do testChatCfg2 (cfg pk) aliceProfile bobProfile (test sk) ps where cfg pk = badgeFileCfgLimits pk FileSizeLimits {noBadge = 100000, supporter = 150000, legend = 300000} - test sk alice bob = withXFTPServer $ do + test sk alice bob = withXFTPServer ps $ do connectUsers alice bob addTestBadge alice =<< issueTestBadgeType sk BTSupporter futureDate @@ -896,7 +914,7 @@ testXFTPSndFileBadgeGrace ps = do Right (pk, sk) <- bbsKeyGen testChatCfg2 (badgeFileCfg pk) aliceProfile bobProfile (test sk) ps where - test sk alice bob = withXFTPServer $ do + test sk alice bob = withXFTPServer ps $ do connectUsers alice bob now <- getCurrentTime @@ -941,7 +959,7 @@ testFileBadgeProofStatus ps = do testXFTPDeleteUploadedFile :: HasCallStack => TestParams -> IO () testXFTPDeleteUploadedFile = testChat2 aliceProfile bobProfile $ \alice bob -> do - withXFTPServer $ do + withXFTPServer alice $ do connectUsers alice bob alice #> "/f @bob ./tests/fixtures/test.pdf" @@ -956,14 +974,15 @@ testXFTPDeleteUploadedFile = bob <## "alice cancelled sending file 1 (test.pdf)" ] - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir bob) bob <## "file cancelled: test.pdf" testXFTPDeleteUploadedFileGroup :: HasCallStack => TestParams -> IO () testXFTPDeleteUploadedFileGroup = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do - withXFTPServer $ do + withXFTPServer alice $ do createGroup3 "team" alice bob cath + let testPdf = tmpFile bob "test.pdf" alice #> "/f #team ./tests/fixtures/test.pdf" alice <## "use /fc 1 to cancel sending" @@ -977,9 +996,9 @@ testXFTPDeleteUploadedFileGroup = ] alice <## "completed uploading file 1 (test.pdf) for #team" - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir bob) bob - <### [ "saving file 1 from alice to ./tests/tmp/test.pdf", + <### [ ConsoleString $ "saving file 1 from alice to " <> testPdf, "started receiving file 1 (test.pdf) from alice" ] bob <## "completed receiving file 1 (test.pdf) from alice" @@ -987,12 +1006,12 @@ testXFTPDeleteUploadedFileGroup = alice ##> "/fs 1" alice <## "sending file 1 (test.pdf) complete" bob ##> "/fs 1" - bob <## "receiving file 1 (test.pdf) complete, path: ./tests/tmp/test.pdf" + bob <## ("receiving file 1 (test.pdf) complete, path: " <> testPdf) cath ##> "/fs 1" cath <## "receiving file 1 (test.pdf) not accepted yet, use /fr 1 to receive file" src <- B.readFile "./tests/fixtures/test.pdf" - dest <- B.readFile "./tests/tmp/test.pdf" + dest <- B.readFile testPdf dest `shouldBe` src alice ##> "/fc 1" @@ -1006,21 +1025,21 @@ testXFTPDeleteUploadedFileGroup = alice ##> "/fs 1" alice <## "sending file 1 (test.pdf) cancelled" bob ##> "/fs 1" - bob <## "receiving file 1 (test.pdf) complete, path: ./tests/tmp/test.pdf" + bob <## ("receiving file 1 (test.pdf) complete, path: " <> testPdf) cath ##> "/fs 1" cath <## "receiving file 1 (test.pdf) cancelled" - cath ##> "/fr 1 ./tests/tmp" + cath ##> ("/fr 1 " <> tmpDir cath) cath <## "file cancelled: test.pdf" testXFTPWithRelativePaths :: HasCallStack => TestParams -> IO () testXFTPWithRelativePaths = testChat2 aliceProfile bobProfile $ \alice bob -> do - withXFTPServer $ do + withXFTPServer alice $ do -- agent is passed xftp work directory only on chat start, -- so for test we work around by stopping and starting chat - setRelativePaths alice "./tests/fixtures" "./tests/tmp/alice_xftp" - setRelativePaths bob "./tests/tmp/bob_files" "./tests/tmp/bob_xftp" + setRelativePaths alice "./tests/fixtures" (tmpFile alice "alice_xftp") + setRelativePaths bob (tmpFile bob "bob_files") (tmpFile bob "bob_xftp") connectUsers alice bob alice #> "/f @bob test.pdf" @@ -1038,12 +1057,12 @@ testXFTPWithRelativePaths = bob <## "completed receiving file 1 (test.pdf) from alice" src <- B.readFile "./tests/fixtures/test.pdf" - dest <- B.readFile "./tests/tmp/bob_files/test.pdf" + dest <- B.readFile (tmpFile bob "bob_files/test.pdf") dest `shouldBe` src testXFTPContinueRcv :: HasCallStack => TestParams -> IO () testXFTPContinueRcv ps = do - withXFTPServer $ do + withXFTPServer ps $ do withNewTestChat ps "alice" aliceProfile $ \alice -> do withNewTestChat ps "bob" bobProfile $ \bob -> do connectUsers alice bob @@ -1057,9 +1076,9 @@ testXFTPContinueRcv ps = do -- server is down - file is not received withTestChat ps "bob" $ \bob -> do bob <## "subscribed 1 connections on server localhost" - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir ps) bob - <### [ "saving file 1 from alice to ./tests/tmp/test.pdf", + <### [ ConsoleString $ "saving file 1 from alice to " <> tmpFile ps "test.pdf", "started receiving file 1 (test.pdf) from alice" ] @@ -1068,19 +1087,19 @@ testXFTPContinueRcv ps = do (bob do bob <## "subscribed 1 connections on server localhost" bob <## "completed receiving file 1 (test.pdf) from alice" src <- B.readFile "./tests/fixtures/test.pdf" - dest <- B.readFile "./tests/tmp/test.pdf" + dest <- B.readFile (tmpFile ps "test.pdf") dest `shouldBe` src testXFTPMarkToReceive :: HasCallStack => TestParams -> IO () testXFTPMarkToReceive = do testChat2 aliceProfile bobProfile $ \alice bob -> do - withXFTPServer $ do + withXFTPServer alice $ do connectUsers alice bob alice #> "/f @bob ./tests/fixtures/test.pdf" @@ -1095,8 +1114,8 @@ testXFTPMarkToReceive = do bob ##> "/_stop" bob <## "chat stopped" - bob #$> ("/_files_folder ./tests/tmp/bob_files", id, "ok") - bob #$> ("/_temp_folder ./tests/tmp/bob_xftp", id, "ok") + bob #$> ("/_files_folder " <> tmpFile bob "bob_files", id, "ok") + bob #$> ("/_temp_folder " <> tmpFile bob "bob_xftp", id, "ok") threadDelay 100000 @@ -1111,12 +1130,12 @@ testXFTPMarkToReceive = do bob <## "completed receiving file 1 (test.pdf) from alice" src <- B.readFile "./tests/fixtures/test.pdf" - dest <- B.readFile "./tests/tmp/bob_files/test.pdf" + dest <- B.readFile (tmpFile bob "bob_files/test.pdf") dest `shouldBe` src testXFTPRcvError :: HasCallStack => TestParams -> IO () testXFTPRcvError ps = do - withXFTPServer $ do + withXFTPServer ps $ do withNewTestChat ps "alice" aliceProfile $ \alice -> do withNewTestChat ps "bob" bobProfile $ \bob -> do connectUsers alice bob @@ -1128,12 +1147,12 @@ testXFTPRcvError ps = do alice <## "completed uploading file 1 (test.pdf) for bob" -- server is up w/t store log - file reception should fail - withXFTPServer' xftpServerConfig {serverStoreCfg = XSCMemory Nothing, storeLogFile = Nothing} $ do + withXFTPServer' (xftpServerConfig ps) {serverStoreCfg = XSCMemory Nothing, storeLogFile = Nothing} $ do withTestChat ps "bob" $ \bob -> do bob <## "subscribed 1 connections on server localhost" - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir ps) bob - <### [ "saving file 1 from alice to ./tests/tmp/test.pdf", + <### [ ConsoleString $ "saving file 1 from alice to " <> tmpFile ps "test.pdf", "started receiving file 1 (test.pdf) from alice" ] bob <## "error receiving file 1 (test.pdf) from alice" @@ -1145,20 +1164,22 @@ testXFTPRcvError ps = do testXFTPCancelRcvRepeat :: HasCallStack => TestParams -> IO () testXFTPCancelRcvRepeat = testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do - withXFTPServer $ do - xftpCLI ["rand", "./tests/tmp/testfile", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile"] + withXFTPServer alice $ do + let testfile = tmpFile alice "testfile" + testfile1 = tmpFile bob "testfile_1" + xftpCLI ["rand", testfile, "17mb"] `shouldReturn` ["File created: " <> testfile] connectUsers alice bob - alice #> "/f @bob ./tests/tmp/testfile" + alice #> ("/f @bob " <> testfile) alice <## "use /fc 1 to cancel sending" bob <# "alice> sends file testfile (17.0 MiB / 17825792 bytes)" bob <## "use /fr 1 [/ | ] to receive it" - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir bob) concurrentlyN_ [ alice <## "completed uploading file 1 (testfile) for bob", bob - <### [ "saving file 1 from alice to ./tests/tmp/testfile_1", + <### [ ConsoleString $ "saving file 1 from alice to " <> testfile1, "started receiving file 1 (testfile) from alice" ] ] @@ -1174,28 +1195,28 @@ testXFTPCancelRcvRepeat = bob ##> "/fs 1" bob <## "receiving file 1 (testfile) not accepted yet, use /fr 1 to receive file" - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir bob) bob - <### [ "saving file 1 from alice to ./tests/tmp/testfile_1", + <### [ ConsoleString $ "saving file 1 from alice to " <> testfile1, "started receiving file 1 (testfile) from alice", StartsWith "chat db error: SERcvFileNotFoundXFTP" ] bob <## "completed receiving file 1 (testfile) from alice" bob ##> "/fs 1" - bob <## "receiving file 1 (testfile) complete, path: ./tests/tmp/testfile_1" + bob <## ("receiving file 1 (testfile) complete, path: " <> testfile1) - src <- B.readFile "./tests/tmp/testfile" - dest <- B.readFile "./tests/tmp/testfile_1" + src <- B.readFile testfile + dest <- B.readFile testfile1 dest `shouldBe` src where cfg = testCfg {xftpDescrPartSize = 200} testAutoAcceptFile :: HasCallStack => TestParams -> IO () testAutoAcceptFile = - testChatOpts2 opts aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do + testChatOpts2 opts aliceProfile bobProfile $ \alice bob -> withXFTPServer alice $ do connectUsers alice bob - bob ##> "/_files_folder ./tests/tmp/bob_files" + bob ##> ("/_files_folder " <> tmpFile bob "bob_files") bob <## "ok" alice #> "/f @bob ./tests/fixtures/test.jpg" alice <## "use /fc 1 to cancel sending" @@ -1218,7 +1239,7 @@ testAutoAcceptFile = testProhibitFiles :: HasCallStack => TestParams -> IO () testProhibitFiles = - testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> withXFTPServer $ do + testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> withXFTPServer alice $ do createGroup3 "team" alice bob cath alice ##> "/set files #team off" alice <## "updated group preferences:" @@ -1240,7 +1261,7 @@ testProhibitFiles = testXFTPStandaloneSmall :: HasCallStack => TestParams -> IO () testXFTPStandaloneSmall = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do - withXFTPServer $ do + withXFTPServer src $ do logNote "sending" src ##> "/_upload 1 ./tests/fixtures/logo.jpg" src <## "started standalone uploading file 1 (logo.jpg)" @@ -1254,7 +1275,7 @@ testXFTPStandaloneSmall = testChat2 aliceProfile aliceDesktopProfile $ \src dst _uri4 <- getTermLine src logNote "receiving" - let dstFile = "./tests/tmp/logo.jpg" + let dstFile = tmpFile dst "logo.jpg" dst ##> ("/_download 1 " <> uri3 <> " " <> dstFile) dst <## "started standalone receiving file 1 (logo.jpg)" -- silent progress events @@ -1265,7 +1286,7 @@ testXFTPStandaloneSmall = testChat2 aliceProfile aliceDesktopProfile $ \src dst testXFTPStandaloneSmallInfo :: HasCallStack => TestParams -> IO () testXFTPStandaloneSmallInfo = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do - withXFTPServer $ do + withXFTPServer src $ do logNote "sending" src ##> "/_upload 1 ./tests/fixtures/logo.jpg" src <## "started standalone uploading file 1 (logo.jpg)" @@ -1284,7 +1305,7 @@ testXFTPStandaloneSmallInfo = testChat2 aliceProfile aliceDesktopProfile $ \src dst <## "{\"secret\":\"*********\"}" logNote "receiving" - let dstFile = "./tests/tmp/logo.jpg" + let dstFile = tmpFile dst "logo.jpg" dst ##> ("/_download 1 " <> uri <> " " <> dstFile) -- download sucessfully discarded extra info dst <## "started standalone receiving file 1 (logo.jpg)" -- silent progress events @@ -1295,11 +1316,12 @@ testXFTPStandaloneSmallInfo = testChat2 aliceProfile aliceDesktopProfile $ \src 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"] + withXFTPServer src $ do + let srcFile = tmpFile src "testfile.in" + xftpCLI ["rand", srcFile, "17mb"] `shouldReturn` ["File created: " <> srcFile] logNote "sending" - src ##> "/_upload 1 ./tests/tmp/testfile.in" + src ##> ("/_upload 1 " <> srcFile) src <## "started standalone uploading file 1 (testfile.in)" -- silent progress events threadDelay 250000 @@ -1311,22 +1333,23 @@ testXFTPStandaloneLarge = testChat2 aliceProfile aliceDesktopProfile $ \src dst _uri4 <- getTermLine src logNote "receiving" - let dstFile = "./tests/tmp/testfile.out" + let dstFile = tmpFile dst "testfile.out" dst ##> ("/_download 1 " <> uri <> " " <> dstFile) dst <## "started standalone receiving file 1 (testfile.out)" -- silent progress events threadDelay 250000 dst <## "completed standalone receiving file 1 (testfile.out)" - srcBody <- B.readFile "./tests/tmp/testfile.in" + srcBody <- B.readFile srcFile B.readFile dstFile `shouldReturn` srcBody 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"] + withXFTPServer src $ do + let srcFile = tmpFile src "testfile.in" + xftpCLI ["rand", srcFile, "17mb"] `shouldReturn` ["File created: " <> srcFile] logNote "sending" - src ##> "/_upload 1 ./tests/tmp/testfile.in" + src ##> ("/_upload 1 " <> srcFile) src <## "started standalone uploading file 1 (testfile.in)" -- silent progress events @@ -1344,22 +1367,23 @@ testXFTPStandaloneLargeInfo = testChat2 aliceProfile aliceDesktopProfile $ \src dst <## "{\"secret\":\"*********\"}" logNote "receiving" - let dstFile = "./tests/tmp/testfile.out" + let dstFile = tmpFile dst "testfile.out" dst ##> ("/_download 1 " <> uri <> " " <> dstFile) dst <## "started standalone receiving file 1 (testfile.out)" -- silent progress events threadDelay 250000 dst <## "completed standalone receiving file 1 (testfile.out)" - srcBody <- B.readFile "./tests/tmp/testfile.in" + srcBody <- B.readFile srcFile B.readFile dstFile `shouldReturn` srcBody 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"] + withXFTPServer src $ do + let srcFile = tmpFile src "testfile.in" + xftpCLI ["rand", srcFile, "17mb"] `shouldReturn` ["File created: " <> srcFile] logNote "sending" - src ##> "/_upload 1 ./tests/tmp/testfile.in" + src ##> ("/_upload 1 " <> srcFile) src <## "started standalone uploading file 1 (testfile.in)" -- silent progress events threadDelay 250000 @@ -1376,7 +1400,7 @@ testXFTPStandaloneCancelSnd = testChat2 aliceProfile aliceDesktopProfile $ \src threadDelay 1000000 logNote "trying to receive cancelled" - dst ##> ("/_download 1 " <> uri <> " " <> "./tests/tmp/should.not.extist") + dst ##> ("/_download 1 " <> uri <> " " <> tmpFile dst "should.not.extist") dst <## "started standalone receiving file 1 (should.not.extist)" threadDelay 100000 logWarn "no error?" @@ -1385,12 +1409,14 @@ testXFTPStandaloneCancelSnd = testChat2 aliceProfile aliceDesktopProfile $ \src testXFTPStandaloneRelativePaths :: HasCallStack => TestParams -> IO () testXFTPStandaloneRelativePaths = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do - withXFTPServer $ do + withXFTPServer src $ do logNote "sending" - src #$> ("/_files_folder ./tests/tmp/src_files", id, "ok") - src #$> ("/_temp_folder ./tests/tmp/src_xftp_temp", id, "ok") + let srcFiles = tmpFile src "src_files" + dstFiles = tmpFile dst "dst_files" + src #$> ("/_files_folder " <> srcFiles, id, "ok") + src #$> ("/_temp_folder " <> tmpFile src "src_xftp_temp", id, "ok") - xftpCLI ["rand", "./tests/tmp/src_files/testfile.in", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/src_files/testfile.in"] + xftpCLI ["rand", srcFiles "testfile.in", "17mb"] `shouldReturn` ["File created: " <> (srcFiles "testfile.in")] src ##> "/_upload 1 testfile.in" src <## "started standalone uploading file 1 (testfile.in)" @@ -1404,23 +1430,24 @@ testXFTPStandaloneRelativePaths = testChat2 aliceProfile aliceDesktopProfile $ \ _uri4 <- getTermLine src logNote "receiving" - dst #$> ("/_files_folder ./tests/tmp/dst_files", id, "ok") - dst #$> ("/_temp_folder ./tests/tmp/dst_xftp_temp", id, "ok") + dst #$> ("/_files_folder " <> dstFiles, id, "ok") + dst #$> ("/_temp_folder " <> tmpFile dst "dst_xftp_temp", id, "ok") dst ##> ("/_download 1 " <> uri <> " testfile.out") dst <## "started standalone receiving file 1 (testfile.out)" -- silent progress events threadDelay 250000 dst <## "completed standalone receiving file 1 (testfile.out)" - srcBody <- B.readFile "./tests/tmp/src_files/testfile.in" - B.readFile "./tests/tmp/dst_files/testfile.out" `shouldReturn` srcBody + srcBody <- B.readFile (srcFiles "testfile.in") + B.readFile (dstFiles "testfile.out") `shouldReturn` srcBody 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"] + withXFTPServer src $ do + let srcFile = tmpFile src "testfile.in" + xftpCLI ["rand", srcFile, "17mb"] `shouldReturn` ["File created: " <> srcFile] logNote "sending" - src ##> "/_upload 1 ./tests/tmp/testfile.in" + src ##> ("/_upload 1 " <> srcFile) src <## "started standalone uploading file 1 (testfile.in)" -- silent progress events threadDelay 250000 @@ -1432,7 +1459,7 @@ testXFTPStandaloneCancelRcv = testChat2 aliceProfile aliceDesktopProfile $ \src _uri4 <- getTermLine src logNote "receiving" - let dstFile = "./tests/tmp/testfile.out" + let dstFile = tmpFile dst "testfile.out" dst ##> ("/_download 1 " <> uri <> " " <> dstFile) dst <## "started standalone receiving file 1 (testfile.out)" threadDelay 25000 -- give workers some time to avoid internal errors from starting tasks diff --git a/tests/ChatTests/Forward.hs b/tests/ChatTests/Forward.hs index 1654ce5335..a5de4d2c37 100644 --- a/tests/ChatTests/Forward.hs +++ b/tests/ChatTests/Forward.hs @@ -15,6 +15,7 @@ import qualified Data.Text as T import Simplex.Chat.Library.Commands (fixedImagePreview) import Simplex.Chat.Types (ImageData (..)) import System.Directory (copyFile, doesFileExist, removeFile) +import System.FilePath (()) import Test.Hspec hiding (it) chatForwardTests :: SpecWith TestParams @@ -500,7 +501,7 @@ testForwardDeleteForOther = testForwardFileNoFilesFolder :: HasCallStack => TestParams -> IO () testForwardFileNoFilesFolder = testChat3 aliceProfile bobProfile cathProfile $ - \alice bob cath -> withXFTPServer $ do + \alice bob cath -> withXFTPServer alice $ do connectUsers alice bob connectUsers bob cath @@ -513,51 +514,51 @@ testForwardFileNoFilesFolder = bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)" bob <## "use /fr 1 [/ | ] to receive it" - bob ##> "/fr 1 ./tests/tmp" + bob ##> ("/fr 1 " <> tmpDir bob) concurrentlyN_ [ alice <## "completed uploading file 1 (test.pdf) for bob", bob - <### [ "saving file 1 from alice to ./tests/tmp/test.pdf", + <### [ ConsoleString $ "saving file 1 from alice to " <> tmpFile bob "test.pdf", "started receiving file 1 (test.pdf) from alice" ] ] bob <## "completed receiving file 1 (test.pdf) from alice" src <- B.readFile "./tests/fixtures/test.pdf" - dest <- B.readFile "./tests/tmp/test.pdf" + dest <- B.readFile (tmpFile bob "test.pdf") dest `shouldBe` src -- forward file bob `send` "@cath <- @alice hi" bob <# "@cath <- @alice" bob <## " hi" - bob <# "/f @cath ./tests/tmp/test.pdf" + bob <# ("/f @cath " <> tmpFile bob "test.pdf") bob <## "use /fc 2 to cancel sending" cath <# "bob> -> forwarded" cath <## " hi" cath <# "bob> sends file test.pdf (266.0 KiB / 272376 bytes)" cath <## "use /fr 1 [/ | ] to receive it" - cath ##> "/fr 1 ./tests/tmp" + cath ##> ("/fr 1 " <> tmpDir cath) concurrentlyN_ [ bob <## "completed uploading file 2 (test.pdf) for cath", cath - <### [ "saving file 1 from bob to ./tests/tmp/test_1.pdf", + <### [ ConsoleString $ "saving file 1 from bob to " <> tmpFile cath "test_1.pdf", "started receiving file 1 (test.pdf) from bob" ] ] cath <## "completed receiving file 1 (test.pdf) from bob" - dest2 <- B.readFile "./tests/tmp/test_1.pdf" + dest2 <- B.readFile (tmpFile cath "test_1.pdf") dest2 `shouldBe` src testForwardFileContactToContact :: HasCallStack => TestParams -> IO () testForwardFileContactToContact = testChat3 aliceProfile bobProfile cathProfile $ - \alice bob cath -> withXFTPServer $ do - setRelativePaths alice "./tests/fixtures" "./tests/tmp/alice_xftp" - setRelativePaths bob "./tests/tmp/bob_files" "./tests/tmp/bob_xftp" - setRelativePaths cath "./tests/tmp/cath_files" "./tests/tmp/cath_xftp" + \alice bob cath -> withXFTPServer alice $ do + setRelativePaths alice "./tests/fixtures" (tmpFile alice "alice_xftp") + setRelativePaths bob (tmpFile bob "bob_files") (tmpFile bob "bob_xftp") + setRelativePaths cath (tmpFile cath "cath_files") (tmpFile cath "cath_xftp") connectUsers alice bob connectUsers bob cath @@ -581,7 +582,7 @@ testForwardFileContactToContact = bob <## "completed receiving file 1 (test.pdf) from alice" src <- B.readFile "./tests/fixtures/test.pdf" - dest <- B.readFile "./tests/tmp/bob_files/test.pdf" + dest <- B.readFile (tmpFile bob "bob_files/test.pdf") dest `shouldBe` src -- forward file @@ -605,24 +606,24 @@ testForwardFileContactToContact = ] cath <## "completed receiving file 1 (test_1.pdf) from bob" - src2 <- B.readFile "./tests/tmp/bob_files/test_1.pdf" + src2 <- B.readFile (tmpFile bob "bob_files/test_1.pdf") src2 `shouldBe` dest - dest2 <- B.readFile "./tests/tmp/cath_files/test_1.pdf" + dest2 <- B.readFile (tmpFile cath "cath_files/test_1.pdf") dest2 `shouldBe` src2 -- deleting original file doesn't delete forwarded file - checkActionDeletesFile "./tests/tmp/bob_files/test.pdf" $ do + checkActionDeletesFile (tmpFile bob "bob_files/test.pdf") $ do bob ##> "/clear alice" bob <## "alice: all messages are removed locally ONLY" - fwdFileExists <- doesFileExist "./tests/tmp/bob_files/test_1.pdf" + fwdFileExists <- doesFileExist (tmpFile bob "bob_files/test_1.pdf") fwdFileExists `shouldBe` True testForwardFileGroupToNotes :: HasCallStack => TestParams -> IO () testForwardFileGroupToNotes = testChat2 aliceProfile cathProfile $ - \alice cath -> withXFTPServer $ do - setRelativePaths alice "./tests/fixtures" "./tests/tmp/alice_xftp" - setRelativePaths cath "./tests/tmp/cath_files" "./tests/tmp/cath_xftp" + \alice cath -> withXFTPServer alice $ do + setRelativePaths alice "./tests/fixtures" (tmpFile alice "alice_xftp") + setRelativePaths cath (tmpFile cath "cath_files") (tmpFile cath "cath_xftp") createGroup2 "team" alice cath createCCNoteFolder cath @@ -646,7 +647,7 @@ testForwardFileGroupToNotes = cath <## "completed receiving file 1 (test.pdf) from alice" src <- B.readFile "./tests/fixtures/test.pdf" - dest <- B.readFile "./tests/tmp/cath_files/test.pdf" + dest <- B.readFile (tmpFile cath "cath_files/test.pdf") dest `shouldBe` src -- forward file @@ -655,23 +656,23 @@ testForwardFileGroupToNotes = cath <## " hi" cath <# "* file 2 (test_1.pdf)" - dest2 <- B.readFile "./tests/tmp/cath_files/test_1.pdf" + dest2 <- B.readFile (tmpFile cath "cath_files/test_1.pdf") dest2 `shouldBe` dest -- deleting original file doesn't delete forwarded file - checkActionDeletesFile "./tests/tmp/cath_files/test.pdf" $ do + checkActionDeletesFile (tmpFile cath "cath_files/test.pdf") $ do cath ##> "/clear #team" cath <## "#team: all messages are removed locally ONLY" - fwdFileExists <- doesFileExist "./tests/tmp/cath_files/test_1.pdf" + fwdFileExists <- doesFileExist (tmpFile cath "cath_files/test_1.pdf") fwdFileExists `shouldBe` True testForwardFileNotesToGroup :: HasCallStack => TestParams -> IO () testForwardFileNotesToGroup = testChat2 aliceProfile cathProfile $ - \alice cath -> withXFTPServer $ do - setRelativePaths alice "./tests/tmp/alice_files" "./tests/tmp/alice_xftp" - setRelativePaths cath "./tests/tmp/cath_files" "./tests/tmp/cath_xftp" - copyFile "./tests/fixtures/test.pdf" "./tests/tmp/alice_files/test.pdf" + \alice cath -> withXFTPServer alice $ do + setRelativePaths alice (tmpFile alice "alice_files") (tmpFile alice "alice_xftp") + setRelativePaths cath (tmpFile cath "cath_files") (tmpFile cath "cath_xftp") + copyFile "./tests/fixtures/test.pdf" (tmpFile alice "alice_files/test.pdf") createCCNoteFolder alice createGroup2 "team" alice cath @@ -699,17 +700,17 @@ testForwardFileNotesToGroup = ] cath <## "completed receiving file 1 (test_1.pdf) from alice" - src <- B.readFile "./tests/tmp/alice_files/test.pdf" - src2 <- B.readFile "./tests/tmp/alice_files/test_1.pdf" + src <- B.readFile (tmpFile alice "alice_files/test.pdf") + src2 <- B.readFile (tmpFile alice "alice_files/test_1.pdf") src2 `shouldBe` src - dest2 <- B.readFile "./tests/tmp/cath_files/test_1.pdf" + dest2 <- B.readFile (tmpFile cath "cath_files/test_1.pdf") dest2 `shouldBe` src2 -- deleting original file doesn't delete forwarded file - checkActionDeletesFile "./tests/tmp/alice_files/test.pdf" $ do + checkActionDeletesFile (tmpFile alice "alice_files/test.pdf") $ do alice ##> "/clear *" alice <## "notes: all messages are removed" - fwdFileExists <- doesFileExist "./tests/tmp/alice_files/test_1.pdf" + fwdFileExists <- doesFileExist (tmpFile alice "alice_files/test_1.pdf") fwdFileExists `shouldBe` True testForwardContactToContactMulti :: HasCallStack => TestParams -> IO () @@ -789,14 +790,17 @@ testForwardGroupToGroupMulti = testMultiForwardFiles :: HasCallStack => TestParams -> IO () testMultiForwardFiles = testChat3 aliceProfile bobProfile cathProfile $ - \alice bob cath -> withXFTPServer $ do - setRelativePaths alice "./tests/tmp/alice_app_files" "./tests/tmp/alice_xftp" - copyFile "./tests/fixtures/test.jpg" "./tests/tmp/alice_app_files/test.jpg" - copyFile "./tests/fixtures/test.pdf" "./tests/tmp/alice_app_files/test.pdf" - copyFile "./tests/fixtures/test_1MB.pdf" "./tests/tmp/alice_app_files/test_1MB.pdf" - copyFile "./tests/fixtures/logo.jpg" "./tests/tmp/alice_app_files/logo.jpg" - setRelativePaths bob "./tests/tmp/bob_app_files" "./tests/tmp/bob_xftp" - setRelativePaths cath "./tests/tmp/cath_app_files" "./tests/tmp/cath_xftp" + \alice bob cath -> withXFTPServer alice $ do + let aliceFiles = tmpFile alice "alice_app_files" + bobFiles = tmpFile bob "bob_app_files" + cathFiles = tmpFile cath "cath_app_files" + setRelativePaths alice aliceFiles (tmpFile alice "alice_xftp") + copyFile "./tests/fixtures/test.jpg" (aliceFiles "test.jpg") + copyFile "./tests/fixtures/test.pdf" (aliceFiles "test.pdf") + copyFile "./tests/fixtures/test_1MB.pdf" (aliceFiles "test_1MB.pdf") + copyFile "./tests/fixtures/logo.jpg" (aliceFiles "logo.jpg") + setRelativePaths bob bobFiles (tmpFile bob "bob_xftp") + setRelativePaths cath cathFiles (tmpFile cath "cath_xftp") connectUsers alice bob connectUsers bob cath @@ -876,12 +880,12 @@ testMultiForwardFiles = ] bob <## "completed receiving file 2 (test.pdf) from alice" - src1 <- B.readFile "./tests/tmp/alice_app_files/test.jpg" - dest1 <- B.readFile "./tests/tmp/bob_app_files/test.jpg" + src1 <- B.readFile (aliceFiles "test.jpg") + dest1 <- B.readFile (bobFiles "test.jpg") dest1 `shouldBe` src1 - src2 <- B.readFile "./tests/tmp/alice_app_files/test.pdf" - dest2 <- B.readFile "./tests/tmp/bob_app_files/test.pdf" + src2 <- B.readFile (aliceFiles "test.pdf") + dest2 <- B.readFile (bobFiles "test.pdf") dest2 `shouldBe` src2 -- forward file @@ -955,14 +959,14 @@ testMultiForwardFiles = ] cath <## "completed receiving file 2 (test_1.pdf) from bob" - src1B <- B.readFile ("./tests/tmp/bob_app_files/" <> jpgFileName) + src1B <- B.readFile (bobFiles jpgFileName) src1B `shouldBe` dest1 - dest1C <- B.readFile ("./tests/tmp/cath_app_files/" <> jpgFileName) + dest1C <- B.readFile (cathFiles jpgFileName) dest1C `shouldBe` src1B - src2B <- B.readFile "./tests/tmp/bob_app_files/test_1.pdf" + src2B <- B.readFile (bobFiles "test_1.pdf") src2B `shouldBe` dest2 - dest2C <- B.readFile "./tests/tmp/cath_app_files/test_1.pdf" + dest2C <- B.readFile (cathFiles "test_1.pdf") dest2C `shouldBe` src2B bob ##> "/fr 3" @@ -986,19 +990,19 @@ testMultiForwardFiles = bob ##> ("/_forward plan @2 " <> msgIds) bob <## "all messages can be forwarded" - removeFile "./tests/tmp/bob_app_files/test_1MB.pdf" + removeFile (bobFiles "test_1MB.pdf") bob ##> ("/_forward plan @2 " <> msgIds) bob <## "1 file(s) are missing" bob <## "all messages can be forwarded" - removeFile "./tests/tmp/bob_app_files/test.pdf" + removeFile (bobFiles "test.pdf") bob ##> ("/_forward plan @2 " <> msgIds) bob <## "2 file(s) are missing" bob <## "5 message(s) out of 6 can be forwarded" -- deleting original file doesn't delete forwarded file - checkActionDeletesFile "./tests/tmp/bob_app_files/test.jpg" $ do + checkActionDeletesFile (bobFiles "test.jpg") $ do bob ##> "/clear alice" bob <## "alice: all messages are removed locally ONLY" - fwdFileExists <- doesFileExist ("./tests/tmp/bob_app_files/" <> jpgFileName) + fwdFileExists <- doesFileExist (bobFiles jpgFileName) fwdFileExists `shouldBe` True diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index e17de3a766..a649ceb808 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -2002,7 +2002,7 @@ testGroupDelayedModerationFullDelete ps = do testDeleteMemberWithMessages :: HasCallStack => TestParams -> IO () testDeleteMemberWithMessages = testChat3 aliceProfile bobProfile cathProfile $ - \alice bob cath -> withXFTPServer $ do + \alice bob cath -> withXFTPServer alice $ do createGroup3' "team" alice (bob, GRMember) (cath, GRMember) threadDelay 750000 alice ##> "/set delete #team on" @@ -2021,10 +2021,13 @@ testDeleteMemberWithMessages = ] threadDelay 750000 - alice #$> ("/_files_folder ./tests/tmp/alice_app_files", id, "ok") - bob #$> ("/_files_folder ./tests/tmp/bob_app_files", id, "ok") - cath #$> ("/_files_folder ./tests/tmp/cath_app_files", id, "ok") - copyFile "./tests/fixtures/test.jpg" "./tests/tmp/bob_app_files/test.jpg" + let aliceFiles = tmpFile alice "alice_app_files" + bobFiles = tmpFile bob "bob_app_files" + cathFiles = tmpFile cath "cath_app_files" + alice #$> ("/_files_folder " <> aliceFiles, id, "ok") + bob #$> ("/_files_folder " <> bobFiles, id, "ok") + cath #$> ("/_files_folder " <> cathFiles, id, "ok") + copyFile "./tests/fixtures/test.jpg" (bobFiles "test.jpg") bob ##> "/_send #1 json [{\"filePath\": \"test.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"file from bob\"}}]" bob <# "#team file from bob" @@ -2056,9 +2059,9 @@ testDeleteMemberWithMessages = cath <## "completed receiving file 1 (test.jpg) from bob" src <- B.readFile "./tests/fixtures/test.jpg" - B.readFile "./tests/tmp/alice_app_files/test.jpg" `shouldReturn` src - B.readFile "./tests/tmp/bob_app_files/test.jpg" `shouldReturn` src - B.readFile "./tests/tmp/cath_app_files/test.jpg" `shouldReturn` src + B.readFile (aliceFiles "test.jpg") `shouldReturn` src + B.readFile (bobFiles "test.jpg") `shouldReturn` src + B.readFile (cathFiles "test.jpg") `shouldReturn` src threadDelay 1000000 alice ##> "/rm #team bob messages=on" @@ -2067,9 +2070,9 @@ testDeleteMemberWithMessages = bob <## "use /d #team to delete the group" cath <## "#team: alice removed bob from the group with all messages (signed)" - doesFileExist "./tests/tmp/alice_app_files/test.jpg" `shouldReturn` False - doesFileExist "./tests/tmp/bob_app_files/test.jpg" `shouldReturn` False - doesFileExist "./tests/tmp/cath_app_files/test.jpg" `shouldReturn` False + doesFileExist (aliceFiles "test.jpg") `shouldReturn` False + doesFileExist (bobFiles "test.jpg") `shouldReturn` False + doesFileExist (cathFiles "test.jpg") `shouldReturn` False -- Under fullDelete, bob's items are physically deleted on all sides; only the system event remains. alice #$> ("/_get chat #1 count=1", chat, [(1, "removed bob (signed)")]) @@ -2265,8 +2268,8 @@ testSharedMessageBody ps' = ps = ps' {printOutput = True} :: TestParams tmp = tmpPath ps serverCfg' = - smpServerCfg - { transports = [("7003", transport @TLS, False)], + (smpServerCfg ps) + { transports = [(smpTestPort2 ps, transport @TLS, False)], serverStoreCfg = persistentServerStoreCfg tmp } opts' = @@ -2319,8 +2322,8 @@ testSharedBatchBody ps = where tmp = tmpPath ps serverCfg' = - smpServerCfg - { transports = [("7003", transport @TLS, False)], + (smpServerCfg ps) + { transports = [(smpTestPort2 ps, transport @TLS, False)], serverStoreCfg = persistentServerStoreCfg tmp } opts' = @@ -2524,8 +2527,8 @@ testSharedBatchBodyMixed ps = oldCfg = testCfg {chatVRange = mkVersionRange (VersionChat 9) (VersionChat 17)} tmp = tmpPath ps serverCfg' = - smpServerCfg - { transports = [("7003", transport @TLS, False)], + (smpServerCfg ps) + { transports = [(smpTestPort2 ps, transport @TLS, False)], serverStoreCfg = persistentServerStoreCfg tmp } opts' = @@ -5614,7 +5617,7 @@ testGroupMsgForwardDeletion = testGroupMsgForwardFile :: HasCallStack => TestParams -> IO () testGroupMsgForwardFile = testChat3 aliceProfile bobProfile cathProfile $ - \alice bob cath -> withXFTPServer $ do + \alice bob cath -> withXFTPServer alice $ do createGroup3 "team" alice bob cath setupGroupForwarding alice bob cath @@ -5629,12 +5632,12 @@ testGroupMsgForwardFile = cath <# "#team bob> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]" cath <## "use /fr 1 [/ | ] to receive it [>>]" ] - cath ##> "/fr 1 ./tests/tmp" - cath <## "saving file 1 from bob to ./tests/tmp/test.jpg" + cath ##> ("/fr 1 " <> tmpDir cath) + cath <## ("saving file 1 from bob to " <> tmpFile cath "test.jpg") cath <## "started receiving file 1 (test.jpg) from bob" cath <## "completed receiving file 1 (test.jpg) from bob" src <- B.readFile "./tests/fixtures/test.jpg" - dest <- B.readFile "./tests/tmp/test.jpg" + dest <- B.readFile (tmpFile cath "test.jpg") dest `shouldBe` src testGroupMsgForwardChangeRole :: HasCallStack => TestParams -> IO () @@ -5986,7 +5989,7 @@ testGroupHistoryPreferenceOff = testGroupHistoryHostFile :: HasCallStack => TestParams -> IO () testGroupHistoryHostFile = testChat3 aliceProfile bobProfile cathProfile $ - \alice bob cath -> withXFTPServer $ do + \alice bob cath -> withXFTPServer alice $ do createGroup2 "team" alice bob alice #> "/f #team ./tests/fixtures/test.jpg" @@ -6012,20 +6015,20 @@ testGroupHistoryHostFile = bob <## "#team: new member cath is connected" ] - cath ##> "/fr 1 ./tests/tmp" + cath ##> ("/fr 1 " <> tmpDir cath) cath - <### [ "saving file 1 from alice to ./tests/tmp/test.jpg", + <### [ ConsoleString $ "saving file 1 from alice to " <> tmpFile cath "test.jpg", "started receiving file 1 (test.jpg) from alice" ] cath <## "completed receiving file 1 (test.jpg) from alice" src <- B.readFile "./tests/fixtures/test.jpg" - dest <- B.readFile "./tests/tmp/test.jpg" + dest <- B.readFile (tmpFile cath "test.jpg") dest `shouldBe` src testGroupHistoryMemberFile :: HasCallStack => TestParams -> IO () testGroupHistoryMemberFile = testChat3 aliceProfile bobProfile cathProfile $ - \alice bob cath -> withXFTPServer $ do + \alice bob cath -> withXFTPServer alice $ do createGroup2 "team" alice bob bob #> "/f #team ./tests/fixtures/test.jpg" @@ -6051,27 +6054,28 @@ testGroupHistoryMemberFile = bob <## "#team: new member cath is connected" ] - cath ##> "/fr 1 ./tests/tmp" + cath ##> ("/fr 1 " <> tmpDir cath) cath - <### [ "saving file 1 from bob to ./tests/tmp/test.jpg", + <### [ ConsoleString $ "saving file 1 from bob to " <> tmpFile cath "test.jpg", "started receiving file 1 (test.jpg) from bob" ] cath <## "completed receiving file 1 (test.jpg) from bob" src <- B.readFile "./tests/fixtures/test.jpg" - dest <- B.readFile "./tests/tmp/test.jpg" + dest <- B.readFile (tmpFile cath "test.jpg") dest `shouldBe` src testGroupHistoryLargeFile :: HasCallStack => TestParams -> IO () testGroupHistoryLargeFile = testChatCfg3 cfg aliceProfile bobProfile cathProfile $ - \alice bob cath -> withXFTPServer $ do - xftpCLI ["rand", "./tests/tmp/testfile", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile"] + \alice bob cath -> withXFTPServer alice $ do + let testfile = tmpFile bob "testfile" + xftpCLI ["rand", testfile, "17mb"] `shouldReturn` ["File created: " <> testfile] createGroup2 "team" alice bob - bob ##> "/_send #1 json [{\"filePath\": \"./tests/tmp/testfile\", \"msgContent\": {\"text\":\"hello\",\"type\":\"file\"}}]" + bob ##> ("/_send #1 json [{\"filePath\": \"" <> testfile <> "\", \"msgContent\": {\"text\":\"hello\",\"type\":\"file\"}}]") bob <# "#team hello" - bob <# "/f #team ./tests/tmp/testfile" + bob <# ("/f #team " <> testfile) bob <## "use /fc 1 to cancel sending" bob <## "completed uploading file 1 (testfile) for #team" @@ -6080,14 +6084,14 @@ testGroupHistoryLargeFile = alice <## "use /fr 1 [/ | ] to receive it" -- admin receiving file does not prevent the new member from receiving it later - alice ##> "/fr 1 ./tests/tmp" + alice ##> ("/fr 1 " <> tmpDir alice) alice - <### [ "saving file 1 from bob to ./tests/tmp/testfile_1", + <### [ ConsoleString $ "saving file 1 from bob to " <> tmpFile alice "testfile_1", "started receiving file 1 (testfile) from bob" ] alice <## "completed receiving file 1 (testfile) from bob" - src <- B.readFile "./tests/tmp/testfile" - destAlice <- B.readFile "./tests/tmp/testfile_1" + src <- B.readFile testfile + destAlice <- B.readFile (tmpFile alice "testfile_1") destAlice `shouldBe` src connectUsers alice cath @@ -6107,14 +6111,14 @@ testGroupHistoryLargeFile = bob <## "#team: new member cath is connected" ] - cath ##> "/fr 1 ./tests/tmp" + cath ##> ("/fr 1 " <> tmpDir cath) cath - <### [ "saving file 1 from bob to ./tests/tmp/testfile_2", + <### [ ConsoleString $ "saving file 1 from bob to " <> tmpFile cath "testfile_2", "started receiving file 1 (testfile) from bob" ] cath <## "completed receiving file 1 (testfile) from bob" - destCath <- B.readFile "./tests/tmp/testfile_2" + destCath <- B.readFile (tmpFile cath "testfile_2") destCath `shouldBe` src where cfg = testCfg {xftpDescrPartSize = 200} @@ -6122,17 +6126,19 @@ testGroupHistoryLargeFile = testGroupHistoryMultipleFiles :: HasCallStack => TestParams -> IO () testGroupHistoryMultipleFiles = testChat3 aliceProfile bobProfile cathProfile $ - \alice bob cath -> withXFTPServer $ do - xftpCLI ["rand", "./tests/tmp/testfile_bob", "2mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_bob"] - xftpCLI ["rand", "./tests/tmp/testfile_alice", "1mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_alice"] + \alice bob cath -> withXFTPServer alice $ do + let testfileBob = tmpFile bob "testfile_bob" + testfileAlice = tmpFile alice "testfile_alice" + xftpCLI ["rand", testfileBob, "2mb"] `shouldReturn` ["File created: " <> testfileBob] + xftpCLI ["rand", testfileAlice, "1mb"] `shouldReturn` ["File created: " <> testfileAlice] createGroup2 "team" alice bob threadDelay 1000000 - bob ##> "/_send #1 json [{\"filePath\": \"./tests/tmp/testfile_bob\", \"msgContent\": {\"text\":\"hi alice\",\"type\":\"file\"}}]" + bob ##> ("/_send #1 json [{\"filePath\": \"" <> testfileBob <> "\", \"msgContent\": {\"text\":\"hi alice\",\"type\":\"file\"}}]") bob <# "#team hi alice" - bob <# "/f #team ./tests/tmp/testfile_bob" + bob <# ("/f #team " <> testfileBob) bob <## "use /fc 1 to cancel sending" bob <## "completed uploading file 1 (testfile_bob) for #team" @@ -6142,9 +6148,9 @@ testGroupHistoryMultipleFiles = threadDelay 1000000 - alice ##> "/_send #1 json [{\"filePath\": \"./tests/tmp/testfile_alice\", \"msgContent\": {\"text\":\"hey bob\",\"type\":\"file\"}}]" + alice ##> ("/_send #1 json [{\"filePath\": \"" <> testfileAlice <> "\", \"msgContent\": {\"text\":\"hey bob\",\"type\":\"file\"}}]") alice <# "#team hey bob" - alice <# "/f #team ./tests/tmp/testfile_alice" + alice <# ("/f #team " <> testfileAlice) alice <## "use /fc 2 to cancel sending" alice <## "completed uploading file 2 (testfile_alice) for #team" @@ -6172,45 +6178,47 @@ testGroupHistoryMultipleFiles = bob <## "#team: new member cath is connected" ] - cath ##> "/fr 1 ./tests/tmp" + cath ##> ("/fr 1 " <> tmpDir cath) cath - <### [ "saving file 1 from bob to ./tests/tmp/testfile_bob_1", + <### [ ConsoleString $ "saving file 1 from bob to " <> tmpFile cath "testfile_bob_1", "started receiving file 1 (testfile_bob) from bob" ] cath <## "completed receiving file 1 (testfile_bob) from bob" - srcBob <- B.readFile "./tests/tmp/testfile_bob" - destBob <- B.readFile "./tests/tmp/testfile_bob_1" + srcBob <- B.readFile testfileBob + destBob <- B.readFile (tmpFile cath "testfile_bob_1") destBob `shouldBe` srcBob - cath ##> "/fr 2 ./tests/tmp" + cath ##> ("/fr 2 " <> tmpDir cath) cath - <### [ "saving file 2 from alice to ./tests/tmp/testfile_alice_1", + <### [ ConsoleString $ "saving file 2 from alice to " <> tmpFile cath "testfile_alice_1", "started receiving file 2 (testfile_alice) from alice" ] cath <## "completed receiving file 2 (testfile_alice) from alice" - srcAlice <- B.readFile "./tests/tmp/testfile_alice" - destAlice <- B.readFile "./tests/tmp/testfile_alice_1" + srcAlice <- B.readFile testfileAlice + destAlice <- B.readFile (tmpFile cath "testfile_alice_1") destAlice `shouldBe` srcAlice cath ##> "/_get chat #1 count=100" r <- chatF <$> getTermLine cath r - `shouldContain` [ ((0, "hi alice"), Just "./tests/tmp/testfile_bob_1"), - ((0, "hey bob"), Just "./tests/tmp/testfile_alice_1") + `shouldContain` [ ((0, "hi alice"), Just $ tmpFile cath "testfile_bob_1"), + ((0, "hey bob"), Just $ tmpFile cath "testfile_alice_1") ] testGroupHistoryFileCancel :: HasCallStack => TestParams -> IO () testGroupHistoryFileCancel = testChat3 aliceProfile bobProfile cathProfile $ - \alice bob cath -> withXFTPServer $ do - xftpCLI ["rand", "./tests/tmp/testfile_bob", "2mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_bob"] - xftpCLI ["rand", "./tests/tmp/testfile_alice", "1mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_alice"] + \alice bob cath -> withXFTPServer alice $ do + let testfileBob = tmpFile bob "testfile_bob" + testfileAlice = tmpFile alice "testfile_alice" + xftpCLI ["rand", testfileBob, "2mb"] `shouldReturn` ["File created: " <> testfileBob] + xftpCLI ["rand", testfileAlice, "1mb"] `shouldReturn` ["File created: " <> testfileAlice] createGroup2 "team" alice bob - bob ##> "/_send #1 json [{\"filePath\": \"./tests/tmp/testfile_bob\", \"msgContent\": {\"text\":\"hi alice\",\"type\":\"file\"}}]" + bob ##> ("/_send #1 json [{\"filePath\": \"" <> testfileBob <> "\", \"msgContent\": {\"text\":\"hi alice\",\"type\":\"file\"}}]") bob <# "#team hi alice" - bob <# "/f #team ./tests/tmp/testfile_bob" + bob <# ("/f #team " <> testfileBob) bob <## "use /fc 1 to cancel sending" bob <## "completed uploading file 1 (testfile_bob) for #team" @@ -6224,9 +6232,9 @@ testGroupHistoryFileCancel = threadDelay 1000000 - alice ##> "/_send #1 json [{\"filePath\": \"./tests/tmp/testfile_alice\", \"msgContent\": {\"text\":\"hey bob\",\"type\":\"file\"}}]" + alice ##> ("/_send #1 json [{\"filePath\": \"" <> testfileAlice <> "\", \"msgContent\": {\"text\":\"hey bob\",\"type\":\"file\"}}]") alice <# "#team hey bob" - alice <# "/f #team ./tests/tmp/testfile_alice" + alice <# ("/f #team " <> testfileAlice) alice <## "use /fc 2 to cancel sending" alice <## "completed uploading file 2 (testfile_alice) for #team" @@ -6257,9 +6265,11 @@ testGroupHistoryFileCancel = testGroupHistoryFileCancelNoText :: HasCallStack => TestParams -> IO () testGroupHistoryFileCancelNoText = testChat3 aliceProfile bobProfile cathProfile $ - \alice bob cath -> withXFTPServer $ do - xftpCLI ["rand", "./tests/tmp/testfile_bob", "2mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_bob"] - xftpCLI ["rand", "./tests/tmp/testfile_alice", "1mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile_alice"] + \alice bob cath -> withXFTPServer alice $ do + let testfileBob = tmpFile bob "testfile_bob" + testfileAlice = tmpFile alice "testfile_alice" + xftpCLI ["rand", testfileBob, "2mb"] `shouldReturn` ["File created: " <> testfileBob] + xftpCLI ["rand", testfileAlice, "1mb"] `shouldReturn` ["File created: " <> testfileAlice] createGroup2 "team" alice bob @@ -6268,7 +6278,7 @@ testGroupHistoryFileCancelNoText = -- bob file - bob #> "/f #team ./tests/tmp/testfile_bob" + bob #> ("/f #team " <> testfileBob) bob <## "use /fc 1 to cancel sending" bob <## "completed uploading file 1 (testfile_bob) for #team" @@ -6281,7 +6291,7 @@ testGroupHistoryFileCancelNoText = -- alice file - alice #> "/f #team ./tests/tmp/testfile_alice" + alice #> ("/f #team " <> testfileAlice) alice <## "use /fc 2 to cancel sending" alice <## "completed uploading file 2 (testfile_alice) for #team" @@ -7641,8 +7651,8 @@ testGroupMemberInactive ps = do alice <# "#team bob> hey" where serverCfg' = - smpServerCfg - { transports = [("7003", transport @TLS, False)], + (smpServerCfg ps) + { transports = [(smpTestPort2 ps, transport @TLS, False)], msgQueueQuota = 2 } fastRetryInterval = defaultReconnectInterval {initialInterval = 50_000} -- same as in agent tests @@ -8295,7 +8305,7 @@ testScopedSupportDontForwardBetweenScopes = testScopedSupportForwardFile :: HasCallStack => TestParams -> IO () testScopedSupportForwardFile = - testChat4 aliceProfile bobProfile cathProfile danProfile $ \alice bob cath dan -> withXFTPServer $ do + testChat4 aliceProfile bobProfile cathProfile danProfile $ \alice bob cath dan -> withXFTPServer alice $ do createGroup4 "team" alice (bob, GRMember) (cath, GRMember) (dan, GRModerator) setupGroupForwarding alice bob dan @@ -8318,9 +8328,9 @@ testScopedSupportForwardFile = bob <## "completed uploading file 1 (test.jpg) for #team" - dan ##> "/fr 1 ./tests/tmp" + dan ##> ("/fr 1 " <> tmpDir dan) dan - <### [ "saving file 1 from bob to ./tests/tmp/test.jpg", + <### [ ConsoleString $ "saving file 1 from bob to " <> tmpFile dan "test.jpg", "started receiving file 1 (test.jpg) from bob" ] dan <## "completed receiving file 1 (test.jpg) from bob" @@ -11949,7 +11959,7 @@ testChannelMessageFile ps = withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> withNewTestChat ps "cath" cathProfile $ \cath -> withNewTestChat ps "dan" danProfile $ \dan -> - withNewTestChat ps "eve" eveProfile $ \eve -> withXFTPServer $ do + withNewTestChat ps "eve" eveProfile $ \eve -> withXFTPServer ps $ do createChannel1Relay "team" alice bob cath dan eve -- the roster arrives as a file before this one; Postgres assigns it a new id and does not -- reuse it on delete (SQLite does), so the received message file is id 2 here, 1 on SQLite. @@ -11986,7 +11996,7 @@ testChannelMessageFile ps = ] where receiveFile cc name fileId src = do - let path = "./tests/tmp/test_" <> name <> ".jpg" + let path = tmpFile cc $ "test_" <> name <> ".jpg" cc ##> ("/fr " <> show fileId <> " " <> path) cc <### [ ConsoleString ("saving file " <> show fileId <> " from #team to " <> path), @@ -12001,7 +12011,7 @@ testChannelMessageFileCancel ps = withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> withNewTestChat ps "cath" cathProfile $ \cath -> withNewTestChat ps "dan" danProfile $ \dan -> - withNewTestChat ps "eve" eveProfile $ \eve -> withXFTPServer $ do + withNewTestChat ps "eve" eveProfile $ \eve -> withXFTPServer ps $ do createChannel1Relay "team" alice bob cath dan eve #if defined(dbPostgres) let rcvFileId = 2 :: Int @@ -12181,7 +12191,7 @@ testChannelOwnerFileTransferAsMember ps = withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> withNewTestChat ps "cath" cathProfile $ \cath -> withNewTestChat ps "dan" danProfile $ \dan -> - withNewTestChat ps "eve" eveProfile $ \eve -> withXFTPServer $ do + withNewTestChat ps "eve" eveProfile $ \eve -> withXFTPServer ps $ do createChannel1Relay "team" alice bob cath dan eve #if defined(dbPostgres) let rcvFileId = 2 :: Int @@ -12217,7 +12227,7 @@ testChannelOwnerFileTransferAsMember ps = ] where receiveFile cc name fileId src = do - let path = "./tests/tmp/test_" <> name <> ".jpg" + let path = tmpFile cc $ "test_" <> name <> ".jpg" cc ##> ("/fr " <> show fileId <> " " <> path) cc <### [ ConsoleString ("saving file " <> show fileId <> " from alice to " <> path), @@ -12232,7 +12242,7 @@ testGroupHistoryFileBadgeProof ps = do let cfg = testCfg {badgePublicKeys = testBadgeKeys pk, fileSizeLimits = FileSizeLimits {noBadge = 100000, supporter = 300000, legend = 400000}} testChatCfg3 cfg aliceProfile bobProfile cathProfile (test sk) ps where - test sk alice bob cath = withXFTPServer $ do + test sk alice bob cath = withXFTPServer ps $ do createGroup2 "team" alice bob addTestBadge alice =<< issueTestBadge sk futureDate @@ -12261,14 +12271,14 @@ testGroupHistoryFileBadgeProof ps = do bob <## "#team: new member cath is connected" ] - cath ##> "/fr 1 ./tests/tmp" + cath ##> ("/fr 1 " <> tmpDir ps) cath - <### [ "saving file 1 from alice to ./tests/tmp/test.pdf", + <### [ ConsoleString $ "saving file 1 from alice to " <> tmpFile ps "test.pdf", "started receiving file 1 (test.pdf) from alice" ] cath <## "completed receiving file 1 (test.pdf) from alice" src <- B.readFile "./tests/fixtures/test.pdf" - dest <- B.readFile "./tests/tmp/test.pdf" + dest <- B.readFile (tmpFile ps "test.pdf") dest `shouldBe` src testGroupHistoryRcvFileBadgeProof :: HasCallStack => TestParams -> IO () @@ -12277,7 +12287,7 @@ testGroupHistoryRcvFileBadgeProof ps = do let cfg = testCfg {badgePublicKeys = testBadgeKeys pk, fileSizeLimits = FileSizeLimits {noBadge = 100000, supporter = 300000, legend = 400000}} testChatCfg3 cfg aliceProfile bobProfile cathProfile (test sk) ps where - test sk alice bob cath = withXFTPServer $ do + test sk alice bob cath = withXFTPServer ps $ do createGroup2 "team" alice bob addTestBadge bob =<< issueTestBadge sk futureDate @@ -12285,11 +12295,11 @@ testGroupHistoryRcvFileBadgeProof ps = do bob <## "use /fc 1 to cancel sending" alice <# "#team bob> sends file test.pdf (266.0 KiB / 272376 bytes)" alice <## "use /fr 1 [/ | ] to receive it" - alice ##> "/fr 1 ./tests/tmp" + alice ##> ("/fr 1 " <> tmpDir ps) concurrentlyN_ [ bob <## "completed uploading file 1 (test.pdf) for #team", alice - <### [ "saving file 1 from bob to ./tests/tmp/test.pdf", + <### [ ConsoleString $ "saving file 1 from bob to " <> tmpFile ps "test.pdf", "started receiving file 1 (test.pdf) from bob" ] ] @@ -12314,14 +12324,14 @@ testGroupHistoryRcvFileBadgeProof ps = do bob <## "#team: new member cath is connected" ] - cath ##> "/fr 1 ./tests/tmp" + cath ##> ("/fr 1 " <> tmpDir ps) cath - <### [ "saving file 1 from bob to ./tests/tmp/test_1.pdf", + <### [ ConsoleString $ "saving file 1 from bob to " <> tmpFile ps "test_1.pdf", "started receiving file 1 (test.pdf) from bob" ] cath <## "completed receiving file 1 (test.pdf) from bob" src <- B.readFile "./tests/fixtures/test.pdf" - dest <- B.readFile "./tests/tmp/test_1.pdf" + dest <- B.readFile (tmpFile ps "test_1.pdf") dest `shouldBe` src testChannelFileBadgeProof :: HasCallStack => TestParams -> IO () @@ -12332,7 +12342,7 @@ testChannelFileBadgeProof ps = do withNewTestChatCfgOpts ps cfg relayTestOpts "bob" bobProfile $ \bob -> withNewTestChatCfg ps cfg "cath" cathProfile $ \cath -> withNewTestChatCfg ps cfg "dan" danProfile $ \dan -> - withNewTestChatCfg ps cfg "eve" eveProfile $ \eve -> withXFTPServer $ do + withNewTestChatCfg ps cfg "eve" eveProfile $ \eve -> withXFTPServer ps $ do createChannel1Relay "team" alice bob cath dan eve addTestBadge alice =<< issueTestBadge sk futureDate #if defined(dbPostgres) @@ -12359,7 +12369,7 @@ testChannelFileBadgeProof ps = do ] src <- B.readFile "./tests/fixtures/test.jpg" - let path = "./tests/tmp/test_cath.jpg" + let path = tmpFile ps "test_cath.jpg" cath ##> ("/fr " <> show rcvFileId <> " " <> path) cath <### [ ConsoleString ("saving file " <> show rcvFileId <> " from alice to " <> path), @@ -12385,7 +12395,7 @@ testChannelFileBadgeProof ps = do eve <# "#team> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]" eve <## ("use /fr " <> show (rcvFileId + 1) <> " [/ | ] to receive it [>>]") ] - let path2 = "./tests/tmp/test_cath_2.jpg" + let path2 = tmpFile ps "test_cath_2.jpg" cath ##> ("/fr " <> show (rcvFileId + 1) <> " " <> path2) cath <### [ ConsoleString ("saving file " <> show (rcvFileId + 1) <> " from #team to " <> path2), @@ -12400,7 +12410,7 @@ testChannelOwnerFileCancelAsMember ps = withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> withNewTestChat ps "cath" cathProfile $ \cath -> withNewTestChat ps "dan" danProfile $ \dan -> - withNewTestChat ps "eve" eveProfile $ \eve -> withXFTPServer $ do + withNewTestChat ps "eve" eveProfile $ \eve -> withXFTPServer ps $ do createChannel1Relay "team" alice bob cath dan eve #if defined(dbPostgres) let rcvFileId = 2 :: Int @@ -12744,8 +12754,9 @@ testChannelSignedFile ps = withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> withNewTestChat ps "cath" cathProfile $ \cath -> withNewTestChat ps "dan" danProfile $ \dan -> - withNewTestChat ps "eve" eveProfile $ \eve -> withXFTPServer $ do - xftpCLI ["rand", "./tests/tmp/testfile", "1mb"] `shouldReturn` ["File created: ./tests/tmp/testfile"] + withNewTestChat ps "eve" eveProfile $ \eve -> withXFTPServer ps $ do + let testfile = tmpFile ps "testfile" + xftpCLI ["rand", testfile, "1mb"] `shouldReturn` ["File created: " <> testfile] createChannel1Relay "team" alice bob cath dan eve promoteChannelMember "team" alice bob cath [dan, eve] -- roster serves arrive as files that Postgres deletes without reusing the id (SQLite reuses @@ -12775,9 +12786,9 @@ testChannelSignedFile ps = ] -- cath sends a signed file - cath ##> "/_send #1 sign=on json [{\"filePath\": \"./tests/tmp/testfile\", \"msgContent\": {\"text\":\"signed file\",\"type\":\"file\"}}]" + cath ##> ("/_send #1 sign=on json [{\"filePath\": \"" <> testfile <> "\", \"msgContent\": {\"text\":\"signed file\",\"type\":\"file\"}}]") cath <# "#team signed file (signed)" - cath <# "/f #team ./tests/tmp/testfile" + cath <# ("/f #team " <> testfile) cath <## ("use /fc " <> show fileId <> " to cancel sending") cath <## ("completed uploading file " <> show fileId <> " (testfile) for #team") @@ -12798,14 +12809,14 @@ testChannelSignedFile ps = ] -- dan downloads: the signed digest is verified and the file completes - dan ##> ("/fr " <> show fileId <> " ./tests/tmp") + dan ##> ("/fr " <> show fileId <> " " <> tmpDir ps) dan - <### [ ConsoleString ("saving file " <> show fileId <> " from cath to ./tests/tmp/testfile_1"), + <### [ ConsoleString ("saving file " <> show fileId <> " from cath to " <> tmpFile ps "testfile_1"), ConsoleString ("started receiving file " <> show fileId <> " (testfile) from cath") ] dan <## ("completed receiving file " <> show fileId <> " (testfile) from cath") - src <- B.readFile "./tests/tmp/testfile" - destDan <- B.readFile "./tests/tmp/testfile_1" + src <- B.readFile testfile + destDan <- B.readFile (tmpFile ps "testfile_1") destDan `shouldBe` src -- the signed digest was carried to dan and stored, so verification ran (not skipped) and passed digestCount <- withCCTransaction dan $ \db -> diff --git a/tests/ChatTests/Local.hs b/tests/ChatTests/Local.hs index 6760901c1d..ca1ccfd50d 100644 --- a/tests/ChatTests/Local.hs +++ b/tests/ChatTests/Local.hs @@ -121,7 +121,7 @@ testFiles :: TestParams -> IO () testFiles ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do -- setup createCCNoteFolder alice - let files = "./tests/tmp/app_files" + let files = tmpFile ps "app_files" alice ##> ("/_files_folder " <> files) alice <## "ok" @@ -170,10 +170,10 @@ testFiles ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do testOtherFiles :: TestParams -> IO () testOtherFiles = - testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do + testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> withXFTPServer alice $ do connectUsers alice bob createCCNoteFolder bob - bob ##> "/_files_folder ./tests/tmp/" + bob ##> ("/_files_folder " <> tmpDir bob) bob <## "ok" alice #> "/f @bob ./tests/fixtures/test.jpg" @@ -197,7 +197,7 @@ testOtherFiles = bob ##> "/tail *" bob ##> "/fs 1" bob <## "receiving file 1 (test.jpg) complete, path: test.jpg" - doesFileExist "./tests/tmp/test.jpg" `shouldReturn` True + doesFileExist (tmpFile bob "test.jpg") `shouldReturn` True where cfg = testCfg {inlineFiles = defaultInlineFilesConfig {offerChunks = 100, sendChunks = 100, receiveChunks = 100}} @@ -212,9 +212,10 @@ testCreateMulti ps = withNewTestChat ps "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" - copyFile "./tests/fixtures/test.pdf" "./tests/tmp/alice_app_files/test.pdf" + let files = tmpFile ps "alice_app_files" + alice #$> ("/_files_folder " <> files, id, "ok") + copyFile "./tests/fixtures/test.jpg" (files "test.jpg") + copyFile "./tests/fixtures/test.pdf" (files "test.pdf") let cm1 = "{\"msgContent\": {\"type\": \"text\", \"text\": \"message without file\"}}" cm2 = "{\"filePath\": \"test.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"sending file 1\"}}" @@ -227,8 +228,8 @@ testCreateMultiFiles ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do alice <# "* sending file 2" alice <# "* file 2 (test.pdf)" - doesFileExist "./tests/tmp/alice_app_files/test.jpg" `shouldReturn` True - doesFileExist "./tests/tmp/alice_app_files/test.pdf" `shouldReturn` True + doesFileExist (files "test.jpg") `shouldReturn` True + doesFileExist (files "test.pdf") `shouldReturn` True alice ##> "/_get chat *1 count=3" r <- chatF <$> getTermLine alice diff --git a/tests/ChatTests/Names.hs b/tests/ChatTests/Names.hs index 46b62801fe..190949d09c 100644 --- a/tests/ChatTests/Names.hs +++ b/tests/ChatTests/Names.hs @@ -28,7 +28,7 @@ chatNamesTests = do it "connect by name resolving to business (primary) and channel" testConnectByNameBusinessAndChannel testConnectByName :: HasCallStack => TestParams -> IO () -testConnectByName ps = withSmpServerAndNames $ \reg -> +testConnectByName ps = withSmpServerAndNames ps $ \reg -> testChat2 aliceProfile bobProfile (test reg) ps where aliceName = SimplexNameInfo NTContact (SimplexDomain TLDSimplex "alice" []) @@ -63,7 +63,7 @@ testConnectByName ps = withSmpServerAndNames $ \reg -> pure () testConnectByNameNotClaimed :: HasCallStack => TestParams -> IO () -testConnectByNameNotClaimed ps = withSmpServerAndNames $ \reg -> +testConnectByNameNotClaimed ps = withSmpServerAndNames ps $ \reg -> testChat2 aliceProfile bobProfile (test reg) ps where aliceName = SimplexNameInfo NTContact (SimplexDomain TLDSimplex "alice" []) @@ -76,7 +76,7 @@ testConnectByNameNotClaimed ps = withSmpServerAndNames $ \reg -> bob <## "SimpleX name alice.simplex is not included in the connection link's profile" testConnectByNameKnownContactNotClaimed :: HasCallStack => TestParams -> IO () -testConnectByNameKnownContactNotClaimed ps = withSmpServerAndNames $ \reg -> +testConnectByNameKnownContactNotClaimed ps = withSmpServerAndNames ps $ \reg -> testChat2 aliceProfile bobProfile (test reg) ps where aliceName = SimplexNameInfo NTContact (SimplexDomain TLDSimplex "alice" []) @@ -99,7 +99,7 @@ testConnectByNameKnownContactNotClaimed ps = withSmpServerAndNames $ \reg -> bob <## "SimpleX name alice.simplex is not included in the connection link's profile" testConnectByNameNotFound :: HasCallStack => TestParams -> IO () -testConnectByNameNotFound ps = withSmpServerAndNames $ \_reg -> +testConnectByNameNotFound ps = withSmpServerAndNames ps $ \_reg -> testChat2 aliceProfile bobProfile test ps where test _alice bob = do @@ -108,7 +108,7 @@ testConnectByNameNotFound ps = withSmpServerAndNames $ \_reg -> bob .<## "smpErr = NAME {nameErr = NOT_FOUND}}" testSetNameNotOwnAddress :: HasCallStack => TestParams -> IO () -testSetNameNotOwnAddress ps = withSmpServerAndNames $ \reg -> +testSetNameNotOwnAddress ps = withSmpServerAndNames ps $ \reg -> testChat2 aliceProfile bobProfile (test reg) ps where aliceName = SimplexNameInfo NTContact (SimplexDomain TLDSimplex "alice" []) @@ -124,7 +124,7 @@ testSetNameNotOwnAddress ps = withSmpServerAndNames $ \reg -> -- a self-claimed name is never auto-verified from link data: the claim is not proof of ownership testChannelDomainLinkJoinUnverified :: HasCallStack => TestParams -> IO () -testChannelDomainLinkJoinUnverified ps = withSmpServerAndNames $ \reg -> +testChannelDomainLinkJoinUnverified ps = withSmpServerAndNames ps $ \reg -> withNewTestChat ps "alice" aliceProfile $ \alice -> withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath -> withNewTestChat ps "bob" bobProfile $ \bob -> do @@ -144,7 +144,7 @@ testChannelDomainLinkJoinUnverified ps = withSmpServerAndNames $ \reg -> teamName = SimplexNameInfo NTPublicGroup (SimplexDomain TLDSimplex "team" []) testChannelDomainVerify :: HasCallStack => TestParams -> IO () -testChannelDomainVerify ps = withSmpServerAndNames $ \reg -> +testChannelDomainVerify ps = withSmpServerAndNames ps $ \reg -> withNewTestChat ps "alice" aliceProfile $ \alice -> withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath -> withNewTestChat ps "bob" bobProfile $ \bob -> do @@ -174,7 +174,7 @@ testChannelDomainVerify ps = withSmpServerAndNames $ \reg -> teamName = SimplexNameInfo NTPublicGroup (SimplexDomain TLDSimplex "team" []) testConnectByChannelName :: HasCallStack => TestParams -> IO () -testConnectByChannelName ps = withSmpServerAndNames $ \reg -> +testConnectByChannelName ps = withSmpServerAndNames ps $ \reg -> withNewTestChat ps "alice" aliceProfile $ \alice -> withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath -> withNewTestChat ps "bob" bobProfile $ \bob -> do @@ -208,7 +208,7 @@ testConnectByChannelName ps = withSmpServerAndNames $ \reg -> -- first and succeeds (bob has joined #team), so it is the primary (planSimplexName); otherSimplexName -- is the direct contact @team.simplex, shown as "You can also connect to @team.simplex in direct chat". testConnectByNameChannelAndContact :: HasCallStack => TestParams -> IO () -testConnectByNameChannelAndContact ps = withSmpServerAndNames $ \reg -> +testConnectByNameChannelAndContact ps = withSmpServerAndNames ps $ \reg -> withNewTestChat ps "alice" aliceProfile $ \alice -> withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath -> withNewTestChat ps "bob" bobProfile $ \bob -> do @@ -247,7 +247,7 @@ testConnectByNameChannelAndContact ps = withSmpServerAndNames $ \reg -> -- channel #acme, shown as "You can also join channel #acme". The channel link is a real, fetchable -- #acme channel, so the failure is the faithful "channel does not claim this domain" case, not a broken link. testConnectByNameContactAndChannel :: HasCallStack => TestParams -> IO () -testConnectByNameContactAndChannel ps = withSmpServerAndNames $ \reg -> +testConnectByNameContactAndChannel ps = withSmpServerAndNames ps $ \reg -> withNewTestChat ps "alice" aliceProfile $ \alice -> withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath -> withNewTestChat ps "bob" bobProfile $ \bob -> do @@ -266,7 +266,7 @@ testConnectByNameContactAndChannel ps = withSmpServerAndNames $ \reg -> acmeName = SimplexNameInfo NTContact (SimplexDomain TLDSimplex "acme" []) testConnectByNameBusinessAndChannel :: HasCallStack => TestParams -> IO () -testConnectByNameBusinessAndChannel ps = withSmpServerAndNames $ \reg -> +testConnectByNameBusinessAndChannel ps = withSmpServerAndNames ps $ \reg -> withNewTestChat ps "alice" aliceProfile $ \alice -> withNewTestChatOpts ps relayTestOpts "cath" cathProfile $ \cath -> withNewTestChat ps "bob" bobProfile $ \bob -> do diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index 743bd5be52..f91c31ac0e 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -737,26 +737,26 @@ testCreateAddressOnServer :: HasCallStack => TestParams -> IO () testCreateAddressOnServer ps = testChat aliceProfile test ps where tmp = tmpPath ps - -- second SMP server, distinct from alice's configured server (localhost:7001) - altServer = "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7003" + -- second SMP server, distinct from alice's configured server + altServer = smpServer2Str ps altServerCfg = - smpServerCfg - { transports = [("7003", transport @TLS, False)], + (smpServerCfg ps) + { transports = [(smpTestPort2 ps, transport @TLS, False)], serverStoreCfg = persistentServerStoreCfg tmp } test alice = do withSmpServer' altServerCfg $ do - -- without a server the address is created on the configured server (7001) + -- without a server the address is created on the configured server alice ##> "/_address 1" (_, defaultLink) <- getContactLinks alice True - defaultLink `shouldContain` "localhost%3A7001" -- server is URL-encoded in the link + defaultLink `shouldContain` ("localhost%3A" <> smpTestPort ps) -- server is URL-encoded in the link alice ##> "/_delete_address 1" alice <## "Your chat address is deleted - accepted contacts will remain connected." alice <## "To create a new chat address use /ad" - -- with a server the address is pinned to the requested server (7003) + -- with a server the address is pinned to the requested server alice ##> ("/_address 1 " <> altServer) (_, pinnedLink) <- getContactLinks alice True - pinnedLink `shouldContain` "localhost%3A7003" + pinnedLink `shouldContain` ("localhost%3A" <> smpTestPort2 ps) alice <## "disconnected 1 connections on server localhost" testRetryConnectingViaContactLink :: HasCallStack => TestParams -> IO () @@ -800,8 +800,8 @@ testRetryConnectingViaContactLink ps = testChatCfgOpts2 cfg' opts' aliceProfile alice <## "disconnected 2 connections on server localhost" bob <## "disconnected 1 connections on server localhost" serverCfg' = - smpServerCfg - { transports = [("7003", transport @TLS, False)], + (smpServerCfg ps) + { transports = [(smpTestPort2 ps, transport @TLS, False)], msgQueueQuota = 2, serverStoreCfg = persistentServerStoreCfg tmp } @@ -2467,12 +2467,12 @@ testChangePCCUserDiffSrv ps = do alice ##> "/smp" alice <## "Your servers" alice <## " SMP servers" - alice <## " smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001" - alice #$> ("/smp smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@127.0.0.1:7003", id, "ok") + alice <## (" " <> smpServerStr ps) + alice #$> ("/smp " <> altServer, id, "ok") alice ##> "/smp" alice <## "Your servers" alice <## " SMP servers" - alice <## " smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@127.0.0.1:7003" + alice <## (" " <> altServer) alice ##> "/user alice" showActiveUser alice "alice (Alice)" -- Change connection to newly created user and use the newly created connection @@ -2494,9 +2494,10 @@ testChangePCCUserDiffSrv ps = do (bob <## "alisa: contact is connected") alice <##> bob where + altServer = "smp://" <> testServerKeyHash <> ":server_password@127.0.0.1:" <> smpTestPort2 ps serverCfg' = - smpServerCfg - { transports = [("7003", transport @TLS, False), ("7002", transport @TLS, False)], + (smpServerCfg ps) + { transports = [(smpTestPort2 ps, transport @TLS, False), (xftpTestPort ps, transport @TLS, False)], msgQueueQuota = 2 } @@ -2534,13 +2535,13 @@ testSetGroupAlias = testChat2 aliceProfile bobProfile $ testSetContactPrefs :: HasCallStack => TestParams -> IO () testSetContactPrefs = testChat2 aliceProfile bobProfile $ - \alice bob -> withXFTPServer $ do - alice #$> ("/_files_folder ./tests/tmp/alice", id, "ok") - bob #$> ("/_files_folder ./tests/tmp/bob", id, "ok") - createDirectoryIfMissing True "./tests/tmp/alice" - createDirectoryIfMissing True "./tests/tmp/bob" - copyFile "./tests/fixtures/test.txt" "./tests/tmp/alice/test.txt" - copyFile "./tests/fixtures/test.txt" "./tests/tmp/bob/test.txt" + \alice bob -> withXFTPServer alice $ do + alice #$> ("/_files_folder " <> tmpFile alice "alice", id, "ok") + bob #$> ("/_files_folder " <> tmpFile bob "bob", id, "ok") + createDirectoryIfMissing True $ tmpFile alice "alice" + createDirectoryIfMissing True $ tmpFile bob "bob" + copyFile "./tests/fixtures/test.txt" $ tmpFile alice "alice/test.txt" + copyFile "./tests/fixtures/test.txt" $ tmpFile bob "bob/test.txt" bob ##> "/_profile 1 {\"displayName\": \"bob\", \"fullName\": \"\", \"shortDescr\": \"Bob\", \"preferences\": {\"voice\": {\"allow\": \"no\"}, \"receipts\": {\"allow\": \"yes\", \"activated\": true}}}" bob <## "profile image removed" bob <## "updated preferences:" @@ -3010,13 +3011,13 @@ testGroupPrefsDirectForRole = testChat4 aliceProfile bobProfile cathProfile danP testGroupPrefsFilesForRole :: HasCallStack => TestParams -> IO () testGroupPrefsFilesForRole = testChat3 aliceProfile bobProfile cathProfile $ - \alice bob cath -> withXFTPServer $ do - alice #$> ("/_files_folder ./tests/tmp/alice", id, "ok") - bob #$> ("/_files_folder ./tests/tmp/bob", id, "ok") - createDirectoryIfMissing True "./tests/tmp/alice" - createDirectoryIfMissing True "./tests/tmp/bob" - copyFile "./tests/fixtures/test.txt" "./tests/tmp/alice/test1.txt" - copyFile "./tests/fixtures/test.txt" "./tests/tmp/bob/test2.txt" + \alice bob cath -> withXFTPServer alice $ do + alice #$> ("/_files_folder " <> tmpFile alice "alice", id, "ok") + bob #$> ("/_files_folder " <> tmpFile bob "bob", id, "ok") + createDirectoryIfMissing True $ tmpFile alice "alice" + createDirectoryIfMissing True $ tmpFile bob "bob" + copyFile "./tests/fixtures/test.txt" $ tmpFile alice "alice/test1.txt" + copyFile "./tests/fixtures/test.txt" $ tmpFile bob "bob/test2.txt" createGroup3 "team" alice bob cath threadDelay 1000000 alice ##> "/set files #team on owner" @@ -3045,7 +3046,7 @@ testGroupPrefsFilesForRole = testChat3 aliceProfile bobProfile cathProfile $ testGroupPrefsSimplexLinksForRole :: HasCallStack => TestParams -> IO () testGroupPrefsSimplexLinksForRole = testChat3 aliceProfile bobProfile cathProfile $ - \alice bob cath -> withXFTPServer $ do + \alice bob cath -> withXFTPServer alice $ do createGroup3 "team" alice bob cath threadDelay 1000000 alice ##> "/set links #team on owner" @@ -3421,8 +3422,8 @@ testShortLinkInvitationConnectRetry ps = testChatOpts2 opts' aliceProfile bobPro bob <## "disconnected 1 connections on server localhost" tmp = tmpPath ps serverCfg' = - smpServerCfg - { transports = [("7003", transport @TLS, False)], + (smpServerCfg ps) + { transports = [(smpTestPort2 ps, transport @TLS, False)], serverStoreCfg = persistentServerStoreCfg tmp } opts' = @@ -3594,8 +3595,8 @@ testShortLinkAddressConnectRetry ps = where tmp = tmpPath ps serverCfg' = - smpServerCfg - { transports = [("7003", transport @TLS, False)], + (smpServerCfg ps) + { transports = [(smpTestPort2 ps, transport @TLS, False)], serverStoreCfg = persistentServerStoreCfg tmp } opts' = @@ -3657,8 +3658,8 @@ testShortLinkAddressConnectRetryIncognito ps = where tmp = tmpPath ps serverCfg' = - smpServerCfg - { transports = [("7003", transport @TLS, False)], + (smpServerCfg ps) + { transports = [(smpTestPort2 ps, transport @TLS, False)], serverStoreCfg = persistentServerStoreCfg tmp } opts' = @@ -3939,8 +3940,8 @@ testShortLinkGroupRetry ps = testChatOpts2 opts' aliceProfile bobProfile test ps bob <## "disconnected 2 connections on server localhost" tmp = tmpPath ps serverCfg' = - smpServerCfg - { transports = [("7003", transport @TLS, False)], + (smpServerCfg ps) + { transports = [(smpTestPort2 ps, transport @TLS, False)], serverStoreCfg = persistentServerStoreCfg tmp } opts' = diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index f16b3ac090..fa853c2df9 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -34,7 +34,6 @@ import Simplex.Chat.Store.Profiles (getUserContactProfiles) import Simplex.Chat.Types import Simplex.Chat.Types.Preferences import Simplex.Chat.Types.Shared -import Simplex.FileTransfer.Client.Main (xftpClientCLI) import Simplex.Messaging.Agent.Client (agentClientStore) import Simplex.Messaging.Agent.Store.AgentStore (maybeFirstRow, withTransaction) import qualified Simplex.Messaging.Agent.Store.DB as DB @@ -43,9 +42,9 @@ import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport, pattern P import Simplex.Messaging.Encoding.String import Simplex.Messaging.Version import System.Directory (doesFileExist) -import System.Environment (lookupEnv, withArgs) -import System.IO.Silently (capture_) +import System.Environment (getExecutablePath, lookupEnv) import System.Info (os) +import System.Process (readProcess) import Test.Hspec hiding (it) import qualified Test.Hspec as Hspec import UnliftIO (timeout) @@ -745,7 +744,7 @@ connectUsers_ cc1 cc2 noShortLink = do (cc1 <## (name2 <> ": contact is connected")) showName :: TestCC -> IO String -showName (TestCC ChatController {currentUser} _ _ _ _ _) = do +showName TestCC {chatController = ChatController {currentUser}} = do Just User {localDisplayName, profile = LocalProfile {fullName, shortDescr}} <- readTVarIO currentUser pure . T.unpack $ viewName localDisplayName <> optionalFullName localDisplayName fullName shortDescr @@ -890,7 +889,9 @@ linkAnotherSchema link | otherwise = error "link starts with neither https://simplex.chat/ nor simplex:/" xftpCLI :: [String] -> IO [String] -xftpCLI params = lines <$> capture_ (withArgs params xftpClientCLI) +xftpCLI params = do + exe <- getExecutablePath + lines <$> readProcess exe ("xftp-cli" : params) "" setRelativePaths :: HasCallStack => TestCC -> String -> String -> IO () setRelativePaths cc filesFolder tempFolder = do diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs index 1bb6ac34eb..9c045d7651 100644 --- a/tests/RemoteTests.hs +++ b/tests/RemoteTests.hs @@ -190,8 +190,8 @@ storedBindingsTest = testRemote $ \compress mobile desktop -> do desktop ##> "/stop remote host new" desktop <## "ok" - desktop ##> ("/start remote host new addr=" <> localAddress <> " iface=\"lo\" port=52230") - desktop <## ("new remote host started on " <> localAddress <> ":52230") + desktop ##> ("/start remote host new addr=" <> localAddress <> " iface=\"lo\" port=" <> remoteTestPort desktop) + desktop <## ("new remote host started on " <> localAddress <> ":" <> remoteTestPort desktop) desktop <##. "other addresses: " desktop <## "Remote session invitation:" inv <- getTermLine desktop @@ -244,17 +244,17 @@ remoteMessageTest = testRemote3 $ \compress mobile desktop bob -> do remoteStoreFileTest :: HasCallStack => ((Bool, Bool), TestParams) -> IO () remoteStoreFileTest = testRemote3 $ \compress mobile desktop bob -> - withXFTPServer $ do - let mobileFiles = "./tests/tmp/mobile_files" + withXFTPServer mobile $ do + let mobileFiles = tmpFile mobile "mobile_files" mobile ##> ("/_files_folder " <> mobileFiles) mobile <## "ok" - let desktopFiles = "./tests/tmp/desktop_files" + let desktopFiles = tmpFile desktop "desktop_files" desktop ##> ("/_files_folder " <> desktopFiles) desktop <## "ok" - let desktopHostFiles = "./tests/tmp/remote_hosts_data" + let desktopHostFiles = tmpFile desktop "remote_hosts_data" desktop ##> ("/remote_hosts_folder " <> desktopHostFiles) desktop <## "ok" - let bobFiles = "./tests/tmp/bob_files" + let bobFiles = tmpFile bob "bob_files" bob ##> ("/_files_folder " <> bobFiles) bob <## "ok" @@ -286,7 +286,7 @@ remoteStoreFileTest = runExceptT (remoteStoreFile rhClient "tests/fixtures/test.pdf" "../x") >>= \case Left (RPEInvalidBody _) -> pure () r -> fail $ "expected RPEInvalidBody, got " <> show r - doesFileExist "./tests/tmp/x" `shouldReturn` False + doesFileExist (tmpFile mobile "x") `shouldReturn` False -- the undrained attachment did not break the session desktop ##> "/store remote file 1 tests/fixtures/test.pdf" desktop <## "file test_3.pdf stored on remote host 1" @@ -384,13 +384,13 @@ remoteStoreFileTest = r `shouldContain` err remoteCLIFileTest :: HasCallStack => ((Bool, Bool), TestParams) -> IO () -remoteCLIFileTest = testRemote3 $ \compress mobile desktop bob -> withXFTPServer $ do - let mobileFiles = "./tests/tmp/mobile_files" +remoteCLIFileTest = testRemote3 $ \compress mobile desktop bob -> withXFTPServer mobile $ do + let mobileFiles = tmpFile mobile "mobile_files" mobile ##> ("/_files_folder " <> mobileFiles) mobile <## "ok" - let bobFiles = "./tests/tmp/bob_files/" + let bobFiles = tmpFile bob "bob_files/" createDirectoryIfMissing True bobFiles - let desktopHostFiles = "./tests/tmp/remote_hosts_data" + let desktopHostFiles = tmpFile desktop "remote_hosts_data" desktop ##> ("/remote_hosts_folder " <> desktopHostFiles) desktop <## "ok" @@ -440,7 +440,7 @@ remoteCLIFileTest = testRemote3 $ \compress mobile desktop bob -> withXFTPServer [ do desktop <## "completed uploading file 2 (test.jpg) for bob", do - bob <## "saving file 2 from alice to ./tests/tmp/bob_files/test.jpg" + bob <## ("saving file 2 from alice to " <> bobFiles <> "test.jpg") bob <## "started receiving file 2 (test.jpg) from alice" bob <## "completed receiving file 2 (test.jpg) from alice" ] diff --git a/tests/SchemaDump.hs b/tests/SchemaDump.hs index 783f6587bf..0f2cddcc1c 100644 --- a/tests/SchemaDump.hs +++ b/tests/SchemaDump.hs @@ -5,7 +5,6 @@ module SchemaDump where -import ChatClient (withTmpFiles) import ChatTests.DBUtils import Control.Concurrent.STM import Control.DeepSeq @@ -62,7 +61,7 @@ schemaDumpTest = do it "verify strict tables" testVerifyStrict testVerifySchemaDump :: IO () -testVerifySchemaDump = withTmpFiles $ do +testVerifySchemaDump = do savedSchema <- ifM (doesFileExist appSchema) (readFile appSchema) (pure "") savedSchema `deepseq` pure () void $ createChatStore (DBOpts testDB chatDBFunctions "" False True TQOff) (MigrationConfig MCError Nothing) @@ -70,7 +69,7 @@ testVerifySchemaDump = withTmpFiles $ do removeFile testDB testVerifyLintFKeyIndexes :: IO () -testVerifyLintFKeyIndexes = withTmpFiles $ do +testVerifyLintFKeyIndexes = do savedLint <- ifM (doesFileExist appLint) (readFile appLint) (pure "") savedLint `deepseq` pure () void $ createChatStore (DBOpts testDB chatDBFunctions "" False True TQOff) (MigrationConfig MCError Nothing) @@ -78,7 +77,7 @@ testVerifyLintFKeyIndexes = withTmpFiles $ do removeFile testDB testSchemaMigrations :: IO () -testSchemaMigrations = withTmpFiles $ do +testSchemaMigrations = do let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) Store.migrations Right st <- createDBStore (DBOpts testDB chatDBFunctions "" False True TQOff) noDownMigrations (MigrationConfig MCError Nothing) mapM_ (testDownMigration st) $ drop (length noDownMigrations) Store.migrations diff --git a/tests/Test.hs b/tests/Test.hs index 84a019c21c..c6a2c0b28d 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TupleSections #-} @@ -21,16 +22,17 @@ import ProtocolTests import OperatorTests import RandomServers import RemoteTests +import Simplex.FileTransfer.Client.Main (xftpClientCLI) +import System.Environment (getArgs, withArgs) import Test.Hspec hiding (it) import UnliftIO.Temporary (withTempDirectory) import ValidNames import ViewTests #if defined(dbPostgres) -import Control.Exception (bracket_) +import Control.Exception (bracket_, finally) import PostgresSchemaDump import Simplex.Chat.Store.Postgres.Migrations (migrations) import Simplex.Messaging.Agent.Store.Postgres.Util (createDBAndUserIfNotExists, dropDatabaseAndUser) -import System.Directory (createDirectoryIfMissing, removePathForcibly) #else import APIDocs import qualified Simplex.Messaging.TMap as TM @@ -40,25 +42,32 @@ import WebRTCTests #endif main :: IO () -main = do +main = + getArgs >>= \case + "xftp-cli" : params -> withArgs params xftpClientCLI + _ -> runTests + +runTests :: IO () +runTests = do setLogLevel LogError #if !defined(dbPostgres) chatQueryStats <- TM.emptyIO agentQueryStats <- TM.emptyIO #endif - withGlobalLogging logCfg . hspec + portBases <- newPortBases + withTestDB . withTmpFiles . withGlobalLogging logCfg . hspec . parallel $ do #if defined(dbPostgres) - createdDropDb . around_ (bracket_ (createDirectoryIfMissing False "tests/tmp") (removePathForcibly "tests/tmp")) $ + sequential $ describe "Postgres schema dump" $ postgresSchemaDumpTest migrations schemaDumpDBOpts "src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql" #else - describe "Schema dump" schemaDumpTest + sequential $ describe "Schema dump" schemaDumpTest #if MIN_VERSION_base(4,18,0) - describe "Bot API docs" apiDocsTest + sequential $ describe "Bot API docs" apiDocsTest #endif around tmpBracket $ describe "WebRTC encryption" webRTCTests #endif @@ -73,13 +82,13 @@ main = do describe "Operators" operatorTests describe "Random servers" randomServersTests #if !defined(dbPostgres) - around (tmpTestBracket chatQueryStats agentQueryStats) $ describe "names tests" chatNamesTests - around (tmpTestBracket chatQueryStats agentQueryStats) $ xdescribe'' "SimpleX Directory names" directoryNameTests + around (tmpTestBracket chatQueryStats agentQueryStats portBases) $ describe "names tests" chatNamesTests + around (tmpTestBracket chatQueryStats agentQueryStats portBases) $ xdescribe'' "SimpleX Directory names" directoryNameTests #endif #if defined(dbPostgres) - createdDropDb . around testBracket + around (testBracket portBases) #else - around (testBracket chatQueryStats agentQueryStats) + around (testBracket chatQueryStats agentQueryStats portBases) #endif $ do #if !defined(dbPostgres) @@ -90,24 +99,29 @@ main = do xdescribe'' "SimpleX Directory service bot" directoryServiceTests describe "Remote session" remoteTests #if !defined(dbPostgres) - xdescribe'' "Save query plans" saveQueryPlans + sequential $ xdescribe'' "Save query plans" saveQueryPlans #endif where #if defined(dbPostgres) - createdDropDb = - before_ (dropDatabaseAndUser testDBConnectInfo >> createDBAndUserIfNotExists testDBConnectInfo) - . after_ (dropDatabaseAndUser testDBConnectInfo) - testBracket test = withSmpServer $ tmpBracket $ \tmpPath -> test TestParams {tmpPath, printOutput = False} + withTestDB = + bracket_ + (dropDatabaseAndUser testDBConnectInfo >> createDBAndUserIfNotExists testDBConnectInfo) + (dropDatabaseAndUser testDBConnectInfo) + testBracket portBases test = + withPortBase portBases $ \portBase -> tmpBracket $ \tmpPath -> do + let ps = TestParams {tmpPath, portBase, printOutput = False} + withSmpServer ps (test ps) `finally` dropTestSchemas ps #else - testBracket chatQueryStats agentQueryStats test = - withSmpServer $ tmpBracket $ \tmpPath -> test TestParams {tmpPath, chatQueryStats, agentQueryStats, printOutput = False} - tmpTestBracket chatQueryStats agentQueryStats test = - tmpBracket $ \tmpPath -> test TestParams {tmpPath, chatQueryStats, agentQueryStats, printOutput = False} + withTestDB = id + testBracket chatQueryStats agentQueryStats portBases test = + tmpTestBracket chatQueryStats agentQueryStats portBases $ \ps -> withSmpServer ps $ test ps + tmpTestBracket chatQueryStats agentQueryStats portBases test = + withPortBase portBases $ \portBase -> tmpBracket $ \tmpPath -> test TestParams {tmpPath, portBase, chatQueryStats, agentQueryStats, printOutput = False} #endif tmpBracket test = do t <- getSystemTime let ts = show (systemSeconds t) <> show (systemNanoseconds t) - withTmpFiles $ withTempDirectory "tests/tmp" ts test + withTempDirectory "tests/tmp" ts test logCfg :: LogConfig logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}