Skip to content

Commit 99bfb21

Browse files
eyeinskyeyeinsky
committed
wip Move test from brig to integration package
1 parent ac79182 commit 99bfb21

File tree

2 files changed

+99
-92
lines changed

2 files changed

+99
-92
lines changed

‎integration/test/Test/Search.hs‎

Lines changed: 99 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ import GHC.Stack
1212
import SetupHelpers
1313
import Testlib.Assertions
1414
import Testlib.Prelude
15+
import Debug.Trace
1516

1617
--------------------------------------------------------------------------------
1718
-- LOCAL SEARCH
@@ -335,3 +336,101 @@ testTeamSearchEmailFilter = do
335336
ownerId <- objId owner
336337
memberId <- objId mem
337338
uids `shouldMatchSet` [ownerId, memberId]
339+
340+
testUserSearchable :: App ()
341+
testUserSearchable = do
342+
-- (owner, tid) <- createUserWithTeam brig
343+
(owner, tid, mem : _) <- createTeam OwnDomain 2
344+
345+
let -- Helper to change user searchability.
346+
setSearchable self uid searchable = do
347+
req <- baseRequest self Brig Versioned $ joinHttpPath ["users", uid, "searchable"]
348+
submit "POST" $ addJSON searchable req
349+
350+
-- partner <- createTeamMember owner def {role = "partner"}
351+
-- Create user in team, default is searchable = True.
352+
u1 <- createTeamMember owner def
353+
assertBool "created users are searchable by default" =<< (u1 %. "searchable" & asBool)
354+
355+
-- Setting self to non-searchable won't work -- only admin can do it.
356+
u1id <- u1 %. "id" & asString
357+
setSearchable u1id u1id False `bindResponse` \resp ->
358+
resp.status `shouldMatchInt` 403
359+
resp.json %. "label" `shouldMatch` "insufficient-permissions"
360+
361+
-- refetch u1
362+
-- assertBool "Searchable is still True" . profileSearchable =<< parseOrFail "UserProfile" (getProfile brig owner u1id)
363+
364+
traceShow u1 $ pure ()
365+
366+
{-
367+
-- Make a member in the current team
368+
let mkTeamMember :: Permissions -> Http User
369+
mkTeamMember perms = do
370+
member <- createTeamMember brig galley owner tid perms
371+
selfUser <$> (responseJsonError =<< get (brig . path "/self" . zUser (userId member)))
372+
373+
374+
-- Team admin can set user to non-searchable.
375+
admin <- userId <$> mkTeamMember (rolePermissions RoleAdmin)
376+
post (setSearchable admin u1id False) !!! const 200 === statusCode
377+
liftIO . assertBool "Searchable is now False" . not . profileSearchable =<< parseOrFail "UserProfile" (getProfile brig owner u1id)
378+
379+
-- Team owner can, too.
380+
post (setSearchable owner u1id True) !!! const 200 === statusCode
381+
post (setSearchable owner u1id False) !!! const 200 === statusCode
382+
383+
-- By default created team members are found.
384+
u3 <- mkTeamMember (rolePermissions RoleMember)
385+
Search.refreshIndex brig
386+
s <- Search.executeSearch brig u1id $ fromName $ userDisplayName u3
387+
liftIO $ assertBool "u1 must find u3 as they are searchable by default" $ uidsInResult [userId u3] s
388+
389+
-- Use set to non-searchable is not found by other team members.
390+
u4 <- mkTeamMember (rolePermissions RoleMember)
391+
post (setSearchable owner (userId u4) False) !!! const 200 === statusCode
392+
Search.refreshIndex brig
393+
s <- Search.executeSearch brig u1id $ fromName $ userDisplayName u4
394+
liftIO $ assertBool "u1 must not find u4 as they are set non-searchable" $ not $ uidsInResult [userId u4] s
395+
396+
-- Even admin nor owner won't find non-searchable users via /search/contacts
397+
sAdmin <- Search.executeSearch brig admin $ fromName $ userDisplayName u4
398+
liftIO $ assertBool "Team admin won't find non-searchable user from /search/concatcs" $ not $ uidsInResult [userId u4] sAdmin
399+
sOwner <- Search.executeSearch brig owner $ fromName $ userDisplayName u4
400+
liftIO $ assertBool "Team owner won't find non-searchable user from /search/concatcs" $ not $ uidsInResult [userId u4] sOwner
401+
402+
-- Exact handle search with HTTP HEAD still works for non-searchable users
403+
u4' <- setRandomHandle brig u4 -- Add handle to the non-searchable u4
404+
let u4handle = fromJust $ userHandle u4'
405+
Bilge.head (brig . paths ["handles", toByteString' u4handle] . zUser (userId u3))
406+
!!! const 200 === statusCode
407+
408+
-- Regular user can't find non-searchable team member by exact handle.
409+
s <- Search.executeSearch brig u1id $ fromHandle u4handle
410+
liftIO $ assertBool "u1 must not find non-searchable u4 by exact handle" $ not $ uidsInResult [userId u4] s
411+
412+
-- /teams/:tid/members gets all members
413+
r :: Team.Member.TeamMembersPage <- parseOrFail "TeamMembersPage" $ get (galley . paths ["teams", toByteString' tid, "members"] . zUser u1id) <!! const 200 === statusCode
414+
let teamMembers = mtpResults $ Team.Member.unTeamMembersPage r :: [Team.Member.TeamMemberOptPerms]
415+
uids = map (^. Team.Member.userId) teamMembers
416+
liftIO $ assertBool "/teams/:tid/members returns searchable and non-searchable users from team" $ all (`elem` uids) $ u1id : map userId [u3, u4]
417+
418+
-- /teams/:tid/search?searchable=false gets only non-searchable members
419+
r :: SearchResult TeamContact <- parseOrFail "SearchResult TeamContact" $
420+
get ( brig
421+
. paths ["teams", toByteString' tid, "search"]
422+
. queryItem "searchable" "false"
423+
. zUser admin) <!! const 200 === statusCode
424+
let uids = map teamContactUserId $ searchResults r
425+
liftIO $ assertBool "/teams/:tid/members?searchable=false returns only non-searchable members" $ userId u4 `elem` uids
426+
427+
where
428+
contactUid :: Contact -> UserId
429+
contactUid = qUnqualified . contactQualifiedId
430+
431+
uidsInResult :: [UserId] -> SearchResult Contact -> Bool
432+
uidsInResult uids r = all (`elem` foundUids) uids
433+
where
434+
foundUids = map contactUid (searchResults r)
435+
-}
436+
pure ()

‎services/brig/test/integration/API/User/Account.hs‎

Lines changed: 0 additions & 92 deletions
Original file line numberDiff line numberDiff line change
@@ -121,7 +121,6 @@ tests _ at opts p b c ch g aws userJournalWatcher =
121121
test p "get /users/<localdomain>/:uid - 404" $ testNonExistingUser b,
122122
test p "get /users/:domain/:uid - 422" $ testUserInvalidDomain b,
123123
test p "get /users/:uid - 200" $ testExistingUserUnqualified b,
124-
test p "testUserSearchable" $ testUserSearchable b g,
125124
test p "get /users/<localdomain>/:uid - 200" $ testExistingUser b,
126125
test p "get /users?:id=.... - 200" $ testMultipleUsersUnqualified b,
127126
test p "head /users/:uid - 200" $ testUserExistsUnqualified b,
@@ -646,97 +645,6 @@ testExistingUserUnqualified brig = do
646645
b ^? key "id" >>= maybeFromJSON
647646
)
648647

649-
testUserSearchable :: Brig -> Galley -> Http ()
650-
testUserSearchable brig galley = do
651-
(owner, tid) <- createUserWithTeam brig
652-
653-
-- Make a member in the current team
654-
let mkTeamMember :: Permissions -> Http User
655-
mkTeamMember perms = do
656-
member <- createTeamMember brig galley owner tid perms
657-
selfUser <$> (responseJsonError =<< get (brig . path "/self" . zUser (userId member)))
658-
659-
-- Helper to change user searchability.
660-
setSearchable :: UserId -> UserId -> Bool -> Request -> Request
661-
setSearchable byZuid uid searchable =
662-
brig
663-
. paths ["users", pack $ show uid, "searchable"]
664-
. zUser byZuid
665-
. toJsonBody searchable
666-
667-
-- Create user in team, default is searchable = True.
668-
u1id <- userId <$> mkTeamMember (rolePermissions RoleMember)
669-
u1p <- parseOrFail "UserProfile" (getProfile brig owner u1id)
670-
liftIO $ assertBool "created users are searchable by default" $ profileSearchable u1p
671-
672-
-- Setting self to non-searchable won't work -- only admin can do it.
673-
post (setSearchable u1id u1id False) !!! do
674-
const 403 === statusCode
675-
const (Just "insufficient-permissions") === fmap Error.label . responseJsonMaybe
676-
liftIO . assertBool "Searchable is still True" . profileSearchable =<< parseOrFail "UserProfile" (getProfile brig owner u1id)
677-
678-
-- Team admin can set user to non-searchable.
679-
admin <- userId <$> mkTeamMember (rolePermissions RoleAdmin)
680-
post (setSearchable admin u1id False) !!! const 200 === statusCode
681-
liftIO . assertBool "Searchable is now False" . not . profileSearchable =<< parseOrFail "UserProfile" (getProfile brig owner u1id)
682-
683-
-- Team owner can, too.
684-
post (setSearchable owner u1id True) !!! const 200 === statusCode
685-
post (setSearchable owner u1id False) !!! const 200 === statusCode
686-
687-
-- By default created team members are found.
688-
u3 <- mkTeamMember (rolePermissions RoleMember)
689-
Search.refreshIndex brig
690-
s <- Search.executeSearch brig u1id $ fromName $ userDisplayName u3
691-
liftIO $ assertBool "u1 must find u3 as they are searchable by default" $ uidsInResult [userId u3] s
692-
693-
-- Use set to non-searchable is not found by other team members.
694-
u4 <- mkTeamMember (rolePermissions RoleMember)
695-
post (setSearchable owner (userId u4) False) !!! const 200 === statusCode
696-
Search.refreshIndex brig
697-
s <- Search.executeSearch brig u1id $ fromName $ userDisplayName u4
698-
liftIO $ assertBool "u1 must not find u4 as they are set non-searchable" $ not $ uidsInResult [userId u4] s
699-
700-
-- Even admin nor owner won't find non-searchable users via /search/contacts
701-
sAdmin <- Search.executeSearch brig admin $ fromName $ userDisplayName u4
702-
liftIO $ assertBool "Team admin won't find non-searchable user from /search/concatcs" $ not $ uidsInResult [userId u4] sAdmin
703-
sOwner <- Search.executeSearch brig owner $ fromName $ userDisplayName u4
704-
liftIO $ assertBool "Team owner won't find non-searchable user from /search/concatcs" $ not $ uidsInResult [userId u4] sOwner
705-
706-
-- Exact handle search with HTTP HEAD still works for non-searchable users
707-
u4' <- setRandomHandle brig u4 -- Add handle to the non-searchable u4
708-
let u4handle = fromJust $ userHandle u4'
709-
Bilge.head (brig . paths ["handles", toByteString' u4handle] . zUser (userId u3))
710-
!!! const 200 === statusCode
711-
712-
-- Regular user can't find non-searchable team member by exact handle.
713-
s <- Search.executeSearch brig u1id $ fromHandle u4handle
714-
liftIO $ assertBool "u1 must not find non-searchable u4 by exact handle" $ not $ uidsInResult [userId u4] s
715-
716-
-- /teams/:tid/members gets all members
717-
r :: Team.Member.TeamMembersPage <- parseOrFail "TeamMembersPage" $ get (galley . paths ["teams", toByteString' tid, "members"] . zUser u1id) <!! const 200 === statusCode
718-
let teamMembers = mtpResults $ Team.Member.unTeamMembersPage r :: [Team.Member.TeamMemberOptPerms]
719-
uids = map (^. Team.Member.userId) teamMembers
720-
liftIO $ assertBool "/teams/:tid/members returns searchable and non-searchable users from team" $ all (`elem` uids) $ u1id : map userId [u3, u4]
721-
722-
-- /teams/:tid/search?searchable=false gets only non-searchable members
723-
r :: SearchResult TeamContact <- parseOrFail "SearchResult TeamContact" $
724-
get ( brig
725-
. paths ["teams", toByteString' tid, "search"]
726-
. queryItem "searchable" "false"
727-
. zUser admin) <!! const 200 === statusCode
728-
let uids = map teamContactUserId $ searchResults r
729-
liftIO $ assertBool "/teams/:tid/members?searchable=false returns only non-searchable members" $ userId u4 `elem` uids
730-
731-
where
732-
contactUid :: Contact -> UserId
733-
contactUid = qUnqualified . contactQualifiedId
734-
735-
uidsInResult :: [UserId] -> SearchResult Contact -> Bool
736-
uidsInResult uids r = all (`elem` foundUids) uids
737-
where
738-
foundUids = map contactUid (searchResults r)
739-
740648
testExistingUser :: Brig -> Http ()
741649
testExistingUser brig = do
742650
quser <- userQualifiedId <$> randomUser brig

0 commit comments

Comments
 (0)