mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-10-23 19:23:36 +00:00
fix more tests
This commit is contained in:
Evgeny @ SimpleX Chat committed
1 parent
076b536cd5
commit
79079f64c3
7 files changed
+157
-134
No files matched your search
@@ -32,6 +32,16 @@ concurrently in one process with `parallel` and `--jobs`.
|
||||
"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.
|
||||
- Bots started through `directoryService`, `badgeService` and
|
||||
`simplexChatCore` take `coreOptions` and the config from `testPortsCfg`.
|
||||
- `TestTerminal` wraps the virtual terminal and writes the cursor row to
|
||||
`termQ` on `PutLn`.
|
||||
- The "no output left" check runs in the bracket body; `stopTestChat` stops
|
||||
the client in a separate thread with a 60 s limit and keeps the store open
|
||||
after the limit.
|
||||
- Per-test limit 180 s; the "channels" group is `sequential`; `@@@` waits
|
||||
500 ms. TTL and timed-message tests use multi-second TTLs; ratchet
|
||||
desynchronization helpers turn receipts off.
|
||||
|
||||
## Status
|
||||
|
||||
|
||||
@@ -38,7 +38,7 @@ import Simplex.Chat.Badges.Ledger (addMonths, creditTypeTag, debitTypeTag, endOf
|
||||
import Simplex.Chat.Badges.Service
|
||||
import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), ChatResponse (CRCustomChatResponse))
|
||||
import Simplex.Chat.Core (sendChatCmdStr)
|
||||
import Simplex.Chat.Options (CoreChatOpts (..))
|
||||
import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts (..))
|
||||
import Simplex.Chat.Options.DB
|
||||
import Simplex.Messaging.Agent.Store.Common (withTransaction)
|
||||
import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
|
||||
@@ -96,16 +96,16 @@ testIssuerKeyIdx :: Int
|
||||
testIssuerKeyIdx = 1
|
||||
|
||||
mkBadgeServiceOpts :: TestParams -> BBSSecretKey -> BadgeServiceOpts
|
||||
mkBadgeServiceOpts TestParams {tmpPath = ps} secretKey =
|
||||
mkBadgeServiceOpts ps secretKey =
|
||||
BadgeServiceOpts
|
||||
{ coreOptions =
|
||||
testCoreOpts
|
||||
coreOpts
|
||||
{ dbOptions =
|
||||
(dbOptions testCoreOpts)
|
||||
#if defined(dbPostgres)
|
||||
{dbSchemaPrefix = "client_" <> serviceDbPrefix}
|
||||
{dbSchemaPrefix = testSchemaPrefix ps serviceDbPrefix}
|
||||
#else
|
||||
{dbFilePrefix = ps </> serviceDbPrefix}
|
||||
{dbFilePrefix = tmpPath ps </> serviceDbPrefix}
|
||||
#endif
|
||||
},
|
||||
serviceName = "SimpleX Badges",
|
||||
@@ -115,6 +115,8 @@ mkBadgeServiceOpts TestParams {tmpPath = ps} secretKey =
|
||||
issuerKey = Just BadgeIssuerKey {keyIdx = testIssuerKeyIdx, secretKey},
|
||||
testing = True
|
||||
}
|
||||
where
|
||||
(_, ChatOpts {coreOptions = coreOpts}) = testPortsCfg ps testCfg testOpts
|
||||
|
||||
-- | A clock the service and the client both read: real time plus an offset the test moves. It
|
||||
-- tracks real time rather than freezing it, so a sleeper still sleeps the right real duration.
|
||||
@@ -157,7 +159,7 @@ withBadgeServiceEnv ps test = do
|
||||
svcCfg = testCfg {badgePublicKeys = M.singleton testIssuerKeyIdx pk, badgeCurrentTime = testClockTime clock}
|
||||
withNewTestChatCfg ps testCfg serviceDbPrefix badgeProfile $ \_ -> pure ()
|
||||
-- First start: badge service takes the CreateMyAddress branch.
|
||||
runBadgeService svcCfg opts $ \_ -> pure ()
|
||||
runBadgeService ps svcCfg opts $ \_ -> pure ()
|
||||
-- Reopen the DB to read the link the service created.
|
||||
bsLink <- withTestChat ps serviceDbPrefix $ \bs -> do
|
||||
bs <## "subscribed 1 connections on server localhost"
|
||||
@@ -168,7 +170,7 @@ withBadgeServiceEnv ps test = do
|
||||
let clientCfg =
|
||||
svcCfg {badgeServiceAddress = Just $ either (error . ("bad badge service address: " <>)) id $ strDecode (B.pack bsLink)}
|
||||
-- Second start: badge service takes the ShowMyAddress branch, then serves the test body.
|
||||
runBadgeService svcCfg opts $ \env -> do
|
||||
runBadgeService ps svcCfg opts $ \env -> do
|
||||
cc <- atomically $ readTMVar $ serviceCC env
|
||||
test BadgeServiceEnv {bsIssuerKey = BadgeIssuerKey {keyIdx = testIssuerKeyIdx, secretKey = sk}, bsClock = clock, bsClientCfg = clientCfg, bsAddress = bsLink, bsController = cc}
|
||||
|
||||
@@ -184,10 +186,10 @@ issueCode cc badgeType months =
|
||||
-- | The post-start hook fills serviceCC once the address exists, so waiting on it is the service
|
||||
-- being ready. A fixed delay here raced with startup and left the address output of one start
|
||||
-- arriving during the next test.
|
||||
runBadgeService :: ChatConfig -> BadgeServiceOpts -> (ServiceState -> IO ()) -> IO ()
|
||||
runBadgeService cfg opts action = do
|
||||
runBadgeService :: TestParams -> ChatConfig -> BadgeServiceOpts -> (ServiceState -> IO ()) -> IO ()
|
||||
runBadgeService ps cfg opts action = do
|
||||
env <- newServiceState
|
||||
t <- forkIO $ badgeService opts cfg env
|
||||
t <- forkIO $ badgeService opts (fst $ testPortsCfg ps cfg testOpts) env
|
||||
ready <- timeout 30000000 $ atomically $ readTMVar $ serviceCC env
|
||||
when (isNothing ready) $ killThread t >> error "badge service did not start"
|
||||
action env `finally` killThread t
|
||||
|
||||
+40
-42
@@ -40,7 +40,7 @@ import Simplex.Chat.Options.DB
|
||||
import Simplex.Chat.Store
|
||||
import Simplex.Chat.Store.Profiles
|
||||
import Simplex.Chat.Terminal
|
||||
import Simplex.Chat.Terminal.Output (newChatTerminal)
|
||||
import Simplex.Chat.Terminal.Output (WithTerminal (..), newChatTerminal)
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Shared (GroupMemberRole (..))
|
||||
import Simplex.FileTransfer.Description (kb, mb)
|
||||
@@ -70,7 +70,7 @@ import Simplex.Messaging.Version.Internal
|
||||
import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive)
|
||||
import System.FilePath ((</>))
|
||||
import qualified System.Terminal as C
|
||||
import System.Terminal.Internal (VirtualTerminal (..), VirtualTerminalSettings (..), withVirtualTerminal)
|
||||
import System.Terminal.Internal (Command (..), Terminal (..), VirtualTerminal (..), VirtualTerminalSettings (..), withVirtualTerminal)
|
||||
import System.Timeout (timeout)
|
||||
import Test.Hspec (Expectation, HasCallStack, shouldReturn)
|
||||
#if defined(dbPostgres)
|
||||
@@ -260,14 +260,33 @@ termSettings =
|
||||
|
||||
data TestCC = TestCC
|
||||
{ chatController :: ChatController,
|
||||
virtualTerminal :: VirtualTerminal,
|
||||
chatAsync :: Async (),
|
||||
termAsync :: Async (),
|
||||
termQ :: TQueue String,
|
||||
printOutput :: Bool,
|
||||
ccParams :: TestParams
|
||||
}
|
||||
|
||||
data TestTerminal = TestTerminal VirtualTerminal (TQueue String)
|
||||
|
||||
instance Terminal TestTerminal where
|
||||
termType (TestTerminal t _) = termType t
|
||||
termEvent (TestTerminal t _) = termEvent t
|
||||
termInterrupt (TestTerminal t _) = termInterrupt t
|
||||
termCommand (TestTerminal t q) c = do
|
||||
case c of
|
||||
PutLn -> atomically $ do
|
||||
C.Position {row} <- readTVar $ virtualCursor t
|
||||
rows <- readTVar $ virtualWindow t
|
||||
writeTQueue q $ dropWhileEnd (== ' ') $ rows !! row
|
||||
_ -> pure ()
|
||||
termCommand t c
|
||||
termFlush (TestTerminal t _) = termFlush t
|
||||
termGetWindowSize (TestTerminal t _) = termGetWindowSize t
|
||||
termGetCursorPosition (TestTerminal t _) = termGetCursorPosition t
|
||||
|
||||
instance WithTerminal TestTerminal where
|
||||
withTerm t = ($ t)
|
||||
|
||||
aCfg :: AgentConfig
|
||||
aCfg = (agentConfig defaultChatConfig) {tbqSize = 16}
|
||||
|
||||
@@ -380,29 +399,31 @@ insertUser st = withTransaction st (`DB.execute_` "INSERT INTO users (user_id) V
|
||||
startTestChat_ :: TestParams -> ChatDatabase -> ChatConfig -> ChatOpts -> String -> User -> IO TestCC
|
||||
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
|
||||
termQ <- newTQueueIO
|
||||
t <- withVirtualTerminal termSettings $ pure . (`TestTerminal` termQ)
|
||||
ct <- newChatTerminal t opts
|
||||
Right cc <- newChatController db (Just user) cfg opts False
|
||||
void $ execChatCommand' (SetTempFolder (tmpPath </> dbPrefix)) 0 `runReaderT` cc
|
||||
chatAsync <- async $ runSimplexChat cfg opts user cc $ \_u cc' -> runChatTerminal ct cc' opts
|
||||
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, ccParams = ps}
|
||||
pure TestCC {chatController = cc, chatAsync, termQ, printOutput, ccParams = ps}
|
||||
|
||||
stopTestChat :: TestParams -> TestCC -> IO ()
|
||||
stopTestChat ps TestCC {chatController = cc@ChatController {smpAgent, chatStore}, chatAsync, termAsync} = do
|
||||
stopChatController cc
|
||||
uninterruptibleCancel termAsync
|
||||
uninterruptibleCancel chatAsync
|
||||
liftIO $ disposeAgentClient smpAgent
|
||||
stopTestChat ps TestCC {chatController = cc@ChatController {smpAgent, chatStore}, chatAsync} = do
|
||||
stopped <- async $ do
|
||||
stopChatController cc
|
||||
cancel chatAsync
|
||||
disposeAgentClient smpAgent
|
||||
r <- timeout 60000000 $ wait stopped
|
||||
#if !defined(dbPostgres)
|
||||
chatStats <- withConnection chatStore $ readTVarIO . DB.slow
|
||||
atomically $ modifyTVar' (chatQueryStats ps) $ M.unionWith combineStats chatStats
|
||||
agentStats <- withConnection (agentClientStore smpAgent) $ readTVarIO . DB.slow
|
||||
atomically $ modifyTVar' (agentQueryStats ps) $ M.unionWith combineStats agentStats
|
||||
#endif
|
||||
closeDBStore chatStore
|
||||
case r of
|
||||
Just () -> closeDBStore chatStore
|
||||
Nothing -> putStrLn "stopTestChat: chat did not stop in 60 seconds"
|
||||
threadDelay 200000
|
||||
#if !defined(dbPostgres)
|
||||
where
|
||||
@@ -455,7 +476,8 @@ withTestChatOpts :: HasCallStack => TestParams -> ChatOpts -> String -> (HasCall
|
||||
withTestChatOpts ps = withTestChatCfgOpts ps testCfg
|
||||
|
||||
withTestChatCfgOpts :: HasCallStack => TestParams -> ChatConfig -> ChatOpts -> String -> (HasCallStack => TestCC -> IO a) -> IO a
|
||||
withTestChatCfgOpts ps cfg opts dbPrefix = bracket (startTestChat ps cfg opts dbPrefix) (\cc -> cc <// 100000 >> stopTestChat ps cc)
|
||||
withTestChatCfgOpts ps cfg opts dbPrefix runTest =
|
||||
bracket (startTestChat ps cfg opts dbPrefix) (stopTestChat ps) (\cc -> runTest cc >>= ((cc <// 100000) $>))
|
||||
|
||||
-- enable output for specific test.
|
||||
-- usage: withTestOutput $ testChat2 aliceProfile bobProfile $ \alice bob -> do ...
|
||||
@@ -482,29 +504,6 @@ enableNamesRole TestCC {chatController = cc} = do
|
||||
}
|
||||
enableNames srv@UserServer {roles} = (srv :: UserServer 'PSMP) {roles = (roles :: ServerRolesOverride) {names = Just True}}
|
||||
|
||||
readTerminalOutput :: VirtualTerminal -> TQueue String -> IO ()
|
||||
readTerminalOutput t termQ = do
|
||||
let w = virtualWindow t
|
||||
winVar <- atomically $ newTVar . init =<< readTVar w
|
||||
forever . atomically $ do
|
||||
win <- readTVar winVar
|
||||
win' <- init <$> readTVar w
|
||||
if win' == win
|
||||
then retry
|
||||
else do
|
||||
let diff = getDiff win' win
|
||||
forM_ diff $ writeTQueue termQ
|
||||
writeTVar winVar win'
|
||||
where
|
||||
getDiff :: [String] -> [String] -> [String]
|
||||
getDiff win win' = getDiff_ 1 (length win) win win'
|
||||
getDiff_ :: Int -> Int -> [String] -> [String] -> [String]
|
||||
getDiff_ n len win' win =
|
||||
let diff = drop (len - n) win'
|
||||
in if drop n win <> diff == win'
|
||||
then map (dropWhileEnd (== ' ')) diff
|
||||
else getDiff_ (n + 1) len win' win
|
||||
|
||||
withTmpFiles :: IO () -> IO ()
|
||||
withTmpFiles =
|
||||
bracket_
|
||||
@@ -523,16 +522,15 @@ withPortBase bases = bracket takeBase (\b -> atomically $ modifyTVar' bases (b :
|
||||
|
||||
testChatN :: HasCallStack => ChatConfig -> ChatOpts -> [Profile] -> (HasCallStack => [TestCC] -> IO ()) -> TestParams -> IO ()
|
||||
testChatN cfg opts ps test params =
|
||||
bracket (getTestCCs $ zip ps [1 ..]) endTests test
|
||||
bracket (getTestCCs $ zip ps [1 ..]) (mapConcurrently_ $ stopTestChat params) $ \tcs -> do
|
||||
test tcs
|
||||
mapConcurrently_ (<// 100000) tcs
|
||||
where
|
||||
useClientServices = False
|
||||
-- useClientServices = True
|
||||
getTestCCs :: [(Profile, Int)] -> IO [TestCC]
|
||||
getTestCCs [] = pure []
|
||||
getTestCCs ((p, db) : envs') = (:) <$> createTestChat params cfg opts (show db) useClientServices p <*> getTestCCs envs'
|
||||
endTests tcs = do
|
||||
mapConcurrently_ (<// 100000) tcs
|
||||
mapConcurrently_ (stopTestChat params) tcs
|
||||
|
||||
(<//) :: HasCallStack => TestCC -> Int -> Expectation
|
||||
(<//) cc t = timeout t (getTermLine cc) `shouldReturn` Nothing
|
||||
|
||||
+49
-40
@@ -21,7 +21,7 @@ import Data.Aeson (ToJSON)
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import Data.List (intercalate, stripPrefix)
|
||||
import Data.List (intercalate, isPrefixOf, stripPrefix)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe (isJust, isNothing)
|
||||
import qualified Data.Text as T
|
||||
@@ -1350,18 +1350,23 @@ testNegotiateCall =
|
||||
alice ##> "/_call status @2 connected"
|
||||
alice <## "ok"
|
||||
threadDelay 100000
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "outgoing call: in progress (00:00)")])
|
||||
alice #$> ("/_get chat @2 count=100", callChat, chatFeatures <> [(1, "outgoing call: in progress")])
|
||||
bob ##> "/_call status @2 connected"
|
||||
bob <## "ok"
|
||||
threadDelay 100000
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "incoming call: in progress (00:00)")])
|
||||
bob #$> ("/_get chat @2 count=100", callChat, chatFeatures <> [(0, "incoming call: in progress")])
|
||||
-- either party can end the call
|
||||
bob ##> "/_call end @2"
|
||||
bob <## "ok"
|
||||
threadDelay 100000
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "incoming call: ended (00:00)")])
|
||||
bob #$> ("/_get chat @2 count=100", callChat, chatFeatures <> [(0, "incoming call: ended")])
|
||||
alice <## "call with bob ended"
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "outgoing call: ended (00:00)")])
|
||||
alice #$> ("/_get chat @2 count=100", callChat, chatFeatures <> [(1, "outgoing call: ended")])
|
||||
where
|
||||
callChat = map (fmap noDuration) . chat
|
||||
noDuration s = case words s of
|
||||
ws@(_ : _) | "(0" `isPrefixOf` last ws -> unwords $ init ws
|
||||
_ -> s
|
||||
|
||||
testStopStartChat :: HasCallStack => TestParams -> IO ()
|
||||
testStopStartChat ps =
|
||||
@@ -1370,12 +1375,12 @@ testStopStartChat ps =
|
||||
connectUsers alice bob
|
||||
alice #> "@bob hi"
|
||||
bob <# "alice> hi"
|
||||
alice #$> ("/_ttl 1 4", id, "ok")
|
||||
alice ##> "/_set prefs @2 {\"timedMessages\": {\"allow\": \"yes\", \"ttl\": 2}}"
|
||||
alice #$> ("/_ttl 1 12", id, "ok")
|
||||
alice ##> "/_set prefs @2 {\"timedMessages\": {\"allow\": \"yes\", \"ttl\": 6}}"
|
||||
alice <## "you updated preferences for bob:"
|
||||
alice <## "Disappearing messages: enabled (you allow: yes (2 sec), contact allows: yes)"
|
||||
alice <## "Disappearing messages: enabled (you allow: yes (6 sec), contact allows: yes)"
|
||||
bob <## "alice updated preferences for you:"
|
||||
bob <## "Disappearing messages: enabled (you allow: yes (2 sec), contact allows: yes (2 sec))"
|
||||
bob <## "Disappearing messages: enabled (you allow: yes (6 sec), contact allows: yes (6 sec))"
|
||||
alice #> "@bob hi timed"
|
||||
bob <# "alice> hi timed"
|
||||
let ChatController {agentAsync, cleanupManagerAsync, expireCIThreads, timedItemThreads} = chatController alice
|
||||
@@ -1397,9 +1402,10 @@ testStopStartChat ps =
|
||||
alice <## "subscribed 1 connections on server localhost"
|
||||
bob #> "@alice hello"
|
||||
alice <# "bob> hello"
|
||||
threadDelay 3000000
|
||||
alice <### ["timed message deleted: hi timed", "timed message deleted: hello"]
|
||||
bob <### ["timed message deleted: hi timed", "timed message deleted: hello"]
|
||||
threadDelay 3000000
|
||||
threadDelay 8000000
|
||||
alice #$> ("/_get chat @2 count=100", chat, [(1, "chat banner")])
|
||||
Just (a1', _) <- readTVarIO agentAsync
|
||||
(a1' == a1) `shouldBe` False
|
||||
@@ -1685,6 +1691,7 @@ testConnSyncExtraAgentConns ps = do
|
||||
alice ##> "/_connections diff"
|
||||
alice <## "no difference between agent and chat connections"
|
||||
|
||||
threadDelay 1000000
|
||||
-- deleting connection record in chat db
|
||||
void $ withCCTransaction alice $ \db ->
|
||||
DB.execute_ db "DELETE FROM connections WHERE contact_id = (SELECT contact_id FROM contacts WHERE local_display_name = 'cath')"
|
||||
@@ -2275,17 +2282,17 @@ testUsersDifferentCIExpirationTTL ps = do
|
||||
-- set ttl for first user
|
||||
alice ##> "/user alice"
|
||||
showActiveUser alice "alice (Alice)"
|
||||
alice #$> ("/_ttl 1 2", id, "ok")
|
||||
alice #$> ("/_ttl 1 10", id, "ok")
|
||||
|
||||
-- set ttl for second user
|
||||
alice ##> "/user alisa"
|
||||
showActiveUser alice "alisa"
|
||||
alice #$> ("/_ttl 2 4", id, "ok")
|
||||
alice #$> ("/_ttl 2 25", id, "ok")
|
||||
|
||||
-- first user messages
|
||||
alice ##> "/user alice"
|
||||
showActiveUser alice "alice (Alice)"
|
||||
alice #$> ("/ttl", id, "old messages are set to be deleted after: 2 second(s)")
|
||||
alice #$> ("/ttl", id, "old messages are set to be deleted after: 10 second(s)")
|
||||
|
||||
alice #> "@bob alice 3"
|
||||
bob <# "alice> alice 3"
|
||||
@@ -2297,7 +2304,7 @@ testUsersDifferentCIExpirationTTL ps = do
|
||||
-- second user messages
|
||||
alice ##> "/user alisa"
|
||||
showActiveUser alice "alisa"
|
||||
alice #$> ("/ttl", id, "old messages are set to be deleted after: 4 second(s)")
|
||||
alice #$> ("/ttl", id, "old messages are set to be deleted after: 25 second(s)")
|
||||
|
||||
alice #> "@bob alisa 3"
|
||||
bob <# "alisa> alisa 3"
|
||||
@@ -2306,7 +2313,7 @@ testUsersDifferentCIExpirationTTL ps = do
|
||||
|
||||
alice #$> ("/_get chat @5 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")])
|
||||
|
||||
threadDelay 3000000
|
||||
threadDelay 12000000
|
||||
|
||||
-- messages both before and after setting chat item ttl are deleted
|
||||
-- first user messages
|
||||
@@ -2319,7 +2326,7 @@ testUsersDifferentCIExpirationTTL ps = do
|
||||
showActiveUser alice "alisa"
|
||||
alice #$> ("/_get chat @5 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")])
|
||||
|
||||
threadDelay 2100000
|
||||
threadDelay 15000000
|
||||
|
||||
alice #$> ("/_get chat @5 count=100", chat, [(1,"chat banner")])
|
||||
where
|
||||
@@ -2330,13 +2337,13 @@ testUsersRestartCIExpiration ps = do
|
||||
withNewTestChat ps "bob" bobProfile $ \bob -> do
|
||||
withNewTestChatCfg ps cfg "alice" aliceProfile $ \alice -> do
|
||||
-- set ttl for first user
|
||||
alice #$> ("/_ttl 1 2", id, "ok")
|
||||
alice #$> ("/_ttl 1 10", id, "ok")
|
||||
connectUsers alice bob
|
||||
|
||||
-- create second user and set ttl
|
||||
alice ##> "/create user alisa"
|
||||
showActiveUser alice "alisa"
|
||||
alice #$> ("/_ttl 2 5", id, "ok")
|
||||
alice #$> ("/_ttl 2 25", id, "ok")
|
||||
connectUsers alice bob
|
||||
|
||||
-- first user messages
|
||||
@@ -2368,7 +2375,7 @@ testUsersRestartCIExpiration ps = do
|
||||
-- first user messages
|
||||
alice ##> "/user alice"
|
||||
showActiveUser alice "alice (Alice)"
|
||||
alice #$> ("/ttl", id, "old messages are set to be deleted after: 2 second(s)")
|
||||
alice #$> ("/ttl", id, "old messages are set to be deleted after: 10 second(s)")
|
||||
|
||||
alice #> "@bob alice 3"
|
||||
bob <# "alice> alice 3"
|
||||
@@ -2380,7 +2387,7 @@ testUsersRestartCIExpiration ps = do
|
||||
-- second user messages
|
||||
alice ##> "/user alisa"
|
||||
showActiveUser alice "alisa"
|
||||
alice #$> ("/ttl", id, "old messages are set to be deleted after: 5 second(s)")
|
||||
alice #$> ("/ttl", id, "old messages are set to be deleted after: 25 second(s)")
|
||||
|
||||
alice #> "@bob alisa 3"
|
||||
bob <# "alisa> alisa 3"
|
||||
@@ -2389,7 +2396,7 @@ testUsersRestartCIExpiration ps = do
|
||||
|
||||
alice #$> ("/_get chat @5 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")])
|
||||
|
||||
threadDelay 3000000
|
||||
threadDelay 12000000
|
||||
|
||||
-- messages both before and after restart are deleted
|
||||
-- first user messages
|
||||
@@ -2402,7 +2409,7 @@ testUsersRestartCIExpiration ps = do
|
||||
showActiveUser alice "alisa"
|
||||
alice #$> ("/_get chat @5 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")])
|
||||
|
||||
threadDelay 4000000
|
||||
threadDelay 15000000
|
||||
|
||||
alice #$> ("/_get chat @5 count=100", chat, [(1,"chat banner")])
|
||||
where
|
||||
@@ -2490,7 +2497,7 @@ testDisableCIExpirationOnlyForOneUser ps = do
|
||||
-- create second user and set ttl
|
||||
alice ##> "/create user alisa"
|
||||
showActiveUser alice "alisa"
|
||||
alice #$> ("/_ttl 2 1", id, "ok")
|
||||
alice #$> ("/_ttl 2 5", id, "ok")
|
||||
connectUsers alice bob
|
||||
|
||||
-- first user disables expiration
|
||||
@@ -2502,7 +2509,7 @@ testDisableCIExpirationOnlyForOneUser ps = do
|
||||
-- second user still has ttl configured
|
||||
alice ##> "/user alisa"
|
||||
showActiveUser alice "alisa"
|
||||
alice #$> ("/ttl", id, "old messages are set to be deleted after: 1 second(s)")
|
||||
alice #$> ("/ttl", id, "old messages are set to be deleted after: 5 second(s)")
|
||||
|
||||
alice #> "@bob alisa 1"
|
||||
bob <# "alisa> alisa 1"
|
||||
@@ -2511,7 +2518,7 @@ testDisableCIExpirationOnlyForOneUser ps = do
|
||||
|
||||
alice #$> ("/_get chat @5 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2")])
|
||||
|
||||
threadDelay 2000000
|
||||
threadDelay 6000000
|
||||
|
||||
-- second user messages are deleted
|
||||
alice #$> ("/_get chat @5 count=100", chat, [(1,"chat banner")])
|
||||
@@ -2521,7 +2528,7 @@ testDisableCIExpirationOnlyForOneUser ps = do
|
||||
alice <## "subscribed 1 connections on server localhost"
|
||||
|
||||
-- second user still has ttl configured after restart
|
||||
alice #$> ("/ttl", id, "old messages are set to be deleted after: 1 second(s)")
|
||||
alice #$> ("/ttl", id, "old messages are set to be deleted after: 5 second(s)")
|
||||
|
||||
alice #> "@bob alisa 3"
|
||||
bob <# "alisa> alisa 3"
|
||||
@@ -2530,7 +2537,7 @@ testDisableCIExpirationOnlyForOneUser ps = do
|
||||
|
||||
alice #$> ("/_get chat @5 count=100", chat, [(1,"chat banner"), (1, "alisa 3"), (0, "alisa 4")])
|
||||
|
||||
threadDelay 3000000
|
||||
threadDelay 6000000
|
||||
|
||||
-- second user messages are deleted
|
||||
alice #$> ("/_get chat @5 count=100", chat, [(1,"chat banner")])
|
||||
@@ -2542,13 +2549,13 @@ testUsersTimedMessages ps' = do
|
||||
withNewTestChat ps "bob" bobProfile $ \bob -> do
|
||||
withNewTestChat ps "alice" aliceProfile $ \alice -> do
|
||||
connectUsers alice bob
|
||||
configureTimedMessages alice bob "2" "2"
|
||||
configureTimedMessages alice bob "2" "8"
|
||||
|
||||
-- create second user and configure timed messages for contact
|
||||
alice ##> "/create user alisa"
|
||||
showActiveUser alice "alisa"
|
||||
connectUsers alice bob
|
||||
configureTimedMessages alice bob "5" "3"
|
||||
configureTimedMessages alice bob "5" "16"
|
||||
|
||||
-- first user messages
|
||||
alice ##> "/user alice"
|
||||
@@ -2569,7 +2576,7 @@ testUsersTimedMessages ps' = do
|
||||
alice <# "bob> alisa 2"
|
||||
|
||||
-- messages are deleted after ttl
|
||||
threadDelay 1500000
|
||||
threadDelay 6000000
|
||||
|
||||
alice ##> "/user alice"
|
||||
showActiveUser alice "alice (Alice)"
|
||||
@@ -2579,7 +2586,7 @@ testUsersTimedMessages ps' = do
|
||||
showActiveUser alice "alisa"
|
||||
alice #$> ("/_get chat @5 count=100", chat, [(1,"chat banner"), (1, "alisa 1"), (0, "alisa 2")])
|
||||
|
||||
threadDelay 1000000
|
||||
threadDelay 4000000
|
||||
|
||||
alice <### ["[user: alice] timed message deleted: alice 1", "[user: alice] timed message deleted: alice 2"]
|
||||
bob <### ["timed message deleted: alice 1", "timed message deleted: alice 2"]
|
||||
@@ -2592,7 +2599,7 @@ testUsersTimedMessages ps' = do
|
||||
showActiveUser alice "alisa"
|
||||
alice #$> ("/_get chat @5 count=100", chat, [(1,"chat banner"), (1, "alisa 1"), (0, "alisa 2")])
|
||||
|
||||
threadDelay 1000000
|
||||
threadDelay 7000000
|
||||
|
||||
alice <### ["timed message deleted: alisa 1", "timed message deleted: alisa 2"]
|
||||
bob <### ["timed message deleted: alisa 1", "timed message deleted: alisa 2"]
|
||||
@@ -2632,7 +2639,7 @@ testUsersTimedMessages ps' = do
|
||||
alice #$> ("/_get chat @5 count=100", chat, [(1,"chat banner"), (1, "alisa 3"), (0, "alisa 4")])
|
||||
|
||||
-- messages are deleted after restart
|
||||
threadDelay 1000000
|
||||
threadDelay 8000000
|
||||
|
||||
alice <### ["[user: alice] timed message deleted: alice 3", "[user: alice] timed message deleted: alice 4"]
|
||||
bob <### ["timed message deleted: alice 3", "timed message deleted: alice 4"]
|
||||
@@ -2645,7 +2652,7 @@ testUsersTimedMessages ps' = do
|
||||
showActiveUser alice "alisa"
|
||||
alice #$> ("/_get chat @5 count=100", chat, [(1,"chat banner"), (1, "alisa 3"), (0, "alisa 4")])
|
||||
|
||||
threadDelay 1000000
|
||||
threadDelay 8000000
|
||||
|
||||
alice <### ["timed message deleted: alisa 3", "timed message deleted: alisa 4"]
|
||||
bob <### ["timed message deleted: alisa 3", "timed message deleted: alisa 4"]
|
||||
@@ -2827,17 +2834,17 @@ testSetChatItemTTL =
|
||||
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
||||
alice <## "completed uploading file 1 (test.jpg) for bob"
|
||||
-- above items should be deleted after we set ttl
|
||||
threadDelay 3000000
|
||||
threadDelay 6000000
|
||||
alice #> "@bob 3"
|
||||
bob <# "alice> 3"
|
||||
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 (tmpFile alice "app_files/test.jpg") $
|
||||
alice #$> ("/_ttl 1 2", id, "ok")
|
||||
alice #$> ("/_ttl 1 5", 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")])
|
||||
alice #$> ("/_ttl 1", id, "old messages are set to be deleted after: 2 second(s)")
|
||||
alice #$> ("/_ttl 1", id, "old messages are set to be deleted after: 5 second(s)")
|
||||
alice #$> ("/ttl week", id, "ok")
|
||||
alice #$> ("/ttl", id, "old messages are set to be deleted after: one week")
|
||||
alice #$> ("/ttl none", id, "ok")
|
||||
@@ -2861,13 +2868,13 @@ testSetDirectChatTTL =
|
||||
alice #$> ("/ttl @cath none", id, "ok")
|
||||
alice #$> ("/ttl @cath", id, "old messages are not being deleted")
|
||||
|
||||
threadDelay 3000000
|
||||
threadDelay 6000000
|
||||
alice #> "@bob 3"
|
||||
bob <# "alice> 3"
|
||||
bob #> "@alice 4"
|
||||
alice <# "bob> 4"
|
||||
alice #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((1, "1"), Nothing), ((0, "2"), Nothing), ((1, "3"), Nothing), ((0, "4"), Nothing)])
|
||||
alice #$> ("/_ttl 1 2", id, "ok")
|
||||
alice #$> ("/_ttl 1 5", id, "ok")
|
||||
-- when expiration is turned on, first cycle is synchronous
|
||||
alice #$> ("/_get chat @2 count=100", chat, [(1, "chat banner"), (1, "3"), (0, "4")])
|
||||
|
||||
@@ -3116,13 +3123,15 @@ testMsgDecryptError ps =
|
||||
withTestChat ps "bob" $ \bob -> do
|
||||
bob <## "subscribed 1 connections on server localhost"
|
||||
alice #> "@bob hello again"
|
||||
bob <# "alice> skipped message ID 9..11"
|
||||
bob <# "alice> skipped message ID 7..9"
|
||||
bob <# "alice> hello again"
|
||||
bob #> "@alice received!"
|
||||
alice <# "bob> received!"
|
||||
|
||||
setupDesynchronizedRatchet :: HasCallStack => TestParams -> TestCC -> IO ()
|
||||
setupDesynchronizedRatchet ps alice = do
|
||||
alice ##> "/set receipts all off"
|
||||
alice <## "ok"
|
||||
copyDb "bob" "bob_old"
|
||||
withTestChat ps "bob" $ \bob -> do
|
||||
bob <## "subscribed 1 connections on server localhost"
|
||||
|
||||
@@ -262,7 +262,7 @@ chatGroupTests = do
|
||||
-- TODO - cancellation on failure to create relay group (for owner)
|
||||
-- TODO - async retry connecting to relay (for members)
|
||||
-- TODO - test relay privileges
|
||||
describe "channels" $ do
|
||||
sequential $ describe "channels" $ do
|
||||
describe "relay delivery" $ do
|
||||
describe "single relay" $ do
|
||||
it "should deliver messages to members" testChannels1RelayDeliver
|
||||
@@ -3501,7 +3501,7 @@ testGLinkRejectBlockedName =
|
||||
bob <## "#team: joining the group..."
|
||||
bob <## "#team: join rejected, reason: GRRBlockedName"
|
||||
|
||||
threadDelay 100000
|
||||
threadDelay 1000000
|
||||
|
||||
alice `hasContactProfiles` ["alice"]
|
||||
memCount <- withCCTransaction alice $ \db ->
|
||||
@@ -4097,13 +4097,15 @@ testGroupMsgDecryptError ps =
|
||||
withTestChat ps "bob" $ \bob -> do
|
||||
bob <## "subscribed 2 connections on server localhost"
|
||||
alice #> "#team hello again"
|
||||
bob <# "#team alice> skipped message ID 8..10"
|
||||
bob <# "#team alice> skipped message ID 6..8"
|
||||
bob <# "#team alice> hello again"
|
||||
bob #> "#team received!"
|
||||
alice <# "#team bob> received!"
|
||||
|
||||
setupDesynchronizedRatchet :: HasCallStack => TestParams -> TestCC -> IO ()
|
||||
setupDesynchronizedRatchet ps alice = do
|
||||
alice ##> "/set receipts all off"
|
||||
alice <## "ok"
|
||||
copyDb "bob" "bob_old"
|
||||
withTestChat ps "bob" $ \bob -> do
|
||||
bob <## "subscribed 2 connections on server localhost"
|
||||
@@ -6482,12 +6484,12 @@ testGroupHistoryDisappearingMessage =
|
||||
threadDelay 1000000
|
||||
|
||||
-- 3 seconds so that messages 2 and 3 are not deleted for alice before sending history to cath
|
||||
alice ##> "/set disappear #team on 4"
|
||||
alice ##> "/set disappear #team on 15"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Disappearing messages: on (4 sec)"
|
||||
alice <## "Disappearing messages: on (15 sec)"
|
||||
bob <## "alice updated group #team: (signed)"
|
||||
bob <## "updated group preferences:"
|
||||
bob <## "Disappearing messages: on (4 sec)"
|
||||
bob <## "Disappearing messages: on (15 sec)"
|
||||
|
||||
bob #> "#team 2"
|
||||
alice <# "#team bob> 2"
|
||||
@@ -6531,6 +6533,7 @@ testGroupHistoryDisappearingMessage =
|
||||
r1 <- chat <$> getTermLine cath
|
||||
r1 `shouldContain` [(0, "1"), (0, "2"), (0, "3"), (0, "4")]
|
||||
|
||||
threadDelay 11000000
|
||||
concurrentlyN_
|
||||
[ alice
|
||||
<### [ "timed message deleted: 2",
|
||||
@@ -7614,6 +7617,7 @@ testGroupMemberInactive ps = do
|
||||
bob <# "#team alice> hi"
|
||||
bob #> "#team hey"
|
||||
alice <# "#team bob> hey"
|
||||
threadDelay 1000000
|
||||
|
||||
-- bob is offline
|
||||
alice #> "#team 1"
|
||||
|
||||
+34
-34
@@ -1627,7 +1627,7 @@ testPlanAddressContactViaAddress =
|
||||
bob ##> ("/c " <> cLink)
|
||||
connecting alice bob
|
||||
|
||||
bob ##> "/delete @alice"
|
||||
bob ##> "/delete @alice notify=off"
|
||||
bob <## "alice: contact is deleted"
|
||||
alice ##> "/delete @bob"
|
||||
alice <## "bob: contact is deleted"
|
||||
@@ -1689,7 +1689,7 @@ testPlanAddressContactViaShortAddress =
|
||||
bob ##> ("/c " <> sLink)
|
||||
connecting alice bob
|
||||
|
||||
bob ##> "/delete @alice"
|
||||
bob ##> "/delete @alice notify=off"
|
||||
bob <## "alice: contact is deleted"
|
||||
alice ##> "/delete @bob"
|
||||
alice <## "bob: contact is deleted"
|
||||
@@ -2803,41 +2803,41 @@ testEnableTimedMessagesContact =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
connectUsers alice bob
|
||||
alice ##> "/_set prefs @2 {\"timedMessages\": {\"allow\": \"yes\", \"ttl\": 1}}"
|
||||
alice ##> "/_set prefs @2 {\"timedMessages\": {\"allow\": \"yes\", \"ttl\": 3}}"
|
||||
alice <## "you updated preferences for bob:"
|
||||
alice <## "Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes)"
|
||||
alice <## "Disappearing messages: enabled (you allow: yes (3 sec), contact allows: yes)"
|
||||
bob <## "alice updated preferences for you:"
|
||||
bob <## "Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes (1 sec))"
|
||||
bob <## "Disappearing messages: enabled (you allow: yes (3 sec), contact allows: yes (3 sec))"
|
||||
bob ##> "/set disappear @alice yes"
|
||||
bob <## "your preferences for alice did not change"
|
||||
alice <##> bob
|
||||
threadDelay 500000
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (1 sec)"), (1, "hi"), (0, "hey")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (1 sec)"), (0, "hi"), (1, "hey")])
|
||||
threadDelay 1000000
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (3 sec)"), (1, "hi"), (0, "hey")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (3 sec)"), (0, "hi"), (1, "hey")])
|
||||
threadDelay 3000000
|
||||
alice <### ["timed message deleted: hi", "timed message deleted: hey"]
|
||||
bob <### ["timed message deleted: hi", "timed message deleted: hey"]
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (1 sec)")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (1 sec)")])
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (3 sec)")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (3 sec)")])
|
||||
-- turn off, messages are not disappearing
|
||||
bob ##> "/set disappear @alice no"
|
||||
bob <## "you updated preferences for alice:"
|
||||
bob <## "Disappearing messages: off (you allow: no, contact allows: yes (1 sec))"
|
||||
bob <## "Disappearing messages: off (you allow: no, contact allows: yes (3 sec))"
|
||||
alice <## "bob updated preferences for you:"
|
||||
alice <## "Disappearing messages: off (you allow: yes (1 sec), contact allows: no)"
|
||||
alice <## "Disappearing messages: off (you allow: yes (3 sec), contact allows: no)"
|
||||
alice <##> bob
|
||||
threadDelay 1500000
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (1 sec)"), (0, "Disappearing messages: off"), (1, "hi"), (0, "hey")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (1 sec)"), (1, "Disappearing messages: off"), (0, "hi"), (1, "hey")])
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (3 sec)"), (0, "Disappearing messages: off"), (1, "hi"), (0, "hey")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (3 sec)"), (1, "Disappearing messages: off"), (0, "hi"), (1, "hey")])
|
||||
-- test api
|
||||
bob ##> "/set disappear @alice yes 30s"
|
||||
bob <## "you updated preferences for alice:"
|
||||
bob <## "Disappearing messages: enabled (you allow: yes (30 sec), contact allows: yes (1 sec))"
|
||||
bob <## "Disappearing messages: enabled (you allow: yes (30 sec), contact allows: yes (3 sec))"
|
||||
alice <## "bob updated preferences for you:"
|
||||
alice <## "Disappearing messages: enabled (you allow: yes (30 sec), contact allows: yes (30 sec))"
|
||||
bob ##> "/set disappear @alice week" -- "yes" is optional
|
||||
bob <## "you updated preferences for alice:"
|
||||
bob <## "Disappearing messages: enabled (you allow: yes (1 week), contact allows: yes (1 sec))"
|
||||
bob <## "Disappearing messages: enabled (you allow: yes (1 week), contact allows: yes (3 sec))"
|
||||
alice <## "bob updated preferences for you:"
|
||||
alice <## "Disappearing messages: enabled (you allow: yes (1 week), contact allows: yes (1 week))"
|
||||
|
||||
@@ -2847,23 +2847,23 @@ testEnableTimedMessagesGroup =
|
||||
\alice bob -> do
|
||||
createGroup2 "team" alice bob
|
||||
threadDelay 1000000
|
||||
alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"timedMessages\": {\"enable\": \"on\", \"ttl\": 1}, \"directMessages\": {\"enable\": \"on\"}, \"history\": {\"enable\": \"on\"}}}"
|
||||
alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"\", \"groupPreferences\": {\"timedMessages\": {\"enable\": \"on\", \"ttl\": 3}, \"directMessages\": {\"enable\": \"on\"}, \"history\": {\"enable\": \"on\"}}}"
|
||||
alice <## "updated group preferences:"
|
||||
alice <## "Disappearing messages: on (1 sec)"
|
||||
alice <## "Disappearing messages: on (3 sec)"
|
||||
bob <## "alice updated group #team: (signed)"
|
||||
bob <## "updated group preferences:"
|
||||
bob <## "Disappearing messages: on (1 sec)"
|
||||
bob <## "Disappearing messages: on (3 sec)"
|
||||
threadDelay 1000000
|
||||
alice #> "#team hi"
|
||||
bob <# "#team alice> hi"
|
||||
threadDelay 500000
|
||||
alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "Disappearing messages: on (1 sec)"), (1, "hi")])
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on (1 sec)"), (0, "hi")])
|
||||
threadDelay 1000000
|
||||
alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "Disappearing messages: on (3 sec)"), (1, "hi")])
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on (3 sec)"), (0, "hi")])
|
||||
threadDelay 3000000
|
||||
alice <## "timed message deleted: hi"
|
||||
bob <## "timed message deleted: hi"
|
||||
alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "Disappearing messages: on (1 sec)")])
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on (1 sec)")])
|
||||
alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "Disappearing messages: on (3 sec)")])
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on (3 sec)")])
|
||||
-- turn off, messages are not disappearing
|
||||
alice ##> "/set disappear #team off"
|
||||
alice <## "updated group preferences:"
|
||||
@@ -2875,8 +2875,8 @@ testEnableTimedMessagesGroup =
|
||||
alice #> "#team hey"
|
||||
bob <# "#team alice> hey"
|
||||
threadDelay 1500000
|
||||
alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "Disappearing messages: on (1 sec)"), (1, "Disappearing messages: off"), (1, "hey")])
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on (1 sec)"), (0, "Disappearing messages: off"), (0, "hey")])
|
||||
alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "connected"), (1, "Disappearing messages: on (3 sec)"), (1, "Disappearing messages: off"), (1, "hey")])
|
||||
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "Disappearing messages: on (3 sec)"), (0, "Disappearing messages: off"), (0, "hey")])
|
||||
-- test api
|
||||
alice ##> "/set disappear #team on 30s"
|
||||
alice <## "updated group preferences:"
|
||||
@@ -2898,20 +2898,20 @@ testTimedMessagesEnabledGlobally =
|
||||
alice ##> "/set disappear yes"
|
||||
alice <## "user profile did not change"
|
||||
connectUsers alice bob
|
||||
bob ##> "/_set prefs @2 {\"timedMessages\": {\"allow\": \"yes\", \"ttl\": 1}}"
|
||||
bob ##> "/_set prefs @2 {\"timedMessages\": {\"allow\": \"yes\", \"ttl\": 3}}"
|
||||
bob <## "you updated preferences for alice:"
|
||||
bob <## "Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes)"
|
||||
bob <## "Disappearing messages: enabled (you allow: yes (3 sec), contact allows: yes)"
|
||||
alice <## "bob updated preferences for you:"
|
||||
alice <## "Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes (1 sec))"
|
||||
alice <## "Disappearing messages: enabled (you allow: yes (3 sec), contact allows: yes (3 sec))"
|
||||
alice <##> bob
|
||||
threadDelay 500000
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (1 sec)"), (1, "hi"), (0, "hey")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (1 sec)"), (0, "hi"), (1, "hey")])
|
||||
threadDelay 1000000
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (3 sec)"), (1, "hi"), (0, "hey")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (3 sec)"), (0, "hi"), (1, "hey")])
|
||||
threadDelay 3000000
|
||||
alice <### ["timed message deleted: hi", "timed message deleted: hey"]
|
||||
bob <### ["timed message deleted: hi", "timed message deleted: hey"]
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (1 sec)")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (1 sec)")])
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "Disappearing messages: enabled (3 sec)")])
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(1, "Disappearing messages: enabled (3 sec)")])
|
||||
|
||||
testUpdateMultipleUserPrefs :: HasCallStack => TestParams -> IO ()
|
||||
testUpdateMultipleUserPrefs = testChat3 aliceProfile bobProfile cathProfile $
|
||||
|
||||
@@ -94,7 +94,7 @@ it :: HasCallStack => String -> (ps -> Expectation) -> SpecWith (Arg (ps -> Expe
|
||||
it name test =
|
||||
Hspec.it name $ \tmp -> timeout t (test tmp) >>= maybe (error "test timed out") pure
|
||||
where
|
||||
t = 90 * 1000000
|
||||
t = 180 * 1000000
|
||||
|
||||
xit' :: HasCallStack => String -> (ps -> Expectation) -> SpecWith (Arg (ps -> Expectation))
|
||||
xit' = if os == "linux" then xit else it
|
||||
@@ -350,7 +350,7 @@ itemId i = show $ length chatFeatures + i
|
||||
|
||||
(@@@) :: HasCallStack => TestCC -> [(String, String)] -> Expectation
|
||||
(@@@) cc res = do
|
||||
threadDelay 100000
|
||||
threadDelay 500000
|
||||
getChats mapChats cc res
|
||||
|
||||
mapChats :: [(String, String, Maybe ConnStatus)] -> [(String, String)]
|
||||
|
||||
Reference in new issue
Block a user