WPB-21964: Add Wire Meetings list

changelog.d/2-features/WPB-21964

@@ -0,0 +1 @@
+Add meetings listings endpoint `/meetings/list`.

integration/test/API/Galley.hs

@@ -1003,3 +1003,8 @@ getMeeting :: (HasCallStack, MakesValue user) => user -> String -> String -> App
 getMeeting user domain meetingId = do
   req <- baseRequest user Galley Versioned (joinHttpPath ["meetings", domain, meetingId])
   submit "GET" req
+
+getMeetingsList :: (HasCallStack, MakesValue user) => user -> App Response
+getMeetingsList user = do
+  req <- baseRequest user Galley Versioned "/meetings/list"
+  submit "GET" req

integration/test/Test/Meetings.hs

@@ -197,3 +197,54 @@ testMeetingUpdateUnauthorized = do
           ]
 
   putMeeting otherUser domain meetingId update >>= assertStatus 404
+
+testMeetingListEmpty :: (HasCallStack) => App ()
+testMeetingListEmpty = do
+  (owner, _tid, _members) <- createTeam OwnDomain 1
+  resp <- getMeetingsList owner
+  assertSuccess resp
+  meetings <- resp.json & asList
+  length (meetings :: [Value]) `shouldMatchInt` 0
+
+testMeetingListNoMeetings :: (HasCallStack) => App ()
+testMeetingListNoMeetings = do
+  (owner, _tid, _members) <- createTeam OwnDomain 1
+  _ <- createTeam OwnDomain 1
+  resp <- getMeetingsList owner
+  assertSuccess resp
+  meetings <- resp.json & asList
+  length (meetings :: [Value]) `shouldMatchInt` 0
+
+testMeetingListMultiple :: (HasCallStack) => App ()
+testMeetingListMultiple = do
+  (owner, _tid, _members) <- createTeam OwnDomain 1
+  now <- liftIO getCurrentTime
+  let firstMeeting = defaultMeetingJson "First Meeting" (addUTCTime 3600 now) (addUTCTime 7200 now) []
+      secondMeeting = defaultMeetingJson "Second Meeting" (addUTCTime 3600 now) (addUTCTime 7200 now) []
+      thirdMeeting = defaultMeetingJson "Third Meeting" (addUTCTime 3600 now) (addUTCTime 7200 now) []
+  postMeetings owner firstMeeting >>= assertStatus 201
+  postMeetings owner secondMeeting >>= assertStatus 201
+  postMeetings owner thirdMeeting >>= assertStatus 201
+  resp <- getMeetingsList owner
+  assertSuccess resp
+  meetings <- resp.json & asList
+  length (meetings :: [Value]) `shouldMatchInt` 3
+
+testMeetingListPagination :: (HasCallStack) => App ()
+testMeetingListPagination = do
+  (owner, _tid, _members) <- createTeam OwnDomain 1
+  now <- liftIO getCurrentTime
+  let firstMeeting = defaultMeetingJson "Meeting 1" (addUTCTime 3600 now) (addUTCTime 7200 now) []
+      secondMeeting = defaultMeetingJson "Meeting 2" (addUTCTime 3600 now) (addUTCTime 7200 now) []
+      thirdMeeting = defaultMeetingJson "Meeting 3" (addUTCTime 3600 now) (addUTCTime 7200 now) []
+      fourthMeeting = defaultMeetingJson "Meeting 4" (addUTCTime 3600 now) (addUTCTime 7200 now) []
+      fifthMeeting = defaultMeetingJson "Meeting 5" (addUTCTime 3600 now) (addUTCTime 7200 now) []
+  postMeetings owner firstMeeting >>= assertStatus 201
+  postMeetings owner secondMeeting >>= assertStatus 201
+  postMeetings owner thirdMeeting >>= assertStatus 201
+  postMeetings owner fourthMeeting >>= assertStatus 201
+  postMeetings owner fifthMeeting >>= assertStatus 201
+  resp <- getMeetingsList owner
+  assertSuccess resp
+  meetings <- resp.json & asList
+  length (meetings :: [Value]) `shouldMatchInt` 5

