[FS-1334] Reset a Remote Subconversation

changelog.d/2-features/delete-remote-subconversation

@@ -0,0 +1 @@
+Support deleting a remote subconversation

changelog.d/6-federation/delete-remote-subconversation

@@ -0,0 +1 @@
+Introduce an endpoint for resetting a remote subconversation

libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs

@@ -128,6 +128,7 @@ type GalleyApi =
            EmptyResponse
     :<|> FedEndpoint "on-typing-indicator-updated" TypingDataUpdateRequest EmptyResponse
     :<|> FedEndpoint "get-sub-conversation" GetSubConversationsRequest GetSubConversationsResponse
+    :<|> FedEndpoint "delete-sub-conversation" DeleteSubConversationRequest DeleteSubConversationResponse
 
 data TypingDataUpdateRequest = TypingDataUpdateRequest
   { tdurTypingStatus :: TypingStatus,
@@ -434,3 +435,19 @@ data GetSubConversationsResponse
   | GetSubConversationsResponseSuccess PublicSubConversation
   deriving stock (Eq, Show, Generic)
   deriving (ToJSON, FromJSON) via (CustomEncoded GetSubConversationsResponse)
+
+data DeleteSubConversationRequest = DeleteSubConversationRequest
+  { dscreqUser :: UserId,
+    dscreqConv :: ConvId,
+    dscreqSubConv :: SubConvId,
+    dscreqGroupId :: GroupId,
+    dscreqEpoch :: Epoch
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving (ToJSON, FromJSON) via (CustomEncoded DeleteSubConversationRequest)
+
+data DeleteSubConversationResponse
+  = DeleteSubConversationResponseError GalleyError
+  | DeleteSubConversationResponseSuccess
+  deriving stock (Eq, Show, Generic)
+  deriving (ToJSON, FromJSON) via (CustomEncoded DeleteSubConversationResponse)

libs/wire-api/src/Wire/API/MLS/Epoch.hs

@@ -19,6 +19,7 @@
 
 module Wire.API.MLS.Epoch where
 
+import qualified Data.Aeson as A
 import Data.Binary
 import Data.Schema
 import Imports
@@ -28,6 +29,7 @@ import Wire.Arbitrary
 newtype Epoch = Epoch {epochNumber :: Word64}
   deriving stock (Eq, Show)
   deriving newtype (Arbitrary, Enum, ToSchema)
+  deriving (A.FromJSON, A.ToJSON) via (Schema Epoch)
 
 instance ParseMLS Epoch where
   parseMLS = Epoch <$> parseMLS

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

@@ -408,6 +408,7 @@ type ConversationAPI =
     :<|> Named
            "delete-subconversation"
            ( Summary "Delete an MLS subconversation"
+               :> MakesFederatedCall 'Galley "delete-sub-conversation"
                :> CanThrow 'ConvAccessDenied
                :> CanThrow 'ConvNotFound
                :> CanThrow 'MLSNotEnabled

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

@@ -59,6 +59,7 @@ import qualified Galley.Effects.FireAndForget as E
 import qualified Galley.Effects.MemberStore as E
 import Galley.Effects.ProposalStore (ProposalStore)
 import Galley.Effects.SubConversationStore
+import Galley.Effects.SubConversationSupply
 import Galley.Options
 import Galley.Types.Conversations.Members
 import Galley.Types.UserList (UserList (UserList))
@@ -122,6 +123,7 @@ federationSitemap =
     :<|> Named @"on-client-removed" (callsFed onClientRemoved)
     :<|> Named @"on-typing-indicator-updated" onTypingIndicatorUpdated
     :<|> Named @"get-sub-conversation" getSubConversationForRemoteUser
+    :<|> Named @"delete-sub-conversation" deleteSubConversationForRemoteUser
 
 onClientRemoved ::
   ( Members
@@ -896,3 +898,31 @@ getSubConversationForRemoteUser domain GetSubConversationsRequest {..} =
       let qusr = Qualified gsreqUser domain
       lconv <- qualifyLocal gsreqConv
       getLocalSubConversation qusr lconv gsreqSubConv
+
+deleteSubConversationForRemoteUser ::
+  Members
+    '[ ConversationStore,
+       Input (Local ()),
+       Input Env,
+       MemberStore,
+       Resource,
+       SubConversationStore,
+       SubConversationSupply
+     ]
+    r =>
+  Domain ->
+  DeleteSubConversationRequest ->
+  Sem r DeleteSubConversationResponse
+deleteSubConversationForRemoteUser domain DeleteSubConversationRequest {..} =
+  fmap
+    ( either
+        F.DeleteSubConversationResponseError
+        (\() -> F.DeleteSubConversationResponseSuccess)
+    )
+    . runError @GalleyError
+    . mapToGalleyError @MLSDeleteSubConvStaticErrors
+    $ do
+      let qusr = Qualified dscreqUser domain
+          dsc = DeleteSubConversation dscreqGroupId dscreqEpoch
+      lconv <- qualifyLocal dscreqConv
+      deleteLocalSubConversation qusr lconv dscreqSubConv dsc

services/galley/src/Galley/API/MLS/SubConversation.hs

@@ -19,9 +19,11 @@ module Galley.API.MLS.SubConversation
   ( getSubConversation,
     getLocalSubConversation,
     deleteSubConversation,
+    deleteLocalSubConversation,
     getSubConversationGroupInfo,
     getSubConversationGroupInfoFromLocalConv,
     MLSGetSubConvStaticErrors,
+    MLSDeleteSubConvStaticErrors,
   )
 where
 
@@ -44,7 +46,6 @@ import qualified Galley.Effects.SubConversationStore as Eff
 import Galley.Effects.SubConversationSupply (SubConversationSupply)
 import qualified Galley.Effects.SubConversationSupply as Eff
 import Imports
-import qualified Network.Wai.Utilities.Error as Wai
 import Polysemy
 import Polysemy.Error
 import Polysemy.Input
@@ -54,7 +55,7 @@ import Wire.API.Conversation.Protocol
 import Wire.API.Error
 import Wire.API.Error.Galley
 import Wire.API.Federation.API
-import Wire.API.Federation.API.Galley (GetSubConversationsRequest (..), GetSubConversationsResponse (..))
+import Wire.API.Federation.API.Galley
 import Wire.API.Federation.Error
 import Wire.API.MLS.PublicGroupState
 import Wire.API.MLS.SubConversation
@@ -208,54 +209,66 @@ getSubConversationGroupInfoFromLocalConv qusr subConvId lcnvId = do
   Eff.getSubConversationPublicGroupState (tUnqualified lcnvId) subConvId
     >>= noteS @'MLSMissingGroupInfo
 
+type MLSDeleteSubConvStaticErrors =
+  '[ ErrorS 'ConvAccessDenied,
+     ErrorS 'ConvNotFound,
+     ErrorS 'MLSNotEnabled,
+     ErrorS 'MLSStaleMessage
+   ]
+
 deleteSubConversation ::
-  Members
-    '[ ConversationStore,
-       ErrorS 'ConvAccessDenied,
-       ErrorS 'ConvNotFound,
-       ErrorS 'MLSNotEnabled,
-       ErrorS 'MLSStaleMessage,
-       Error Wai.Error,
-       Input Env,
-       MemberStore,
-       Resource,
-       SubConversationStore,
-       SubConversationSupply
-     ]
-    r =>
+  ( Members
+      '[ ConversationStore,
+         ErrorS 'ConvAccessDenied,
+         ErrorS 'ConvNotFound,
+         ErrorS 'MLSNotEnabled,
+         ErrorS 'MLSStaleMessage,
+         Error FederationError,
+         FederatorAccess,
+         Input Env,
+         MemberStore,
+         Resource,
+         SubConversationStore,
+         SubConversationSupply
+       ]
+      r,
+    CallsFed 'Galley "delete-sub-conversation"
+  ) =>
   Local UserId ->
   Qualified ConvId ->
   SubConvId ->
   DeleteSubConversation ->
   Sem r ()
