diff --git a/changelog.d/2-features/search-scim-groups-members b/changelog.d/2-features/search-scim-groups-members new file mode 100644 index 0000000000..30bd6b9575 --- /dev/null +++ b/changelog.d/2-features/search-scim-groups-members @@ -0,0 +1 @@ +Return group members as part of the search result in SCIM groups. \ No newline at end of file diff --git a/integration/test/API/Spar.hs b/integration/test/API/Spar.hs index 4fbb3aeea6..1c1296be36 100644 --- a/integration/test/API/Spar.hs +++ b/integration/test/API/Spar.hs @@ -141,6 +141,24 @@ filterScimUserGroup domain token mbFilter = do & scimCommonHeaders token & maybe id (\f -> addQueryParams [("filter", f)]) mbFilter +mkScimGroup :: String -> [Value] -> Value +mkScimGroup name members = + object + [ "schemas" .= ["urn:ietf:params:scim:schemas:core:2.0:Group"], + "displayName" .= name, + "members" .= members + ] + +mkScimUser :: String -> Value +mkScimUser scimUserId = + object + [ "type" .= "User", + "$ref" .= "...", -- something like + -- "https://example.org/v2/scim/User/ea2e4bf0-aa5e-11f0-96ad-e776a606779b"? + -- but since we're just receiving this it's ok to ignore. + "value" .= scimUserId + ] + -- | https://staging-nginz-https.zinfra.io/v12/api/swagger-ui/#/default/idp-create createIdp :: (HasCallStack, MakesValue user) => user -> SAML.IdPMetadata -> App Response createIdp user metadata = do diff --git a/integration/test/Test/Spar.hs b/integration/test/Test/Spar.hs index a2c4c46efe..5fc7664868 100644 --- a/integration/test/Test/Spar.hs +++ b/integration/test/Test/Spar.hs @@ -26,10 +26,9 @@ import API.GalleyInternal (setTeamFeatureStatus) import API.Spar import API.SparInternal import Control.Concurrent (threadDelay) -import Control.Lens (to, (?~), (^.)) +import Control.Lens (to, (^.)) import qualified Data.Aeson as A import qualified Data.Aeson.KeyMap as KeyMap -import qualified Data.Aeson.Lens as A import qualified Data.Aeson.Types as A import qualified Data.CaseInsensitive as CI import Data.String.Conversions (cs) @@ -383,8 +382,8 @@ testSparCreateScimTokenWithName = do ---------------------------------------------------------------------- -- scim group stuff -testSparScimCreateGetUserGroup :: (HasCallStack) => App () -testSparScimCreateGetUserGroup = do +testSparScimCreateGetSearchUserGroup :: (HasCallStack) => App () +testSparScimCreateGetSearchUserGroup = do (owner, tid, _) <- createTeam OwnDomain 1 tok <- createScimTokenV6 owner def >>= \resp -> resp.json %. "token" >>= asString assertSuccess =<< setTeamFeatureStatus owner tid "validateSAMLemails" "disabled" @@ -419,47 +418,36 @@ testSparScimCreateGetUserGroup = do scimUserId <- mkMemberCandidate scimUserId2 <- mkMemberCandidate - - resp <- createScimUserGroup OwnDomain tok $ mkScimGroup "ze groop" [mkScimUser scimUserId, mkScimUser scimUserId2] - resp4 <- createScimUserGroup OwnDomain tok $ mkScimGroup "ze group" [mkScimUser scimUserId, mkScimUser scimUserId2] - assertSuccess resp - - gid <- resp.json %. "id" & asString - resp2 <- getScimUserGroup OwnDomain tok gid - resp.json `shouldMatch` resp2.json - - filterResp <- filterScimUserGroup OwnDomain tok $ Just "displayName co \"e gro\"" - assertSuccess filterResp - filterResultJson <- filterResp.json - foundGroups <- filterResultJson %. "Resources" & asList - createdGroup1 <- resp.json - createdGroup2 <- resp4.json - foundGroups `shouldMatch` (map removeMembers [createdGroup1, createdGroup2]) - - filterResultJson %. "totalResults" `shouldMatchInt` 2 - filterResultJson %. "itemsPerPage" `shouldMatchInt` 2 - filterResultJson %. "startIndex" `shouldMatchInt` 1 - where - removeMembers g = g & A.atKey (fromString "members") ?~ toJSON ([] :: [()]) - -mkScimGroup :: String -> [Value] -> Value -mkScimGroup name members = - object - [ "schemas" .= ["urn:ietf:params:scim:schemas:core:2.0:Group"], - "displayName" .= name, - "members" .= members - ] - -mkScimUser :: String -> Value -mkScimUser scimUserId = - object - [ "type" .= "User", - "$ref" .= "...", -- something like - -- "https://example.org/v2/scim/User/ea2e4bf0-aa5e-11f0-96ad-e776a606779b"? - -- but since we're just receiving this it's ok - -- to ignore. - "value" .= scimUserId - ] + scimUserId3 <- mkMemberCandidate + + respGroup1 <- createScimUserGroup OwnDomain tok $ mkScimGroup "a group" [mkScimUser scimUserId, mkScimUser scimUserId2] + respGroup2 <- createScimUserGroup OwnDomain tok $ mkScimGroup "another group" [mkScimUser scimUserId, mkScimUser scimUserId2] + respGroup3 <- createScimUserGroup OwnDomain tok $ mkScimGroup "yet another group" [mkScimUser scimUserId2, mkScimUser scimUserId3] + + createdGroup1 <- respGroup1.json + createdGroup2 <- respGroup2.json + createdGroup3 <- respGroup3.json + + -- Test getting a single SCIM group by id + gid <- respGroup1.json %. "id" & asString + gottenGroup1 <- getScimUserGroup OwnDomain tok gid + respGroup1.json `shouldMatch` gottenGroup1.json + + -- Test filter (get in bulk) SCIM groups + -- 1. Match "group", results in finding all three groups created above. + filterScimUserGroup OwnDomain tok (Just "displayName co \"group\"") `bindResponse` \allThreeResp -> + (allThreeResp.json %. "Resources" & asList) `shouldMatchSet` [createdGroup1, createdGroup2, createdGroup3] + + -- 2. Match "another group", results in finding "another group" and "yet another group". + filterScimUserGroup OwnDomain tok (Just "displayName co \"another group\"") `bindResponse` \justTwo -> + (justTwo.json %. "Resources" & asList) `shouldMatchSet` [createdGroup2, createdGroup3] + + -- 3. Empty groups should have empty member list. + respGroup4 <- createScimUserGroup OwnDomain tok $ mkScimGroup "empty group" [] + filterScimUserGroup OwnDomain tok (Just "displayName co \"empty group\"") `bindResponse` \foundResults -> do + singleEmptyGroup <- foundResults.json %. "Resources" >>= asList >>= assertOne + (singleEmptyGroup %. "members" & asList) `shouldMatch` ([] :: [Value]) + respGroup4.json `shouldMatch` singleEmptyGroup testSparScimUpdateUserGroup :: (HasCallStack) => App () testSparScimUpdateUserGroup = do diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index 6956a6c2a3..36bb424f2f 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -283,7 +283,7 @@ type GetGroupsInternal = :> "user-groups" :> Capture "tid" TeamId :> QueryParam' [Optional, Strict] "nameContains" Text.Text - :> Get '[Servant.JSON] UserGroupPage + :> Get '[Servant.JSON] UserGroupPageWithMembers ) type UpdateGroupInternal = diff --git a/libs/wire-api/src/Wire/API/UserGroup/Pagination.hs b/libs/wire-api/src/Wire/API/UserGroup/Pagination.hs index 909c5f3a9f..92e309515e 100644 --- a/libs/wire-api/src/Wire/API/UserGroup/Pagination.hs +++ b/libs/wire-api/src/Wire/API/UserGroup/Pagination.hs @@ -26,19 +26,30 @@ import Wire.API.Pagination import Wire.API.UserGroup import Wire.Arbitrary as Arbitrary -data UserGroupPage = UserGroupPage - { page :: [UserGroupMeta], +-- | User group without members +type UserGroupPage = UserGroupPage_ UserGroupMeta + +-- | User group with members +type UserGroupPageWithMembers = UserGroupPage_ UserGroup + +-- * User group pages + +-- + +-- | User group pages with different types of user groups. +data UserGroupPage_ a = UserGroupPage + { page :: [a], total :: Int } deriving (Eq, Show, Generic) - deriving (A.FromJSON, A.ToJSON, S.ToSchema) via Schema UserGroupPage + deriving (A.FromJSON, A.ToJSON, S.ToSchema) via Schema (UserGroupPage_ a) -instance ToSchema UserGroupPage where +instance (ToSchema a) => ToSchema (UserGroupPage_ a) where schema = objectWithDocModifier "UserGroupPage" addPageDocs $ UserGroupPage <$> page .= field "page" (array schema) <*> total .= field "total" schema -instance Arbitrary UserGroupPage where +instance (Arbitrary a) => Arbitrary (UserGroupPage_ a) where arbitrary = UserGroupPage <$> arbitrary <*> arbitrary diff --git a/libs/wire-subsystems/src/Wire/BrigAPIAccess.hs b/libs/wire-subsystems/src/Wire/BrigAPIAccess.hs index 5d8bb75318..c9f9aa4168 100644 --- a/libs/wire-subsystems/src/Wire/BrigAPIAccess.hs +++ b/libs/wire-subsystems/src/Wire/BrigAPIAccess.hs @@ -161,7 +161,7 @@ data BrigAPIAccess m a where GetAccountsBy :: GetBy -> BrigAPIAccess m [User] CreateGroupInternal :: ManagedBy -> TeamId -> Maybe UserId -> NewUserGroup -> BrigAPIAccess m (Either Wai.Error UserGroup) GetGroupInternal :: TeamId -> UserGroupId -> Bool -> BrigAPIAccess m (Maybe UserGroup) - GetGroupsInternal :: TeamId -> Maybe Scim.Filter -> BrigAPIAccess m UserGroupPage + GetGroupsInternal :: TeamId -> Maybe Scim.Filter -> BrigAPIAccess m UserGroupPageWithMembers UpdateGroup :: UpdateGroupInternalRequest -> BrigAPIAccess m (Either Wai.Error ()) DeleteGroupInternal :: ManagedBy -> TeamId -> UserGroupId -> BrigAPIAccess m (Either DeleteGroupManagedError ()) diff --git a/libs/wire-subsystems/src/Wire/BrigAPIAccess/Rpc.hs b/libs/wire-subsystems/src/Wire/BrigAPIAccess/Rpc.hs index 8453af73c9..08df77e217 100644 --- a/libs/wire-subsystems/src/Wire/BrigAPIAccess/Rpc.hs +++ b/libs/wire-subsystems/src/Wire/BrigAPIAccess/Rpc.hs @@ -605,7 +605,7 @@ getGroupsInternal :: (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) => TeamId -> Maybe Scim.Filter -> - Sem r UserGroupPage + Sem r UserGroupPageWithMembers getGroupsInternal tid mbFilter = do maybeDisplayName :: Maybe Text <- case mbFilter of Just filter' -> case filter' of diff --git a/libs/wire-subsystems/src/Wire/ScimSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/ScimSubsystem/Interpreter.hs index 1abc9d0ea7..96132f3f6a 100644 --- a/libs/wire-subsystems/src/Wire/ScimSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/ScimSubsystem/Interpreter.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2025 Wire Swiss GmbH @@ -143,12 +141,9 @@ scimGetUserGroupsImpl :: Maybe Scim.Filter -> Sem r (Scim.ListResponse (SCG.StoredGroup SparTag)) scimGetUserGroupsImpl tid mbFilter = do - UserGroupPage {page} :: UserGroupPage <- BrigAPI.getGroupsInternal tid mbFilter + UserGroupPage {page} :: UserGroupPageWithMembers <- BrigAPI.getGroupsInternal tid mbFilter ScimSubsystemConfig scimBaseUri <- input - pure . Scim.fromList $ toStoredGroup scimBaseUri . userGroupFromMeta <$> page - where - userGroupFromMeta :: UserGroupMeta -> UserGroup - userGroupFromMeta UserGroup_ {..} = UserGroup_ {members = pure mempty, ..} + pure . Scim.fromList $ toStoredGroup scimBaseUri <$> page scimUpdateUserGroupImpl :: forall r. diff --git a/libs/wire-subsystems/src/Wire/UserGroupStore.hs b/libs/wire-subsystems/src/Wire/UserGroupStore.hs index ed38a10e4a..cb4c944904 100644 --- a/libs/wire-subsystems/src/Wire/UserGroupStore.hs +++ b/libs/wire-subsystems/src/Wire/UserGroupStore.hs @@ -53,6 +53,7 @@ data UserGroupStore m a where CreateUserGroup :: TeamId -> NewUserGroup -> ManagedBy -> UserGroupStore m UserGroup GetUserGroup :: TeamId -> UserGroupId -> Bool -> UserGroupStore m (Maybe UserGroup) GetUserGroups :: UserGroupPageRequest -> UserGroupStore m UserGroupPage + GetUserGroupsWithMembers :: UserGroupPageRequest -> UserGroupStore m UserGroupPageWithMembers GetUserGroupsForConv :: ConvId -> UserGroupStore m (Vector UserGroup) UpdateUserGroup :: TeamId -> UserGroupId -> UserGroupUpdate -> UserGroupStore m (Maybe ()) DeleteUserGroup :: TeamId -> UserGroupId -> UserGroupStore m (Maybe ()) diff --git a/libs/wire-subsystems/src/Wire/UserGroupStore/Postgres.hs b/libs/wire-subsystems/src/Wire/UserGroupStore/Postgres.hs index 364b2a3bdb..c5609389a3 100644 --- a/libs/wire-subsystems/src/Wire/UserGroupStore/Postgres.hs +++ b/libs/wire-subsystems/src/Wire/UserGroupStore/Postgres.hs @@ -65,6 +65,7 @@ interpretUserGroupStoreToPostgres = CreateUserGroup team newUserGroup managedBy -> createUserGroup team newUserGroup managedBy GetUserGroup team userGroupId includeChannels -> getUserGroup team userGroupId includeChannels GetUserGroups req -> getUserGroups req + GetUserGroupsWithMembers req -> getUserGroupsWithMembers req GetUserGroupsForConv convId -> getUserGroupsForConv convId UpdateUserGroup tid gid gup -> updateGroup tid gid gup DeleteUserGroup tid gid -> deleteGroup tid gid @@ -220,6 +221,109 @@ getUserGroup team id_ includeChannels = do where ug.id = ($1 :: uuid) and ug.team_id = ($2 :: uuid) |] +getUserGroupsWithMembers :: + forall r. + ( UserGroupStorePostgresEffectConstraints r + ) => + UserGroupPageRequest -> + Sem r UserGroupPageWithMembers +getUserGroupsWithMembers req = + runTransaction TxSessions.ReadCommitted TxSessions.Read $ + UserGroupPage + <$> Tx.statement () (refineResult (mapM toUserGroup) $ buildStatement query rows) + <*> getUserGroupCount req + where + rows :: HD.Result [(UUID, Text, Int32, UTCTime, Vector UUID, Int32)] + rows = + HD.rowList $ + (,,,,,) + <$> HD.column (HD.nonNullable HD.uuid) + <*> HD.column (HD.nonNullable HD.text) + <*> HD.column (HD.nonNullable HD.int4) + <*> HD.column (HD.nonNullable HD.timestamptz) + <*> decodeUuidVector + <*> HD.column (HD.nonNullable HD.int4) + + query :: QueryFragment + query = + mconcat $ + map + literal + [ "select", + T.intercalate + ", " + [ "ug.id :: uuid", + "ug.name :: text", + "ug.managed_by :: int", + "ug.created_at :: timestamptz", + "coalesce(array_agg(gm.user_id) filter (WHERE gm.user_id IS NOT NULL), array[]::uuid[]) :: uuid[]", + "count(gm.user_id) :: int" + ], + "from user_group ug", + "left join user_group_member gm on ug.id = gm.user_group_id" + ] + <> [where_ (groupMatchIdName req <> groupPaginationWhereClause req)] + <> [ literal "group by ug.team_id, ug.id" + ] + <> groupPaginationOrderBy req + + toUserGroup :: (UUID, Text, Int32, UTCTime, Vector UUID, Int32) -> Either Text UserGroup + toUserGroup (Id -> id_, name', managedBy', createdAt', members', Just . fromIntegral -> membersCount) = do + name <- userGroupNameFromText name' + managedBy <- parseManagedBy managedBy' + let createdAt = toUTCTimeMillis createdAt' + channels = Nothing + channelsCount = Nothing + members = Identity (fmap Id members' :: Vector UserId) + pure $ UserGroup_ {..} + +groupMatchIdName :: UserGroupPageRequest -> [QueryFragment] +groupMatchIdName req = + clause1 "ug.team_id" "=" req.team + : case req.searchString of + Just name -> [like "ug.name" name] + Nothing -> [] + +groupPaginationWhereClause :: UserGroupPageRequest -> [QueryFragment] +groupPaginationWhereClause req = case paginationClause req.paginationState of + Just c -> [clause (sortOrderOperator req.sortOrder) c] + Nothing -> [] + +groupPaginationOrderBy :: UserGroupPageRequest -> [QueryFragment] +groupPaginationOrderBy req = + [ orderBy + [ (sortColumn req.paginationState, req.sortOrder), + ("ug.id", req.sortOrder) + ], + limit (pageSizeToInt32 req.pageSize) + ] + where + sortColumn :: PaginationState a -> Text + sortColumn = \case + PaginationSortByName _ -> "ug.name" + PaginationSortByCreatedAt _ -> "ug.created_at" + +getUserGroupCount :: UserGroupPageRequest -> Tx.Transaction Int +getUserGroupCount req = Tx.statement () $ refineResult parseCount $ buildStatement query decoder + where + query = literal "select count(*) from user_group ug" <> where_ (groupMatchIdName req) + decoder = HD.singleRow (HD.column (HD.nonNullable HD.int8)) + +decodeUuidVector :: HD.Row (Vector UUID) +decodeUuidVector = + HD.column $ + HD.nonNullable $ + HD.array $ + HD.dimension V.replicateM $ + HD.element $ + HD.nonNullable HD.uuid + +parseManagedBy :: Int32 -> Either Text ManagedBy +parseManagedBy = \case + 0 -> pure ManagedByWire + 1 -> pure ManagedByScim + bad -> Left $ "Could not parse managedBy value: " <> T.pack (show bad) + getUserGroups :: forall r. ( UserGroupStorePostgresEffectConstraints r, @@ -230,7 +334,7 @@ getUserGroups :: getUserGroups req@(UserGroupPageRequest {..}) = do loc <- inputQualifyLocal () runTransaction TxSessions.ReadCommitted TxSessions.Read $ - UserGroupPage <$> getUserGroupsSession loc <*> getCountSession + UserGroupPage <$> getUserGroupsSession loc <*> getUserGroupCount req where getUserGroupsSession :: Local () -> Tx.Transaction [UserGroupMeta] getUserGroupsSession loc = @@ -241,36 +345,12 @@ getUserGroups req@(UserGroupPageRequest {..}) = do [ literal "select", literal selectors, literal "from user_group as ug", - where_ - ( [clause1 "team_id" "=" req.team] - <> [ clause (sortOrderOperator sortOrder) c - | c <- toList (paginationClause paginationState) - ] - <> toList (like "name" <$> searchString) - ) + where_ (groupMatchIdName req <> groupPaginationWhereClause req) ] - <> [ orderBy - [ (sortColumn, sortOrder), - ("id", sortOrder) - ], - limit (pageSizeToInt32 req.pageSize) - ] + <> groupPaginationOrderBy req ) decodeRow - getCountSession :: Tx.Transaction Int - getCountSession = - Tx.statement () $ - refineResult parseCount $ - buildStatement - ( literal "select count(*) from user_group" - <> where_ - ( [clause1 "team_id" "=" req.team] - <> toList (like "name" <$> searchString) - ) - ) - (HD.singleRow (HD.column (HD.nonNullable HD.int8))) - decodeRow :: HD.Result [(UUID, Text, Int32, UTCTime, Maybe Int32, Int32, Maybe (Vector UUID))] decodeRow = HD.rowList @@ -282,27 +362,14 @@ getUserGroups req@(UserGroupPageRequest {..}) = do <*> (if req.includeMemberCount then Just <$> HD.column (HD.nonNullable HD.int4) else pure Nothing) <*> HD.column (HD.nonNullable HD.int4) <*> ( if req.includeChannels - then - Just - <$> HD.column - ( HD.nonNullable - ( HD.array - ( HD.dimension - V.replicateM - (HD.element (HD.nonNullable HD.uuid)) - ) - ) - ) + then Just <$> decodeUuidVector else pure Nothing ) ) parseRow :: Local a -> (UUID, Text, Int32, UTCTime, Maybe Int32, Int32, Maybe (Vector UUID)) -> Either Text UserGroupMeta parseRow loc (Id -> id_, namePre, managedByPre, toUTCTimeMillis -> createdAt, membersCountRaw, channelsCountRaw, maybeChannels) = do - managedBy <- case managedByPre of - 0 -> pure ManagedByWire - 1 -> pure ManagedByScim - bad -> Left $ "Could not parse managedBy value: " <> T.pack (show bad) + managedBy <- parseManagedBy managedByPre name <- userGroupNameFromText namePre let members = Const () membersCount = fromIntegral <$> membersCountRaw @@ -310,19 +377,13 @@ getUserGroups req@(UserGroupPageRequest {..}) = do channels = fmap (fmap (tUntagged . qualifyAs loc . Id)) maybeChannels pure $ UserGroup_ {..} - sortColumn :: Text - sortColumn = case paginationState of - PaginationSortByName _ -> "name" - PaginationSortByCreatedAt _ -> "created_at" - selectors :: Text selectors = T.intercalate ", " $ - filter (not . T.null) $ - ["id", "name", "managed_by", "created_at"] - <> ["(select count(*) from user_group_member as ugm where ugm.user_group_id = ug.id) as members" | includeMemberCount] - <> ["(select count(*) from user_group_channel as ugc where ugc.user_group_id = ug.id) as channels"] - <> ["coalesce((select array_agg(ugc.conv_id) from user_group_channel as ugc where ugc.user_group_id = ug.id), array[]::uuid[]) as channel_ids" | includeChannels] + ["id", "name", "managed_by", "created_at"] + <> ["(select count(*) from user_group_member as ugm where ugm.user_group_id = ug.id) as members" | includeMemberCount] + <> ["(select count(*) from user_group_channel as ugc where ugc.user_group_id = ug.id) as channels"] + <> ["coalesce((select array_agg(ugc.conv_id) from user_group_channel as ugc where ugc.user_group_id = ug.id), array[]::uuid[]) as channel_ids" | includeChannels] createUserGroup :: forall r. diff --git a/libs/wire-subsystems/src/Wire/UserGroupSubsystem.hs b/libs/wire-subsystems/src/Wire/UserGroupSubsystem.hs index 33535ae300..68071e5d67 100644 --- a/libs/wire-subsystems/src/Wire/UserGroupSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/UserGroupSubsystem.hs @@ -75,7 +75,7 @@ data UserGroupSubsystem m a where -- Internal API handlers CreateGroupInternal :: ManagedBy -> TeamId -> Maybe UserId -> NewUserGroup -> UserGroupSubsystem r UserGroup GetGroupInternal :: TeamId -> UserGroupId -> Bool -> UserGroupSubsystem m (Maybe UserGroup) - GetGroupsInternal :: TeamId -> Maybe Text -> UserGroupSubsystem m UserGroupPage + GetGroupsInternal :: TeamId -> Maybe Text -> UserGroupSubsystem m UserGroupPageWithMembers ResetUserGroupInternal :: UpdateGroupInternalRequest -> UserGroupSubsystem m () makeSem ''UserGroupSubsystem diff --git a/libs/wire-subsystems/src/Wire/UserGroupSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/UserGroupSubsystem/Interpreter.hs index 512dc42275..ff446ae855 100644 --- a/libs/wire-subsystems/src/Wire/UserGroupSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/UserGroupSubsystem/Interpreter.hs @@ -282,7 +282,7 @@ getUserGroupsInternal :: ) => TeamId -> Maybe Text -> - Sem r UserGroupPage + Sem r UserGroupPageWithMembers getUserGroupsInternal team displayNameSubstring = do let -- hscim doesn't support pagination at the time of writing this, -- so we better fit all groups into one page! @@ -297,7 +297,7 @@ getUserGroupsInternal team displayNameSubstring = do includeMemberCount = True, includeChannels = False } - Store.getUserGroups pageReq + Store.getUserGroupsWithMembers pageReq updateGroup :: ( Member UserSubsystem r, diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserGroupStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserGroupStore.hs index e3b5c7f6d6..0e01041ab8 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserGroupStore.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserGroupStore.hs @@ -63,6 +63,7 @@ userGroupStoreTestInterpreter = CreateUserGroup tid ng mb -> createUserGroupImpl tid ng mb GetUserGroup tid gid includeChannels -> getUserGroupImpl tid gid includeChannels GetUserGroups req -> getUserGroupsImpl req + GetUserGroupsWithMembers req -> getUserGroupsWithMembersImpl req GetUserGroupsForConv cid -> getUserGroupsForConvImpl cid UpdateUserGroup tid gid gup -> updateUserGroupImpl tid gid gup DeleteUserGroup tid gid -> deleteUserGroupImpl tid gid @@ -124,8 +125,16 @@ filterChannels includeChannels ug = else (ug :: UserGroup) {channels = mempty} getUserGroupsImpl :: (UserGroupStoreInMemEffectConstraints r) => UserGroupPageRequest -> Sem r UserGroupPage -getUserGroupsImpl UserGroupPageRequest {..} = do - meta <- ((snd <$>) . sieve . fmap (_2 %~ userGroupToMeta . (filterChannels includeChannels)) . Map.toList) <$> get @UserGroupInMemState +getUserGroupsImpl req = do + UserGroupPage pages count <- getUserGroupsWithMembersImpl req + pure $ UserGroupPage (map removeMembers pages) count + where + removeMembers :: UserGroup -> UserGroupMeta + removeMembers UserGroup_ {..} = UserGroup_ {members = Const (), ..} + +getUserGroupsWithMembersImpl :: (UserGroupStoreInMemEffectConstraints r) => UserGroupPageRequest -> Sem r UserGroupPageWithMembers +getUserGroupsWithMembersImpl UserGroupPageRequest {..} = do + meta <- ((snd <$>) . sieve . fmap (_2 %~ (filterChannels includeChannels)) . Map.toList) <$> get @UserGroupInMemState pure $ UserGroupPage meta (length meta) where sieve, @@ -134,7 +143,7 @@ getUserGroupsImpl UserGroupPageRequest {..} = do orderByKeys, narrowToSearchString, narrowToTeam :: - [((TeamId, UserGroupId), UserGroupMeta)] -> [((TeamId, UserGroupId), UserGroupMeta)] + [((TeamId, UserGroupId), UserGroup)] -> [((TeamId, UserGroupId), UserGroup)] sieve = dropAfterPageSize @@ -166,7 +175,7 @@ getUserGroupsImpl UserGroupPageRequest {..} = do dropBeforeStart = do dropWhile sqlConds where - sqlConds :: ((TeamId, UserGroupId), UserGroupMeta) -> Bool + sqlConds :: ((TeamId, UserGroupId), UserGroup) -> Bool sqlConds ((_, _), row) = case (paginationState, sortOrder) of (PaginationSortByName (Just (name, tieBreaker)), Asc) -> diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index b7d83f6118..43636d59dd 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -1030,7 +1030,7 @@ getGroupsInternalH :: ) => TeamId -> Maybe T.Text -> - Handler r UserGroupPage + Handler r UserGroupPageWithMembers getGroupsInternalH tid nameContains = lift . liftSem $ getGroupsInternal tid nameContains