Skip to content

Commit db1b267

Browse files
blackheavenblackheaven
committed
refactor: try to push down the stack channels associated query
1 parent 909912b commit db1b267

File tree

4 files changed

+119
-18
lines changed

4 files changed

+119
-18
lines changed

‎libs/wire-subsystems/src/Wire/UserGroupStore.hs‎

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -18,9 +18,16 @@ data UserGroupPageRequest = UserGroupPageRequest
1818
paginationState :: PaginationState,
1919
sortOrder :: SortOrder,
2020
pageSize :: PageSize,
21-
includeMemberCount :: Bool
21+
includeMemberCount :: Bool,
22+
includeConversations :: IncludeConversations
2223
}
2324

25+
data IncludeConversations
26+
= DoNotIncludeConversations
27+
| IncludeConversationsCountOnly
28+
| IncludeConversations
29+
deriving stock (Eq, Show)
30+
2431
data PaginationState = PaginationSortByName (Maybe (UserGroupName, UserGroupId)) | PaginationSortByCreatedAt (Maybe (UTCTimeMillis, UserGroupId))
2532

2633
toSortBy :: PaginationState -> SortBy
@@ -30,7 +37,7 @@ toSortBy = \case
3037

3138
data UserGroupStore m a where
3239
CreateUserGroup :: TeamId -> NewUserGroup -> ManagedBy -> UserGroupStore m UserGroup
33-
GetUserGroup :: TeamId -> UserGroupId -> UserGroupStore m (Maybe UserGroup)
40+
GetUserGroup :: TeamId -> UserGroupId -> IncludeConversations -> UserGroupStore m (Maybe UserGroup)
3441
GetUserGroups :: UserGroupPageRequest -> UserGroupStore m UserGroupPage
3542
UpdateUserGroup :: TeamId -> UserGroupId -> UserGroupUpdate -> UserGroupStore m (Maybe ())
3643
DeleteUserGroup :: TeamId -> UserGroupId -> UserGroupStore m (Maybe ())

‎libs/wire-subsystems/src/Wire/UserGroupStore/Postgres.hs‎

Lines changed: 92 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ import Wire.API.Pagination
3131
import Wire.API.User.Profile
3232
import Wire.API.UserGroup hiding (UpdateUserGroupChannels)
3333
import Wire.API.UserGroup.Pagination
34-
import Wire.UserGroupStore (PaginationState (..), UserGroupPageRequest (..), UserGroupStore (..), toSortBy)
34+
import Wire.UserGroupStore (IncludeConversations (..), PaginationState (..), UserGroupPageRequest (..), UserGroupStore (..), toSortBy)
3535

3636
type UserGroupStorePostgresEffectConstraints r =
3737
( Member (Embed IO) r,
@@ -46,7 +46,11 @@ interpretUserGroupStoreToPostgres ::
4646
interpretUserGroupStoreToPostgres =
4747
interpret $ \case
4848
CreateUserGroup team newUserGroup managedBy -> createUserGroup team newUserGroup managedBy
49-
GetUserGroup team userGroupId -> getUserGroup team userGroupId
49+
GetUserGroup team userGroupId includeConversations' ->
50+
case includeConversations' of
51+
DoNotIncludeConversations -> getUserGroup team userGroupId
52+
IncludeConversationsCountOnly -> getUserGroup team userGroupId
53+
IncludeConversations -> getUserGroupWithConversations team userGroupId
5054
GetUserGroups req -> getUserGroups req
5155
UpdateUserGroup tid gid gup -> updateGroup tid gid gup
5256
DeleteUserGroup tid gid -> deleteGroup tid gid
@@ -115,6 +119,92 @@ getUserGroup team id_ = do
115119
select (user_id :: uuid) from user_group_member where user_group_id = ($1 :: uuid)
116120
|]
117121

