[FS-1335] Remove clients from subconversations when user is removed f…

…rom main conversation (#2942)

changelog.d/2-features/reflect-user-removal-from-parent-in-sub

@@ -0,0 +1 @@
+Removing or kicking a user from a conversation also removes the user's clients from any subconversation.

libs/wire-api/src/Wire/API/User/Client.hs

@@ -63,6 +63,9 @@ module Wire.API.User.Client
     longitude,
     Latitude (..),
     Longitude (..),
+
+    -- * List of MLS client ids
+    ClientList (..),
   )
 where
 
@@ -472,6 +475,22 @@ instance ToSchema Client where
 mlsPublicKeysFieldSchema :: ObjectSchema SwaggerDoc MLSPublicKeys
 mlsPublicKeysFieldSchema = fromMaybe mempty <$> optField "mls_public_keys" mlsPublicKeysSchema
 
+--------------------------------------------------------------------------------
+-- ClientList
+
+-- | Client list for internal API.
+data ClientList = ClientList {clClients :: [ClientId]}
+  deriving stock (Eq, Show, Generic)
+  deriving (Arbitrary) via (GenericUniform ClientList)
+  deriving (FromJSON, ToJSON, Swagger.ToSchema) via Schema ClientList
+
+instance ToSchema ClientList where
+  schema =
+    object "ClientList" $
+      ClientList
+        <$> clClients
+          .= field "client_ids" (array schema)
+
 --------------------------------------------------------------------------------
 -- PubClient
 

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

@@ -132,21 +132,36 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con
       r
   HasConversationActionEffects 'ConversationLeaveTag r =
     ( Members
-        '[ MemberStore,
-           Error InternalError,
+        '[ Error InternalError,
            Error NoChanges,
            ExternalAccess,
            FederatorAccess,
            GundeckAccess,
-           Input UTCTime,
            Input Env,
+           Input UTCTime,
+           MemberStore,
            ProposalStore,
+           SubConversationStore,
            TinyLog
          ]
         r
     )
   HasConversationActionEffects 'ConversationRemoveMembersTag r =
-    (Members '[MemberStore, Error NoChanges] r)
+    ( Members
+        '[ MemberStore,
+           SubConversationStore,
+           ProposalStore,
+           Input Env,
+           Input UTCTime,
+           ExternalAccess,
+           FederatorAccess,
+           GundeckAccess,
+           Error InternalError,
+           Error NoChanges,
+           TinyLog
+         ]
+        r
+    )
   HasConversationActionEffects 'ConversationMemberUpdateTag r =
     (Members '[MemberStore, ErrorS 'ConvMemberNotFound] r)
   HasConversationActionEffects 'ConversationDeleteTag r =
@@ -309,6 +324,9 @@ type family PerformActionCalls tag where
   PerformActionCalls 'ConversationLeaveTag =
     ( CallsFed 'Galley "on-mls-message-sent"
     )
+  PerformActionCalls 'ConversationRemoveMembersTag =
+    ( CallsFed 'Galley "on-mls-message-sent"
+    )
   PerformActionCalls 'ConversationDeleteTag =
     ( CallsFed 'Galley "on-delete-mls-conversation"
     )
@@ -334,31 +352,16 @@ performAction tag origUser lconv action = do
       performConversationJoin origUser lconv action
     SConversationLeaveTag -> do
       let victims = [origUser]
-      E.deleteMembers (tUnqualified lcnv) (toUserList lconv victims)
-      -- update in-memory view of the conversation
-      let lconv' =
-            lconv <&> \c ->
-              foldQualified
-                lconv
-                ( \lu ->
-                    c
-                      { convLocalMembers =
-                          filter (\lm -> lmId lm /= tUnqualified lu) (convLocalMembers c)
-                      }
-                )
-                ( \ru ->
-                    c
-                      { convRemoteMembers =
-                          filter (\rm -> rmId rm /= ru) (convRemoteMembers c)
-                      }
-                )
-                origUser
+      lconv' <- traverse (convDeleteMembers (toUserList lconv victims)) lconv
+      -- send remove proposals in the MLS case
       traverse_ (removeUser lconv') victims
       pure (mempty, action)
     SConversationRemoveMembersTag -> do
       let presentVictims = filter (isConvMemberL lconv) (toList action)
       when (null presentVictims) noChanges
-      E.deleteMembers (tUnqualified lcnv) (toUserList lconv presentVictims)
+      traverse_ (convDeleteMembers (toUserList lconv presentVictims)) lconv
+      -- send remove proposals in the MLS case
+      traverse_ (removeUser lconv) presentVictims
       pure (mempty, action) -- FUTUREWORK: should we return the filtered action here?
     SConversationMemberUpdateTag -> do
       void $ ensureOtherMember lconv (cmuTarget action) conv
@@ -487,8 +490,8 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do
         '[ ConversationStore,
            Error InternalError,
            ErrorS ('ActionDenied 'LeaveConversation),
-           ErrorS 'InvalidOperation,
            ErrorS 'ConvNotFound,
+           ErrorS 'InvalidOperation,
            ErrorS 'MissingLegalholdConsent,
            ExternalAccess,
            FederatorAccess,

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

@@ -104,7 +104,8 @@ rmClientH ::
          MemberStore,
          Error InternalError,
          ProposalStore,
-         P.TinyLog
+         P.TinyLog,
+         SubConversationStore
        ]
       r,
     CallsFed 'Galley "on-client-removed",

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

