Servantify legacy addMember endpoint

changelog.d/5-internal/servantify-add-member

@@ -0,0 +1 @@
+Convert legacy POST conversations/:cnv/members endpoint to Servant

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

@@ -726,6 +726,18 @@ data Invite = Invite -- Deprecated, use InviteQualified (and maybe rename?)
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform Invite)
+  deriving (FromJSON, ToJSON, S.ToSchema) via (Schema Invite)
+
+instance ToSchema Invite where
+  schema =
+    object "Invite" $
+      Invite
+        <$> (toNonEmpty . invUsers)
+          .= fmap List1 (field "users" (nonEmptyArray schema))
+        <*> (Just . invRoleName)
+          .= fmap
+            (fromMaybe roleNameWireAdmin)
+            (optField "conversation_role" Nothing schema)
 
 data InviteQualified = InviteQualified
   { invQUsers :: NonEmpty (Qualified UserId),
@@ -741,7 +753,10 @@ instance ToSchema InviteQualified where
     object "InviteQualified" $
       InviteQualified
         <$> invQUsers .= field "qualified_users" (nonEmptyArray schema)
-        <*> invQRoleName .= (field "conversation_role" schema <|> pure roleNameWireAdmin)
+        <*> (Just . invQRoleName)
+          .= fmap
+            (fromMaybe roleNameWireAdmin)
+            (optField "conversation_role" Nothing schema)
 
 newInvite :: List1 UserId -> Invite
 newInvite us = Invite us roleNameWireAdmin
@@ -752,17 +767,6 @@ modelInvite = Doc.defineModel "Invite" $ do
   Doc.property "users" (Doc.unique $ Doc.array Doc.bytes') $
     Doc.description "List of user IDs to add to a conversation"
 
-instance ToJSON Invite where
-  toJSON i =
-    A.object
-      [ "users" A..= invUsers i,
-        "conversation_role" A..= invRoleName i
-      ]
-
-instance FromJSON Invite where
-  parseJSON = A.withObject "invite object" $ \o ->
-    Invite <$> o A..: "users" <*> o A..:? "conversation_role" A..!= roleNameWireAdmin
-
 --------------------------------------------------------------------------------
 -- update
 

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

@@ -233,7 +233,23 @@ data Api routes = Api
         :> "one2one"
         :> ReqBody '[Servant.JSON] NewConvUnmanaged
         :> ConversationVerb,
-    addMembersToConversationV2 ::
+    -- This endpoint can lead to the following events being sent:
+    -- - MemberJoin event to members
+    addMembersToConversationUnqualified ::
+      routes
+        :- Summary "Add members to an existing conversation (deprecated)"
+        :> CanThrow ConvNotFound
+        :> CanThrow NotConnected
+        :> CanThrow ConvAccessDenied
+        :> CanThrow (InvalidOp "Invalid operation")
+        :> ZUser
+        :> ZConn
+        :> "conversations"
+        :> Capture "cnv" ConvId
+        :> "members"
+        :> ReqBody '[JSON] Invite
+        :> MultiVerb 'POST '[JSON] ConvUpdateResponses (UpdateResult Event),
+    addMembersToConversation ::
       routes
         :- Summary "Add qualified members to an existing conversation."
         :> ZUser

services/galley/src/Galley/API/Public.hs

@@ -54,7 +54,6 @@ import Network.Wai.Utilities.ZAuth hiding (ZAuthUser)
 import Servant hiding (Handler, JSON, addHeader, contentType, respond)
 import Servant.Server.Generic (genericServerT)
 import Servant.Swagger.Internal.Orphans ()
-import qualified Wire.API.Conversation as Public
 import qualified Wire.API.Conversation.Code as Public
 import qualified Wire.API.Conversation.Typing as Public
 import qualified Wire.API.CustomBackend as Public
@@ -89,7 +88,8 @@ servantSitemap =
         GalleyAPI.createGroupConversation = Create.createGroupConversation,
         GalleyAPI.createSelfConversation = Create.createSelfConversation,
         GalleyAPI.createOne2OneConversation = Create.createOne2OneConversation,
-        GalleyAPI.addMembersToConversationV2 = Update.addMembers,
+        GalleyAPI.addMembersToConversationUnqualified = Update.addMembersUnqualified,
+        GalleyAPI.addMembersToConversation = Update.addMembers,
         GalleyAPI.removeMemberUnqualified = Update.removeMemberUnqualified,
         GalleyAPI.removeMember = Update.removeMemberQualified,
         GalleyAPI.updateOtherMemberUnqualified = Update.updateOtherMemberUnqualified,
@@ -644,28 +644,6 @@ sitemap = do
     errorResponse (Error.errorDescriptionTypeToWai @Error.ConvNotFound)
     errorResponse Error.invalidAccessOp
 
-  -- This endpoint can lead to the following events being sent:
-  -- - MemberJoin event to members
-  post "/conversations/:cnv/members" (continue Update.addMembersH) $
-    zauthUserId
-      .&. zauthConnId
-      .&. capture "cnv"
-      .&. jsonRequest @Public.Invite
-  document "POST" "addMembers" $ do
-    summary "Add users to an existing conversation"
-    parameter Path "cnv" bytes' $
-      description "Conversation ID"
-    body (ref Public.modelInvite) $
-      description "JSON body"
-    returns (ref Public.modelEvent)
-    response 200 "Members added" end
-    response 204 "No change" end
-    response 412 "The user(s) cannot be added to the conversation (eg., due to legalhold policy conflict)." end
-    errorResponse (Error.errorDescriptionTypeToWai @Error.ConvNotFound)
-    errorResponse (Error.invalidOp "Conversation type does not allow adding members")
-    errorResponse (Error.errorDescriptionTypeToWai @Error.NotConnected)
-    errorResponse (Error.errorDescriptionTypeToWai @Error.ConvAccessDenied)
-
   -- This endpoint can lead to the following events being sent:
   -- - Typing event to members
   post "/conversations/:cnv/typing" (continue Update.isTypingH) $

services/galley/src/Galley/API/Update.hs

@@ -38,7 +38,7 @@ module Galley.API.Update
     updateConversationAccess,
 
     -- * Managing Members
-    addMembersH,
+    addMembersUnqualified,
     addMembers,
     updateUnqualifiedSelfMember,
     updateSelfMember,
@@ -567,13 +567,6 @@ joinConversation zusr zcon cnv access = do
         (convTargets conv <> extraTargets)
         action
 
-addMembersH :: UserId ::: ConnId ::: ConvId ::: JsonRequest Public.Invite -> Galley Response
-addMembersH (zusr ::: zcon ::: cid ::: req) = do
-  (Invite u r) <- fromJsonBody req
-  domain <- viewFederationDomain
-  let qInvite = Public.InviteQualified (flip Qualified domain <$> toNonEmpty u) r
-  handleUpdateResult <$> addMembers zusr zcon cid qInvite
-
 -- | Add users to a conversation without performing any checks. Return extra
 -- notification targets and the action performed.
 addMembersToLocalConversation ::
@@ -656,6 +649,12 @@ performAddMemberAction qusr conv invited role = do
     checkLHPolicyConflictsRemote :: FutureWork 'LegalholdPlusFederationNotImplemented [Remote UserId] -> Galley ()
     checkLHPolicyConflictsRemote _remotes = pure ()
 
+addMembersUnqualified ::
+  UserId -> ConnId -> ConvId -> Public.Invite -> Galley (UpdateResult Event)
+addMembersUnqualified zusr zcon cnv (Public.Invite users role) = do
+  qusers <- traverse (fmap unTagged . qualifyLocal) (toNonEmpty users)
+  addMembers zusr zcon cnv (Public.InviteQualified qusers role)
+
 addMembers :: UserId -> ConnId -> ConvId -> Public.InviteQualified -> Galley (UpdateResult Event)
 addMembers zusr zcon cnv (Public.InviteQualified users role) = do
   lusr <- qualifyLocal zusr