Servantify other member update

changelog.d/1-api-changes/deprecate-other-member-update

@@ -0,0 +1 @@
+Deprecate `PUT /conversations/:cnv/members/:usr` endpoint

changelog.d/1-api-changes/qualified-other-member-update

@@ -0,0 +1 @@
+Add qualified endpoint for updating conversation members

changelog.d/6-federation/servantify-other-member-update

@@ -0,0 +1 @@
+Convert the `PUT /conversations/:cnv/members/:usr` endpoint to Servant

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

@@ -45,7 +45,6 @@ import Control.Lens ((?~))
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson as A
 import Data.Id
-import Data.Json.Util
 import Data.Qualified
 import Data.Schema
 import qualified Data.Swagger as S
@@ -271,9 +270,7 @@ data OtherMemberUpdate = OtherMemberUpdate
   { omuConvRoleName :: Maybe RoleName
   }
   deriving stock (Eq, Show, Generic)
-
-instance Arbitrary OtherMemberUpdate where
-  arbitrary = OtherMemberUpdate . Just <$> arbitrary
+  deriving (FromJSON, ToJSON, S.ToSchema) via (Schema OtherMemberUpdate)
 
 modelOtherMemberUpdate :: Doc.Model
 modelOtherMemberUpdate = Doc.defineModel "otherMemberUpdate" $ do
@@ -282,15 +279,19 @@ modelOtherMemberUpdate = Doc.defineModel "otherMemberUpdate" $ do
     Doc.description "Name of the conversation role updated to"
     Doc.optional
 
-instance ToJSON OtherMemberUpdate where
-  toJSON m =
-    A.object $
-      "conversation_role" A..= omuConvRoleName m
-        # []
+instance Arbitrary OtherMemberUpdate where
+  arbitrary = OtherMemberUpdate . Just <$> arbitrary
+
+instance ToSchema OtherMemberUpdate where
+  schema =
+    (`withParser` (either fail pure . validateOtherMemberUpdate))
+      . objectWithDocModifier
+        "OtherMemberUpdate"
+        (description ?~ "Update user properties of other members relative to a conversation")
+      $ OtherMemberUpdate
+        <$> omuConvRoleName .= optField "conversation_role" Nothing schema
 
-instance FromJSON OtherMemberUpdate where
-  parseJSON = A.withObject "other-member-update object" $ \m -> do
-    u <- OtherMemberUpdate <$> m A..:? "conversation_role"
-    unless (isJust (omuConvRoleName u)) $
-      fail "One of { 'conversation_role'} required."
-    return u
+validateOtherMemberUpdate :: OtherMemberUpdate -> Either String OtherMemberUpdate
+validateOtherMemberUpdate u
+  | isJust (omuConvRoleName u) = pure u
+  | otherwise = Left "'conversation_role' is required"

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

@@ -206,6 +206,8 @@ type ConvNotFound = ErrorDescription 404 "no-conversation" "Conversation not fou
 convNotFound :: ConvNotFound
 convNotFound = mkErrorDescription
 
+type ConvMemberNotFound = ErrorDescription 404 "no-conversation-member" "Conversation member not found"
+
 type UnknownClient = ErrorDescription 403 "unknown-client" "Unknown Client"
 
 unknownClient :: UnknownClient

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

@@ -277,6 +277,46 @@ data Api routes = Api
              RemoveFromConversationHTTPResponse
              RemoveFromConversationResponse,
     -- This endpoint can lead to the following events being sent:
+    -- - MemberStateUpdate event to members
+    updateOtherMemberUnqualified ::
+      routes
+        :- Summary "Update membership of the specified user (deprecated)"
+        :> Description "Use `PUT /conversations/:cnv_domain/:cnv/members/:usr_domain/:usr` instead"
+        :> ZUser
+        :> ZConn
+        :> CanThrow ConvNotFound
+        :> CanThrow ConvMemberNotFound
+        :> CanThrow (InvalidOp "Invalid operation")
+        :> "conversations"
+        :> Capture' '[Description "Conversation ID"] "cnv" ConvId
+        :> "members"
+        :> Capture' '[Description "Target User ID"] "usr" UserId
+        :> ReqBody '[JSON] OtherMemberUpdate
+        :> MultiVerb
+             'PUT
+             '[JSON]
+             '[RespondEmpty 200 "Membership updated"]
+             (),
+    updateOtherMember ::
+      routes
+        :- Summary "Update membership of the specified user"
+        :> Description "**Note**: at least one field has to be provided."
+        :> ZUser
+        :> ZConn
+        :> CanThrow ConvNotFound
+        :> CanThrow ConvMemberNotFound
+        :> CanThrow (InvalidOp "Invalid operation")
+        :> "conversations"
+        :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId
+        :> "members"
+        :> QualifiedCapture' '[Description "Target User ID"] "usr" UserId
+        :> ReqBody '[JSON] OtherMemberUpdate
+        :> MultiVerb
+             'PUT
+             '[JSON]
+             '[RespondEmpty 200 "Membership updated"]
+             (),
+    -- This endpoint can lead to the following events being sent:
     -- - ConvRename event to members
     updateConversationNameDeprecated ::
       routes

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

