Add federated endpoints to get subconversations (#2952)

* Add get-sub-conversation endpoint type * Refactor: Generalize getConversationAndCheckMembership * Add federation and generalize client endpoint * Int. test: local member, remote subconversation * Fix bug: conversation qualified wrong * Add tests for federation endpoint * Move test stub into correct group * Add changelog entry * Remove unused constraints Co-authored-by: Marko Dimjašević <[email protected]>
wireapp · Dec 27, 2022 · afa0fbf · afa0fbf
1 parent 28c03de
commit afa0fbf
Show file tree

Hide file tree

Showing 8 changed files with 232 additions and 36 deletions.
diff --git a/changelog.d/2-features/pr-2952 b/changelog.d/2-features/pr-2952
@@ -0,0 +1 @@
+Add federated endpoints to get subconversations
diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs
@@ -75,6 +75,7 @@ type GalleyApi =
     :<|> FedEndpoint "query-group-info" GetGroupInfoRequest GetGroupInfoResponse
     :<|> FedEndpoint "on-client-removed" ClientRemovedRequest EmptyResponse
     :<|> FedEndpoint "on-typing-indicator-updated" TypingDataUpdateRequest EmptyResponse
+    :<|> FedEndpoint "get-sub-conversation" GetSubConversationsRequest GetSubConversationsResponse
 
 data TypingDataUpdateRequest = TypingDataUpdateRequest
   { tdurTypingStatus :: TypingStatus,
@@ -367,3 +368,17 @@ data GetGroupInfoResponse
   | GetGroupInfoResponseState Base64ByteString
   deriving stock (Eq, Show, Generic)
   deriving (ToJSON, FromJSON) via (CustomEncoded GetGroupInfoResponse)
+
+data GetSubConversationsRequest = GetSubConversationsRequest
+  { gsreqUser :: UserId,
+    gsreqConv :: ConvId,
+    gsreqSubConv :: SubConvId
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving (ToJSON, FromJSON) via (CustomEncoded GetSubConversationsRequest)
+
+data GetSubConversationsResponse
+  = GetSubConversationsResponseError GalleyError
+  | GetSubConversationsResponseSuccess PublicSubConversation
+  deriving stock (Eq, Show, Generic)
+  deriving (ToJSON, FromJSON) via (CustomEncoded GetSubConversationsResponse)
diff --git a/libs/wire-api/src/Wire/API/MLS/SubConversation.hs b/libs/wire-api/src/Wire/API/MLS/SubConversation.hs
@@ -46,7 +46,7 @@ import Wire.Arbitrary
 -- conversation. The pair of a qualified conversation ID and a subconversation
 -- ID identifies globally.
 newtype SubConvId = SubConvId {unSubConvId :: Text}
-  deriving newtype (Eq, ToSchema, Ord, S.ToParamSchema, ToByteString)
+  deriving newtype (Eq, ToSchema, Ord, S.ToParamSchema, ToByteString, ToJSON, FromJSON)
   deriving stock (Generic)
   deriving (Arbitrary) via (GenericUniform SubConvId)
   deriving stock (Show)

diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs
@@ -120,6 +120,7 @@ federationSitemap =
     :<|> Named @"query-group-info" queryGroupInfo
     :<|> Named @"on-client-removed" onClientRemoved
     :<|> Named @"on-typing-indicator-updated" onTypingIndicatorUpdated
+    :<|> Named @"get-sub-conversation" getSubConversationForRemoteUser
 
 onClientRemoved ::
   ( Members
@@ -847,3 +848,24 @@ onTypingIndicatorUpdated origDomain TypingDataUpdateRequest {..} = do
     runError @(Tagged 'ConvNotFound ()) $
       isTyping qusr Nothing lcnv tdurTypingStatus
   pure EmptyResponse
+
+getSubConversationForRemoteUser ::
+  Members
+    '[ SubConversationStore,
+       ConversationStore,
+       Input (Local ()),
+       Error InternalError,
+       P.TinyLog
+     ]
+    r =>
+  Domain ->
+  GetSubConversationsRequest ->
+  Sem r GetSubConversationsResponse
+getSubConversationForRemoteUser domain GetSubConversationsRequest {..} =
+  fmap (either F.GetSubConversationsResponseError F.GetSubConversationsResponseSuccess)
+    . runError @GalleyError
+    . mapToGalleyError @MLSGetSubConvStaticErrors
+    $ do
+      let qusr = Qualified gsreqUser domain
+      lconv <- qualifyLocal gsreqConv
+      getLocalSubConversation qusr lconv gsreqSubConv
diff --git a/services/galley/src/Galley/API/MLS/SubConversation.hs b/services/galley/src/Galley/API/MLS/SubConversation.hs
@@ -19,7 +19,6 @@ module Galley.API.MLS.SubConversation where
 
 import Data.Id
 import Data.Qualified
-import Galley.API.Error
 import Galley.API.MLS
 import Galley.API.MLS.GroupInfo
 import Galley.API.MLS.Types
@@ -29,32 +28,38 @@ import Galley.App (Env)
 import qualified Galley.Data.Conversation as Data
 import Galley.Data.Conversation.Types
 import Galley.Effects
+import Galley.Effects.FederatorAccess
 import Galley.Effects.SubConversationStore
 import qualified Galley.Effects.SubConversationStore as Eff
 import Imports
-import qualified Network.Wai.Utilities.Error as Wai
 import Polysemy
 import Polysemy.Error
 import Polysemy.Input
-import qualified Polysemy.TinyLog as P
 import Wire.API.Conversation
 import Wire.API.Conversation.Protocol
 import Wire.API.Error
 import Wire.API.Error.Galley
-import Wire.API.Federation.Error (FederationError, federationNotImplemented)
+import Wire.API.Federation.API (Component (Galley), fedClient)
+import Wire.API.Federation.API.Galley (GetSubConversationsRequest (..), GetSubConversationsResponse (..))
+import Wire.API.Federation.Error (FederationError)
 import Wire.API.MLS.PublicGroupState
 import Wire.API.MLS.SubConversation
 
+type MLSGetSubConvStaticErrors =
+  '[ ErrorS 'ConvNotFound,
+     ErrorS 'ConvAccessDenied,
+     ErrorS 'MLSSubConvUnsupportedConvType
+   ]
+
 getSubConversation ::
   Members
     '[ SubConversationStore,
        ConversationStore,
        ErrorS 'ConvNotFound,
        ErrorS 'ConvAccessDenied,
        ErrorS 'MLSSubConvUnsupportedConvType,
-       Error InternalError,
-       Error Wai.Error,
-       P.TinyLog
+       Error FederationError,
+       FederatorAccess
      ]
     r =>
   Local UserId ->
@@ -64,8 +69,8 @@ getSubConversation ::
 getSubConversation lusr qconv sconv = do
   foldQualified
     lusr
-    (\lcnv -> getLocalSubConversation lusr lcnv sconv)
-    (\_rcnv -> throw federationNotImplemented)
+    (\lcnv -> getLocalSubConversation (tUntagged lusr) lcnv sconv)
+    (\rcnv -> getRemoteSubConversation lusr rcnv sconv)
     qconv
 
 getLocalSubConversation ::
@@ -74,17 +79,15 @@ getLocalSubConversation ::
        ConversationStore,
        ErrorS 'ConvNotFound,
        ErrorS 'ConvAccessDenied,
-       ErrorS 'MLSSubConvUnsupportedConvType,
-       Error InternalError,
-       P.TinyLog
+       ErrorS 'MLSSubConvUnsupportedConvType
      ]
     r =>
-  Local UserId ->
+  Qualified UserId ->
   Local ConvId ->
   SubConvId ->
   Sem r PublicSubConversation
-getLocalSubConversation lusr lconv sconv = do
-  c <- getConversationAndCheckMembership (tUnqualified lusr) lconv
+getLocalSubConversation qusr lconv sconv = do
+  c <- getConversationAndCheckMembership qusr lconv
 
   unless (Data.convType c == RegularConv) $
     throwS @'MLSSubConvUnsupportedConvType
@@ -114,7 +117,37 @@ getLocalSubConversation lusr lconv sconv = do
               }
       pure sub
     Just sub -> pure sub