122+
getUserGroupWithChannelIds ::
123+
forall r.
124+
(UserGroupStorePostgresEffectConstraints r) =>
125+
TeamId ->
126+
UserGroupId ->
127+
Sem r (Maybe (UserGroup, Vector ConvId))
128+
getUserGroupWithChannelIds team id_ = do
129+
pool <- input
130+
eitherRes <- liftIO $ use pool session
131+
either throw pure eitherRes
132+
where
133+
session :: Session (Maybe (UserGroup, Vector ConvId))
134+
session = runMaybeT do
135+
(name, managedBy, createdAt, memberIds, channelIds) <- MaybeT $ statement (id_, team) stmt
136+
let members = Identity $ fmap Id memberIds
137+
membersCount = Nothing
138+
channels = mempty
139+
channelsCount = Nothing
140+
ug = UserGroup_ {id_ = id_, name, managedBy, createdAt, members, membersCount, channels, channelsCount}
141+
pure (ug, fmap Id channelIds)
142+
143+
decodeRow :: (Text, Int32, UTCTime, Vector UUID, Vector UUID) -> Either Text (UserGroupName, ManagedBy, UTCTimeMillis, Vector UUID, Vector UUID)
144+
decodeRow (nameTxt, managedByInt, utcTime, membs, chans) = do
145+
name <- userGroupNameFromText nameTxt
146+
managedBy <- managedByFromInt32 managedByInt
147+
pure (name, managedBy, toUTCTimeMillis utcTime, membs, chans)
148+
149+
stmt :: Statement (UserGroupId, TeamId) (Maybe (UserGroupName, ManagedBy, UTCTimeMillis, Vector UUID, Vector UUID))
150+
stmt =
151+
lmap (\(gid, tid) -> (gid.toUUID, tid.toUUID))
152+
. refineResult (mapM decodeRow)
153+
$ [maybeStatement|
154+
select
155+
(name :: text),
156+
(managed_by :: int),
157+
(created_at :: timestamptz),
158+
coalesce((select array_agg(ugm.user_id) from user_group_member ugm where ugm.user_group_id = ug.id), array[]::uuid[]) :: uuid[],
159+
coalesce((select array_agg(ugc.conv_id) from user_group_channel ugc where ugc.user_group_id = ug.id), array[]::uuid[]) :: uuid[]
160+
from user_group ug
161+
where ug.id = ($1 :: uuid) and ug.team_id = ($2 :: uuid)
162+
|]
163+
164+
getUserGroupWithConversations ::
165+
forall r.
166+
-- (UserGroupStorePostgresEffectConstraints r) =>
167+
TeamId ->
168+
UserGroupId ->
169+
Sem r (Maybe UserGroup)
170+
getUserGroupWithConversations _team _id_ = do
171+
error "TODO"
172+
173+
-- pool <- input
174+
-- eitherUserGroup <- liftIO $ use pool session
175+
-- either throw pure eitherUserGroup
176+
-- where
177+
-- session :: Session (Maybe UserGroup)
178+
-- session = runMaybeT do
179+
-- (name, managedBy, createdAt, members', channels') <- MaybeT $ statement (id_, team) getGroupMetadataStatement
180+
-- let membersCount = Nothing
181+
-- channelsCount = Just $ length channels
182+
-- members = Id <$> members'
183+
-- channels = Identity $ Id <$> channels'
184+
-- pure $ UserGroup_ {..}
185+
--
186+
-- decodeMetadataRow ::
187+
-- (Text, Int32, UTCTime, Vector UUID, Vector UUID) ->
188+
-- Either Text (UserGroupName, ManagedBy, UTCTimeMillis, Vector UUID, Vector UUID)
189+
-- decodeMetadataRow (name, managedByInt, utcTime) =
190+
-- (,,toUTCTimeMillis utcTime)
191+
-- <$> userGroupNameFromText name
192+
-- <*> managedByFromInt32 managedByInt
193+
--
194+
-- getGroupMetadataStatement :: Statement (UserGroupId, TeamId) (Maybe (UserGroupName, ManagedBy, UTCTimeMillis), Vector UUID, Vector UUID)
195+
-- getGroupMetadataStatement =
196+
-- lmap (\(gid, tid) -> (gid.toUUID, tid.toUUID))
197+
-- . refineResult (mapM decodeMetadataRow)
198+
-- $ [maybeStatement|
199+
-- select
200+
-- (name :: text),
201+
-- (managed_by :: int),
202+
-- (created_at :: timestamptz),
203+
-- coalesce((select array_agg(ugm.user_id) from user_group_member ugm where ugm.user_group_id = ug.id), array[]::uuid[]) :: uuid[],
204+
-- coalesce((select array_agg(ugc.conv_id) from user_group_channel ugc where ugc.user_group_id = ug.id), array[]::uuid[]) :: uuid[]
205+
-- from user_group ug where ug.id = ($1 :: uuid) AND ug.team_id = ($2 :: uuid)
206+
-- |]
207+
118208
divide3 :: (Divisible f) => (p -> (a, b, c)) -> f a -> f b -> f c -> f p
119209
divide3 f a b c = divide (\p -> let (x, y, z) = f p in (x, (y, z))) a (divide id b c)
120210