libs/wire-api/src/Wire/API/Routes/Public/Galley/Meetings.hs

@@ -73,3 +73,12 @@ type MeetingsAPI =
                :> CanThrow 'MeetingNotFound
                :> Get '[JSON] Meeting
            )
+    :<|> Named
+           "list-meetings"
+           ( Summary "List all meetings for the authenticated user"
+               :> From 'V15
+               :> ZLocalUser
+               :> "meetings"
+               :> "list"
+               :> Get '[JSON] [Meeting]
+           )

libs/wire-subsystems/src/Wire/ConversationStore.hs

@@ -19,9 +19,6 @@
 
 module Wire.ConversationStore where
 
-import Control.Error (lastMay)
-import Data.Aeson qualified as Aeson
-import Data.ByteString qualified as BS
 import Data.Id
 import Data.Misc
 import Data.Qualified
@@ -42,7 +39,6 @@ import Wire.API.MLS.LeafNode
 import Wire.API.MLS.SubConversation
 import Wire.API.Pagination
 import Wire.API.Provider.Service
-import Wire.API.Routes.MultiTablePaging
 import Wire.ConversationStore.MLS.Types
 import Wire.Sem.Paging.Cassandra
 import Wire.StoredConversation
@@ -154,56 +150,6 @@ acceptConnectConversation cid = setConversationType cid One2OneConv
 upsertMember :: (Member ConversationStore r) => Local ConvId -> Local UserId -> Sem r [LocalMember]
 upsertMember c u = fst <$> upsertMembers (tUnqualified c) (UserList [(tUnqualified u, roleNameWireAdmin)] [])
 
-getConversationIdsResultSet :: forall r. (Member ConversationStore r) => Local UserId -> Range 1 1000 Int32 -> Maybe (Qualified ConvId) -> Sem r (ResultSet (Qualified ConvId))
-getConversationIdsResultSet lusr maxIds mLastId = do
-  case fmap (flip relativeTo lusr) mLastId of
-    Nothing -> getLocals Nothing
-    Just (Local (tUnqualified -> lastId)) -> getLocals (Just lastId)
-    Just (Remote lastId) -> getRemotes (Just lastId) maxIds
-  where
-    localDomain = tDomain lusr
-    usr = tUnqualified lusr
-
-    getLocals :: Maybe ConvId -> Sem r (ResultSet (Qualified ConvId))
-    getLocals lastId = do
-      localPage <- flip Qualified localDomain <$$> getLocalConversationIds usr lastId maxIds
-      let remainingSize = fromRange maxIds - fromIntegral (length localPage.resultSetResult)
-      case checked remainingSize of
-        Nothing -> pure localPage {resultSetType = ResultSetTruncated}
-        Just checkedRemaining -> do
-          remotePage <- getRemotes Nothing checkedRemaining
-          pure
-            remotePage
-              { resultSetResult = localPage.resultSetResult <> remotePage.resultSetResult
-              }
-
-    getRemotes :: Maybe (Remote ConvId) -> Range 1 1000 Int32 -> Sem r (ResultSet (Qualified ConvId))
-    getRemotes lastRemote maxRemotes = tUntagged <$$> getRemoteConversationIds usr lastRemote maxRemotes
-
--- | This function only exists because we use the 'MultiTablePage' type for the
--- endpoint. Since now the pagination is based on the qualified ids, we can
--- remove the use of this type in future API versions.
-getConversationIds :: forall r. (Member ConversationStore r) => Local UserId -> Range 1 1000 Int32 -> Maybe ConversationPagingState -> Sem r ConvIdsPage
-getConversationIds lusr maxIds pagingState = do
-  let mLastId = Aeson.decode . BS.fromStrict =<< (.mtpsState) =<< pagingState
-  resultSet <- getConversationIdsResultSet lusr maxIds mLastId
-  let mLastResult = lastMay resultSet.resultSetResult
-  pure
-    MultiTablePage
-      { mtpResults = resultSet.resultSetResult,
-        mtpHasMore = case resultSet.resultSetType of
-          ResultSetTruncated -> True
-          ResultSetComplete -> False,
-        mtpPagingState =
-          MultiTablePagingState
-            { mtpsTable = case fmap (flip relativeTo lusr) mLastResult of
-                Just (Local _) -> PagingLocals
-                Just (Remote _) -> PagingRemotes
-                Nothing -> PagingRemotes,
-              mtpsState = BS.toStrict . Aeson.encode <$> mLastResult
-            }
-      }
-
 getConvOrSubGroupInfo ::
   (Member ConversationStore r) =>
   ConvOrSubConvId ->

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

