Skip to content

Commit d25ac2c

Browse files
blackheavenblackheaven
committed
fix: Sven feedbacks
1 parent d4c4d98 commit d25ac2c

5 files changed

Lines changed: 80 additions & 50 deletions

File tree

‎integration/test/Test/Meetings.hs‎

Lines changed: 45 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -198,15 +198,53 @@ testMeetingUpdateUnauthorized = do
198198

199199
putMeeting otherUser domain meetingId update >>= assertStatus 404
200200

201-
testMeetingLists :: (HasCallStack) => App ()
202-
testMeetingLists = do
201+
testMeetingListEmpty :: (HasCallStack) => App ()
202+
testMeetingListEmpty = do
203+
(owner, _tid, _members) <- createTeam OwnDomain 1
204+
resp <- getMeetingsList owner
205+
assertSuccess resp
206+
meetings <- resp.json & asList
207+
length (meetings :: [Value]) `shouldMatchInt` 0
208+
209+
testMeetingListNoMeetings :: (HasCallStack) => App ()
210+
testMeetingListNoMeetings = do
211+
(owner, _tid, _members) <- createTeam OwnDomain 1
212+
_ <- createTeam OwnDomain 1
213+
resp <- getMeetingsList owner
214+
assertSuccess resp
215+
meetings <- resp.json & asList
216+
length (meetings :: [Value]) `shouldMatchInt` 0
217+
218+
testMeetingListMultiple :: (HasCallStack) => App ()
219+
testMeetingListMultiple = do
203220
(owner, _tid, _members) <- createTeam OwnDomain 1
204221
now <- liftIO getCurrentTime
205-
let startTime = addUTCTime 3600 now
206-
endTime = addUTCTime 7200 now
207-
newMeeting = defaultMeetingJson "Team Standup" startTime endTime []
208-
postMeetings owner newMeeting >>= assertStatus 201
222+
let firstMeeting = defaultMeetingJson "First Meeting" (addUTCTime 3600 now) (addUTCTime 7200 now) []
223+
secondMeeting = defaultMeetingJson "Second Meeting" (addUTCTime 3600 now) (addUTCTime 7200 now) []
224+
thirdMeeting = defaultMeetingJson "Third Meeting" (addUTCTime 3600 now) (addUTCTime 7200 now) []
225+
postMeetings owner firstMeeting >>= assertStatus 201
226+
postMeetings owner secondMeeting >>= assertStatus 201
227+
postMeetings owner thirdMeeting >>= assertStatus 201
228+
resp <- getMeetingsList owner
229+
assertSuccess resp
230+
meetings <- resp.json & asList
231+
length (meetings :: [Value]) `shouldMatchInt` 3
232+
233+
testMeetingListPagination :: (HasCallStack) => App ()
234+
testMeetingListPagination = do
235+
(owner, _tid, _members) <- createTeam OwnDomain 1
236+
now <- liftIO getCurrentTime
237+
let firstMeeting = defaultMeetingJson "Meeting 1" (addUTCTime 3600 now) (addUTCTime 7200 now) []
238+
secondMeeting = defaultMeetingJson "Meeting 2" (addUTCTime 3600 now) (addUTCTime 7200 now) []
239+
thirdMeeting = defaultMeetingJson "Meeting 3" (addUTCTime 3600 now) (addUTCTime 7200 now) []
240+
fourthMeeting = defaultMeetingJson "Meeting 4" (addUTCTime 3600 now) (addUTCTime 7200 now) []
241+
fifthMeeting = defaultMeetingJson "Meeting 5" (addUTCTime 3600 now) (addUTCTime 7200 now) []
242+
postMeetings owner firstMeeting >>= assertStatus 201
243+
postMeetings owner secondMeeting >>= assertStatus 201
244+
postMeetings owner thirdMeeting >>= assertStatus 201
245+
postMeetings owner fourthMeeting >>= assertStatus 201
246+
postMeetings owner fifthMeeting >>= assertStatus 201
209247
resp <- getMeetingsList owner
210248
assertSuccess resp
211249
meetings <- resp.json & asList
212-
length (meetings :: [Value]) `shouldMatchInt` 1
250+
length (meetings :: [Value]) `shouldMatchInt` 5

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

