From 47681a31394ce13fa2535ed06fe91063991538c9 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Thu, 17 Oct 2024 10:43:29 +0200 Subject: [PATCH] [WPB-11368] Test for export team member CSV (#4292) * integration test * Check more fields * Add assertions * Refactor createTeamMember * Test sso_id field * Remove debug output * Suppress warning * Remove old CSV export test * Add CHANGELOG entry * add comment Co-authored-by: Matthias Fischmann * Regenerate nix packages --------- Co-authored-by: Paolo Capriotti Co-authored-by: Matthias Fischmann --- changelog.d/5-internal/test-csv-export | 1 + integration/test/API/BrigInternal.hs | 26 ++++++ integration/test/API/Galley.hs | 6 ++ integration/test/SetupHelpers.hs | 35 +++++--- integration/test/Test/Conversation.hs | 2 +- integration/test/Test/ExternalPartner.hs | 12 +-- integration/test/Test/MLS/Services.hs | 3 +- integration/test/Test/Search.hs | 7 +- integration/test/Test/TeamSettings.hs | 4 +- integration/test/Test/Teams.hs | 81 ++++++++++++++--- services/galley/default.nix | 4 - services/galley/galley.cabal | 3 - services/galley/test/integration/API/Teams.hs | 89 +------------------ 13 files changed, 138 insertions(+), 135 deletions(-) create mode 100644 changelog.d/5-internal/test-csv-export diff --git a/changelog.d/5-internal/test-csv-export b/changelog.d/5-internal/test-csv-export new file mode 100644 index 00000000000..a8df725542b --- /dev/null +++ b/changelog.d/5-internal/test-csv-export @@ -0,0 +1 @@ +Move CSV export test to integration diff --git a/integration/test/API/BrigInternal.hs b/integration/test/API/BrigInternal.hs index 7d1ca70230d..ff8b6f40f61 100644 --- a/integration/test/API/BrigInternal.hs +++ b/integration/test/API/BrigInternal.hs @@ -303,3 +303,29 @@ getPasswordResetCode :: (HasCallStack, MakesValue domain) => domain -> String -> getPasswordResetCode domain email = do req <- baseRequest domain Brig Unversioned "i/users/password-reset-code" submit "GET" $ req & addQueryParams [("email", email)] + +data PutSSOId = PutSSOId + { scimExternalId :: Maybe String, + subject :: Maybe String, + tenant :: Maybe String + } + +instance Default PutSSOId where + def = + PutSSOId + { scimExternalId = Nothing, + subject = Nothing, + tenant = Nothing + } + +putSSOId :: (HasCallStack, MakesValue user) => user -> PutSSOId -> App Response +putSSOId user args = do + uid <- objId user + req <- baseRequest user Brig Unversioned (joinHttpPath ["i", "users", uid, "sso-id"]) + submit "PUT" $ + req + & addJSONObject + [ "scim_external_id" .= args.scimExternalId, + "subject" .= args.subject, + "tenant" .= args.tenant + ] diff --git a/integration/test/API/Galley.hs b/integration/test/API/Galley.hs index e7bdbf486f9..6299fc97f8f 100644 --- a/integration/test/API/Galley.hs +++ b/integration/test/API/Galley.hs @@ -727,3 +727,9 @@ getTeamNotifications user mSince = baseRequest user Galley Versioned "teams/notifications" >>= \req -> submit "GET" $ addQueryParams [("since", since) | since <- maybeToList mSince] req + +-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/get_teams__tid__members_csv +getTeamMembersCsv :: (HasCallStack, MakesValue user) => user -> String -> App Response +getTeamMembersCsv user tid = do + req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tid, "members", "csv"]) + submit "GET" req diff --git a/integration/test/SetupHelpers.hs b/integration/test/SetupHelpers.hs index 43851fd04d7..4e19ae9b0a6 100644 --- a/integration/test/SetupHelpers.hs +++ b/integration/test/SetupHelpers.hs @@ -43,26 +43,35 @@ createTeam :: (HasCallStack, MakesValue domain) => domain -> Int -> App (Value, createTeam domain memberCount = do owner <- createUser domain def {team = True} >>= getJSON 201 tid <- owner %. "team" & asString - members <- for [2 .. memberCount] $ \_ -> createTeamMember owner tid + members <- for [2 .. memberCount] $ \_ -> createTeamMember owner def pure (owner, tid, members) -createTeamMember :: - (HasCallStack, MakesValue inviter) => - inviter -> - String -> - App Value -createTeamMember inviter tid = createTeamMemberWithRole inviter tid "member" +data CreateTeamMember = CreateTeamMember + { role :: String + } -createTeamMemberWithRole :: +instance Default CreateTeamMember where + def = CreateTeamMember {role = "member"} + +createTeamMember :: (HasCallStack, MakesValue inviter) => inviter -> - String -> - String -> + CreateTeamMember -> App Value -createTeamMemberWithRole inviter _ role = do +createTeamMember inviter args = do newUserEmail <- randomEmail - invitation <- postInvitation inviter (PostInvitation (Just newUserEmail) (Just role)) >>= getJSON 201 - invitationCode <- getInvitationCode inviter invitation >>= getJSON 200 >>= (%. "code") & asString + invitation <- + postInvitation + inviter + def + { email = Just newUserEmail, + role = Just args.role + } + >>= getJSON 201 + invitationCode <- + (getInvitationCode inviter invitation >>= getJSON 200) + %. "code" + & asString let body = AddUser { name = Just newUserEmail, diff --git a/integration/test/Test/Conversation.hs b/integration/test/Test/Conversation.hs index 714a75d7254..e6ae83d1519 100644 --- a/integration/test/Test/Conversation.hs +++ b/integration/test/Test/Conversation.hs @@ -667,7 +667,7 @@ testDeleteTeamMemberLimitedEventFanout :: (HasCallStack) => App () testDeleteTeamMemberLimitedEventFanout = do -- Alex will get removed from the team (alice, team, [alex, alison]) <- createTeam OwnDomain 3 - ana <- createTeamMemberWithRole alice team "admin" + ana <- createTeamMember alice def {role = "admin"} [amy, bob] <- for [OwnDomain, OtherDomain] $ flip randomUser def forM_ [amy, bob] $ connectTwoUsers alice [aliceId, alexId, amyId, alisonId, anaId, bobId] <- do diff --git a/integration/test/Test/ExternalPartner.hs b/integration/test/Test/ExternalPartner.hs index ae6381f4187..01bdd629834 100644 --- a/integration/test/Test/ExternalPartner.hs +++ b/integration/test/Test/ExternalPartner.hs @@ -29,7 +29,7 @@ testExternalPartnerPermissions :: (HasCallStack) => App () testExternalPartnerPermissions = do (owner, tid, u1 : u2 : u3 : _) <- createTeam OwnDomain 4 - partner <- createTeamMemberWithRole owner tid "partner" + partner <- createTeamMember owner def {role = "partner"} -- a partner should not be able to create conversation with 2 additional users or more void $ postConversation partner (defProteus {team = Just tid, qualifiedUsers = [u1, u2]}) >>= getJSON 403 @@ -58,23 +58,23 @@ testExternalPartnerPermissions = do testExternalPartnerPermissionsMls :: (HasCallStack) => App () testExternalPartnerPermissionsMls = do -- external partners should not be able to create (MLS) conversations - (owner, tid, _) <- createTeam OwnDomain 2 - bobExt <- createTeamMemberWithRole owner tid "partner" + (owner, _, _) <- createTeam OwnDomain 2 + bobExt <- createTeamMember owner def {role = "partner"} bobExtClient <- createMLSClient def bobExt bindResponse (postConversation bobExtClient defMLS) $ \resp -> do resp.status `shouldMatchInt` 403 testExternalPartnerPermissionMlsOne2One :: (HasCallStack) => App () testExternalPartnerPermissionMlsOne2One = do - (owner, tid, alice : _) <- createTeam OwnDomain 2 - bobExternal <- createTeamMemberWithRole owner tid "partner" + (owner, _, alice : _) <- createTeam OwnDomain 2 + bobExternal <- createTeamMember owner def {role = "partner"} void $ getMLSOne2OneConversation alice bobExternal >>= getJSON 200 testExternalPartnerPermissionsConvName :: (HasCallStack) => App () testExternalPartnerPermissionsConvName = do (owner, tid, u1 : _) <- createTeam OwnDomain 2 - partner <- createTeamMemberWithRole owner tid "partner" + partner <- createTeamMember owner def {role = "partner"} conv <- postConversation partner (defProteus {team = Just tid, qualifiedUsers = [u1]}) >>= getJSON 201 diff --git a/integration/test/Test/MLS/Services.hs b/integration/test/Test/MLS/Services.hs index 1160fe7c423..153023d1a36 100644 --- a/integration/test/Test/MLS/Services.hs +++ b/integration/test/Test/MLS/Services.hs @@ -1,3 +1,4 @@ +{-# OPTIONS -Wno-ambiguous-fields #-} module Test.MLS.Services where import API.Brig @@ -13,7 +14,7 @@ testWhitelistUpdatePermissions = do (owner, tid, []) <- createTeam OwnDomain 1 -- Create a team admin - admin <- createTeamMemberWithRole owner tid "admin" + admin <- createTeamMember owner def {role = "admin"} -- Create a service email <- randomEmail diff --git a/integration/test/Test/Search.hs b/integration/test/Test/Search.hs index af3f00d4e56..7ca6b48e4c6 100644 --- a/integration/test/Test/Search.hs +++ b/integration/test/Test/Search.hs @@ -1,3 +1,4 @@ +{-# OPTIONS -Wno-ambiguous-fields #-} module Test.Search where import qualified API.Brig as BrigP @@ -19,9 +20,9 @@ testSearchContactForExternalUsers = do owner <- randomUser OwnDomain def {BrigI.team = True} tid <- owner %. "team" & asString - partner <- createTeamMemberWithRole owner tid "partner" - tm1 <- createTeamMember owner tid - tm2 <- createTeamMember owner tid + partner <- createTeamMember owner def {role = "partner"} + tm1 <- createTeamMember owner def + tm2 <- createTeamMember owner def -- a team member can search for contacts bindResponse (BrigP.searchContacts tm1 (owner %. "name") OwnDomain) $ \resp -> diff --git a/integration/test/Test/TeamSettings.hs b/integration/test/Test/TeamSettings.hs index 03a667cf78e..74e8eaa65a6 100644 --- a/integration/test/Test/TeamSettings.hs +++ b/integration/test/Test/TeamSettings.hs @@ -26,7 +26,7 @@ import Testlib.Prelude testTeamSettingsUpdate :: (HasCallStack) => App () testTeamSettingsUpdate = do (ownerA, tidA, [mem]) <- createTeam OwnDomain 2 - partner <- createTeamMemberWithRole ownerA tidA "partner" + partner <- createTeamMember ownerA def {role = "partner"} bindResponse (putAppLockSettings tidA ownerA def) $ \resp -> do resp.status `shouldMatchInt` 200 @@ -45,7 +45,7 @@ testTeamSettingsUpdate = do testTeamPropertiesUpdate :: (HasCallStack) => App () testTeamPropertiesUpdate = do (ownerA, tidA, [mem]) <- createTeam OwnDomain 2 - partner <- createTeamMemberWithRole ownerA tidA "partner" + partner <- createTeamMember ownerA def {role = "partner"} bindResponse (putTeamProperties tidA ownerA def) $ \resp -> do resp.status `shouldMatchInt` 200 diff --git a/integration/test/Test/Teams.hs b/integration/test/Test/Teams.hs index 082186d78df..623983abcba 100644 --- a/integration/test/Test/Teams.hs +++ b/integration/test/Test/Teams.hs @@ -18,13 +18,17 @@ module Test.Teams where import API.Brig -import API.BrigInternal (createUser, getInvitationCode, refreshIndex) +import qualified API.BrigInternal as I import API.Common -import API.Galley (getTeam, getTeamMembers, getTeamNotifications) +import API.Galley (getTeam, getTeamMembers, getTeamMembersCsv, getTeamNotifications) import API.GalleyInternal (setTeamFeatureStatus) import Control.Monad.Codensity (Codensity (runCodensity)) import Control.Monad.Extra (findM) import Control.Monad.Reader (asks) +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Map as Map +import Data.Time.Clock +import Data.Time.Format import Notifications import SetupHelpers import Testlib.JSON @@ -52,13 +56,13 @@ testInvitePersonalUserToTeam = do ownerId <- owner %. "id" & asString setTeamFeatureStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" >>= assertSuccess - user <- createUser domain def >>= getJSON 201 + user <- I.createUser domain def >>= getJSON 201 uid <- user %. "id" >>= asString email <- user %. "email" >>= asString inv <- postInvitation owner (PostInvitation (Just email) Nothing) >>= getJSON 201 checkListInvitations owner tid email - code <- getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString + code <- I.getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString inv %. "url" & asString >>= assertUrlContainsCode code acceptTeamInvitation user code Nothing >>= assertStatus 400 acceptTeamInvitation user code (Just "wrong-password") >>= assertStatus 403 @@ -105,7 +109,7 @@ testInvitePersonalUserToTeam = do ids <- for documents ((%. "id") >=> asString) ids `shouldContain` [ownerId] - refreshIndex domain + I.refreshIndex domain -- a team member can now search for the former personal user bindResponse (searchContacts tm (user %. "name") domain) $ \resp -> do resp.status `shouldMatchInt` 200 @@ -140,11 +144,11 @@ testInvitePersonalUserToLargeTeam = do teamSize <- readServiceConfig Galley %. "settings.maxFanoutSize" & asInt <&> (+ 1) (owner, tid, (alice : otherTeamMembers)) <- createTeam OwnDomain teamSize -- User to be invited to the team - knut <- createUser OwnDomain def >>= getJSON 201 + knut <- I.createUser OwnDomain def >>= getJSON 201 -- Non team friends of knut - dawn <- createUser OwnDomain def >>= getJSON 201 - eli <- createUser OtherDomain def >>= getJSON 201 + dawn <- I.createUser OwnDomain def >>= getJSON 201 + eli <- I.createUser OtherDomain def >>= getJSON 201 -- knut is also friends with alice, but not any other team members. traverse_ (connectTwoUsers knut) [alice, dawn, eli] @@ -159,7 +163,7 @@ testInvitePersonalUserToLargeTeam = do knutEmail <- knut %. "email" >>= asString inv <- postInvitation owner (PostInvitation (Just knutEmail) Nothing) >>= getJSON 201 - code <- getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString + code <- I.getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString withWebSockets [owner, alice, dawn, eli, head otherTeamMembers] $ \[wsOwner, wsAlice, wsDawn, wsEli, wsOther] -> do acceptTeamInvitation knut code (Just defPassword) >>= assertSuccess @@ -204,16 +208,16 @@ testInvitePersonalUserToTeamMultipleInvitations :: (HasCallStack) => App () testInvitePersonalUserToTeamMultipleInvitations = do (owner, tid, _) <- createTeam OwnDomain 0 (owner2, _, _) <- createTeam OwnDomain 0 - user <- createUser OwnDomain def >>= getJSON 201 + user <- I.createUser OwnDomain def >>= getJSON 201 email <- user %. "email" >>= asString inv <- postInvitation owner (PostInvitation (Just email) Nothing) >>= getJSON 201 inv2 <- postInvitation owner2 (PostInvitation (Just email) Nothing) >>= getJSON 201 - code <- getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString + code <- I.getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString acceptTeamInvitation user code (Just defPassword) >>= assertSuccess bindResponse (getSelf user) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "team" `shouldMatch` tid - code2 <- getInvitationCode owner2 inv2 >>= getJSON 200 >>= (%. "code") & asString + code2 <- I.getInvitationCode owner2 inv2 >>= getJSON 200 >>= (%. "code") & asString bindResponse (acceptTeamInvitation user code2 (Just defPassword)) $ \resp -> do resp.status `shouldMatchInt` 403 resp.json %. "label" `shouldMatch` "cannot-join-multiple-teams" @@ -227,10 +231,10 @@ testInvitationTypesAreDistinct = do -- We are only testing one direction because the other is not possible -- because the non-existing user cannot have a valid session (owner, _, _) <- createTeam OwnDomain 0 - user <- createUser OwnDomain def >>= getJSON 201 + user <- I.createUser OwnDomain def >>= getJSON 201 email <- user %. "email" >>= asString inv <- postInvitation owner (PostInvitation (Just email) Nothing) >>= getJSON 201 - code <- getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString + code <- I.getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString let body = AddUser { name = Just email, @@ -276,3 +280,52 @@ testUpgradePersonalToTeamAlreadyInATeam = do bindResponse (upgradePersonalToTeam alice "wonderland") $ \resp -> do resp.status `shouldMatchInt` 403 resp.json %. "label" `shouldMatch` "user-already-in-a-team" + +-- for additional tests of the CSV download particularly with SCIM users, please refer to 'Test.Spar.Scim.UserSpec' +testTeamMemberCsvExport :: (HasCallStack) => App () +testTeamMemberCsvExport = do + (owner, tid, members) <- createTeam OwnDomain 10 + let numClients = [0, 1, 2] <> repeat 0 + modifiedMembers <- for (zip numClients (owner : members)) $ \(n, m) -> do + handle <- randomHandle + putHandle m handle >>= assertSuccess + replicateM_ n $ addClient m def + void $ I.putSSOId m def {I.scimExternalId = Just "foo"} >>= getBody 200 + setField "handle" handle m + >>= setField "role" (if m == owner then "owner" else "member") + >>= setField "num_clients" (show n) + + memberMap :: Map.Map String Value <- fmap Map.fromList $ for (modifiedMembers) $ \m -> do + uid <- m %. "id" & asString + pure (uid, m) + + bindResponse (getTeamMembersCsv owner tid) $ \resp -> do + resp.status `shouldMatchInt` 200 + let rows = sort $ tail $ B8.lines $ resp.body + length rows `shouldMatchInt` 10 + for_ rows $ \row -> do + let cols = B8.split ',' row + let uid = read $ B8.unpack $ cols !! 11 + let mem = memberMap Map.! uid + + ownerId <- owner %. "id" & asString + let ownerMember = memberMap Map.! ownerId + + let parseField = unquote . read . B8.unpack . (cols !!) + + parseField 0 `shouldMatch` (mem %. "name") + parseField 1 `shouldMatch` (mem %. "handle") + parseField 2 `shouldMatch` (mem %. "email") + role <- mem %. "role" & asString + parseField 3 `shouldMatch` role + when (role /= "owner") $ do + now <- formatTime defaultTimeLocale "%Y-%m-%d" <$> liftIO getCurrentTime + take 10 (parseField 4) `shouldMatch` now + parseField 5 `shouldMatch` (ownerMember %. "handle") + parseField 7 `shouldMatch` "wire" + parseField 9 `shouldMatch` "foo" + parseField 12 `shouldMatch` (mem %. "num_clients") + where + unquote :: String -> String + unquote ('\'' : x) = x + unquote x = x diff --git a/services/galley/default.nix b/services/galley/default.nix index 337edc485eb..446b4c9450e 100644 --- a/services/galley/default.nix +++ b/services/galley/default.nix @@ -116,7 +116,6 @@ , utf8-string , uuid , uuid-types -, vector , wai , wai-extra , wai-middleware-gunzip @@ -237,7 +236,6 @@ mkDerivation { bytestring-conversion call-stack cassandra-util - cassava cereal conduit containers @@ -276,7 +274,6 @@ mkDerivation { quickcheck-instances random retry - saml2-web-sso servant-client servant-client-core servant-server @@ -302,7 +299,6 @@ mkDerivation { unliftio unordered-containers uuid - vector wai wai-utilities warp diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index d0f0d567a5e..ae6bdfc65a4 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -483,7 +483,6 @@ executable galley-integration , bytestring-conversion , call-stack , cassandra-util - , cassava , cereal , containers , cookie @@ -521,7 +520,6 @@ executable galley-integration , quickcheck-instances , random , retry - , saml2-web-sso >=0.20 , servant-client , servant-client-core , servant-server @@ -547,7 +545,6 @@ executable galley-integration , unliftio , unordered-containers , uuid - , vector , wai , wai-utilities , warp diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index ceb2dbb7f51..cc49154eddb 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -31,13 +31,11 @@ import API.Util qualified as Util import API.Util.TeamFeature qualified as Util import Bilge hiding (head, timeout) import Bilge.Assert -import Control.Arrow ((>>>)) import Control.Lens hiding ((#), (.=)) import Control.Monad.Catch import Data.Aeson hiding (json) import Data.ByteString.Conversion import Data.Code qualified as Code -import Data.Csv (FromNamedRecord (..), decodeByName) import Data.Currency qualified as Currency import Data.Default import Data.Id @@ -46,8 +44,7 @@ import Data.LegalHold qualified as LH import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List1 hiding (head) import Data.List1 qualified as List1 -import Data.Map qualified as Map -import Data.Misc (HttpsUrl, PlainTextPassword6, mkHttpsUrl, plainTextPassword6) +import Data.Misc import Data.Qualified import Data.Range import Data.Set qualified as Set @@ -56,7 +53,6 @@ import Data.Text.Ascii (AsciiChars (validate)) import Data.UUID qualified as UUID import Data.UUID.Util qualified as UUID import Data.UUID.V1 qualified as UUID -import Data.Vector qualified as V import Galley.Env qualified as Galley import Galley.Options (featureFlags, maxConvSize, maxFanoutSize, settings) import Galley.Types.Conversations.Roles @@ -65,7 +61,6 @@ import Imports import Network.HTTP.Types.Status (status403) import Network.Wai.Utilities.Error qualified as Error import Network.Wai.Utilities.Error qualified as Wai -import SAML2.WebSSO.Types qualified as SAML import Test.Tasty import Test.Tasty.Cannon (TimeoutUnit (..), (#)) import Test.Tasty.Cannon qualified as WS @@ -82,19 +77,15 @@ import Wire.API.Internal.Notification hiding (target) import Wire.API.Routes.Internal.Galley.TeamsIntra as TeamsIntra import Wire.API.Routes.Version import Wire.API.Team -import Wire.API.Team.Export (TeamExportUser (..)) import Wire.API.Team.Feature import Wire.API.Team.Member import Wire.API.Team.Member qualified as Member -import Wire.API.Team.Member qualified as TM import Wire.API.Team.Member qualified as Teams import Wire.API.Team.Permission as P import Wire.API.Team.Role import Wire.API.Team.SearchVisibility import Wire.API.User qualified as Public import Wire.API.User qualified as U -import Wire.API.User.Client qualified as C -import Wire.API.User.Client.Prekey qualified as PC tests :: IO TestSetup -> TestTree tests s = @@ -104,11 +95,6 @@ tests s = test s "create binding team with currency" testCreateBindingTeamWithCurrency, testGroup "List Team Members" $ [ test s "a member should be able to list their team" testListTeamMembersDefaultLimit, - let numMembers = 5 - in test - s - ("admins should be able to get a csv stream with their team (" <> show numMembers <> " members)") - (testListTeamMembersCsv numMembers), test s "the list should be limited to the number requested (hard truncation is not tested here)" testListTeamMembersTruncated, test s "pagination" testListTeamMembersPagination ], @@ -232,79 +218,6 @@ testListTeamMembersDefaultLimit = do "member list indicates that there are no more members" (listFromServer ^. teamMemberListType == ListComplete) --- | for ad-hoc load-testing, set @numMembers@ to, say, 10k and see what --- happens. but please don't give that number to our ci! :) --- for additional tests of the CSV download particularly with SCIM users, please refer to 'Test.Spar.Scim.UserSpec' -testListTeamMembersCsv :: (HasCallStack) => Int -> TestM () -testListTeamMembersCsv numMembers = do - let teamSize = numMembers + 1 - - (owner, tid, mbs) <- Util.createBindingTeamWithNMembersWithHandles True numMembers - let numClientMappings = Map.fromList $ (owner : mbs) `zip` (cycle [1, 2, 3] :: [Int]) - addClients numClientMappings - resp <- Util.getTeamMembersCsv owner tid - let rbody = fromMaybe (error "no body") . responseBody $ resp - usersInCsv <- either (error "could not decode csv") pure (decodeCSV @TeamExportUser rbody) - liftIO $ do - assertEqual "total number of team members" teamSize (length usersInCsv) - assertEqual "owners in team" 1 (countOn tExportRole (Just RoleOwner) usersInCsv) - assertEqual "members in team" numMembers (countOn tExportRole (Just RoleMember) usersInCsv) - - do - let someUsersInCsv = take 50 usersInCsv - someHandles = tExportHandle <$> someUsersInCsv - users <- Util.getUsersByHandle (catMaybes someHandles) - mbrs <- view teamMembers <$> Util.bulkGetTeamMembers owner tid (U.userId <$> users) - - let check :: (Eq a) => String -> (TeamExportUser -> Maybe a) -> UserId -> Maybe a -> IO () - check msg getTeamExportUserAttr uid userAttr = do - assertBool msg (isJust userAttr) - assertEqual (msg <> ": " <> show uid) 1 (countOn getTeamExportUserAttr userAttr usersInCsv) - - liftIO . forM_ (zip users mbrs) $ \(user, mbr) -> do - assertEqual "user/member id match" (U.userId user) (mbr ^. TM.userId) - check "tExportDisplayName" (Just . tExportDisplayName) (U.userId user) (Just $ U.userDisplayName user) - check "tExportEmail" tExportEmail (U.userId user) (U.userEmail user) - - liftIO . forM_ (zip3 someUsersInCsv users mbrs) $ \(export, user, mbr) -> do - -- FUTUREWORK: there are a lot of cases we don't cover here (manual invitation, saml, other roles, ...). - assertEqual ("tExportDisplayName: " <> show (U.userId user)) (U.userDisplayName user) (tExportDisplayName export) - assertEqual ("tExportHandle: " <> show (U.userId user)) (U.userHandle user) (tExportHandle export) - assertEqual ("tExportEmail: " <> show (U.userId user)) (U.userEmail user) (tExportEmail export) - assertEqual ("tExportRole: " <> show (U.userId user)) (permissionsRole $ view permissions mbr) (tExportRole export) - assertEqual ("tExportCreatedOn: " <> show (U.userId user)) (snd <$> view invitation mbr) (tExportCreatedOn export) - assertEqual ("tExportInvitedBy: " <> show (U.userId user)) Nothing (tExportInvitedBy export) - assertEqual ("tExportIdpIssuer: " <> show (U.userId user)) (userToIdPIssuer user) (tExportIdpIssuer export) - assertEqual ("tExportManagedBy: " <> show (U.userId user)) (U.userManagedBy user) (tExportManagedBy export) - assertEqual ("tExportUserId: " <> show (U.userId user)) (U.userId user) (tExportUserId export) - assertEqual "tExportNumDevices: " (Map.findWithDefault (-1) (U.userId user) numClientMappings) (tExportNumDevices export) - where - userToIdPIssuer :: (HasCallStack) => U.User -> Maybe HttpsUrl - userToIdPIssuer usr = case (U.userIdentity >=> U.ssoIdentity) usr of - Just (U.UserSSOId (SAML.UserRef (SAML.Issuer issuer) _)) -> either (const $ error "shouldn't happen") Just $ mkHttpsUrl issuer - Just _ -> Nothing - Nothing -> Nothing - - decodeCSV :: (FromNamedRecord a) => LByteString -> Either String [a] - decodeCSV bstr = decodeByName bstr <&> (snd >>> V.toList) - - countOn :: (Eq b) => (a -> b) -> b -> [a] -> Int - countOn prop val xs = sum $ fmap (bool 0 1 . (== val) . prop) xs - - addClients :: Map.Map UserId Int -> TestM () - addClients xs = forM_ (Map.toList xs) addClientForUser - - addClientForUser :: (UserId, Int) -> TestM () - addClientForUser (uid, n) = forM_ [0 .. (n - 1)] (addClient uid) - - addClient :: UserId -> Int -> TestM () - addClient uid i = do - brig <- viewBrig - post (brig . paths ["i", "clients", toByteString' uid] . contentJson . json (newClient (someLastPrekeys !! i)) . queryItem "skip_reauth" "true") !!! const 201 === statusCode - - newClient :: PC.LastPrekey -> C.NewClient - newClient lpk = C.newClient C.PermanentClientType lpk - testListTeamMembersPagination :: TestM () testListTeamMembersPagination = do (owner, tid, _) <- Util.createBindingTeamWithNMembers 18