@@ -21,11 +21,12 @@ module Wire.ConversationSubsystem where
 
 import Data.Id
 import Data.Qualified
+import Data.Range (Range)
 import Data.Singletons (Sing)
 import Galley.Types.Clients (Clients)
 import Imports
 import Polysemy
-import Wire.API.Conversation (ExtraConversationData, NewConv, NewOne2OneConv)
+import Wire.API.Conversation (ConvIdsPage, ConversationPagingState, ExtraConversationData, NewConv, NewOne2OneConv)
 import Wire.API.Conversation.Action
 import Wire.API.Event.Conversation
 import Wire.NotificationSubsystem (LocalConversationUpdate)
@@ -62,6 +63,14 @@ data ConversationSubsystem m a where
     Maybe ConnId ->
     Connect ->
     ConversationSubsystem m (StoredConversation, Bool)
+  GetConversations ::
+    [ConvId] ->
+    ConversationSubsystem m [StoredConversation]
+  GetConversationIds ::
+    Local UserId ->
+    Range 1 1000 Int32 ->
+    Maybe ConversationPagingState ->
+    ConversationSubsystem r ConvIdsPage
   InternalGetClientIds :: [UserId] -> ConversationSubsystem m Clients
   InternalGetLocalMember ::
     ConvId ->

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

@@ -20,8 +20,10 @@ module Wire.ConversationSubsystem.Interpreter
   )
 where
 
-import Control.Error (headMay)
+import Control.Error (headMay, lastMay)
 import Control.Lens hiding ((??))
+import Data.Aeson qualified as Aeson
+import Data.ByteString qualified as BS
 import Data.Default
 import Data.Id
 import Data.Json.Util (ToJSONObject (toJSONObject))
@@ -54,6 +56,7 @@ import Wire.API.Federation.Client (FederatorClient)
 import Wire.API.Federation.Error
 import Wire.API.History (History (HistoryPrivate))
 import Wire.API.Push.V2 qualified as PushV2
+import Wire.API.Routes.MultiTablePaging
 import Wire.API.Team
 import Wire.API.Team.Collaborator qualified as CollaboratorPermission
 import Wire.API.Team.Feature
@@ -78,6 +81,7 @@ import Wire.LegalHoldStore (LegalHoldStore)
 import Wire.NotificationSubsystem as NS
 import Wire.Sem.Now (Now)
 import Wire.Sem.Now qualified as Now
+import Wire.Sem.Paging.Cassandra (ResultSet (..), ResultSetType (..))
 import Wire.Sem.Random (Random)
 import Wire.Sem.Random qualified as Random
 import Wire.StoredConversation hiding (convTeam, id_, localOne2OneConvId)
@@ -141,6 +145,10 @@ interpretConversationSubsystem = interpret $ \case
     createProteusSelfConversationLogic lusr
   ConversationSubsystem.CreateConnectConversation lusr conn j ->
     createConnectConversationLogic lusr conn j
+  ConversationSubsystem.GetConversations convIds ->
+    ConvStore.getConversations convIds
+  ConversationSubsystem.GetConversationIds lusr maxIds pagingState ->
+    getConversationIdsImpl lusr maxIds pagingState
   InternalGetClientIds uids ->
     internalGetClientIdsImpl uids
   ConversationSubsystem.InternalGetLocalMember cid uid ->