Lines changed: 0 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,6 @@ import Wire.API.Conversation (ConvIdsPage, ConversationPagingState, ExtraConvers
3030
import Wire.API.Conversation.Action
3131
import Wire.API.Event.Conversation
3232
import Wire.NotificationSubsystem (LocalConversationUpdate)
33-
import Wire.Sem.Paging.Cassandra (ResultSet)
3433
import Wire.StoredConversation
3534

3635
data ConversationSubsystem m a where
@@ -67,11 +66,6 @@ data ConversationSubsystem m a where
6766
GetConversations ::
6867
[ConvId] ->
6968
ConversationSubsystem m [StoredConversation]
70-
GetConversationIdsResultSet ::
71-
Local UserId ->
72-
Range 1 1000 Int32 ->
73-
Maybe (Qualified ConvId) ->
74-
ConversationSubsystem r (ResultSet (Qualified ConvId))
7569
GetConversationIds ::
7670
Local UserId ->
7771
Range 1 1000 Int32 ->

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

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -147,8 +147,6 @@ interpretConversationSubsystem = interpret $ \case
147147
createConnectConversationLogic lusr conn j
148148
ConversationSubsystem.GetConversations convIds ->
149149
ConvStore.getConversations convIds
150-
ConversationSubsystem.GetConversationIdsResultSet lusr maxIds mLastId ->
151-
getConversationIdsResultSetImpl lusr maxIds mLastId
152150
ConversationSubsystem.GetConversationIds lusr maxIds pagingState ->
153151
getConversationIdsImpl lusr maxIds pagingState
154152
InternalGetClientIds uids ->

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

Lines changed: 27 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -45,7 +45,7 @@ import Wire.MeetingsStore qualified as Store
4545
import Wire.MeetingsSubsystem
4646
import Wire.Sem.Now (Now)
4747
import Wire.Sem.Now qualified as Now
48-
import Wire.Sem.Paging.Cassandra (ResultSet (..), ResultSetType (..))
48+
import Wire.API.Routes.MultiTablePaging qualified as MultiTablePaging
4949
import Wire.StoredConversation
5050
import Wire.TeamSubsystem (TeamSubsystem)
5151
import Wire.TeamSubsystem qualified as TeamSubsystem
@@ -250,32 +250,32 @@ getAllMemberMeetings zUser cutoff = do
250250
( Member Store.MeetingsStore r,
251251
Member ConversationSubsystem r
252252
) =>
253-
Maybe (Qualified ConvId) ->
254-
Sem r [API.Meeting]
255-
processPage lastId = do
253+
Maybe ConversationPagingState -> Sem r [API.Meeting]
254+
processPage pagingState = do
256255
let range = unsafeRange 1000 :: Range 1 1000 Int32
257-
resultSet <- ConversationSubsystem.getConversationIdsResultSet zUser range lastId
258-
let qConvIds = resultSet.resultSetResult
259-
uConvIds = map qUnqualified qConvIds
260-
if null uConvIds
261-
then pure []
262-
else do
263-
convs <- ConversationSubsystem.getConversations uConvIds
264-
let meetingConvs = filter isMeetingConv convs
265-
meetingConvIds = Set.fromList $ map (.id_) meetingConvs
266-
-- Identify which Qualified ConvIds correspond to meeting conversations
267-
-- We use the original Qualified IDs to query the meeting store
268-
let targetQConvIds = filter (\qId -> qUnqualified qId `Set.member` meetingConvIds) qConvIds
269-
-- Fetch meetings for these conversations
270-
pageMeetings <- forM targetQConvIds $ \qConvId -> do
271-
Store.listMeetingsByConversation (qUnqualified qConvId) cutoff
272-
let currentMeetings = storedMeetingToMeeting (tDomain zUser) <$> concat pageMeetings
273-
-- Check if there are more pages
274-
case resultSet.resultSetType of
275-
ResultSetTruncated -> do
276-
-- Recurse with last ID
277-
rest <- processPage (Just (last qConvIds))
278-
pure (currentMeetings <> rest)
279-
ResultSetComplete -> pure currentMeetings
256+
page <- ConversationSubsystem.getConversationIds zUser range pagingState
257+
case page of
258+
MultiTablePaging.MultiTablePage uConvIds hasMore _ ->
259+
if null uConvIds
260+
then pure []
261+
else do
262+
convs <- ConversationSubsystem.getConversations (map qUnqualified uConvIds)
263+
let meetingConvs = filter isMeetingConv convs
264+
meetingConvIds = Set.fromList $ map (.id_) meetingConvs
265+
-- Identify which Qualified ConvIds correspond to meeting conversations
266+
-- We use the original Qualified IDs to query the meeting store
267+
let targetQConvIds = filter (\qId -> qUnqualified qId `Set.member` meetingConvIds) uConvIds
268+
-- Fetch meetings for these conversations
269+
pageMeetings <- forM targetQConvIds $ \qConvId -> do
270+
Store.listMeetingsByConversation (qUnqualified qConvId) cutoff
271+
let currentMeetings = storedMeetingToMeeting (tDomain zUser) <$> concat pageMeetings
272+
-- Check if there are more pages
273+
if hasMore
274+
then do
275+
-- Recurse with paging state from the page
276+
let nextPageState = Just page.mtpPagingState
277+
rest <- processPage nextPageState
278+
pure (currentMeetings <> rest)
279+
else pure currentMeetings
280280
isMeetingConv :: StoredConversation -> Bool
281281
isMeetingConv conv = conv.metadata.cnvmGroupConvType == Just MeetingConversation

‎services/galley/src/Galley/API/Internal.hs‎

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -89,7 +89,7 @@ import Wire.API.User.Client
8989
import Wire.BackendNotificationQueueAccess
9090
import Wire.BrigAPIAccess (BrigAPIAccess)
9191
import Wire.ConversationStore
92-
import Wire.ConversationStore qualified as E
92+
import Wire.ConversationStore qualified as ConversationStore
9393
import Wire.ConversationStore.MLS.Types
9494
import Wire.ConversationSubsystem
9595
import Wire.ConversationSubsystem.One2One
@@ -179,7 +179,7 @@ ejpdGetConvInfo uid = do
179179
One2OneConv -> Nothing
180180
SelfConv -> Nothing
181181
ConnectConv -> Nothing
182-
renderedPage <- mapMaybe mk <$> E.getConversations (fst $ partitionQualified luid convids)
182+
renderedPage <- mapMaybe mk <$> ConversationStore.getConversations (fst $ partitionQualified luid convids)
183183
if MTP.mtpHasMore page
184184
then do
185185
newPage <- Query.conversationIdsPageFrom luid (mkPageRequest . MTP.mtpPagingState $ page)
@@ -201,7 +201,7 @@ conversationAPI =
201201
<@> mkNamedAPI @"conversation-mls-one-to-one" Query.getMLSOne2OneConversationInternal
202202
<@> mkNamedAPI @"conversation-mls-one-to-one-established" Query.isMLSOne2OneEstablished
203203
<@> mkNamedAPI @"get-conversation-by-id" Query.getLocalConversationInternal
204-
<@> mkNamedAPI @"is-conversation-out-of-sync" E.isConversationOutOfSync
204+
<@> mkNamedAPI @"is-conversation-out-of-sync" ConversationStore.isConversationOutOfSync
205205

206206
legalholdWhitelistedTeamsAPI :: API ILegalholdWhitelistedTeamsAPI GalleyEffects
207207
legalholdWhitelistedTeamsAPI = mkAPI $ \tid -> hoistAPIHandler Imports.id (base tid)
@@ -429,18 +429,18 @@ rmUser lusr conn = do
429429
leaveLocalConversations :: [ConvId] -> Sem r ()
430430
leaveLocalConversations ids = do
431431
let qUser = tUntagged lusr
432-
cc <- E.getConversations ids
432+
cc <- ConversationStore.getConversations ids
433433
now <- Now.get
434434
pp <- for cc $ \c -> case Data.convType c of
435435
SelfConv -> pure Nothing
436-
One2OneConv -> E.deleteMembers c.id_ (UserList [tUnqualified lusr] []) $> Nothing
437-
ConnectConv -> E.deleteMembers c.id_ (UserList [tUnqualified lusr] []) $> Nothing
436+
One2OneConv -> ConversationStore.deleteMembers c.id_ (UserList [tUnqualified lusr] []) $> Nothing
437+
ConnectConv -> ConversationStore.deleteMembers c.id_ (UserList [tUnqualified lusr] []) $> Nothing
438438
RegularConv
439439
| tUnqualified lusr `isMember` c.localMembers -> do
440440
runError (removeUser (qualifyAs lusr c) RemoveUserIncludeMain (tUntagged lusr)) >>= \case
441441
Left e -> P.err $ Log.msg ("failed to send remove proposal: " <> internalErrorDescription e)
442442
Right _ -> pure ()
443-
E.deleteMembers c.id_ (UserList [tUnqualified lusr] [])
443+
ConversationStore.deleteMembers c.id_ (UserList [tUnqualified lusr] [])
444444
let e =
445445
Event
446446
{ evtConv = tUntagged (qualifyAs lusr c.id_),
@@ -540,5 +540,5 @@ iGetMLSClientListForConv ::
540540
GroupId ->
541541
Sem r ClientList
542542
iGetMLSClientListForConv gid = do
543-
cm <- E.lookupMLSClients gid
543+
cm <- ConversationStore.lookupMLSClients gid
544544
pure $ ClientList (concatMap (Map.keys . snd) (Map.assocs (unClientMap cm)))

0 commit comments

Comments
 (0)