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

wip

Browse Source
This commit is contained in:
spaced4ndy
2026-08-12 18:31:55 +04:00
parent 247e327ebe
commit 261e6103f8
22 changed files with 598 additions and 102 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tests/Bots/DirectoryTests.hs
+95 -76
View File
@@ -45,6 +45,7 @@ directoryServiceTests = do
it "should support group names with spaces" testGroupNameWithSpaces
it "should return more groups in search, all and recent groups" testSearchGroups
it "should page from the sort key, not group ID" testSearchGroupsPaging
it "should answer search over service RPC" testDirectorySearchRpc
it "should invite to owners' group if specified" testInviteToOwnersGroup
it "should re-invite owner who left owners' group" testInviteOwnerAfterLeavingOwnersGroup
describe "de-listing the group" $ do
@@ -156,7 +157,7 @@ viewName = T.unpack . MD.viewName . T.pack
testDirectoryService :: HasCallStack => TestParams -> IO ()
testDirectoryService ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -277,7 +278,7 @@ testDirectoryService ps =
testSuspendResume :: HasCallStack => TestParams -> IO ()
testSuspendResume ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob -> do
bob `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
@@ -349,7 +350,7 @@ testSuspendResume ps =
testDeleteGroup :: HasCallStack => TestParams -> IO ()
testDeleteGroup ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob -> do
bob `connectVia` dsLink
registerGroup superUser bob "privacy" "Privacy"
@@ -361,7 +362,7 @@ testDeleteGroup ps =
testDeleteGroupAdmin :: HasCallStack => TestParams -> IO ()
testDeleteGroupAdmin ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob -> do
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -395,7 +396,7 @@ testDeleteGroupAdmin ps =
testSetRole :: HasCallStack => TestParams -> IO ()
testSetRole ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -432,7 +433,7 @@ testSetRole ps =
testJoinGroup :: HasCallStack => TestParams -> IO ()
testJoinGroup ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob -> do
withNewTestChat ps "cath" cathProfile $ \cath ->
withNewTestChat ps "dan" danProfile $ \dan -> do
@@ -488,7 +489,7 @@ testJoinGroup ps =
testGroupNameWithSpaces :: HasCallStack => TestParams -> IO ()
testGroupNameWithSpaces ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob -> do
bob `connectVia` dsLink
registerGroup superUser bob "Privacy & Security" ""
@@ -506,7 +507,7 @@ testGroupNameWithSpaces ps =
testSearchGroups :: HasCallStack => TestParams -> IO ()
testSearchGroups ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob -> do
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -594,7 +595,7 @@ testSearchGroups ps =
-- group has the most members, so it sorts first, and a group_id cursor would send it again.
testSearchGroupsPaging :: HasCallStack => TestParams -> IO ()
testSearchGroupsPaging ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob -> do
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -652,9 +653,25 @@ testSearchGroupsPaging ps =
u <##. "Link to join the group "
u <## (show count <> " members")
-- the app path: a client that is not a contact searches the directory over the service RPC
testDirectorySearchRpc :: HasCallStack => TestParams -> IO ()
testDirectorySearchRpc ps =
withDirectoryService ps $ \superUser (dsShortLink, _) ->
withNewTestChat ps "bob" bobProfile $ \bob -> do
bob `connectVia` dsShortLink
registerGroupId superUser bob "PrivacyGroup" "" 1 1
withNewTestChat ps "cath" cathProfile $ \cath -> do
-- cath never connects to the directory: the request goes to the address
cath ##> ("/_service_request 1 " <> dsShortLink <> " {\"type\":\"search\",\"searchText\":\"privacy\"}")
cath <##. "service response: {\"entries\":[{"
cath ##> ("/_service_request 1 " <> dsShortLink <> " {\"type\":\"search\",\"searchText\":\"nothing matches this\"}")
cath <## "service response: {\"entries\":[],\"type\":\"searchResults\"}"
cath ##> ("/_service_request 1 " <> dsShortLink <> " {\"type\":\"nonsense\"}")
cath <## "service response: {\"errorMessage\":\"unsupported request\",\"type\":\"error\"}"
testInviteToOwnersGroup :: HasCallStack => TestParams -> IO ()
testInviteToOwnersGroup ps =
withDirectoryServiceCfgOwnersGroup ps testCfg True Nothing $ \superUser dsLink ->
withDirectoryServiceCfgOwnersGroup ps testCfg True Nothing $ \superUser (_, dsLink) ->
withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob -> do
bob `connectVia` dsLink
registerGroupId superUser bob "privacy" "Privacy" 2 1
@@ -672,7 +689,7 @@ testInviteToOwnersGroup ps =
testInviteOwnerAfterLeavingOwnersGroup :: HasCallStack => TestParams -> IO ()
testInviteOwnerAfterLeavingOwnersGroup ps =
withDirectoryServiceCfgOwnersGroup ps testCfg True Nothing $ \superUser dsLink ->
withDirectoryServiceCfgOwnersGroup ps testCfg True Nothing $ \superUser (_, dsLink) ->
withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob -> do
bob `connectVia` dsLink
registerGroupId superUser bob "privacy" "Privacy" 2 1
@@ -698,7 +715,7 @@ testInviteOwnerAfterLeavingOwnersGroup ps =
testDelistedOwnerLeaves :: HasCallStack => TestParams -> IO ()
testDelistedOwnerLeaves ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -717,7 +734,7 @@ testDelistedOwnerLeaves ps =
testDelistedOwnerRemoved :: HasCallStack => TestParams -> IO ()
testDelistedOwnerRemoved ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -735,7 +752,7 @@ testDelistedOwnerRemoved ps =
testNotDelistedMemberLeaves :: HasCallStack => TestParams -> IO ()
testNotDelistedMemberLeaves ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -750,7 +767,7 @@ testNotDelistedMemberLeaves ps =
testNotDelistedMemberRemoved :: HasCallStack => TestParams -> IO ()
testNotDelistedMemberRemoved ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -764,7 +781,7 @@ testNotDelistedMemberRemoved ps =
testDelistedServiceRemoved :: HasCallStack => TestParams -> IO ()
testDelistedServiceRemoved ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -782,7 +799,7 @@ testDelistedServiceRemoved ps =
testDelistedGroupDeleted :: HasCallStack => TestParams -> IO ()
testDelistedGroupDeleted ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -806,7 +823,7 @@ testDelistedGroupDeleted ps =
testDelistedRoleChanges :: HasCallStack => TestParams -> IO ()
testDelistedRoleChanges ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -855,7 +872,7 @@ testDelistedRoleChanges ps =
testNotDelistedMemberRoleChanged :: HasCallStack => TestParams -> IO ()
testNotDelistedMemberRoleChanged ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -872,7 +889,7 @@ testNotDelistedMemberRoleChanged ps =
testNotSentApprovalBadRoles :: HasCallStack => TestParams -> IO ()
testNotSentApprovalBadRoles ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -895,7 +912,7 @@ testNotSentApprovalBadRoles ps =
testNotApprovedBadRoles :: HasCallStack => TestParams -> IO ()
testNotApprovedBadRoles ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -922,7 +939,7 @@ testNotApprovedBadRoles ps =
testRegOwnerChangedProfile :: HasCallStack => TestParams -> IO ()
testRegOwnerChangedProfile ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -944,7 +961,7 @@ testRegOwnerChangedProfile ps =
testAnotherOwnerChangedProfile :: HasCallStack => TestParams -> IO ()
testAnotherOwnerChangedProfile ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -966,7 +983,7 @@ testAnotherOwnerChangedProfile ps =
testNotConnectedOwnerChangedProfile :: HasCallStack => TestParams -> IO ()
testNotConnectedOwnerChangedProfile ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
withNewTestChat ps "dan" danProfile $ \dan -> do
@@ -987,7 +1004,7 @@ testNotConnectedOwnerChangedProfile ps =
testRegOwnerRemovedLink :: HasCallStack => TestParams -> IO ()
testRegOwnerRemovedLink ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -1024,7 +1041,7 @@ testRegOwnerRemovedLink ps =
testAnotherOwnerRemovedLink :: HasCallStack => TestParams -> IO ()
testAnotherOwnerRemovedLink ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -1060,7 +1077,7 @@ testAnotherOwnerRemovedLink ps =
testNotConnectedOwnerRemovedLink :: HasCallStack => TestParams -> IO ()
testNotConnectedOwnerRemovedLink ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
withNewTestChat ps "dan" danProfile $ \dan -> do
@@ -1104,7 +1121,7 @@ testNotConnectedOwnerRemovedLink ps =
testDuplicateAskConfirmation :: HasCallStack => TestParams -> IO ()
testDuplicateAskConfirmation ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -1123,7 +1140,7 @@ testDuplicateAskConfirmation ps =
testDuplicateProhibitRegistration :: HasCallStack => TestParams -> IO ()
testDuplicateProhibitRegistration ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -1135,7 +1152,7 @@ testDuplicateProhibitRegistration ps =
testDuplicateProhibitConfirmation :: HasCallStack => TestParams -> IO ()
testDuplicateProhibitConfirmation ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -1154,7 +1171,7 @@ testDuplicateProhibitConfirmation ps =
testDuplicateProhibitWhenUpdated :: HasCallStack => TestParams -> IO ()
testDuplicateProhibitWhenUpdated ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -1185,7 +1202,7 @@ testDuplicateProhibitWhenUpdated ps =
testDuplicateProhibitApproval :: HasCallStack => TestParams -> IO ()
testDuplicateProhibitApproval ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -1211,7 +1228,7 @@ 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 "./tests/tmp/web") $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -1286,7 +1303,7 @@ checkListings listed promoted = do
testAlwaysCaptcha :: HasCallStack => TestParams -> IO ()
testAlwaysCaptcha ps =
withDirectoryServiceOpts ps (\o -> o {alwaysCaptcha = True}) $ \superUser dsLink ->
withDirectoryServiceOpts ps (\o -> o {alwaysCaptcha = True}) $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -1327,7 +1344,7 @@ testAlwaysCaptcha ps =
testKnocking :: HasCallStack => TestParams -> IO ()
testKnocking ps =
withDirectoryServiceOpts ps (\o -> o {knocking = True}) $ \superUser dsLink ->
withDirectoryServiceOpts ps (\o -> o {knocking = True}) $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -1350,7 +1367,7 @@ testKnocking ps =
testCaptchaByDefault :: HasCallStack => TestParams -> IO ()
testCaptchaByDefault ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -1382,7 +1399,7 @@ testCaptchaByDefault ps =
testCapthaScreening :: HasCallStack => TestParams -> IO ()
testCapthaScreening ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -1470,7 +1487,7 @@ testVoiceCaptchaScreening ps@TestParams {tmpPath} = do
"print(5)"
]
setPermissions mockScript $ setOwnerExecutable True $ setOwnerReadable True $ setOwnerWritable True emptyPermissions
withDirectoryServiceVoiceCaptcha ps mockScript $ \superUser dsLink ->
withDirectoryServiceVoiceCaptcha ps mockScript $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -1530,7 +1547,7 @@ testVoiceCaptchaRetry ps@TestParams {tmpPath} = do
"print(5)"
]
setPermissions mockScript $ setOwnerExecutable True $ setOwnerReadable True $ setOwnerWritable True emptyPermissions
withDirectoryServiceVoiceCaptcha ps mockScript $ \superUser dsLink ->
withDirectoryServiceVoiceCaptcha ps mockScript $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -1582,7 +1599,7 @@ testVoiceCaptchaVoiceDisabled ps@TestParams {tmpPath} = do
"print(5)"
]
setPermissions mockScript $ setOwnerExecutable True $ setOwnerReadable True $ setOwnerWritable True emptyPermissions
withDirectoryServiceVoiceCaptcha ps mockScript $ \superUser dsLink ->
withDirectoryServiceVoiceCaptcha ps mockScript $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -1640,7 +1657,7 @@ testVoiceCaptchaOldClient ps@TestParams {tmpPath} = do
"print(5)"
]
setPermissions mockScript $ setOwnerExecutable True $ setOwnerReadable True $ setOwnerWritable True emptyPermissions
withDirectoryServiceVoiceCaptcha ps mockScript $ \superUser dsLink ->
withDirectoryServiceVoiceCaptcha ps mockScript $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChatCfg ps testCfg {chatVRange = (chatVRange testCfg) {maxVersion = prevVersion memberSupportVoiceVersion}} "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -1682,28 +1699,28 @@ testVoiceCaptchaOldClient ps@TestParams {tmpPath} = do
cath <## " Correct, you joined the group privacy"
cath <## "#privacy: you joined the group"
withDirectoryServiceOpts :: HasCallStack => TestParams -> (DirectoryOpts -> DirectoryOpts) -> (TestCC -> String -> IO ()) -> IO ()
withDirectoryServiceOpts :: HasCallStack => TestParams -> (DirectoryOpts -> DirectoryOpts) -> (TestCC -> (String, String) -> IO ()) -> IO ()
withDirectoryServiceOpts ps modOpts test = do
dsLink <-
dsLinks <-
withNewTestChatCfg ps testCfg serviceDbPrefix directoryProfile $ \ds ->
withNewTestChatCfg ps testCfg "super_user" aliceProfile $ \superUser -> do
connectUsers ds superUser
ds ##> "/ad"
getContactLink ds True
ds ##> "/ad pq_ratchet=on"
getContactLinks ds True
let opts = modOpts $ mkDirectoryOpts ps [KnownContact 2 "alice"] Nothing Nothing
runDirectory testCfg opts $
withTestChatCfg ps testCfg "super_user" $ \superUser -> do
superUser <## "subscribed 1 connections on server localhost"
test superUser dsLink
test superUser dsLinks
withDirectoryServiceVoiceCaptcha :: HasCallStack => TestParams -> FilePath -> (TestCC -> String -> IO ()) -> IO ()
withDirectoryServiceVoiceCaptcha :: HasCallStack => TestParams -> FilePath -> (TestCC -> (String, String) -> IO ()) -> IO ()
withDirectoryServiceVoiceCaptcha ps voiceScript =
withDirectoryServiceOpts ps (\o -> o {voiceCaptchaGenerator = Just voiceScript})
testRestoreDirectory :: HasCallStack => TestParams -> IO ()
testRestoreDirectory ps = do
testListUserGroups False ps
restoreDirectoryService ps 11 $ \superUser _dsLink ->
restoreDirectoryService ps 11 $ \superUser (_, _dsLink) ->
withTestChat ps "bob" $ \bob ->
withTestChat ps "cath" $ \cath -> do
bob <## "subscribed 5 connections on server localhost"
@@ -1808,15 +1825,17 @@ addCathAsOwner bob cath = do
joinGroup "privacy" cath bob
cath <## "#privacy: member 'SimpleX Directory' is connected"
withDirectoryService :: HasCallStack => TestParams -> (TestCC -> String -> IO ()) -> IO ()
withDirectoryService :: HasCallStack => TestParams -> (TestCC -> (String, String) -> IO ()) -> IO ()
withDirectoryService ps = withDirectoryServiceCfg ps testCfg
withDirectoryServiceCfg :: HasCallStack => TestParams -> ChatConfig -> (TestCC -> String -> IO ()) -> IO ()
withDirectoryServiceCfg :: HasCallStack => TestParams -> ChatConfig -> (TestCC -> (String, String) -> IO ()) -> IO ()
withDirectoryServiceCfg ps cfg = withDirectoryServiceCfgOwnersGroup ps cfg False Nothing
withDirectoryServiceCfgOwnersGroup :: HasCallStack => TestParams -> ChatConfig -> Bool -> Maybe FilePath -> (TestCC -> String -> IO ()) -> IO ()
-- the short link is the only form that carries the address DR keys, so service request tests
-- need it; tests that only connect take the full link and void the other
withDirectoryServiceCfgOwnersGroup :: HasCallStack => TestParams -> ChatConfig -> Bool -> Maybe FilePath -> (TestCC -> (String, String) -> IO ()) -> IO ()
withDirectoryServiceCfgOwnersGroup ps cfg createOwnersGroup webFolder test = do
dsLink <-
dsLinks <-
withNewTestChatCfg ps cfg serviceDbPrefix directoryProfile $ \ds ->
withNewTestChatCfg ps cfg "super_user" aliceProfile $ \superUser -> do
connectUsers ds superUser
@@ -1832,33 +1851,33 @@ withDirectoryServiceCfgOwnersGroup ps cfg createOwnersGroup webFolder test = do
ds ##> "/j owners"
ds <## "#owners: you joined the group"
superUser <## "#owners: 'SimpleX Directory' joined the group"
ds ##> "/ad"
getContactLink ds True
withDirectoryOwnersGroup ps cfg dsLink createOwnersGroup webFolder test
ds ##> "/ad pq_ratchet=on"
getContactLinks ds True
withDirectoryOwnersGroup ps cfg dsLinks createOwnersGroup webFolder test
restoreDirectoryService :: HasCallStack => TestParams -> Int -> (TestCC -> String -> IO ()) -> IO ()
restoreDirectoryService :: HasCallStack => TestParams -> Int -> (TestCC -> (String, String) -> IO ()) -> IO ()
restoreDirectoryService ps connCount test = do
dsLink <-
dsLinks <-
withTestChat ps serviceDbPrefix $ \ds -> do
ds .<## ("subscribed " <> show connCount <> " connections on server localhost")
ds ##> "/sa"
dsLink <- getContactLink ds False
dsLinks <- getContactLinks ds False
ds <## "auto_accept on"
pure dsLink
withDirectory ps testCfg dsLink test
pure dsLinks
withDirectory ps testCfg dsLinks test
withDirectory :: HasCallStack => TestParams -> ChatConfig -> String -> (TestCC -> String -> IO ()) -> IO ()
withDirectory ps cfg dsLink = withDirectoryOwnersGroup ps cfg dsLink False Nothing
withDirectory :: HasCallStack => TestParams -> ChatConfig -> (String, String) -> (TestCC -> (String, String) -> IO ()) -> IO ()
withDirectory ps cfg dsLinks = withDirectoryOwnersGroup ps cfg dsLinks False Nothing
withDirectoryOwnersGroup :: HasCallStack => TestParams -> ChatConfig -> String -> Bool -> Maybe FilePath -> (TestCC -> String -> IO ()) -> IO ()
withDirectoryOwnersGroup ps cfg dsLink createOwnersGroup webFolder test = do
withDirectoryOwnersGroup :: HasCallStack => TestParams -> ChatConfig -> (String, String) -> Bool -> Maybe FilePath -> (TestCC -> (String, String) -> IO ()) -> IO ()
withDirectoryOwnersGroup ps cfg dsLinks createOwnersGroup webFolder test = do
let opts = mkDirectoryOpts ps [KnownContact 2 "alice"] (if createOwnersGroup then Just $ KnownGroup 1 "owners" else Nothing) webFolder
runDirectory cfg opts $
withTestChatCfg ps cfg "super_user" $ \superUser -> do
if createOwnersGroup
then superUser <## "subscribed 2 connections on server localhost"
else superUser <## "subscribed 1 connections on server localhost"
test superUser dsLink
test superUser dsLinks
runDirectory :: ChatConfig -> DirectoryOpts -> IO () -> IO ()
runDirectory cfg opts action = do
@@ -2019,7 +2038,7 @@ groupNotFound_ suffix u s = do
testCaptchaTooManyAttempts :: HasCallStack => TestParams -> IO ()
testCaptchaTooManyAttempts ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -2057,7 +2076,7 @@ testCaptchaTooManyAttempts ps =
testCaptchaUnknownCommand :: HasCallStack => TestParams -> IO ()
testCaptchaUnknownCommand ps =
withDirectoryService ps $ \superUser dsLink ->
withDirectoryService ps $ \superUser (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob ->
withNewTestChat ps "cath" cathProfile $ \cath -> do
bob `connectVia` dsLink
@@ -2083,7 +2102,7 @@ testCaptchaUnknownCommand ps =
testHelpNoAudio :: HasCallStack => TestParams -> IO ()
testHelpNoAudio ps =
withDirectoryService ps $ \_ dsLink ->
withDirectoryService ps $ \_ (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob -> do
bob `connectVia` dsLink
-- commands help should not mention /audio
@@ -2100,7 +2119,7 @@ testHelpNoAudio ps =
testAudioCommandInDM :: HasCallStack => TestParams -> IO ()
testAudioCommandInDM ps =
withDirectoryService ps $ \_ dsLink ->
withDirectoryService ps $ \_ (_, dsLink) ->
withNewTestChat ps "bob" bobProfile $ \bob -> do
bob `connectVia` dsLink
bob #> "@'SimpleX Directory' /audio"
@@ -2109,7 +2128,7 @@ testAudioCommandInDM ps =
testRegisterChannelViaCard :: HasCallStack => TestParams -> IO ()
testRegisterChannelViaCard ps =
withDirectoryServiceCfg ps testCfg $ \superUser dsLink ->
withDirectoryServiceCfg ps testCfg $ \superUser (_, dsLink) ->
withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob ->
withRelay ps $ \relay -> do
-- bob connects to directory service first
@@ -2188,7 +2207,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 ->
withDirectoryServiceCfg ps testCfg $ \superUser dsLink ->
withDirectoryServiceCfg ps testCfg $ \superUser (_, dsLink) ->
withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob ->
withRelay ps $ \relay -> do
enableNamesRole bob
@@ -2229,7 +2248,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 ->
withDirectoryServiceCfg ps testCfg $ \superUser dsLink ->
withDirectoryServiceCfg ps testCfg $ \superUser (_, dsLink) ->
withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob ->
withRelay ps $ \relay -> do
enableNamesRole bob
@@ -2270,7 +2289,7 @@ testDirectoryChannelNameNotVerified ps = withSmpServerAndNames $ \reg ->
testLinkAsTextSearch :: HasCallStack => TestParams -> IO ()
testLinkAsTextSearch ps =
withDirectoryServiceCfg ps testCfg $ \_superUser dsLink ->
withDirectoryServiceCfg ps testCfg $ \_superUser (_, dsLink) ->
withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob ->
withRelay ps $ \relay -> do
bob `connectVia` dsLink
@@ -2282,7 +2301,7 @@ testLinkAsTextSearch ps =
testNonOwnerSharesCard :: HasCallStack => TestParams -> IO ()
testNonOwnerSharesCard ps =
withDirectoryServiceCfg ps testCfg $ \_superUser dsLink ->
withDirectoryServiceCfg ps testCfg $ \_superUser (_, dsLink) ->
withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob ->
withRelay ps $ \relay ->
withNewTestChatCfg ps testCfg "cath" cathProfile $ \cath -> do
@@ -2297,7 +2316,7 @@ testNonOwnerSharesCard ps =
testDeleteChannelRegistration :: HasCallStack => TestParams -> IO ()
testDeleteChannelRegistration ps =
withDirectoryServiceCfg ps testCfg $ \superUser dsLink ->
withDirectoryServiceCfg ps testCfg $ \superUser (_, dsLink) ->
withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob ->
withRelay ps $ \relay -> do
bob `connectVia` dsLink
@@ -2342,7 +2361,7 @@ testDeleteChannelRegistration ps =
testReregistrationAlreadyListed :: HasCallStack => TestParams -> IO ()
testReregistrationAlreadyListed ps =
withDirectoryServiceCfg ps testCfg $ \superUser dsLink ->
withDirectoryServiceCfg ps testCfg $ \superUser (_, dsLink) ->
withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob ->
withRelay ps $ \relay -> do
bob `connectVia` dsLink
tests/ProtocolTests.hs
+25
View File
@@ -7,8 +7,10 @@
module ProtocolTests where
import Control.Concurrent.STM (atomically)
import qualified Data.Aeson as J
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Time.Clock.System (SystemTime (..), systemToUTCTime)
import Simplex.Chat.Library.Internal (decodeLinkUserData, encodeShortLinkData)
import Simplex.Chat.Protocol
@@ -27,6 +29,29 @@ protocolTests :: Spec
protocolTests = do
decodeChatMessageTest
shortLinkDataTests
serviceBodyTests
serviceBodyTests :: Spec
serviceBodyTests = describe "service payload compression" $ do
it "passes a small payload through uncompressed" $ do
let payload = "{\"ping\":1}"
compressServiceBody payload `shouldBe` Right payload
decompressServiceBody payload `shouldBe` Right payload
it "compresses a payload over the size bound and restores it" $ do
let payload = "{\"pong\":\"" <> B.replicate 12000 'a' <> "\"}"
compressed <- either fail pure $ compressServiceBody payload
B.length compressed `shouldSatisfy` (<= maxCompressedInfoLength)
B.head compressed `shouldBe` 'X'
decompressServiceBody compressed `shouldBe` Right payload
it "rejects a payload that is too large even compressed" $ do
-- random bytes do not compress, so this stays over the bound
g <- C.newRandom
payload <- atomically $ C.randomBytes (maxCompressedInfoLength * 2) g
compressServiceBody payload `shouldBe` Left "service payload is too large"
it "rejects a payload that expands past the decompressed bound" $ do
let bomb = compressedBatchMsgBody_ $ B.replicate (maxDecompressedMsgLength + 1) 'a'
B.length bomb `shouldSatisfy` (< maxCompressedInfoLength)
decompressServiceBody bomb `shouldBe` Left "decompressed size exceeds limit"
srv :: SMPServer
srv = SMPServer "smp.simplex.im" "5223" (C.KeyHash "\215m\248\251")