core: use port 7001 for test server (#1857)
* core: use port 7001 for test server * enable only failing tests * start/stop server for every test * log message that failed to parse * stop chat synchronously * print call stack * add HasCallStack * increase test timeout * add call stacks * more call stacks * fix test * disable failing test * add delay between the tests * make delay more visible * remove change in error message * reduce test delay, increase timeout * increase delay between the tests * run each test with a database in a different folder * folder name * refactor * update nix file, more stacks
This commit is contained in:
Evgeny Poberezkin
GitHub
parent
4815e447fa
commit
a1ed0a84b8
2
.github/workflows/build.yml
vendored
2
.github/workflows/build.yml
vendored
@ -109,7 +109,7 @@ jobs:
|
||||
|
||||
- name: Unix test
|
||||
if: matrix.os != 'windows-latest' && matrix.os != 'ubuntu-20.04'
|
||||
timeout-minutes: 10
|
||||
timeout-minutes: 20
|
||||
shell: bash
|
||||
run: cabal test --test-show-details=direct
|
||||
|
||||
|
||||
1
.gitignore
vendored
1
.gitignore
vendored
@ -42,6 +42,7 @@ stack.yaml.lock
|
||||
|
||||
# Temporary test files
|
||||
tests/tmp
|
||||
tests/tmp*
|
||||
logs/
|
||||
|
||||
|
||||
|
||||
@ -7,7 +7,7 @@ constraints: zip +disable-bzip2 +disable-zstd
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/simplex-chat/simplexmq.git
|
||||
tag: d1b4fa89115612c62baa38e3102c6eed8a48cf42
|
||||
tag: 5d8febc3535424b9c60eca508f57ba886c1ed8ba
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
{
|
||||
"https://github.com/simplex-chat/simplexmq.git"."d1b4fa89115612c62baa38e3102c6eed8a48cf42" = "0ryyxw1ibsbm9vj08jv0xqw8m4i72bynixd5kbsv8l7aldk0sphw";
|
||||
"https://github.com/simplex-chat/simplexmq.git"."5d8febc3535424b9c60eca508f57ba886c1ed8ba" = "0h1rn0b6402jdbp9rl5yavbdvhav631r93b90y86n9xcczzfr8y8";
|
||||
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
|
||||
"https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd";
|
||||
"https://github.com/simplex-chat/sqlcipher-simple.git"."5e154a2aeccc33ead6c243ec07195ab673137221" = "1d1gc5wax4vqg0801ajsmx1sbwvd9y7p7b8mmskvqsmpbwgbh0m0";
|
||||
|
||||
@ -3360,10 +3360,15 @@ sendFileInline_ FileTransferMeta {filePath, chunkSize} sharedMsgId sendMsg =
|
||||
chSize = fromIntegral chunkSize
|
||||
|
||||
parseChatMessage :: ChatMonad m => ByteString -> m (ChatMessage 'Json)
|
||||
parseChatMessage = liftEither . first (ChatError . CEInvalidChatMessage) . strDecode
|
||||
parseChatMessage = parseChatMessage_
|
||||
{-# INLINE parseChatMessage #-}
|
||||
|
||||
parseAChatMessage :: ChatMonad m => ByteString -> m AChatMessage
|
||||
parseAChatMessage = liftEither . first (ChatError . CEInvalidChatMessage) . strDecode
|
||||
parseAChatMessage = parseChatMessage_
|
||||
{-# INLINE parseAChatMessage #-}
|
||||
|
||||
parseChatMessage_ :: (ChatMonad m, StrEncoding s) => ByteString -> m s
|
||||
parseChatMessage_ = liftEither . first (ChatError . CEInvalidChatMessage) . strDecode
|
||||
|
||||
sendFileChunk :: ChatMonad m => User -> SndFileTransfer -> m ()
|
||||
sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, agentConnId = AgentConnId acId} =
|
||||
|
||||
@ -49,7 +49,7 @@ extra-deps:
|
||||
# - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
|
||||
# - ../simplexmq
|
||||
- github: simplex-chat/simplexmq
|
||||
commit: d1b4fa89115612c62baa38e3102c6eed8a48cf42
|
||||
commit: 5d8febc3535424b9c60eca508f57ba886c1ed8ba
|
||||
# - ../direct-sqlcipher
|
||||
- github: simplex-chat/direct-sqlcipher
|
||||
commit: 34309410eb2069b029b8fc1872deb1e0db123294
|
||||
|
||||
@ -1,14 +1,14 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE NumericUnderscores #-}
|
||||
{-# LANGUAGE OverloadedLists #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module ChatClient where
|
||||
|
||||
import Control.Concurrent (ThreadId, forkIO, forkIOWithUnmask, killThread, threadDelay)
|
||||
import Control.Concurrent (forkIOWithUnmask, killThread, threadDelay)
|
||||
import Control.Concurrent.Async
|
||||
import Control.Concurrent.STM
|
||||
import Control.Exception (bracket, bracket_)
|
||||
@ -33,17 +33,18 @@ import Simplex.Messaging.Server (runSMPServerBlocking)
|
||||
import Simplex.Messaging.Server.Env.STM
|
||||
import Simplex.Messaging.Transport
|
||||
import Simplex.Messaging.Version
|
||||
import System.Directory (createDirectoryIfMissing, removePathForcibly)
|
||||
import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive)
|
||||
import System.FilePath ((</>))
|
||||
import qualified System.Terminal as C
|
||||
import System.Terminal.Internal (VirtualTerminal (..), VirtualTerminalSettings (..), withVirtualTerminal)
|
||||
import System.Timeout (timeout)
|
||||
import Test.Hspec (Expectation, shouldReturn)
|
||||
import Test.Hspec (Expectation, HasCallStack, shouldReturn)
|
||||
|
||||
testDBPrefix :: FilePath
|
||||
testDBPrefix = "tests/tmp/test"
|
||||
|
||||
serverPort :: ServiceName
|
||||
serverPort = "5001"
|
||||
serverPort = "7001"
|
||||
|
||||
testOpts :: ChatOpts
|
||||
testOpts =
|
||||
@ -51,7 +52,7 @@ testOpts =
|
||||
{ dbFilePrefix = undefined,
|
||||
dbKey = "",
|
||||
-- dbKey = "this is a pass-phrase to encrypt the database",
|
||||
smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:5001"],
|
||||
smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001"],
|
||||
networkConfig = defaultNetworkConfig,
|
||||
logLevel = CLLImportant,
|
||||
logConnections = False,
|
||||
@ -107,15 +108,15 @@ testAgentCfgV1 =
|
||||
testCfgV1 :: ChatConfig
|
||||
testCfgV1 = testCfg {agentConfig = testAgentCfgV1}
|
||||
|
||||
createTestChat :: ChatConfig -> ChatOpts -> String -> Profile -> IO TestCC
|
||||
createTestChat cfg opts@ChatOpts {dbKey} dbPrefix profile = do
|
||||
db@ChatDatabase {chatStore} <- createChatDatabase (testDBPrefix <> dbPrefix) dbKey False
|
||||
createTestChat :: FilePath -> ChatConfig -> ChatOpts -> String -> Profile -> IO TestCC
|
||||
createTestChat tmp cfg opts@ChatOpts {dbKey} dbPrefix profile = do
|
||||
db@ChatDatabase {chatStore} <- createChatDatabase (tmp </> dbPrefix) dbKey False
|
||||
Right user <- withTransaction chatStore $ \db' -> runExceptT $ createUserRecord db' (AgentUserId 1) profile True
|
||||
startTestChat_ db cfg opts user
|
||||
|
||||
startTestChat :: ChatConfig -> ChatOpts -> String -> IO TestCC
|
||||
startTestChat cfg opts@ChatOpts {dbKey} dbPrefix = do
|
||||
db@ChatDatabase {chatStore} <- createChatDatabase (testDBPrefix <> dbPrefix) dbKey False
|
||||
startTestChat :: FilePath -> ChatConfig -> ChatOpts -> String -> IO TestCC
|
||||
startTestChat tmp cfg opts@ChatOpts {dbKey} dbPrefix = do
|
||||
db@ChatDatabase {chatStore} <- createChatDatabase (tmp </> dbPrefix) dbKey False
|
||||
Just user <- find activeUser <$> withTransaction chatStore getUsers
|
||||
startTestChat_ db cfg opts user
|
||||
|
||||
@ -132,44 +133,44 @@ startTestChat_ db cfg opts user = do
|
||||
|
||||
stopTestChat :: TestCC -> IO ()
|
||||
stopTestChat TestCC {chatController = cc, chatAsync, termAsync} = do
|
||||
void . forkIO $ stopChatController cc
|
||||
stopChatController cc
|
||||
uninterruptibleCancel termAsync
|
||||
uninterruptibleCancel chatAsync
|
||||
threadDelay 100000
|
||||
threadDelay 200000
|
||||
|
||||
withNewTestChat :: String -> Profile -> (TestCC -> IO a) -> IO a
|
||||
withNewTestChat = withNewTestChatCfgOpts testCfg testOpts
|
||||
withNewTestChat :: HasCallStack => FilePath -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withNewTestChat tmp = withNewTestChatCfgOpts tmp testCfg testOpts
|
||||
|
||||
withNewTestChatV1 :: String -> Profile -> (TestCC -> IO a) -> IO a
|
||||
withNewTestChatV1 = withNewTestChatCfg testCfgV1
|
||||
withNewTestChatV1 :: HasCallStack => FilePath -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withNewTestChatV1 tmp = withNewTestChatCfg tmp testCfgV1
|
||||
|
||||
withNewTestChatCfg :: ChatConfig -> String -> Profile -> (TestCC -> IO a) -> IO a
|
||||
withNewTestChatCfg cfg = withNewTestChatCfgOpts cfg testOpts
|
||||
withNewTestChatCfg :: HasCallStack => FilePath -> ChatConfig -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withNewTestChatCfg tmp cfg = withNewTestChatCfgOpts tmp cfg testOpts
|
||||
|
||||
withNewTestChatOpts :: ChatOpts -> String -> Profile -> (TestCC -> IO a) -> IO a
|
||||
withNewTestChatOpts = withNewTestChatCfgOpts testCfg
|
||||
withNewTestChatOpts :: HasCallStack => FilePath -> ChatOpts -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withNewTestChatOpts tmp = withNewTestChatCfgOpts tmp testCfg
|
||||
|
||||
withNewTestChatCfgOpts :: ChatConfig -> ChatOpts -> String -> Profile -> (TestCC -> IO a) -> IO a
|
||||
withNewTestChatCfgOpts cfg opts dbPrefix profile runTest =
|
||||
withNewTestChatCfgOpts :: HasCallStack => FilePath -> ChatConfig -> ChatOpts -> String -> Profile -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withNewTestChatCfgOpts tmp cfg opts dbPrefix profile runTest =
|
||||
bracket
|
||||
(createTestChat cfg opts dbPrefix profile)
|
||||
(createTestChat tmp cfg opts dbPrefix profile)
|
||||
stopTestChat
|
||||
(\cc -> runTest cc >>= ((cc <// 100000) $>))
|
||||
|
||||
withTestChatV1 :: String -> (TestCC -> IO a) -> IO a
|
||||
withTestChatV1 = withTestChatCfg testCfgV1
|
||||
withTestChatV1 :: HasCallStack => FilePath -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChatV1 tmp = withTestChatCfg tmp testCfgV1
|
||||
|
||||
withTestChat :: String -> (TestCC -> IO a) -> IO a
|
||||
withTestChat = withTestChatCfgOpts testCfg testOpts
|
||||
withTestChat :: HasCallStack => FilePath -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChat tmp = withTestChatCfgOpts tmp testCfg testOpts
|
||||
|
||||
withTestChatCfg :: ChatConfig -> String -> (TestCC -> IO a) -> IO a
|
||||
withTestChatCfg cfg = withTestChatCfgOpts cfg testOpts
|
||||
withTestChatCfg :: HasCallStack => FilePath -> ChatConfig -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChatCfg tmp cfg = withTestChatCfgOpts tmp cfg testOpts
|
||||
|
||||
withTestChatOpts :: ChatOpts -> String -> (TestCC -> IO a) -> IO a
|
||||
withTestChatOpts = withTestChatCfgOpts testCfg
|
||||
withTestChatOpts :: HasCallStack => FilePath -> ChatOpts -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChatOpts tmp = withTestChatCfgOpts tmp testCfg
|
||||
|
||||
withTestChatCfgOpts :: ChatConfig -> ChatOpts -> String -> (TestCC -> IO a) -> IO a
|
||||
withTestChatCfgOpts cfg opts dbPrefix = bracket (startTestChat cfg opts dbPrefix) (\cc -> cc <// 100000 >> stopTestChat cc)
|
||||
withTestChatCfgOpts :: HasCallStack => FilePath -> ChatConfig -> ChatOpts -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChatCfgOpts tmp cfg opts dbPrefix = bracket (startTestChat tmp cfg opts dbPrefix) (\cc -> cc <// 100000 >> stopTestChat cc)
|
||||
|
||||
readTerminalOutput :: VirtualTerminal -> TQueue String -> IO ()
|
||||
readTerminalOutput t termQ = do
|
||||
@ -198,10 +199,10 @@ withTmpFiles :: IO () -> IO ()
|
||||
withTmpFiles =
|
||||
bracket_
|
||||
(createDirectoryIfMissing False "tests/tmp")
|
||||
(removePathForcibly "tests/tmp")
|
||||
(removeDirectoryRecursive "tests/tmp")
|
||||
|
||||
testChatN :: ChatConfig -> ChatOpts -> [Profile] -> ([TestCC] -> IO ()) -> IO ()
|
||||
testChatN cfg opts ps test = withTmpFiles $ do
|
||||
testChatN :: HasCallStack => ChatConfig -> ChatOpts -> [Profile] -> (HasCallStack => [TestCC] -> IO ()) -> FilePath -> IO ()
|
||||
testChatN cfg opts ps test tmp = do
|
||||
tcs <- getTestCCs (zip ps [1 ..]) []
|
||||
test tcs
|
||||
concurrentlyN_ $ map (<// 100000) tcs
|
||||
@ -209,12 +210,12 @@ testChatN cfg opts ps test = withTmpFiles $ do
|
||||
where
|
||||
getTestCCs :: [(Profile, Int)] -> [TestCC] -> IO [TestCC]
|
||||
getTestCCs [] tcs = pure tcs
|
||||
getTestCCs ((p, db) : envs') tcs = (:) <$> createTestChat cfg opts (show db) p <*> getTestCCs envs' tcs
|
||||
getTestCCs ((p, db) : envs') tcs = (:) <$> createTestChat tmp cfg opts (show db) p <*> getTestCCs envs' tcs
|
||||
|
||||
(<//) :: TestCC -> Int -> Expectation
|
||||
(<//) :: HasCallStack => TestCC -> Int -> Expectation
|
||||
(<//) cc t = timeout t (getTermLine cc) `shouldReturn` Nothing
|
||||
|
||||
getTermLine :: TestCC -> IO String
|
||||
getTermLine :: HasCallStack => TestCC -> IO String
|
||||
getTermLine cc =
|
||||
5000000 `timeout` atomically (readTQueue $ termQ cc) >>= \case
|
||||
Just s -> do
|
||||
@ -227,36 +228,36 @@ getTermLine cc =
|
||||
userName :: TestCC -> IO [Char]
|
||||
userName (TestCC ChatController {currentUser} _ _ _ _) = T.unpack . localDisplayName . fromJust <$> readTVarIO currentUser
|
||||
|
||||
testChat2 :: Profile -> Profile -> (TestCC -> TestCC -> IO ()) -> IO ()
|
||||
testChat2 :: HasCallStack => Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
testChat2 = testChatCfgOpts2 testCfg testOpts
|
||||
|
||||
testChatCfg2 :: ChatConfig -> Profile -> Profile -> (TestCC -> TestCC -> IO ()) -> IO ()
|
||||
testChatCfg2 :: HasCallStack => ChatConfig -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
testChatCfg2 cfg = testChatCfgOpts2 cfg testOpts
|
||||
|
||||
testChatOpts2 :: ChatOpts -> Profile -> Profile -> (TestCC -> TestCC -> IO ()) -> IO ()
|
||||
testChatOpts2 :: HasCallStack => ChatOpts -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
testChatOpts2 = testChatCfgOpts2 testCfg
|
||||
|
||||
testChatCfgOpts2 :: ChatConfig -> ChatOpts -> Profile -> Profile -> (TestCC -> TestCC -> IO ()) -> IO ()
|
||||
testChatCfgOpts2 :: HasCallStack => ChatConfig -> ChatOpts -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
testChatCfgOpts2 cfg opts p1 p2 test = testChatN cfg opts [p1, p2] test_
|
||||
where
|
||||
test_ :: [TestCC] -> IO ()
|
||||
test_ [tc1, tc2] = test tc1 tc2
|
||||
test_ _ = error "expected 2 chat clients"
|
||||
|
||||
testChat3 :: Profile -> Profile -> Profile -> (TestCC -> TestCC -> TestCC -> IO ()) -> IO ()
|
||||
testChat3 :: HasCallStack => Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
testChat3 = testChatCfgOpts3 testCfg testOpts
|
||||
|
||||
testChatCfg3 :: ChatConfig -> Profile -> Profile -> Profile -> (TestCC -> TestCC -> TestCC -> IO ()) -> IO ()
|
||||
testChatCfg3 :: HasCallStack => ChatConfig -> Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
testChatCfg3 cfg = testChatCfgOpts3 cfg testOpts
|
||||
|
||||
testChatCfgOpts3 :: ChatConfig -> ChatOpts -> Profile -> Profile -> Profile -> (TestCC -> TestCC -> TestCC -> IO ()) -> IO ()
|
||||
testChatCfgOpts3 :: HasCallStack => ChatConfig -> ChatOpts -> Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
testChatCfgOpts3 cfg opts p1 p2 p3 test = testChatN cfg opts [p1, p2, p3] test_
|
||||
where
|
||||
test_ :: [TestCC] -> IO ()
|
||||
test_ [tc1, tc2, tc3] = test tc1 tc2 tc3
|
||||
test_ _ = error "expected 3 chat clients"
|
||||
|
||||
testChat4 :: Profile -> Profile -> Profile -> Profile -> (TestCC -> TestCC -> TestCC -> TestCC -> IO ()) -> IO ()
|
||||
testChat4 :: HasCallStack => Profile -> Profile -> Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
testChat4 p1 p2 p3 p4 test = testChatN testCfg testOpts [p1, p2, p3, p4] test_
|
||||
where
|
||||
test_ :: [TestCC] -> IO ()
|
||||
@ -285,7 +286,7 @@ serverCfg =
|
||||
caCertificateFile = "tests/fixtures/tls/ca.crt",
|
||||
privateKeyFile = "tests/fixtures/tls/server.key",
|
||||
certificateFile = "tests/fixtures/tls/server.crt",
|
||||
logStatsInterval = Just 86400,
|
||||
logStatsInterval = Nothing,
|
||||
logStatsStartTime = 0,
|
||||
serverStatsLogFile = "tests/smp-server-stats.daily.log",
|
||||
serverStatsBackupFile = Nothing,
|
||||
@ -293,16 +294,16 @@ serverCfg =
|
||||
logTLSErrors = True
|
||||
}
|
||||
|
||||
withSmpServer :: IO a -> IO a
|
||||
withSmpServer = serverBracket (`runSMPServerBlocking` serverCfg) (pure ()) . const
|
||||
withSmpServer :: IO () -> IO ()
|
||||
withSmpServer = serverBracket (`runSMPServerBlocking` serverCfg)
|
||||
|
||||
serverBracket :: (TMVar Bool -> IO ()) -> IO () -> (ThreadId -> IO a) -> IO a
|
||||
serverBracket process afterProcess f = do
|
||||
serverBracket :: (TMVar Bool -> IO ()) -> IO () -> IO ()
|
||||
serverBracket server f = do
|
||||
started <- newEmptyTMVarIO
|
||||
bracket
|
||||
(forkIOWithUnmask ($ process started))
|
||||
(\t -> killThread t >> afterProcess >> waitFor started "stop")
|
||||
(\t -> waitFor started "start" >> f t)
|
||||
(forkIOWithUnmask ($ server started))
|
||||
(\t -> killThread t >> waitFor started "stop")
|
||||
(\_ -> waitFor started "start" >> f)
|
||||
where
|
||||
waitFor started s =
|
||||
5000000 `timeout` atomically (takeTMVar started) >>= \case
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -2,15 +2,15 @@
|
||||
|
||||
module MobileTests where
|
||||
|
||||
import ChatClient
|
||||
import ChatTests
|
||||
import Control.Monad.Except
|
||||
import Simplex.Chat.Mobile
|
||||
import Simplex.Chat.Store
|
||||
import Simplex.Chat.Types (AgentUserId (..), Profile (..))
|
||||
import System.FilePath ((</>))
|
||||
import Test.Hspec
|
||||
|
||||
mobileTests :: Spec
|
||||
mobileTests :: SpecWith FilePath
|
||||
mobileTests = do
|
||||
describe "mobile API" $ do
|
||||
it "start new chat without user" testChatApiNoUser
|
||||
@ -82,18 +82,19 @@ parsedMarkdown = "{\"formattedText\":[{\"format\":{\"bold\":{}},\"text\":\"hello
|
||||
parsedMarkdown = "{\"formattedText\":[{\"format\":{\"type\":\"bold\"},\"text\":\"hello\"}]}"
|
||||
#endif
|
||||
|
||||
testChatApiNoUser :: IO ()
|
||||
testChatApiNoUser = withTmpFiles $ do
|
||||
Right cc <- chatMigrateInit testDBPrefix ""
|
||||
Left (DBMErrorNotADatabase _) <- chatMigrateInit testDBPrefix "myKey"
|
||||
testChatApiNoUser :: FilePath -> IO ()
|
||||
testChatApiNoUser tmp = do
|
||||
let dbPrefix = tmp </> "1"
|
||||
Right cc <- chatMigrateInit dbPrefix ""
|
||||
Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "myKey"
|
||||
chatSendCmd cc "/u" `shouldReturn` noActiveUser
|
||||
chatSendCmd cc "/_start" `shouldReturn` noActiveUser
|
||||
chatSendCmd cc "/create user alice Alice" `shouldReturn` activeUser
|
||||
chatSendCmd cc "/_start" `shouldReturn` chatStarted
|
||||
|
||||
testChatApi :: IO ()
|
||||
testChatApi = withTmpFiles $ do
|
||||
let dbPrefix = testDBPrefix <> "1"
|
||||
testChatApi :: FilePath -> IO ()
|
||||
testChatApi tmp = do
|
||||
let dbPrefix = tmp </> "1"
|
||||
f = chatStoreFile dbPrefix
|
||||
st <- createChatStore f "myKey" True
|
||||
Right _ <- withTransaction st $ \db -> runExceptT $ createUserRecord db (AgentUserId 1) aliceProfile {preferences = Nothing} True
|
||||
|
||||
@ -20,12 +20,11 @@ schemaDumpTest =
|
||||
it "verify and overwrite schema dump" testVerifySchemaDump
|
||||
|
||||
testVerifySchemaDump :: IO ()
|
||||
testVerifySchemaDump =
|
||||
withTmpFiles $ do
|
||||
void $ createChatStore testDB "" False
|
||||
void $ readCreateProcess (shell $ "touch " <> schema) ""
|
||||
savedSchema <- readFile schema
|
||||
savedSchema `deepseq` pure ()
|
||||
void $ readCreateProcess (shell $ "sqlite3 " <> testDB <> " '.schema --indent' > " <> schema) ""
|
||||
currentSchema <- readFile schema
|
||||
savedSchema `shouldBe` currentSchema
|
||||
testVerifySchemaDump = withTmpFiles $ do
|
||||
void $ createChatStore testDB "" False
|
||||
void $ readCreateProcess (shell $ "touch " <> schema) ""
|
||||
savedSchema <- readFile schema
|
||||
savedSchema `deepseq` pure ()
|
||||
void $ readCreateProcess (shell $ "sqlite3 " <> testDB <> " '.schema --indent' > " <> schema) ""
|
||||
currentSchema <- readFile schema
|
||||
savedSchema `shouldBe` currentSchema
|
||||
|
||||
@ -1,25 +1,29 @@
|
||||
import ChatClient
|
||||
import ChatTests
|
||||
-- import Control.Logger.Simple
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Logger.Simple
|
||||
import Data.Time.Clock.System
|
||||
import MarkdownTests
|
||||
import MobileTests
|
||||
import ProtocolTests
|
||||
import SchemaDump
|
||||
import Test.Hspec
|
||||
import UnliftIO.Temporary (withTempDirectory)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
-- setLogLevel LogDebug -- LogError
|
||||
-- withGlobalLogging logCfg $
|
||||
withSmpServer . hspec $ do
|
||||
setLogLevel LogError -- LogDebug
|
||||
withGlobalLogging logCfg . hspec $ do
|
||||
describe "SimpleX chat markdown" markdownTests
|
||||
describe "SimpleX chat protocol" protocolTests
|
||||
describe "Mobile API Tests" mobileTests
|
||||
-- Workaround for SQLite IO error in first test after mobile tests on Mac
|
||||
it "Delay after Mobile API Tests" $ threadDelay 100000
|
||||
describe "SimpleX chat client" chatTests
|
||||
describe "Schema dump" schemaDumpTest
|
||||
around testBracket $ do
|
||||
describe "Mobile API Tests" mobileTests
|
||||
describe "SimpleX chat client" chatTests
|
||||
where
|
||||
testBracket test = do
|
||||
t <- getSystemTime
|
||||
let ts = show (systemSeconds t) <> show (systemNanoseconds t)
|
||||
withSmpServer $ withTmpFiles $ withTempDirectory "tests" ("tmp" <> ts) test
|
||||
|
||||
-- logCfg :: LogConfig
|
||||
-- logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
|
||||
logCfg :: LogConfig
|
||||
logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user