dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-05-27 00:54:46 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into short-links

Browse Source
This commit is contained in:
Evgeny Poberezkin
2024-07-25 13:15:34 +01:00
parent f334843e01 9093c7b120
commit a10d128cdc
7 changed files with 98 additions and 82 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tests/CoreTests/TRcvQueuesTests.hs
+21 -20
View File
@@ -1,6 +1,7 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
module CoreTests.TRcvQueuesTests where
@@ -30,13 +31,13 @@ tRcvQueuesTests = do
describe "queue transfer" $ do
it "getDelSessQueues-batchAddQueues preserves total length" removeSubsTest
checkDataInvariant :: RQ.TRcvQueues -> IO Bool
checkDataInvariant :: RQ.Queue q => RQ.TRcvQueues q -> IO Bool
checkDataInvariant trq = atomically $ do
conns <- readTVar $ RQ.getConnections trq
qs <- readTVar $ RQ.getRcvQueues trq
-- three invariant checks
let inv1 = all (\cId -> (S.fromList . L.toList <$> M.lookup cId conns) == Just (M.keysSet (M.filter (\q -> connId q == cId) qs))) (M.keys conns)
inv2 = all (\(k, q) -> maybe False ((k `elem`) . L.toList) (M.lookup (connId q) conns)) (M.assocs qs)
let inv1 = all (\cId -> (S.fromList . L.toList <$> M.lookup cId conns) == Just (M.keysSet (M.filter (\q -> RQ.connId' q == cId) qs))) (M.keys conns)
inv2 = all (\(k, q) -> maybe False ((k `elem`) . L.toList) (M.lookup (RQ.connId' q) conns)) (M.assocs qs)
inv3 = all (\(k, q) -> RQ.qKey q == k) (M.assocs qs)
pure $ inv1 && inv2 && inv3
@@ -76,7 +77,7 @@ batchIdempotentTest = do
atomically $ RQ.batchAddQueues trq qs
checkDataInvariant trq `shouldReturn` True
readTVarIO (RQ.getRcvQueues trq) `shouldReturn` qs'
fmap L.nub <$> readTVarIO (RQ.getConnections trq) `shouldReturn`cs' -- connections get duplicated, but that doesn't appear to affect anybody
fmap L.nub <$> readTVarIO (RQ.getConnections trq) `shouldReturn` cs' -- connections get duplicated, but that doesn't appear to affect anybody
deleteConnTest :: IO ()
deleteConnTest = do
@@ -112,23 +113,23 @@ getDelSessQueuesTest :: IO ()
getDelSessQueuesTest = do
trq <- atomically RQ.empty
let qs =
[ dummyRQ 0 "smp://1234-w==@alpha" "c1",
dummyRQ 0 "smp://1234-w==@alpha" "c2",
dummyRQ 0 "smp://1234-w==@beta" "c3",
dummyRQ 1 "smp://1234-w==@beta" "c4"
[ ("1", dummyRQ 0 "smp://1234-w==@alpha" "c1"),
("1", dummyRQ 0 "smp://1234-w==@alpha" "c2"),
("1", dummyRQ 0 "smp://1234-w==@beta" "c3"),
("1", dummyRQ 1 "smp://1234-w==@beta" "c4")
]
atomically $ RQ.batchAddQueues trq qs
checkDataInvariant trq `shouldReturn` True
-- no user
atomically (RQ.getDelSessQueues (2, "smp://1234-w==@alpha", Nothing) trq) `shouldReturn` ([], [])
atomically (RQ.getDelSessQueues (2, "smp://1234-w==@alpha", Nothing) "1" trq) `shouldReturn` ([], [])
checkDataInvariant trq `shouldReturn` True
-- wrong user
atomically (RQ.getDelSessQueues (1, "smp://1234-w==@alpha", Nothing) trq) `shouldReturn` ([], [])
atomically (RQ.getDelSessQueues (1, "smp://1234-w==@alpha", Nothing) "1" trq) `shouldReturn` ([], [])
checkDataInvariant trq `shouldReturn` True
-- connections intact
atomically (RQ.hasConn "c1" trq) `shouldReturn` True
atomically (RQ.hasConn "c2" trq) `shouldReturn` True
atomically (RQ.getDelSessQueues (0, "smp://1234-w==@alpha", Nothing) trq) `shouldReturn` ([dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@alpha" "c1"], ["c1", "c2"])
atomically (RQ.getDelSessQueues (0, "smp://1234-w==@alpha", Nothing) "1" trq) `shouldReturn` ([dummyRQ 0 "smp://1234-w==@alpha" "c2", dummyRQ 0 "smp://1234-w==@alpha" "c1"], ["c1", "c2"])
checkDataInvariant trq `shouldReturn` True
-- connections gone
atomically (RQ.hasConn "c1" trq) `shouldReturn` False
@@ -141,29 +142,29 @@ removeSubsTest :: IO ()
removeSubsTest = do
aq <- atomically RQ.empty
let qs =
[ dummyRQ 0 "smp://1234-w==@alpha" "c1",
dummyRQ 0 "smp://1234-w==@alpha" "c2",
dummyRQ 0 "smp://1234-w==@beta" "c3",
dummyRQ 1 "smp://1234-w==@beta" "c4"
[ ("1", dummyRQ 0 "smp://1234-w==@alpha" "c1"),
("1", dummyRQ 0 "smp://1234-w==@alpha" "c2"),
("1", dummyRQ 0 "smp://1234-w==@beta" "c3"),
("1", dummyRQ 1 "smp://1234-w==@beta" "c4")
]
atomically $ RQ.batchAddQueues aq qs
pq <- atomically RQ.empty
atomically (totalSize aq pq) `shouldReturn` (4, 4)
atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@alpha", Nothing) aq >>= RQ.batchAddQueues pq . fst
atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@alpha", Nothing) "1" aq >>= RQ.batchAddQueues pq . map ("1",) . fst
atomically (totalSize aq pq) `shouldReturn` (4, 4)
atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@beta", Just "non-existent") aq >>= RQ.batchAddQueues pq . fst
atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@beta", Just "non-existent") "1" aq >>= RQ.batchAddQueues pq . map ("1",) . fst
atomically (totalSize aq pq) `shouldReturn` (4, 4)
atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@localhost", Nothing) aq >>= RQ.batchAddQueues pq . fst
atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@localhost", Nothing) "1" aq >>= RQ.batchAddQueues pq . map ("1",) . fst
atomically (totalSize aq pq) `shouldReturn` (4, 4)
atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@beta", Just "c3") aq >>= RQ.batchAddQueues pq . fst
atomically $ RQ.getDelSessQueues (0, "smp://1234-w==@beta", Just "c3") "1" aq >>= RQ.batchAddQueues pq . map ("1",) . fst
atomically (totalSize aq pq) `shouldReturn` (4, 4)
totalSize :: RQ.TRcvQueues -> RQ.TRcvQueues -> STM (Int, Int)
totalSize :: RQ.TRcvQueues q -> RQ.TRcvQueues q -> STM (Int, Int)
totalSize a b = do
qsizeA <- M.size <$> readTVar (RQ.getRcvQueues a)
qsizeB <- M.size <$> readTVar (RQ.getRcvQueues b)