-deleteSubConversation lusr qconv sconv dsc = do
-  assertMLSEnabled
+deleteSubConversation lusr qconv sconv dsc =
   foldQualified
     lusr
-    (\lcnv -> deleteLocalSubConversation lusr lcnv sconv dsc)
-    (\_rcnv -> throw federationNotImplemented)
+    (\lcnv -> deleteLocalSubConversation (tUntagged lusr) lcnv sconv dsc)
+    (\rcnv -> deleteRemoteSubConversation lusr rcnv sconv dsc)
     qconv
 
 deleteLocalSubConversation ::
   Members
     '[ ConversationStore,
        ErrorS 'ConvAccessDenied,
        ErrorS 'ConvNotFound,
+       ErrorS 'MLSNotEnabled,
        ErrorS 'MLSStaleMessage,
+       Input Env,
        MemberStore,
        Resource,
        SubConversationStore,
        SubConversationSupply
      ]
     r =>
-  Local UserId ->
+  Qualified UserId ->
   Local ConvId ->
   SubConvId ->
   DeleteSubConversation ->
   Sem r ()
-deleteLocalSubConversation lusr lcnvId scnvId dsc = do
+deleteLocalSubConversation qusr lcnvId scnvId dsc = do
+  assertMLSEnabled
   let cnvId = tUnqualified lcnvId