@@ -39,21 +39,39 @@ errorDescriptionToWai ::
 errorDescriptionToWai (ErrorDescription msg) =
   mkError (statusVal (Proxy @code)) (LT.pack (symbolVal (Proxy @lbl))) (LT.fromStrict msg)
 
+errorDescriptionTypeToWai ::
+  forall e (code :: Nat) (lbl :: Symbol) (desc :: Symbol).
+  ( KnownStatus code,
+    KnownSymbol lbl,
+    KnownSymbol desc,
+    e ~ ErrorDescription code lbl desc
+  ) =>
+  Error
+errorDescriptionTypeToWai = errorDescriptionToWai (mkErrorDescription :: e)
+
 throwErrorDescription ::
   (KnownStatus code, KnownSymbol lbl, MonadThrow m) =>
   ErrorDescription code lbl desc ->
   m a
 throwErrorDescription = throwM . errorDescriptionToWai
 
+throwErrorDescriptionType ::
+  forall e (code :: Nat) (lbl :: Symbol) (desc :: Symbol) m a.
+  ( KnownStatus code,
+    KnownSymbol lbl,
+    KnownSymbol desc,
+    MonadThrow m,
+    e ~ ErrorDescription code lbl desc
+  ) =>
+  m a
+throwErrorDescriptionType = throwErrorDescription (mkErrorDescription :: e)
+
 internalError :: Error
 internalError = internalErrorWithDescription "internal error"
 
 internalErrorWithDescription :: LText -> Error
 internalErrorWithDescription = mkError status500 "internal-error"
 
-convMemberNotFound :: Error
-convMemberNotFound = mkError status404 "no-conversation-member" "conversation member not found"
-
 invalidSelfOp :: Error
 invalidSelfOp = invalidOp "invalid operation for self conversation"
 

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

@@ -92,6 +92,8 @@ servantSitemap =
         GalleyAPI.addMembersToConversationV2 = Update.addMembers,
         GalleyAPI.removeMemberUnqualified = Update.removeMemberUnqualified,
         GalleyAPI.removeMember = Update.removeMemberQualified,
+        GalleyAPI.updateOtherMemberUnqualified = Update.updateOtherMemberUnqualified,
+        GalleyAPI.updateOtherMember = Update.updateOtherMember,
         GalleyAPI.updateConversationNameDeprecated = Update.updateLocalConversationName,
         GalleyAPI.updateConversationNameUnqualified = Update.updateLocalConversationName,
         GalleyAPI.updateConversationName = Update.updateConversationName,
@@ -721,27 +723,6 @@ sitemap = do
     errorResponse (Error.errorDescriptionToWai Error.notConnected)
     errorResponse (Error.errorDescriptionToWai Error.convAccessDenied)
 
-  -- This endpoint can lead to the following events being sent:
-  -- - MemberStateUpdate event to members
-  put "/conversations/:cnv/members/:usr" (continue Update.updateOtherMemberH) $
-    zauthUserId
-      .&. zauthConnId
-      .&. capture "cnv"
-      .&. capture "usr"
-      .&. jsonRequest @Public.OtherMemberUpdate
-  document "PUT" "updateOtherMember" $ do
-    summary "Update membership of the specified user"
-    notes "Even though all fields are optional, at least one needs to be given."
-    parameter Path "cnv" bytes' $
-      description "Conversation ID"
-    parameter Path "usr" bytes' $
-      description "Target User ID"
-    body (ref Public.modelOtherMemberUpdate) $
-      description "JSON body"
-    errorResponse (Error.errorDescriptionToWai Error.convNotFound)
-    errorResponse Error.convMemberNotFound
-    errorResponse Error.invalidTargetUserOp
-
   -- 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,8 @@ module Galley.API.Update
     addMembers,
     updateUnqualifiedSelfMember,
     updateSelfMember,