@@ -820,3 +828,65 @@ internalGetClientIdsImpl users = do
   if isInternal
     then fromUserClients <$> lookupClients users
     else UserClientIndexStore.getClients users
+
+getConversationIdsResultSetImpl ::
+  forall r.
+  (Member ConversationStore r) =>
+  Local UserId ->
+  Range 1 1000 Int32 ->
+  Maybe (Qualified ConvId) ->
+  Sem r (ResultSet (Qualified ConvId))
+getConversationIdsResultSetImpl lusr maxIds mLastId = do
+  case fmap (flip relativeTo lusr) mLastId of
+    Nothing -> getLocals Nothing
+    Just (Local (tUnqualified -> lastId)) -> getLocals (Just lastId)
+    Just (Remote lastId) -> getRemotes (Just lastId) maxIds
+  where
+    localDomain = tDomain lusr
+    usr = tUnqualified lusr
+
+    getLocals :: Maybe ConvId -> Sem r (ResultSet (Qualified ConvId))
+    getLocals lastId = do
+      localPage <- flip Qualified localDomain <$$> ConvStore.getLocalConversationIds usr lastId maxIds
+      let remainingSize = fromRange maxIds - fromIntegral (length localPage.resultSetResult)
+      case checked remainingSize of
+        Nothing -> pure localPage {resultSetType = ResultSetTruncated}
+        Just checkedRemaining -> do
+          remotePage <- getRemotes Nothing checkedRemaining
+          pure
+            remotePage
+              { resultSetResult = localPage.resultSetResult <> remotePage.resultSetResult
+              }
+
+    getRemotes :: Maybe (Remote ConvId) -> Range 1 1000 Int32 -> Sem r (ResultSet (Qualified ConvId))
+    getRemotes lastRemote maxRemotes = tUntagged <$$> ConvStore.getRemoteConversationIds usr lastRemote maxRemotes
+
+-- | This function only exists because we use the 'MultiTablePage' type for the
+-- endpoint. Since now the pagination is based on the qualified ids, we can
+-- remove the use of this type in future API versions.
+getConversationIdsImpl ::
+  forall r.
+  (Member ConversationStore r) =>
+  Local UserId ->
+  Range 1 1000 Int32 ->
+  Maybe ConversationPagingState ->
+  Sem r ConvIdsPage
+getConversationIdsImpl lusr maxIds pagingState = do
+  let mLastId = Aeson.decode . BS.fromStrict =<< (.mtpsState) =<< pagingState
+  resultSet <- getConversationIdsResultSetImpl lusr maxIds mLastId
+  let mLastResult = lastMay resultSet.resultSetResult
+  pure
+    MultiTablePage
+      { mtpResults = resultSet.resultSetResult,
+        mtpHasMore = case resultSet.resultSetType of
+          ResultSetTruncated -> True
+          ResultSetComplete -> False,
+        mtpPagingState =
+          MultiTablePagingState
+            { mtpsTable = case fmap (flip relativeTo lusr) mLastResult of
+                Just (Local _) -> PagingLocals
+                Just (Remote _) -> PagingRemotes
+                Nothing -> PagingRemotes,
+              mtpsState = BS.toStrict . Aeson.encode <$> mLastResult
+            }
+      }

libs/wire-subsystems/src/Wire/MeetingsStore.hs

@@ -148,5 +148,13 @@ data MeetingsStore m a where
   GetMeeting ::
     MeetingId ->
     MeetingsStore m (Maybe StoredMeeting)
+  ListMeetingsByUser ::
+    UserId ->
+    UTCTime ->
+    MeetingsStore m [StoredMeeting]
+  ListMeetingsByConversation ::
+    ConvId ->
+    UTCTime ->
+    MeetingsStore m [StoredMeeting]
 
 makeSem ''MeetingsStore

libs/wire-subsystems/src/Wire/MeetingsStore/Postgres.hs