@@ -145,6 +145,7 @@ onClientRemoved ::
          Input UTCTime,
          MemberStore,
          ProposalStore,
+         SubConversationStore,
          TinyLog
        ]
       r,

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

@@ -28,6 +28,7 @@ import Control.Exception.Safe (catchAny)
 import Control.Lens hiding (Getter, Setter, (.=))
 import Data.Id as Id
 import Data.List1 (maybeList1)
+import qualified Data.Map as Map
 import Data.Qualified
 import Data.Range
 import Data.Singletons
@@ -60,6 +61,7 @@ import Galley.Effects.FederatorAccess
 import Galley.Effects.GundeckAccess
 import Galley.Effects.LegalHoldStore as LegalHoldStore
 import Galley.Effects.MemberStore
+import qualified Galley.Effects.MemberStore as E
 import Galley.Effects.TeamStore
 import qualified Galley.Intra.Push as Intra
 import Galley.Monad
@@ -86,7 +88,7 @@ import qualified Servant hiding (WithStatus)
 import System.Logger.Class hiding (Path, name)
 import qualified System.Logger.Class as Log
 import Wire.API.ApplyMods
-import Wire.API.Conversation hiding (Member)
+import Wire.API.Conversation
 import Wire.API.Conversation.Action
 import Wire.API.Conversation.Role
 import Wire.API.CustomBackend
@@ -96,6 +98,7 @@ import Wire.API.Event.Conversation
 import Wire.API.Federation.API
 import Wire.API.Federation.API.Galley
 import Wire.API.Federation.Error
+import Wire.API.MLS.Group
 import Wire.API.Provider.Service hiding (Service)
 import Wire.API.Routes.API
 import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti
@@ -109,6 +112,7 @@ import Wire.API.Team
 import Wire.API.Team.Feature
 import Wire.API.Team.Member
 import Wire.API.Team.SearchVisibility
+import Wire.API.User.Client
 import Wire.Sem.Paging
 import Wire.Sem.Paging.Cassandra
 
@@ -271,6 +275,19 @@ type InternalAPIBase =
                :> ReqBody '[Servant.JSON] Connect
                :> ConversationVerb
            )
+    -- This endpoint is meant for testing membership of a conversation
+    :<|> Named
+           "get-conversation-clients"
+           ( Summary "Get mls conversation client list"
+               :> ZLocalUser
+               :> CanThrow 'ConvNotFound
+               :> "conversation"
+               :> Capture "cnv" ConvId
+               :> MultiVerb1
+                    'GET
+                    '[Servant.JSON]
+                    (Respond 200 "Clients" ClientList)
+           )
     :<|> Named
            "guard-legalhold-policy-conflicts"
            ( "guard-legalhold-policy-conflicts"
@@ -479,6 +496,7 @@ internalAPI =
     mkNamedAPI @"status" (pure ())
       <@> mkNamedAPI @"delete-user" (callsFed rmUser)
       <@> mkNamedAPI @"connect" (callsFed Create.createConnectConversation)
+      <@> mkNamedAPI @"get-conversation-clients" iGetMLSClientListForConv
       <@> mkNamedAPI @"guard-legalhold-policy-conflicts" guardLegalholdPolicyConflictsH
       <@> legalholdWhitelistedTeamsAPI
       <@> iTeamsAPI
@@ -688,6 +706,7 @@ rmUser ::
          MemberStore,
          ProposalStore,
          P.TinyLog,
+         SubConversationStore,
          TeamStore
        ]
       r,
@@ -842,3 +861,18 @@ guardLegalholdPolicyConflictsH ::
 guardLegalholdPolicyConflictsH glh = do
   mapError @LegalholdConflicts (const $ Tagged @'MissingLegalholdConsent ()) $
     guardLegalholdPolicyConflicts (glhProtectee glh) (glhUserClients glh)
+
+-- | Get an MLS conversation client list
+iGetMLSClientListForConv ::
+  forall r.
+  Members
+    '[ MemberStore,
+       ErrorS 'ConvNotFound
+     ]
+    r =>
+  Local UserId ->
+  ConvId ->
+  Sem r ClientList
+iGetMLSClientListForConv lusr cnv = do
+  cm <- E.lookupMLSClients (convToGroupId (qualifyAs lusr cnv))
+  pure $ ClientList (concatMap (Map.keys . snd) (Map.assocs cm))