From afa0fbf4651a2f8011a825b039bae33c80308a4f Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Tue, 27 Dec 2022 17:11:47 +0100 Subject: [PATCH] Add federated endpoints to get subconversations (#2952) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * 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ć --- changelog.d/2-features/pr-2952 | 1 + .../src/Wire/API/Federation/API/Galley.hs | 15 ++ .../src/Wire/API/MLS/SubConversation.hs | 2 +- services/galley/src/Galley/API/Federation.hs | 22 +++ .../src/Galley/API/MLS/SubConversation.hs | 65 ++++++--- services/galley/src/Galley/API/Query.hs | 4 +- services/galley/src/Galley/API/Util.hs | 29 ++-- services/galley/test/integration/API/MLS.hs | 130 ++++++++++++++++-- 8 files changed, 232 insertions(+), 36 deletions(-) create mode 100644 changelog.d/2-features/pr-2952 diff --git a/changelog.d/2-features/pr-2952 b/changelog.d/2-features/pr-2952 new file mode 100644 index 00000000000..0bfe30efe71 --- /dev/null +++ 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 index 2166f915c5a..9ef47081b3b 100644 --- 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 index 10e79f727b7..09a77b89a13 100644 --- 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 index e18f660c444..20ab7e727be 100644 --- 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 index dfc0234b55b..d9cf14acc04 100644 --- 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,22 +28,29 @@ 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, @@ -52,9 +58,8 @@ getSubConversation :: 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 index 99fdf91f88e..4e93d5839d7 100644 --- 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 index 305226946cc..3e99373a74b 100644 --- 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 index b8758cc984f..7aaf921179c 100644 --- 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 + 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