@@ -29,6 +29,7 @@ import Data.Profunctor (dimap)
 import Data.Range (Range, fromRange)
 import Data.Time.Clock
 import Data.UUID (UUID, nil)
+import Data.Vector qualified as V
 import Hasql.Pool
 import Hasql.Session
 import Hasql.Statement
@@ -54,6 +55,10 @@ interpretMeetingsStoreToPostgres =
       updateMeetingImpl meetingId title startDate endDate schedule
     GetMeeting meetingId ->
       getMeetingImpl meetingId
+    ListMeetingsByUser userId cutoffTime ->
+      listMeetingsByUserImpl userId cutoffTime
+    ListMeetingsByConversation convId cutoffTime ->
+      listMeetingsByConversationImpl convId cutoffTime
 
 -- * Create
 
@@ -263,3 +268,67 @@ getMeetingStatement =
       FROM meetings
       WHERE id = $1 :: uuid
     |]
+
+-- * List
+
+listMeetingsByUserImpl ::
+  ( Member (Input Pool) r,
+    Member (Embed IO) r,
+    Member (Error UsageError) r
+  ) =>
+  UserId ->
+  UTCTime ->
+  Sem r [StoredMeeting]
+listMeetingsByUserImpl userId cutoffTime = do
+  pool <- input
+  result <- liftIO $ use pool session
+  either throw pure result
+  where
+    session :: Session [StoredMeeting]
+    session = statement (toUUID userId, cutoffTime) $ V.toList <$> listStatement
+    listStatement :: Statement (UUID, UTCTime) (V.Vector StoredMeeting)
+    listStatement =
+      refineResult
+        (traverse (postgresUnmarshall @StoredMeetingTuple @StoredMeeting))
+        $ [vectorStatement|
+          SELECT
+            id :: uuid, title :: text, creator :: uuid,
+            start_time :: timestamptz, end_time :: timestamptz,
+            recurrence_frequency :: text?, recurrence_interval :: int4?, recurrence_until :: timestamptz?,
+            conversation_id :: uuid, invited_emails :: text[], trial :: boolean,
+            created_at :: timestamptz, updated_at :: timestamptz
+          FROM meetings
+          WHERE creator = ($1 :: uuid) AND end_time >= ($2 :: timestamptz)
+          ORDER BY start_time ASC
+        |]
+
+listMeetingsByConversationImpl ::
+  ( Member (Input Pool) r,
+    Member (Embed IO) r,
+    Member (Error UsageError) r
+  ) =>
+  ConvId ->
+  UTCTime ->
+  Sem r [StoredMeeting]
+listMeetingsByConversationImpl convId cutoffTime = do
+  pool <- input
+  result <- liftIO $ use pool session
+  either throw pure result
+  where
+    session :: Session [StoredMeeting]
+    session = statement (toUUID convId, cutoffTime) $ V.toList <$> listStatement
+    listStatement :: Statement (UUID, UTCTime) (V.Vector StoredMeeting)
+    listStatement =
+      refineResult
+        (traverse (postgresUnmarshall @StoredMeetingTuple @StoredMeeting))
+        $ [vectorStatement|
+          SELECT
+            id :: uuid, title :: text, creator :: uuid,
+            start_time :: timestamptz, end_time :: timestamptz,
+            recurrence_frequency :: text?, recurrence_interval :: int4?, recurrence_until :: timestamptz?,
+            conversation_id :: uuid, invited_emails :: text[], trial :: boolean,
+            created_at :: timestamptz, updated_at :: timestamptz
+          FROM meetings
+          WHERE conversation_id = ($1 :: uuid) AND end_time >= ($2 :: timestamptz)
+          ORDER BY start_time ASC
+        |]

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

@@ -40,5 +40,8 @@ data MeetingsSubsystem m a where
     Local UserId ->
     Qualified MeetingId ->
     MeetingsSubsystem m (Maybe Meeting)
+  ListMeetings ::
+    Local UserId ->
+    MeetingsSubsystem m [Meeting]
 
 makeSem ''MeetingsSubsystem