-    updateOtherMemberH,
+    updateOtherMember,
+    updateOtherMemberUnqualified,
     removeMember,
     removeMemberQualified,
     removeMemberUnqualified,
@@ -113,7 +114,8 @@ import qualified Wire.API.Conversation as Public
 import qualified Wire.API.Conversation.Code as Public
 import Wire.API.Conversation.Role (roleNameWireAdmin)
 import Wire.API.ErrorDescription
-  ( ConvNotFound,
+  ( ConvMemberNotFound,
+    ConvNotFound,
     codeNotFound,
     convNotFound,
     missingLegalholdConsent,
@@ -580,18 +582,31 @@ updateRemoteSelfMember ::
 updateRemoteSelfMember zusr zcon rcid update = do
   statusMap <- Data.remoteConversationStatus zusr [rcid]
   case Map.lookup rcid statusMap of
-    Nothing -> throwM convMemberNotFound
+    Nothing -> throwErrorDescriptionType @ConvMemberNotFound
     Just _ ->
       void $ processUpdateMemberEvent zusr zcon (unTagged rcid) [zusr] zusr update
 
-updateOtherMemberH :: UserId ::: ConnId ::: ConvId ::: UserId ::: JsonRequest Public.OtherMemberUpdate -> Galley Response
-updateOtherMemberH (zusr ::: zcon ::: cid ::: victim ::: req) = do
-  update <- fromJsonBody req
-  updateOtherMember zusr zcon cid victim update
-  return empty
+updateOtherMember ::
+  UserId ->
+  ConnId ->
+  Qualified ConvId ->
+  Qualified UserId ->
+  Public.OtherMemberUpdate ->
+  Galley ()
+updateOtherMember zusr zcon qcid qvictim update = do
+  localDomain <- viewFederationDomain
+  if qDomain qcid == localDomain && qDomain qvictim == localDomain
+    then updateOtherMemberUnqualified zusr zcon (qUnqualified qcid) (qUnqualified qvictim) update
+    else throwM federationNotImplemented
 
-updateOtherMember :: UserId -> ConnId -> ConvId -> UserId -> Public.OtherMemberUpdate -> Galley ()
-updateOtherMember zusr zcon cid victim update = do
+updateOtherMemberUnqualified ::
+  UserId ->
+  ConnId ->
+  ConvId ->
+  UserId ->
+  Public.OtherMemberUpdate ->
+  Galley ()
+updateOtherMemberUnqualified zusr zcon cid victim update = do
   localDomain <- viewFederationDomain
   when (zusr == victim) $
     throwM invalidTargetUserOp

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

@@ -294,7 +294,7 @@ getSelfMemberFromLocalsLegacy usr lmems =
   eitherM (throwM . errorDescriptionToWai) pure . runExceptT $ getSelfMemberFromLocals usr lmems
 
 getOtherMember :: (Foldable t, Monad m) => UserId -> t LocalMember -> ExceptT Error m LocalMember
-getOtherMember = getLocalMember convMemberNotFound
+getOtherMember = getLocalMember (errorDescriptionTypeToWai @ConvMemberNotFound)
 
 getOtherMemberLegacy :: Foldable t => UserId -> t LocalMember -> Galley LocalMember
 getOtherMemberLegacy usr lmems =

services/galley/test/integration/API.hs

@@ -183,6 +183,8 @@ tests s =
           test s "rename conversation" putConvRenameOk,
           test s "rename qualified conversation" putQualifiedConvRenameOk,
           test s "rename qualified conversation failure" putQualifiedConvRenameFailure,
+          test s "other member update role" putOtherMemberOk,
+          test s "qualified other member update role" putQualifiedOtherMemberOk,
           test s "member update (otr mute)" putMemberOtrMuteOk,
           test s "member update (otr archive)" putMemberOtrArchiveOk,
           test s "member update (hidden)" putMemberHiddenOk,
@@ -2553,6 +2555,73 @@ putConvRenameOk = do
       evtFrom e @?= qbob
       evtData e @?= EdConvRename (ConversationRename "gossip++")
 
+putQualifiedOtherMemberOk :: TestM ()
+putQualifiedOtherMemberOk = do
+  c <- view tsCannon
+  qalice <- randomQualifiedUser
+  qbob <- randomQualifiedUser
+  let bob = qUnqualified qbob
+      alice = qUnqualified qalice
+  connectUsers alice (singleton bob)
+  conv <- decodeConvId <$> postConv alice [bob] (Just "gossip") [] Nothing Nothing
+  let qconv = Qualified conv (qDomain qbob)
+      expectedMemberUpdateData =
+        MemberUpdateData
+          { misTarget = Just alice,
+            misOtrMutedStatus = Nothing,
+            misOtrMutedRef = Nothing,
+            misOtrArchived = Nothing,
+            misOtrArchivedRef = Nothing,
+            misHidden = Nothing,
+            misHiddenRef = Nothing,
+            misConvRoleName = Just roleNameWireMember
+          }
+
+  WS.bracketR2 c alice bob $ \(wsA, wsB) -> do
+    -- demote qalice
+    putOtherMemberQualified bob qalice (OtherMemberUpdate (Just roleNameWireMember)) qconv
+      !!! const 200 === statusCode
+    void . liftIO . WS.assertMatchN (5 # Second) [wsA, wsB] $ \n -> do
+      let e = List1.head (WS.unpackPayload n)
+      ntfTransient n @?= False
+      evtConv e @?= qconv
+      evtType e @?= MemberStateUpdate
+      evtFrom e @?= qbob
+      evtData e @?= EdMemberUpdate expectedMemberUpdateData
+
+putOtherMemberOk :: TestM ()
+putOtherMemberOk = do
+  c <- view tsCannon
+  alice <- randomUser
+  qbob <- randomQualifiedUser
+  let bob = qUnqualified qbob
+  connectUsers alice (singleton bob)
+  conv <- decodeConvId <$> postConv alice [bob] (Just "gossip") [] Nothing Nothing
+  let qconv = Qualified conv (qDomain qbob)
+      expectedMemberUpdateData =
+        MemberUpdateData
+          { misTarget = Just alice,
+            misOtrMutedStatus = Nothing,
+            misOtrMutedRef = Nothing,
+            misOtrArchived = Nothing,
+            misOtrArchivedRef = Nothing,
+            misHidden = Nothing,
+            misHiddenRef = Nothing,
+            misConvRoleName = Just roleNameWireMember
+          }
+
+  WS.bracketR2 c alice bob $ \(wsA, wsB) -> do
+    -- demote alice
+    putOtherMember bob alice (OtherMemberUpdate (Just roleNameWireMember)) conv
+      !!! const 200 === statusCode
+    void . liftIO . WS.assertMatchN (5 # Second) [wsA, wsB] $ \n -> do
+      let e = List1.head (WS.unpackPayload n)
+      ntfTransient n @?= False
+      evtConv e @?= qconv
+      evtType e @?= MemberStateUpdate
+      evtFrom e @?= qbob
+      evtData e @?= EdMemberUpdate expectedMemberUpdateData
+
 putMemberOtrMuteOk :: TestM ()
 putMemberOtrMuteOk = do
   putMemberOk (memberUpdate {mupOtrMuteStatus = Just 1, mupOtrMuteRef = Just "ref"})

services/galley/test/integration/API/Util.hs

@@ -955,6 +955,29 @@ putMember u m (Qualified c dom) = do
       . zType "access"
       . json m
 
+putOtherMemberQualified ::
+  UserId ->
+  Qualified UserId ->
+  OtherMemberUpdate ->
+  Qualified ConvId ->
+  TestM ResponseLBS
+putOtherMemberQualified from to m c = do
+  g <- view tsGalley
+  put $
+    g
+      . paths
+        [ "conversations",
+          toByteString' (qDomain c),
+          toByteString' (qUnqualified c),
+          "members",
+          toByteString' (qDomain to),
+          toByteString' (qUnqualified to)
+        ]
+      . zUser from
+      . zConn "conn"
+      . zType "access"
+      . json m
+
 putOtherMember :: UserId -> UserId -> OtherMemberUpdate -> ConvId -> TestM ResponseLBS
 putOtherMember from to m c = do
   g <- view tsGalley