WPB-21964: Add Wire Meetings creation endpoint

charts/background-worker/templates/configmap.yaml

@@ -25,6 +25,12 @@ data:
       host: brig
       port: 8080
 
+    {{- if .enableFederation }}
+    federator:
+      host: {{ .federator.host }}
+      port: {{ .federator.port }}
+    {{- end }}
+
     gundeck:
       host: gundeck
       port: 8080
@@ -103,4 +109,4 @@ data:
     {{- if .postgresMigration }}
     postgresMigration: {{- toYaml .postgresMigration | nindent 6 }}
     {{- end }}
-  {{- end }}
+  {{- end }}

charts/background-worker/values.yaml

@@ -19,6 +19,9 @@ config:
   logLevel: Info
   logFormat: StructuredJSON
   enableFederation: false # keep in sync with brig, cargohold and galley charts' config.enableFederation as well as wire-server chart's tags.federation
+  federator:
+    host: federator
+    port: 8080
   rabbitmq:
     host: rabbitmq
     port: 5672

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

@@ -121,6 +121,9 @@ config:
 
     checkGroupInfo: false
 
+    meetings:
+      validityPeriodHours: 48.0
+
     # 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

@@ -961,3 +961,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,193 @@
+{-# 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 <- assertOne resp.jsonBody
+  meeting %. "title" `shouldMatch` "Team Standup"
+  meeting %. "qualified_creator" %. "id" `shouldMatch` ownerId
+  meeting %. "invited_emails" `shouldMatch` ["alice@example.com", "bob@example.com"]
+
+testMeetingGet :: (HasCallStack) => App ()
+testMeetingGet = do
+  (owner, _tid, _members) <- createTeam OwnDomain 1
+  now <- liftIO getCurrentTime
+  let startTime = addUTCTime 3600 now
+      endTime = addUTCTime 7200 now
+      newMeeting = defaultMeetingJson "Team Standup" startTime endTime []
+
+  r1 <- postMeetings owner newMeeting
+  assertSuccess r1
+
+  meeting <- assertOne r1.jsonBody
+  (meetingId, domain) <- getMeetingIdAndDomain meeting
+
+  r2 <- getMeeting owner domain meetingId
+  assertSuccess r2
+
+  fetchedMeeting <- assertOne r2.jsonBody
+  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 <- assertOne r.jsonBody
+  meeting %. "trial" `shouldMatch` True
+
+-- Test that non-paying team members create trial meetings
+testMeetingCreateNonPayingTeamTrial :: (HasCallStack) => App ()
+testMeetingCreateNonPayingTeamTrial = do
+  (owner, tid, _members) <- createTeam OwnDomain 1
+
+  let teamId = tid
+  I.setTeamFeatureLockStatus owner tid "meetingsPremium" "unlocked"
+  setTeamFeatureConfig owner teamId "meetingsPremium" (Aeson.object [Key.fromString "status" .= Key.fromString "disabled"]) >>= assertStatus 200
+
+  now <- liftIO getCurrentTime
+  let startTime = addUTCTime 3600 now
+      endTime = addUTCTime 7200 now
+      newMeeting = defaultMeetingJson "Non-Paying Team Meeting" startTime endTime []
+
+  r <- postMeetings owner newMeeting
+  assertSuccess r
+
+  meeting <- assertOne r.jsonBody
+  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 <- assertOne r.jsonBody
+  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 <- assertOne r1.jsonBody
+  (meetingId, domain) <- getMeetingIdAndDomain meeting
+
+  r2 <- getMeeting owner domain meetingId
+  assertSuccess r2
+
+  fetchedMeeting <- assertOne r2.jsonBody
+  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/galley-types/default.nix

@@ -12,6 +12,7 @@
 , data-default
 , errors
 , gitignoreSource
+, http-types
 , imports
 , lens
 , lib
@@ -21,6 +22,7 @@
 , types-common
 , utf8-string
 , uuid
+, wai-utilities
 , wire-api
 }:
 mkDerivation {
@@ -36,6 +38,7 @@ mkDerivation {
     crypton
     data-default
     errors
+    http-types
     imports
     lens
     memory
@@ -44,6 +47,7 @@ mkDerivation {
     types-common
     utf8-string
     uuid
+    wai-utilities
     wire-api
   ];
   license = lib.licenses.agpl3Only;

libs/galley-types/galley-types.cabal

@@ -16,6 +16,7 @@ library
     Galley.Types
     Galley.Types.Conversations.One2One
     Galley.Types.Conversations.Roles
+    Galley.Types.Error
     Galley.Types.Teams
 
   other-modules:      Paths_galley_types
@@ -76,6 +77,7 @@ library
     , crypton
     , data-default
     , errors
+    , http-types
     , imports
     , lens                   >=4.12
     , memory
@@ -84,6 +86,7 @@ library
     , types-common           >=0.16
     , utf8-string
     , uuid
+    , wai-utilities
     , wire-api
 
   default-language:   GHC2021

services/galley/src/Galley/API/Error.hs → libs/galley-types/src/Galley/Types/Error.hs

@@ -18,7 +18,7 @@
 -- | Most of the errors thrown by galley are defined as static errors in
 -- 'Wire.API.Error.Galley' and declared as part of the API. Errors defined here
 -- are dynamic, and mostly internal.
-module Galley.API.Error
+module Galley.Types.Error
   ( -- * Internal errors
     InvalidInput (..),
     InternalError (..),

libs/types-common/src/Data/Id.hs

@@ -57,6 +57,7 @@ module Data.Id
     OAuthClientId,
     OAuthRefreshTokenId,
     ChallengeId,
+    MeetingId,
 
     -- * Utils
     uuidSchema,
@@ -114,6 +115,7 @@ data IdTag
   | OAuthRefreshToken
   | Challenge
   | Job
+  | Meeting
 
 idTagName :: IdTag -> Text
 idTagName Asset = "Asset"
@@ -129,6 +131,7 @@ idTagName OAuthClient = "OAuthClient"
 idTagName OAuthRefreshToken = "OAuthRefreshToken"
 idTagName Challenge = "Challenge"
 idTagName Job = "Job"
+idTagName Meeting = "Meeting"
 
 class KnownIdTag (t :: IdTag) where
   idTagValue :: IdTag
@@ -157,6 +160,8 @@ instance KnownIdTag 'OAuthRefreshToken where idTagValue = OAuthRefreshToken
 
 instance KnownIdTag 'Job where idTagValue = Job
 
+instance KnownIdTag 'Meeting where idTagValue = Meeting
+
 type AssetId = Id 'Asset
 
 type InvitationId = Id 'Invitation
@@ -185,6 +190,8 @@ type ChallengeId = Id 'Challenge
 
 type JobId = Id 'Job
 
+type MeetingId = Id 'Meeting
+
 -- Id -------------------------------------------------------------------------
 
 data NoId = NoId deriving (Eq, Show, Generic)

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

@@ -840,7 +840,7 @@ instance PostgresMarshall Int32 ReceiptMode where
 --------------------------------------------------------------------------------
 -- create
 
-data GroupConvType = GroupConversation | Channel
+data GroupConvType = GroupConversation | Channel | MeetingConversation
   deriving stock (Eq, Show, Generic, Enum)
   deriving (Arbitrary) via (GenericUniform GroupConvType)
   deriving (FromJSON, ToJSON, S.ToSchema) via Schema GroupConvType
@@ -850,7 +850,8 @@ instance ToSchema GroupConvType where
     enum @Text "GroupConvType" $
       mconcat
         [ element "group_conversation" GroupConversation,
-          element "channel" Channel
+          element "channel" Channel,
+          element "meeting" MeetingConversation
         ]
 
 instance C.Cql GroupConvType where