WPB-21964: Add Wire Meetings creation endpoint

changelog.d/2-features/WPB-21964-meetings

@@ -0,0 +1,10 @@
+Add Meetings API for creating and managing scheduled meetings.
+
+New endpoints:
+- `POST /meetings` - Create a meeting with title, start/end times, recurrence patterns (daily, weekly, etc.), and invited emails. Each meeting creates an associated MLS conversation.
+- `GET /meetings/:domain/:meetingId` - Retrieve a meeting by ID. Accessible to the meeting creator or any conversation member.
+
+Features:
+- Recurring meeting support with configurable patterns and end dates
+- Trial status: personal users receive trial meetings, paying team members receive non-trial meetings
+- Meeting expiration: old meetings are automatically filtered based on a configurable validity period

charts/galley/templates/configmap.yaml

@@ -112,6 +112,8 @@ data:
       {{- if .settings.checkGroupInfo }}
       checkGroupInfo: {{ .settings.checkGroupInfo }}
       {{- end }}
+      meetings:
+        {{- toYaml .settings.meetings | nindent 8 }}
       featureFlags:
         sso: {{ .settings.featureFlags.sso }}
         legalhold: {{ .settings.featureFlags.legalhold }}

charts/galley/values.yaml

@@ -122,6 +122,9 @@ config:
 
     checkGroupInfo: false
 
+    meetings:
+      validityPeriod: "48h"
+
     # To disable proteus for new federated conversations:
     # federationProtocols: ["mls"]
 

integration/integration.cabal

@@ -172,6 +172,7 @@ library
     Test.Federator
     Test.LegalHold
     Test.Login
+    Test.Meetings
     Test.MessageTimer
     Test.Migration.Conversation
     Test.Migration.ConversationCodes

integration/test/API/Galley.hs

@@ -979,3 +979,13 @@ searchChannels user tid args = do
             [("discoverable", "true") | args.discoverable]
           ]
       )
+
+postMeetings :: (HasCallStack, MakesValue user) => user -> Value -> App Response
+postMeetings user newMeeting = do
+  req <- baseRequest user Galley Versioned "/meetings"
+  submit "POST" $ req & addJSON newMeeting
+
+getMeeting :: (HasCallStack, MakesValue user) => user -> String -> String -> App Response
+getMeeting user domain meetingId = do
+  req <- baseRequest user Galley Versioned (joinHttpPath ["meetings", domain, meetingId])
+  submit "GET" req

integration/test/Test/FeatureFlags/Util.hs

@@ -254,6 +254,8 @@ hasExplicitLockStatus "sndFactorPasswordChallenge" = True
 hasExplicitLockStatus "outlookCalIntegration" = True
 hasExplicitLockStatus "enforceFileDownloadLocation" = True
 hasExplicitLockStatus "domainRegistration" = True
+hasExplicitLockStatus "meetings" = True
+hasExplicitLockStatus "meetingsPremium" = True
 hasExplicitLockStatus _ = False
 
 checkFeature :: (HasCallStack, MakesValue user, MakesValue tid) => String -> user -> tid -> Value -> App ()

integration/test/Test/Meetings.hs