‎libs/wire-subsystems/src/Wire/UserGroupSubsystem.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ import Wire.API.UserGroup.Pagination
1414

1515
data UserGroupSubsystem m a where
1616
CreateGroup :: UserId -> NewUserGroup -> UserGroupSubsystem m UserGroup
17-
GetGroup :: UserId -> UserGroupId -> UserGroupSubsystem m (Maybe UserGroup)
17+
GetGroup :: UserId -> UserGroupId -> IncludeConversations -> UserGroupSubsystem m (Maybe UserGroup)
1818
GetGroups ::
1919
UserId ->
2020
Maybe Text ->
@@ -25,6 +25,7 @@ data UserGroupSubsystem m a where
2525
Maybe UTCTimeMillis ->
2626
Maybe UserGroupId ->
2727
Bool ->
28+
IncludeConversations ->
2829
UserGroupSubsystem m UserGroupPage
2930
UpdateGroup :: UserId -> UserGroupId -> UserGroupUpdate -> UserGroupSubsystem m ()
3031
DeleteGroup :: UserId -> UserGroupId -> UserGroupSubsystem m ()

‎libs/wire-subsystems/src/Wire/UserGroupSubsystem/Interpreter.hs‎

Lines changed: 16 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,7 @@ import Wire.NotificationSubsystem
2828
import Wire.TeamSubsystem
2929
import Wire.UserGroupStore (PaginationState (..), UserGroupPageRequest (..))
3030
import Wire.UserGroupStore qualified as Store
31-
import Wire.UserGroupSubsystem (UserGroupSubsystem (..))
31+
import Wire.UserGroupSubsystem (IncludeConversations (..), UserGroupSubsystem (..))
3232
import Wire.UserSubsystem (UserSubsystem, getLocalUserProfiles, getUserTeam)
3333