-  pure (toPublicSubConv (tUntagged (qualifyAs lusr sub)))
+  pure (toPublicSubConv (tUntagged (qualifyAs lconv sub)))
+
+getRemoteSubConversation ::
+  forall r.
+  ( Members
+      '[ ErrorS 'ConvNotFound,
+         ErrorS 'ConvAccessDenied,
+         ErrorS 'MLSSubConvUnsupportedConvType,
+         FederatorAccess
+       ]
+      r,
+    Members MLSGetSubConvStaticErrors r,
+    RethrowErrors MLSGetSubConvStaticErrors r
+  ) =>
+  Local UserId ->
+  Remote ConvId ->
+  SubConvId ->
+  Sem r PublicSubConversation
+getRemoteSubConversation lusr rcnv sconv = do
+  res <- runFederated rcnv $ do
+    fedClient @'Galley @"get-sub-conversation" $
+      GetSubConversationsRequest
+        { gsreqUser = tUnqualified lusr,
+          gsreqConv = tUnqualified rcnv,
+          gsreqSubConv = sconv
+        }
+  case res of
+    GetSubConversationsResponseError err ->
+      rethrowErrors @MLSGetSubConvStaticErrors @r err
+    GetSubConversationsResponseSuccess subconv ->
+      pure subconv
 
 getSubConversationGroupInfo ::
   Members

diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs
@@ -136,7 +136,7 @@ getUnqualifiedConversation ::
   ConvId ->
   Sem r Public.Conversation
 getUnqualifiedConversation lusr cnv = do
-  c <- getConversationAndCheckMembership (tUnqualified lusr) (qualifyAs lusr cnv)
+  c <- getConversationAndCheckMembership (tUntagged lusr) (qualifyAs lusr cnv)
   Mapping.conversationView lusr c
 
 getConversation ::
@@ -272,7 +272,7 @@ getConversationRoles ::
   ConvId ->
   Sem r Public.ConversationRolesList
 getConversationRoles lusr cnv = do
-  void $ getConversationAndCheckMembership (tUnqualified lusr) (qualifyAs lusr cnv)
+  void $ getConversationAndCheckMembership (tUntagged lusr) (qualifyAs lusr cnv)
   -- NOTE: If/when custom roles are added, these roles should
   --       be merged with the team roles (if they exist)
   pure $ Public.ConversationRolesList wireConvRoles

diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs
@@ -502,16 +502,29 @@ getMember p u = noteS @e . find ((u ==) . p)
 
 getConversationAndCheckMembership ::
   Members '[ConversationStore, ErrorS 'ConvNotFound, ErrorS 'ConvAccessDenied] r =>
-  UserId ->
+  Qualified UserId ->
   Local ConvId ->
   Sem r Data.Conversation
-getConversationAndCheckMembership uid lcnv = do
-  (conv, _) <-
-    getConversationAndMemberWithError
-      @'ConvAccessDenied
-      uid
-      lcnv
-  pure conv
+getConversationAndCheckMembership quid lcnv = do
+  foldQualified
+    lcnv
+    ( \lusr -> do
+        (conv, _) <-
+          getConversationAndMemberWithError
+            @'ConvAccessDenied
+            (tUnqualified lusr)
+            lcnv
+        pure conv
+    )
+    ( \rusr -> do
+        (conv, _) <-
+          getConversationAndMemberWithError
+            @'ConvNotFound
+            rusr
+            lcnv
+        pure conv
+    )
+    quid
 
 getConversationWithError ::
   ( Member ConversationStore r,

diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs
@@ -61,6 +61,7 @@ import Wire.API.Conversation.Role
 import Wire.API.Error.Galley
 import Wire.API.Federation.API.Common
 import Wire.API.Federation.API.Galley
+import Wire.API.MLS.CipherSuite
 import Wire.API.MLS.Credential
 import Wire.API.MLS.Keys
 import Wire.API.MLS.Serialisation
@@ -207,15 +208,28 @@ tests s =
         ],
       testGroup
         "SubConversation"
-        [ test s "get subconversation of MLS conv - 200" (testCreateSubConv True),
-          test s "get subconversation of Proteus conv - 404" (testCreateSubConv False),
-          test s "join subconversation with an external commit bundle" testJoinSubConv,
-          test s "join subconversation with a client that is not in the main conv" testJoinSubNonMemberClient,
-          test s "add another client to a subconversation" testAddClientSubConv,
-          test s "remove another client from a subconversation" testRemoveClientSubConv,
-          test s "join remote subconversation" testJoinRemoteSubConv,
-          test s "client of a remote user joins subconversation" testRemoteUserJoinSubConv,
-          test s "send an application message in a subconversation" testSendMessageSubConv
+        [ testGroup
+            "Local Sender/Local Subconversation"
+            [ test s "get subconversation of MLS conv - 200" (testCreateSubConv True),
+              test s "get subconversation of Proteus conv - 404" (testCreateSubConv False),
+              test s "join subconversation with an external commit bundle" testJoinSubConv,
+              test s "join subconversation with a client that is not in the main conv" testJoinSubNonMemberClient,
+              test s "add another client to a subconversation" testAddClientSubConv,
+              test s "remove another client from a subconversation" testRemoveClientSubConv,
+              test s "send an application message in a subconversation" testSendMessageSubConv
+            ],
+          testGroup
+            "Local Sender/Remote Subconversation"
+            [ test s "get subconversation of remote conversation - member" (testGetRemoteSubConv True),
+              test s "get subconversation of remote conversation - not member" (testGetRemoteSubConv False),
+              test s "join remote subconversation" testJoinRemoteSubConv
+            ],
+          testGroup
+            "Remote Sender/Local SubConversation"
+            [ test s "get subconversation as a remote member" (testRemoteMemberGetSubConv True),
+              test s "get subconversation as a remote non-member" (testRemoteMemberGetSubConv False),
+              test s "client of a remote user joins subconversation" testRemoteUserJoinSubConv
+            ]
         ]
     ]
 