-  cnv <- getConversationAndCheckMembership (tUntagged lusr) lcnvId
+  cnv <- getConversationAndCheckMembership qusr lcnvId
   cs <- cnvmlsCipherSuite <$> noteS @'ConvNotFound (mlsMetadata cnv)
   withCommitLock (dscGroupId dsc) (dscEpoch dsc) $ do
     sconv <-
@@ -273,3 +286,39 @@ deleteLocalSubConversation lusr lcnvId scnvId dsc = do
 
     -- the following overwrites any prior information about the subconversation
     Eff.createSubConversation cnvId scnvId cs (Epoch 0) newGid Nothing
+
+deleteRemoteSubConversation ::
+  ( Members
+      '[ ErrorS 'ConvAccessDenied,
+         ErrorS 'ConvNotFound,
+         ErrorS 'MLSNotEnabled,
+         ErrorS 'MLSStaleMessage,
+         Error FederationError,
+         FederatorAccess,
+         Input Env
+       ]
+      r,
+    CallsFed 'Galley "delete-sub-conversation"
+  ) =>
+  Local UserId ->
+  Remote ConvId ->
+  SubConvId ->
+  DeleteSubConversation ->
+  Sem r ()
+deleteRemoteSubConversation lusr rcnvId scnvId dsc = do
+  assertMLSEnabled
+  let deleteRequest =
+        DeleteSubConversationRequest
+          { dscreqUser = tUnqualified lusr,
+            dscreqConv = tUnqualified rcnvId,
+            dscreqSubConv = scnvId,
+            dscreqGroupId = dscGroupId dsc,
+            dscreqEpoch = dscEpoch dsc
+          }
+  response <-
+    runFederated
+      rcnvId
+      (fedClient @'Galley @"delete-sub-conversation" deleteRequest)
+  case response of
+    DeleteSubConversationResponseError e -> rethrowErrors @MLSDeleteSubConvStaticErrors e
+    DeleteSubConversationResponseSuccess -> pure ()

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

@@ -50,7 +50,7 @@ conversationAPI =
     <@> mkNamedAPI @"create-self-conversation" createProteusSelfConversation
     <@> mkNamedAPI @"get-mls-self-conversation" getMLSSelfConversationWithError
     <@> mkNamedAPI @"get-subconversation" (callsFed getSubConversation)
-    <@> mkNamedAPI @"delete-subconversation" deleteSubConversation
+    <@> mkNamedAPI @"delete-subconversation" (callsFed deleteSubConversation)
     <@> mkNamedAPI @"get-subconversation-group-info" (callsFed getSubConversationGroupInfo)
     <@> mkNamedAPI @"create-one-to-one-conversation@v2" (callsFed createOne2OneConversation)
     <@> mkNamedAPI @"create-one-to-one-conversation" (callsFed createOne2OneConversation)