@@ -0,0 +1,161 @@
+{-# OPTIONS_GHC -Wno-ambiguous-fields #-}
+
+module Test.Meetings where
+
+import API.Galley
+import qualified API.GalleyInternal as I
+import Data.Aeson as Aeson
+import qualified Data.Aeson.Key as Key
+import Data.Time.Clock
+import qualified Data.Time.Format as Time
+import SetupHelpers
+import Testlib.Prelude as P hiding ((.=))
+
+-- Helper to extract meetingId and domain from a meeting JSON object
+getMeetingIdAndDomain :: (HasCallStack) => Value -> App (String, String)
+getMeetingIdAndDomain meeting = do
+  meetingId <- meeting %. "qualified_id" %. "id" >>= asString
+  domain <- meeting %. "qualified_id" %. "domain" >>= asString
+  pure (meetingId, domain)
+
+testMeetingCreate :: (HasCallStack) => App ()
+testMeetingCreate = do
+  (owner, _tid, _members) <- createTeam OwnDomain 1
+  ownerId <- owner %. "id" >>= asString
+  now <- liftIO getCurrentTime
+  let startTime = addUTCTime 3600 now
+      endTime = addUTCTime 7200 now
+      newMeeting = defaultMeetingJson "Team Standup" startTime endTime ["alice@example.com", "bob@example.com"]
+
+  resp <- postMeetings owner newMeeting
+  assertSuccess resp
+
+  meeting <- getJSON 201 resp
+  meeting %. "title" `shouldMatch` "Team Standup"
+  meeting %. "qualified_creator" %. "id" `shouldMatch` ownerId
+  meeting %. "invited_emails" `shouldMatch` ["alice@example.com", "bob@example.com"]
+
+  -- Verify fetching the meeting
+  (meetingId, domain) <- getMeetingIdAndDomain meeting
+  r2 <- getMeeting owner domain meetingId
+  assertSuccess r2
+
+  fetchedMeeting <- getJSON 200 r2
+  fetchedMeeting %. "title" `shouldMatch` "Team Standup"
+
+testMeetingGetNotFound :: (HasCallStack) => App ()
+testMeetingGetNotFound = do
+  (owner, _tid, _members) <- createTeam OwnDomain 1
+  fakeMeetingId <- randomId
+
+  getMeeting owner "example.com" fakeMeetingId >>= assertLabel 404 "meeting-not-found"
+
+-- Test that personal (non-team) users create trial meetings
+testMeetingCreatePersonalUserTrial :: (HasCallStack) => App ()
+testMeetingCreatePersonalUserTrial = do
+  personalUser <- randomUser OwnDomain def
+  now <- liftIO getCurrentTime
+  let startTime = addUTCTime 3600 now
+      endTime = addUTCTime 7200 now
+      newMeeting = defaultMeetingJson "Personal Meeting" startTime endTime []
+
+  r <- postMeetings personalUser newMeeting
+  assertSuccess r
+
+  meeting <- getJSON 201 r
+  meeting %. "trial" `shouldMatch` True
+
+-- Test that paying team members create non-trial meetings
+testMeetingCreatePayingTeamNonTrial :: (HasCallStack) => App ()
+testMeetingCreatePayingTeamNonTrial = do
+  (owner, tid, _members) <- createTeam OwnDomain 1
+
+  let firstMeeting = Aeson.object [Key.fromString "status" .= Key.fromString "enabled"]
+  I.setTeamFeatureLockStatus owner tid "meetingsPremium" "unlocked"
+  setTeamFeatureConfig owner tid "meetingsPremium" firstMeeting >>= assertStatus 200
+
+  now <- liftIO getCurrentTime
+  let startTime = addUTCTime 3600 now
+      endTime = addUTCTime 7200 now
+      newMeeting = defaultMeetingJson "Paying Team Meeting" startTime endTime []
+
+  r <- postMeetings owner newMeeting
+  assertSuccess r
+
+  meeting <- getJSON 201 r
+  meeting %. "trial" `shouldMatch` False
+
+-- Test that disabled MeetingsConfig feature blocks creation
+testMeetingsConfigDisabledBlocksCreate :: (HasCallStack) => App ()
+testMeetingsConfigDisabledBlocksCreate = do
+  (owner, tid, _members) <- createTeam OwnDomain 1
+
+  -- Disable the MeetingsConfig feature
+  let firstMeeting = Aeson.object [Key.fromString "status" .= Key.fromString "disabled", Key.fromString "lockStatus" .= Key.fromString "unlocked"]
+  setTeamFeatureConfig owner tid "meetings" firstMeeting >>= assertStatus 200
+
+  -- Try to create a meeting - should fail
+  now <- liftIO getCurrentTime
+  let startTime = addUTCTime 3600 now
+      endTime = addUTCTime 7200 now
+      newMeeting = defaultMeetingJson "Team Standup" startTime endTime []
+
+  postMeetings owner newMeeting >>= assertLabel 403 "invalid-op"
+
+testMeetingRecurrence :: (HasCallStack) => App ()
+testMeetingRecurrence = do
+  (owner, _tid, _members) <- createTeam OwnDomain 1
+  now <- liftIO getCurrentTime
+  let startTime = addUTCTime 3600 now
+      endTime = addUTCTime 7200 now
+      recurrenceUntil = Time.formatTime Time.defaultTimeLocale "%FT%TZ" $ addUTCTime (30 * nominalDay) now -- format to avoid rounding expectation mismatch
+      recurrence =
+        Aeson.object
+          [ Key.fromString "frequency" .= Key.fromString "daily",
+            Key.fromString "interval" .= (1 :: Int),
+            Key.fromString "until" .= recurrenceUntil
+          ]
+      newMeeting =
+        Aeson.object
+          [ Key.fromString "title" .= Key.fromString "Daily Standup with Recurrence",
+            Key.fromString "start_time" .= startTime,
+            Key.fromString "end_time" .= endTime,
+            Key.fromString "recurrence" .= recurrence,
+            Key.fromString "invited_emails" .= ["charlie@example.com"]
+          ]
+
+  r1 <- postMeetings owner newMeeting
+  assertSuccess r1
+
+  meeting <- getJSON 201 r1
+  (meetingId, domain) <- getMeetingIdAndDomain meeting
+
+  r2 <- getMeeting owner domain meetingId
+  assertSuccess r2
+
+  fetchedMeeting <- getJSON 200 r2
+  fetchedMeeting %. "title" `shouldMatch` "Daily Standup with Recurrence"
+  recurrence' <- fetchedMeeting %. "recurrence"
+  recurrence' %. "frequency" `shouldMatch` "daily"
+  recurrence' %. "interval" `shouldMatchInt` 1
+  recurrence' %. "until" `shouldMatch` recurrenceUntil
+
+testMeetingCreateInvalidTimes :: (HasCallStack) => App ()
+testMeetingCreateInvalidTimes = do
+  (owner, _tid, _members) <- createTeam OwnDomain 1
+  now <- liftIO getCurrentTime
+  let startTime = addUTCTime 3600 now
+      endTimeInvalid = addUTCTime 3500 now -- endTime is before startTime
+      newMeetingInvalid = defaultMeetingJson "Invalid Time" startTime endTimeInvalid []
+
+  postMeetings owner newMeetingInvalid >>= assertLabel 403 "invalid-op"
+
+-- Helper to create a default new meeting JSON object
+defaultMeetingJson :: String -> UTCTime -> UTCTime -> [String] -> Value
+defaultMeetingJson title startTime endTime invitedEmails =
+  Aeson.object
+    [ Key.fromString "title" .= title,
+      Key.fromString "start_time" .= startTime,
+      Key.fromString "end_time" .= endTime,
+      Key.fromString "invited_emails" .= invitedEmails
+    ]

libs/wire-api/src/Wire/API/Meeting.hs

@@ -23,6 +23,7 @@ import Data.Int qualified as DI
 import Data.Json.Util (utcTimeSchema)
 import Data.OpenApi qualified as S
 import Data.Qualified (Qualified)
+import Data.Range (Range)
 import Data.Schema
 import Data.Time.Clock
 import Deriving.Aeson
@@ -34,7 +35,7 @@ import Wire.Arbitrary (Arbitrary, GenericUniform (..))
 -- | Core Meeting type
 data Meeting = Meeting
   { id :: Qualified MeetingId,
-    title :: Text,
+    title :: Range 1 256 Text,
     creator :: Qualified UserId,
     startTime :: UTCTime,
     endTime :: UTCTime,
@@ -70,7 +71,7 @@ data NewMeeting = NewMeeting
   { startTime :: UTCTime,
     endTime :: UTCTime,
     recurrence :: Maybe Recurrence,
-    title :: Text,
+    title :: Range 1 256 Text,
     invitedEmails :: [EmailAddress]
   }
   deriving stock (Eq, Show, Generic)

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

@@ -31,7 +31,7 @@ import Wire.API.Routes.Version
 type MeetingsAPI =
   Named
     "create-meeting"
-    ( Summary "TODO: Create a new meeting"
+    ( Summary "Create a new meeting"
         :> From 'V15
         :> ZLocalUser
         :> "meetings"
@@ -46,7 +46,7 @@ type MeetingsAPI =
     )
     :<|> Named
            "get-meeting"
-           ( Summary "TODO: Get a single meeting by ID"
+           ( Summary "Get a single meeting by ID"
                :> From 'V15
                :> ZLocalUser
                :> "meetings"

libs/wire-subsystems/default.nix

@@ -106,6 +106,7 @@
 , statistics
 , stomp-queue
 , string-conversions
+, tagged
 , template
 , text
 , text-icu-translit
@@ -231,6 +232,7 @@ mkDerivation {
     ssl-util
     statistics
     stomp-queue
+    tagged
     template
     text
     text-icu-translit
@@ -354,6 +356,7 @@ mkDerivation {
     statistics
     stomp-queue
     string-conversions
+    tagged
     template
     text
     text-icu-translit

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

@@ -63,5 +63,9 @@ data ConversationSubsystem m a where
     Connect ->
     ConversationSubsystem m (StoredConversation, Bool)
   InternalGetClientIds :: [UserId] -> ConversationSubsystem m Clients
+  InternalGetLocalMember ::
+    ConvId ->
+    UserId ->
+    ConversationSubsystem m (Maybe LocalMember)
 
 makeSem ''ConversationSubsystem

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

@@ -143,6 +143,8 @@ interpretConversationSubsystem = interpret $ \case
     createConnectConversationLogic lusr conn j
   InternalGetClientIds uids ->
     internalGetClientIdsImpl uids
+  ConversationSubsystem.InternalGetLocalMember cid uid ->
+    ConvStore.getLocalMember cid uid
 
 createGroupConversationGeneric ::
   forall r.

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

@@ -19,7 +19,10 @@
 
 module Wire.MeetingsStore where
 
+import Data.Bifunctor (Bifunctor (first))
 import Data.Id
+import Data.Range (Range (fromRange), checkedEither)
+import Data.Text qualified as T
 import Data.Time.Clock
 import Data.UUID (UUID)
 import Data.Vector (Vector)
@@ -35,7 +38,7 @@ data StoredMeeting = StoredMeeting
   { -- | unique identifier
     id :: MeetingId,
     -- | title of the meeting
-    title :: Text,
+    title :: Range 1 256 Text,
     -- | user who created the meeting
     creator :: UserId,
     -- | start time of the meeting
@@ -77,7 +80,7 @@ instance PostgresMarshall StoredMeetingTuple StoredMeeting where
   postgresMarshall storedMeeting =
     let (rFreq, rInterval, rUntil) = postgresMarshall storedMeeting.recurrence
      in ( toUUID storedMeeting.id,
-          storedMeeting.title,
+          fromRange storedMeeting.title,
           toUUID storedMeeting.creator,
           storedMeeting.startTime,
           storedMeeting.endTime,
@@ -107,11 +110,12 @@ instance PostgresUnmarshall StoredMeetingTuple StoredMeeting where
       createdAt',
       updateAt'
       ) = do
+      rTitle <- first T.pack $ checkedEither title'
       recurrence' <- postgresUnmarshall (rFreq, rInterval, rUntil)
       pure
         StoredMeeting
           { id = Id id',
-            title = title',
+            title = rTitle,
             creator = Id creator',
             startTime = startTime',
             endTime = endTime',
@@ -125,7 +129,7 @@ instance PostgresUnmarshall StoredMeetingTuple StoredMeeting where
 
 data MeetingsStore m a where
   CreateMeeting ::
-    Text ->
+    Range 1 256 Text ->
     UserId ->
     UTCTime ->
     UTCTime ->

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

@@ -25,6 +25,7 @@ where
 
 import Data.Id
 import Data.Profunctor (dimap)
+import Data.Range (Range)
 import Data.Time.Clock
 import Data.UUID (UUID, nil)
 import Hasql.Pool
@@ -53,7 +54,7 @@ interpretMeetingsStoreToPostgres =
 
 createMeetingImpl ::
   (PGConstraints r) =>
-  Text ->
+  Range 1 256 Text ->
   UserId ->
   UTCTime ->
   UTCTime ->