3434
interpretUserGroupSubsystem ::
@@ -43,9 +43,9 @@ interpretUserGroupSubsystem ::
4343
InterpreterFor UserGroupSubsystem r
4444
interpretUserGroupSubsystem = interpret $ \case
4545
CreateGroup creator newGroup -> createUserGroup creator newGroup
46-
GetGroup getter gid -> getUserGroup getter gid
47-
GetGroups getter q sortByKeys sortOrder pSize mLastGroupName mLastCreatedAt mLastGroupId includeMemberCount ->
48-
getUserGroups getter q sortByKeys sortOrder pSize mLastGroupName mLastCreatedAt mLastGroupId includeMemberCount
46+
GetGroup getter gid includeConversations -> getUserGroup getter gid includeConversations
47+
GetGroups getter q sortByKeys sortOrder pSize mLastGroupName mLastCreatedAt mLastGroupId includeMemberCount includeConversations ->
48+
getUserGroups getter q sortByKeys sortOrder pSize mLastGroupName mLastCreatedAt mLastGroupId includeMemberCount includeConversations
4949
UpdateGroup updater groupId groupUpdate -> updateGroup updater groupId groupUpdate
5050
DeleteGroup deleter groupId -> deleteGroup deleter groupId
5151
AddUser adder groupId addeeId -> addUser adder groupId addeeId
@@ -141,11 +141,12 @@ getUserGroup ::
141141
) =>
142142
UserId ->
143143
UserGroupId ->
144+
IncludeConversations ->
144145
Sem r (Maybe UserGroup)
145-
getUserGroup getter gid = runMaybeT $ do
146+
getUserGroup getter gid includeConversations' = runMaybeT $ do
146147
team <- MaybeT $ getUserTeam getter
147148
getterCanSeeAll <- mkGetterCanSeeAll getter team
148-
userGroup <- MaybeT $ Store.getUserGroup team gid
149+
userGroup <- MaybeT $ Store.getUserGroup team gid includeConversations'
149150
if getterCanSeeAll || getter `elem` (toList (runIdentity userGroup.members))
150151
then pure userGroup
151152
else MaybeT $ pure Nothing
@@ -176,8 +177,9 @@ getUserGroups ::
176177
Maybe UTCTimeMillis ->
177178
Maybe UserGroupId ->
178179
Bool ->
180+
IncludeConversations ->
179181
Sem r UserGroupPage
180-
getUserGroups getter searchString sortBy' sortOrder' mPageSize mLastGroupName mLastCreatedAt mLastGroupId includeMemberCount' = do
182+
getUserGroups getter searchString sortBy' sortOrder' mPageSize mLastGroupName mLastCreatedAt mLastGroupId includeMemberCount' includeConversations' = do
181183
team :: TeamId <- getUserTeam getter >>= ifNothing UserGroupNotATeamAdmin
182184
getterCanSeeAll :: Bool <- fromMaybe False <$> runMaybeT (mkGetterCanSeeAll getter team)
183185
unless getterCanSeeAll (throw UserGroupNotATeamAdmin)
@@ -190,7 +192,8 @@ getUserGroups getter searchString sortBy' sortOrder' mPageSize mLastGroupName mL
190192
SortByCreatedAt -> PaginationSortByCreatedAt $ (,) <$> mLastCreatedAt <*> mLastGroupId,
191193
team = team,
192194
searchString = searchString,
193-
includeMemberCount = includeMemberCount'
195+
includeMemberCount = includeMemberCount',
196+
includeConversations = includeConversations'
194197
}
195198
Store.getUserGroups pageReq
196199
where
@@ -255,7 +258,7 @@ addUser ::
255258
UserId ->
256259
Sem r ()
257260
addUser adder groupId addeeId = do
258-
ug <- getUserGroup adder groupId >>= note UserGroupNotFound
261+
ug <- getUserGroup adder groupId DoNotIncludeConversations >>= note UserGroupNotFound
259262
team <- getTeamAsAdmin adder >>= note UserGroupNotATeamAdmin
260263
void $ internalGetTeamMember addeeId team >>= note UserGroupMemberIsNotInTheSameTeam
261264
unless (addeeId `elem` runIdentity ug.members) $ do
@@ -277,7 +280,7 @@ addUsers ::
277280
Vector UserId ->
278281
Sem r ()
279282
addUsers adder groupId addeeIds = do
280-
ug <- getUserGroup adder groupId >>= note UserGroupNotFound
283+
ug <- getUserGroup adder groupId DoNotIncludeConversations >>= note UserGroupNotFound
281284
team <- getTeamAsAdmin adder >>= note UserGroupNotATeamAdmin
282285
forM_ addeeIds $ \addeeId ->
283286
internalGetTeamMember addeeId team >>= note UserGroupMemberIsNotInTheSameTeam
@@ -302,7 +305,7 @@ updateUsers ::
302305
Vector UserId ->
303306
Sem r ()
304307
updateUsers updater groupId uids = do
305-
void $ getUserGroup updater groupId >>= note UserGroupNotFound
308+
void $ getUserGroup updater groupId DoNotIncludeConversations >>= note UserGroupNotFound
306309
team <- getTeamAsAdmin updater >>= note UserGroupNotATeamAdmin
307310
forM_ uids $ \uid ->
308311
internalGetTeamMember uid team >>= note UserGroupMemberIsNotInTheSameTeam
@@ -324,7 +327,7 @@ removeUser ::
324327
UserId ->
325328
Sem r ()
326329
removeUser remover groupId removeeId = do
327-
ug <- getUserGroup remover groupId >>= note UserGroupNotFound
330+
ug <- getUserGroup remover groupId DoNotIncludeConversations >>= note UserGroupNotFound
328331
team <- getTeamAsAdmin remover >>= note UserGroupNotATeamAdmin
329332
void $ internalGetTeamMember removeeId team >>= note UserGroupMemberIsNotInTheSameTeam
330333
when (removeeId `elem` runIdentity ug.members) $ do
@@ -346,7 +349,7 @@ updateChannels ::
346349
Vector ConvId ->
347350
Sem r ()
348351
updateChannels performer groupId channelIds = do
349-
void $ getUserGroup performer groupId >>= note UserGroupNotFound
352+
void $ getUserGroup performer groupId DoNotIncludeConversations >>= note UserGroupNotFound
350353
teamId <- getTeamAsAdmin performer >>= note UserGroupNotATeamAdmin
351354
traverse_ (getTeamConv performer teamId >=> note UserGroupChannelNotFound) channelIds
352355
Store.updateUserGroupChannels groupId channelIds

0 commit comments

Comments
 (0)