@@ -2383,3 +2397,101 @@ testSendMessageSubConv = do
         liftIO $
           WS.assertMatchN_ (5 # WS.Second) wss $ \n -> do
             wsAssertMLSMessage qcs alice (mpMessage message) n
+
+testGetRemoteSubConv :: Bool -> TestM ()
+testGetRemoteSubConv isAMember = do
+  alice <- randomQualifiedUser
+  let remoteDomain = Domain "faraway.example.com"
+  conv <- randomId
+  let qconv = Qualified conv remoteDomain
+      sconv = SubConvId "conference"
+      fakeSubConv =
+        PublicSubConversation
+          { pscParentConvId = qconv,
+            pscSubConvId = sconv,
+            pscGroupId = GroupId "deadbeef",
+            pscEpoch = Epoch 0,
+            pscCipherSuite = MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519,
+            pscMembers = []
+          }
+
+  let mock req = case frRPC req of
+        "get-sub-conversation" ->
+          pure $
+            if isAMember
+              then Aeson.encode (GetSubConversationsResponseSuccess fakeSubConv)
+              else Aeson.encode (GetSubConversationsResponseError ConvNotFound)
+        rpc -> assertFailure $ "unmocked RPC called: " <> T.unpack rpc
+
+  (_, reqs) <-
+    withTempMockFederator' mock $
+      getSubConv (qUnqualified alice) qconv sconv
+        <!! const (if isAMember then 200 else 404) === statusCode
+  fedSubConv <- assertOne (filter ((== "get-sub-conversation") . frRPC) reqs)
+  let req :: Maybe GetSubConversationsRequest = Aeson.decode (frBody fedSubConv)
+  liftIO $
+    req
+      @?= Just (GetSubConversationsRequest (qUnqualified alice) conv sconv)
+
+testRemoteMemberGetSubConv :: Bool -> TestM ()
+testRemoteMemberGetSubConv isAMember = do
+  -- alice is local, bob is remote
+  -- alice creates a local conversation and invites bob
+  -- bob gets a subconversation via federated enpdoint
+
+  let bobDomain = Domain "faraway.example.com"
+  [alice, bob] <- createAndConnectUsers [Nothing, Just (domainText bobDomain)]
+
+  runMLSTest $ do
+    [alice1, bob1] <- traverse createMLSClient [alice, bob]
+
+    (_groupId, qcnv) <- setupMLSGroup alice1
+    kpb <- claimKeyPackages alice1 bob
+    mp <- createAddCommit alice1 [bob]
+
+    let mockedResponse fedReq =
+          case frRPC fedReq of
+            "mls-welcome" -> pure (Aeson.encode MLSWelcomeSent)
+            "on-new-remote-conversation" -> pure (Aeson.encode EmptyResponse)
+            "on-conversation-updated" -> pure (Aeson.encode ())
+            "get-mls-clients" ->
+              pure
+                . Aeson.encode
+                . Set.singleton
+                $ ClientInfo (ciClient bob1) True
+            "claim-key-packages" -> pure . Aeson.encode $ kpb
+            ms -> assertFailure ("unmocked endpoint called: " <> cs ms)
+
+    void . withTempMockFederator' mockedResponse $
+      sendAndConsumeCommit mp
+
+    let subconv = SubConvId "conference"
+
+    randUser <- randomId
+    let gscr =
+          GetSubConversationsRequest
+            { gsreqUser = if isAMember then qUnqualified bob else randUser,
+              gsreqConv = qUnqualified qcnv,
+              gsreqSubConv = subconv
+            }
+
+    fedGalleyClient <- view tsFedGalleyClient
+    res <- runFedClient @"get-sub-conversation" fedGalleyClient bobDomain gscr
+
+    liftTest $ do
+      if isAMember
+        then do
+          sub <- expectSubConvSuccess res
+          liftIO $ do
+            pscParentConvId sub @?= qcnv
+            pscSubConvId sub @?= subconv
+        else do
+          expectSubConvError ConvNotFound res
+  where
+    expectSubConvSuccess :: GetSubConversationsResponse -> TestM PublicSubConversation
+    expectSubConvSuccess (GetSubConversationsResponseSuccess fakeSubConv) = pure fakeSubConv
+    expectSubConvSuccess (GetSubConversationsResponseError err) = liftIO $ assertFailure ("Unexpected GetSubConversationsResponseError: " <> show err)
+
+    expectSubConvError :: GalleyError -> GetSubConversationsResponse -> TestM ()
+    expectSubConvError _errExpected (GetSubConversationsResponseSuccess _) = liftIO $ assertFailure "Unexpected GetSubConversationsResponseSuccess"
+    expectSubConvError errExpected (GetSubConversationsResponseError err) = liftIO $ err @?= errExpected
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1 @@
		Add federated endpoints to get subconversations