From 7be43994e6de9f9ccf42034da325becec34cd21a Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Tue, 27 Apr 2021 15:52:44 +0200 Subject: [PATCH 1/8] add Galley/Federation/Client.hs and dependencies --- .../src/Wire/API/Federation/Client.hs | 6 +++ services/brig/src/Brig/API/Client.hs | 1 + services/brig/src/Brig/API/Error.hs | 2 +- services/brig/src/Brig/API/Types.hs | 8 +-- services/brig/src/Brig/API/User.hs | 1 + services/brig/src/Brig/Federation/Client.hs | 3 +- services/galley/galley.cabal | 10 +++- services/galley/package.yaml | 2 + services/galley/src/Galley/API/Util.hs | 2 +- services/galley/src/Galley/App.hs | 4 +- .../galley/src/Galley/Federation/Client.hs | 53 +++++++++++++++++++ 11 files changed, 79 insertions(+), 13 deletions(-) create mode 100644 services/galley/src/Galley/Federation/Client.hs diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Client.hs b/libs/wire-api-federation/src/Wire/API/Federation/Client.hs index fe19b9b5785..6d96fb69f51 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Client.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Client.hs @@ -79,6 +79,12 @@ instance (Monad m, MonadError FederationClientError m) => MonadError FederationC throwError = FederatorClient . throwError catchError (FederatorClient action) f = FederatorClient $ catchError action (runFederatorClient . f) +data FederationError + = FederationUnavailable Text + | FederationNotImplemented + | FederationNotConfigured + | FederationCallFailure FederationClientError + data FederationClientError = FederationClientInvalidMethod HTTP.Method | FederationClientStreamingUnsupported diff --git a/services/brig/src/Brig/API/Client.hs b/services/brig/src/Brig/API/Client.hs index 895e8d802ed..9cb05778beb 100644 --- a/services/brig/src/Brig/API/Client.hs +++ b/services/brig/src/Brig/API/Client.hs @@ -69,6 +69,7 @@ import Network.Wai.Utilities import System.Logger.Class (field, msg, val, (~~)) import qualified System.Logger.Class as Log import UnliftIO.Async (Concurrently (Concurrently, runConcurrently)) +import Wire.API.Federation.Client (FederationError (..)) import qualified Wire.API.Message as Message import Wire.API.User.Client (QualifiedUserClientMap (..), QualifiedUserClients (..)) import Wire.API.UserMap (QualifiedUserMap (QualifiedUserMap)) diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index 1e2def23efa..990ba8d726f 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -37,7 +37,7 @@ import Network.HTTP.Types.Status import qualified Network.HTTP.Types.Status as HTTP import qualified Network.Wai.Utilities.Error as Wai import qualified Servant.Client as Servant -import Wire.API.Federation.Client (FederationClientError (..)) +import Wire.API.Federation.Client (FederationClientError (..), FederationError (..)) import qualified Wire.API.Federation.GRPC.Types as Proto data Error where diff --git a/services/brig/src/Brig/API/Types.hs b/services/brig/src/Brig/API/Types.hs index 68f3b60ad5f..0af41cbdc6d 100644 --- a/services/brig/src/Brig/API/Types.hs +++ b/services/brig/src/Brig/API/Types.hs @@ -43,7 +43,7 @@ import Brig.User.Auth.Cookie (RetryAfter (..)) import Data.Id import Imports import qualified Network.Wai.Utilities.Error as Wai -import Wire.API.Federation.Client (FederationClientError) +import Wire.API.Federation.Client (FederationClientError, FederationError) ------------------------------------------------------------------------------- -- Successes @@ -185,12 +185,6 @@ data SendLoginCodeError = SendLoginInvalidPhone Phone | SendLoginPasswordExists -data FederationError - = FederationUnavailable Text - | FederationNotImplemented - | FederationNotConfigured - | FederationCallFailure FederationClientError - data ClientError = ClientNotFound | ClientDataError !ClientDataError diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 541a66aad7c..2a940125b70 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -151,6 +151,7 @@ import Imports import Network.Wai.Utilities import qualified System.Logger.Class as Log import System.Logger.Message +import Wire.API.Federation.Client (FederationError (..)) data AllowSCIMUpdates = AllowSCIMUpdates diff --git a/services/brig/src/Brig/Federation/Client.hs b/services/brig/src/Brig/Federation/Client.hs index ff8301209b9..dd421be722c 100644 --- a/services/brig/src/Brig/Federation/Client.hs +++ b/services/brig/src/Brig/Federation/Client.hs @@ -20,7 +20,6 @@ module Brig.Federation.Client where -import Brig.API.Types (FederationError (..)) import Brig.App (AppIO, federator, viewFederationDomain) import Brig.Types (Prekey, PrekeyBundle) import qualified Brig.Types.Search as Public @@ -39,7 +38,7 @@ import Mu.GRpc.Client.TyApps import qualified System.Logger.Class as Log import Util.Options (epHost, epPort) import Wire.API.Federation.API.Brig as FederatedBrig -import Wire.API.Federation.Client (FederationClientError, FederatorClient, runFederatorClientWith) +import Wire.API.Federation.Client (FederationClientError, FederationError (..), FederatorClient, runFederatorClientWith) import Wire.API.Federation.GRPC.Client import Wire.API.Message (UserClientMap, UserClients) import Wire.API.User.Client.Prekey (ClientPrekey) diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 01ce26d50b1..d9a475dd6b0 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 8c007b9ab879e8b7a10f8066385a1dd36f86037c33233a58a441c680ac3831e7 +-- hash: ebe33c033b7a06a7e58be32fdadbad8a7441a3e5619b2d517bfe15acb3f84aaf name: galley version: 0.83.0 @@ -55,6 +55,7 @@ library Galley.Data.Types Galley.External Galley.External.LegalHoldService + Galley.Federation.Client Galley.Intra.Client Galley.Intra.Journal Galley.Intra.Push @@ -105,6 +106,7 @@ library , http-client-openssl >=0.2 , http-client-tls >=0.2.2 , http-types >=0.8 + , http2-client-grpc , imports , insert-ordered-containers , lens >=4.4 @@ -148,6 +150,7 @@ library , wai-utilities >=0.16 , warp >=3.0 , wire-api + , wire-api-federation default-language: Haskell2010 executable galley @@ -168,6 +171,7 @@ executable galley , ssl-util , types-common , wire-api + , wire-api-federation if flag(static) ld-options: -static default-language: Haskell2010 @@ -263,6 +267,7 @@ executable galley-integration , warp , warp-tls >=3.2 , wire-api + , wire-api-federation , yaml default-language: Haskell2010 @@ -297,6 +302,7 @@ executable galley-migrate-data , types-common , unliftio , wire-api + , wire-api-federation if flag(static) ld-options: -static default-language: Haskell2010 @@ -349,6 +355,7 @@ executable galley-schema , text , tinylog , wire-api + , wire-api-federation if flag(static) ld-options: -static default-language: Haskell2010 @@ -384,4 +391,5 @@ test-suite galley-types-tests , wai , wai-predicates , wire-api + , wire-api-federation default-language: Haskell2010 diff --git a/services/galley/package.yaml b/services/galley/package.yaml index ab3fe32c641..893beffe169 100644 --- a/services/galley/package.yaml +++ b/services/galley/package.yaml @@ -16,6 +16,7 @@ dependencies: - ssl-util - raw-strings-qq >=1.0 - wire-api +- wire-api-federation library: source-dirs: src @@ -48,6 +49,7 @@ library: - http-client-openssl >=0.2 - http-client-tls >=0.2.2 - http-types >=0.8 + - http2-client-grpc - insert-ordered-containers - lens >=4.4 - metrics-wai >=0.4 diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 6a63d41b20e..6a61f0cfab2 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -305,5 +305,5 @@ canDeleteMember deleter deletee -------------------------------------------------------------------------------- -- Federation -viewFederationDomain :: Galley Domain +viewFederationDomain :: MonadReader Env m => m Domain viewFederationDomain = view (options . optSettings . setFederationDomain) diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index 43bd9784230..c01e870b076 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -26,6 +26,7 @@ module Galley.App options, applog, manager, + federator, cstate, deleteQueue, createEnv, @@ -99,6 +100,7 @@ data Env = Env _options :: Opts, _applog :: Logger, _manager :: Manager, + _federator :: Maybe Endpoint, -- FUTUREWORK: should we use a better type here? E.g. to avoid fresh connections all the time? _cstate :: ClientState, _deleteQueue :: Q.Queue DeleteItem, _extEnv :: ExtEnv, @@ -186,7 +188,7 @@ createEnv m o = do l <- Logger.mkLogger (o ^. optLogLevel) (o ^. optLogNetStrings) (o ^. optLogFormat) mgr <- initHttpManager o validateOptions l o - Env def m o l mgr <$> initCassandra o l + Env def m o l mgr (o ^. optFederator) <$> initCassandra o l <*> Q.new 16000 <*> initExtEnv <*> maybe (return Nothing) (fmap Just . Aws.mkEnv l mgr) (o ^. optJournal) diff --git a/services/galley/src/Galley/Federation/Client.hs b/services/galley/src/Galley/Federation/Client.hs new file mode 100644 index 00000000000..1ae3e083ae8 --- /dev/null +++ b/services/galley/src/Galley/Federation/Client.hs @@ -0,0 +1,53 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2020 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . +module Galley.Federation.Client where + +import Control.Error (throwE) +import Control.Error.Util ((!?)) +import Control.Lens (view, (^.)) +import Control.Monad.Except (ExceptT, runExceptT) +import Data.Domain +import qualified Data.Text as T +import Galley.API.Util (viewFederationDomain) +import Galley.App (Galley, federator) +import Imports +import Network.GRPC.Client.Helpers (GrpcClient, grpcClientConfigSimple) +import Util.Options (epHost, epPort) +import Wire.API.Federation.Client (FederationClientError, FederationError (..), FederatorClient, runFederatorClientWith) +import Wire.API.Federation.GRPC.Client + +type FederationAppIO = ExceptT FederationError Galley + +-- FUTUREWORK: It would be nice to share the client across all calls to +-- federator and not call this function on every invocation of federated +-- requests, but there are some issues in http2-client which might need some +-- fixing first. More context here: +-- https://github.com/lucasdicioccio/http2-client/issues/37 +-- https://github.com/lucasdicioccio/http2-client/issues/49 +mkFederatorClient :: FederationAppIO GrpcClient +mkFederatorClient = do + federatorEndpoint <- view federator !? FederationNotConfigured + let cfg = grpcClientConfigSimple (T.unpack (federatorEndpoint ^. epHost)) (fromIntegral (federatorEndpoint ^. epPort)) False + createGrpcClient cfg + >>= either (throwE . FederationUnavailable . reason) pure + +executeFederated :: Domain -> FederatorClient component (ExceptT FederationClientError FederationAppIO) a -> FederationAppIO a +executeFederated targetDomain action = do + federatorClient <- mkFederatorClient + originDomain <- viewFederationDomain + runExceptT (runFederatorClientWith federatorClient targetDomain originDomain action) + >>= either (throwE . FederationCallFailure) pure From 98cf007d08ab27bb6e0035b076f53fa452be4cb8 Mon Sep 17 00:00:00 2001 From: jschaul Date: Tue, 27 Apr 2021 16:47:07 +0200 Subject: [PATCH 2/8] add galley federator API stub --- .../src/Wire/API/Federation/API/Galley.hs | 66 +++++++++++++++++++ .../wire-api-federation.cabal | 3 +- 2 files changed, 68 insertions(+), 1 deletion(-) create mode 100644 libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs 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 new file mode 100644 index 00000000000..cf0d1b79366 --- /dev/null +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE DerivingVia #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2020 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Wire.API.Federation.API.Galley where + +import Servant.API (JSON, Post, ReqBody, (:>)) +import Servant.API.Generic ((:-)) + +type ConversationMemberChange = () + +type ConversationMemberChangeResponse = () + +type JoinConversation = () + +type JoinConversationResponse = () + +data Api routes = Api + { conversationMemberChange :: + routes + :- "federation" + :> "notify-a-conversation-update" + :> ReqBody '[JSON] ConversationMemberChange + :> Post '[JSON] ConversationMemberChangeResponse, + addToConversation :: + routes + :- "federation" + :> "join-conversation" + :> ReqBody '[JSON] JoinConversation + :> Post '[JSON] JoinConversationResponse + } + +-- Usecase: +-- +-- backend A: conversation 1 (members: alice@A alice2@A) +-- backend B: Bob, Bob2 +-- +-- +-- alice adds Bob: /add-to-conversation(bob)@A +-- A -> B: check bob exists on B +-- A: add B to conversation database entry +-- A -> B: by the way, B is now in one of my conversations. (B writes in its DB: Bob exists in a conversation in A) +-- +-- Bob adds Bob2: /add-to-conversation(bob2)@B +-- B -> A: add Bob2 to your conversation +-- +-- +-- Bob adds Charlie@C /add-to-conversation(charlie)@B +-- B -> C check Charlie exists? +-- B -> A: Add Charlie@C to your conversation 1. +-- diff --git a/libs/wire-api-federation/wire-api-federation.cabal b/libs/wire-api-federation/wire-api-federation.cabal index 514f982f037..f280b6eacc3 100644 --- a/libs/wire-api-federation/wire-api-federation.cabal +++ b/libs/wire-api-federation/wire-api-federation.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: d46afde4e3a98dd57f7e30f974dfcc9037f1c4f5ed087f29b3f69cd4dcf732bc +-- hash: ad51205c57d0dcf41c68effbec318807a340ee2d2abfa805b1f921fe7e3281be name: wire-api-federation version: 0.1.0 @@ -25,6 +25,7 @@ library Wire.API.Federation.API Wire.API.Federation.API.Brig Wire.API.Federation.API.Conversation + Wire.API.Federation.API.Galley Wire.API.Federation.Client Wire.API.Federation.Event Wire.API.Federation.GRPC.Client From 96a55015eddc6d8d6ca2ce3a3e1b8e252b8070cc Mon Sep 17 00:00:00 2001 From: jschaul Date: Tue, 27 Apr 2021 17:32:45 +0200 Subject: [PATCH 3/8] add thoughts to the code for now --- .../src/Wire/API/Federation/API/Galley.hs | 44 ++++++++++++++++++- 1 file changed, 43 insertions(+), 1 deletion(-) 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 cf0d1b79366..5c7ec049e9a 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 @@ -34,12 +34,22 @@ data Api routes = Api { conversationMemberChange :: routes :- "federation" - :> "notify-a-conversation-update" + -- for the usecase: + -- given alice,alice2 @A and bob @B: + -- alice adds Bob: /add-to-conversation(bob)@A + -- A -> B: check bob exists on B + -- A: add B to conversation database entry + -- A -> B: by the way, B is now in one of my conversations. + -- (B writes this in its DB: "Bob exists in a conversation with ID 1 in A) + :> "conversation-member-change" :> ReqBody '[JSON] ConversationMemberChange :> Post '[JSON] ConversationMemberChangeResponse, addToConversation :: routes :- "federation" + -- can we merge the "add member to conversation" (claiming to be a user already in that conv) + -- with "join conversation by id" (where we only look at the conv id, not at a user id. + -- ? :> "join-conversation" :> ReqBody '[JSON] JoinConversation :> Post '[JSON] JoinConversationResponse @@ -64,3 +74,35 @@ data Api routes = Api -- B -> C check Charlie exists? -- B -> A: Add Charlie@C to your conversation 1. -- +-- +-- Galley conversation client-server API: +-- +-- yes - get conversation (self, cnvId) +-- yes - get conversation roles (self, cnvId) +-- yes - join conversation by id +-- yes - add users to existing conv +-- yes - rename conversation +-- [yes] delete member of a conversation +-- [yes] send a message! (cnvId/otr/messages) +-- +-- [yes] other member update (e.g. make someone conv admin) +-- [yes? low prio] - join conversation by reusable code +-- [yes? low prio] code check, get conversation code +-- [yes? low prio] update conversation access mode (e.g. allow guests into a conv) +-- [yes? low prio] - change read receipts mode on a conv +-- [yes? low prio] - change timer settings on a conv +-- +-- [no] get a user's conversation IDs (self) +-- [no] get a user's conversation by ID/start (self) +-- [no] create group conversation (self, newConvData) +-- [no] create self conversation (self) +-- [?] create one2one conversation (self, newConvData) +-- [no] update/delete conversation code +-- [no] get/put self conv +-- [skip it not useful?] typing notifications +-- [maybe?] otr/broadcast (i.e. account status updates) +-- +-- [?] teams/:tid/conversations/ endpoints: +-- - get (by id, all) +-- - get roles +-- - delete From 8320d15377f62c89ca4038c7150b875bbfc0498d Mon Sep 17 00:00:00 2001 From: jschaul Date: Tue, 27 Apr 2021 17:49:47 +0200 Subject: [PATCH 4/8] WIP --- .../src/Wire/API/Federation/API/Galley.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) 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 5c7ec049e9a..5f0b472de70 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 @@ -22,6 +22,7 @@ module Wire.API.Federation.API.Galley where import Servant.API (JSON, Post, ReqBody, (:>)) import Servant.API.Generic ((:-)) +-- TODO types type ConversationMemberChange = () type ConversationMemberChangeResponse = () @@ -41,7 +42,8 @@ data Api routes = Api -- A: add B to conversation database entry -- A -> B: by the way, B is now in one of my conversations. -- (B writes this in its DB: "Bob exists in a conversation with ID 1 in A) - :> "conversation-member-change" + :> "conversations" + :> "member-change" :> ReqBody '[JSON] ConversationMemberChange :> Post '[JSON] ConversationMemberChangeResponse, addToConversation :: @@ -50,7 +52,8 @@ data Api routes = Api -- can we merge the "add member to conversation" (claiming to be a user already in that conv) -- with "join conversation by id" (where we only look at the conv id, not at a user id. -- ? - :> "join-conversation" + :> "conversations" + :> "join" :> ReqBody '[JSON] JoinConversation :> Post '[JSON] JoinConversationResponse } From 438831ae2dce4c429377d7c5c85a4c4894a4b676 Mon Sep 17 00:00:00 2001 From: jschaul Date: Tue, 27 Apr 2021 22:41:05 +0200 Subject: [PATCH 5/8] Add to the Galley Federation API stub and link to confluence page --- .../src/Wire/API/Federation/API/Galley.hs | 107 +++++++----------- 1 file changed, 43 insertions(+), 64 deletions(-) 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 5f0b472de70..e81eef749e7 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 @@ -19,22 +19,27 @@ module Wire.API.Federation.API.Galley where +import Data.Id (ConvId) +import Data.Text +import Imports import Servant.API (JSON, Post, ReqBody, (:>)) import Servant.API.Generic ((:-)) - --- TODO types -type ConversationMemberChange = () - -type ConversationMemberChangeResponse = () - -type JoinConversation = () - -type JoinConversationResponse = () +import Wire.API.Arbitrary +import qualified Wire.API.Event.Conversation as Public data Api routes = Api - { conversationMemberChange :: + { conversationRename :: routes :- "federation" + :> "conversations" + -- usecase: Alice@A wants to change the title of a conversation containing her but hosted in B. + :> "rename" + :> ReqBody '[JSON] RenameConversation + :> Post '[JSON] RenameConversationResponse, + conversationMemberChange :: + routes + :- "federation" + :> "conversations" -- for the usecase: -- given alice,alice2 @A and bob @B: -- alice adds Bob: /add-to-conversation(bob)@A @@ -42,70 +47,44 @@ data Api routes = Api -- A: add B to conversation database entry -- A -> B: by the way, B is now in one of my conversations. -- (B writes this in its DB: "Bob exists in a conversation with ID 1 in A) - :> "conversations" :> "member-change" :> ReqBody '[JSON] ConversationMemberChange :> Post '[JSON] ConversationMemberChangeResponse, addToConversation :: routes :- "federation" + :> "conversations" -- can we merge the "add member to conversation" (claiming to be a user already in that conv) -- with "join conversation by id" (where we only look at the conv id, not at a user id. - -- ? - :> "conversations" + -- ? Question of trust and/or possibility for bugs? + -- + -- Usecase: given conversation-1@A with members Alice@A, Bob@B + -- + -- Bob@B adds BobTwo@B: /add-to-conversation(bob2)@B + -- B -> A: add Bob2 to your conversation, please :> "join" :> ReqBody '[JSON] JoinConversation :> Post '[JSON] JoinConversationResponse } --- Usecase: --- --- backend A: conversation 1 (members: alice@A alice2@A) --- backend B: Bob, Bob2 --- --- --- alice adds Bob: /add-to-conversation(bob)@A --- A -> B: check bob exists on B --- A: add B to conversation database entry --- A -> B: by the way, B is now in one of my conversations. (B writes in its DB: Bob exists in a conversation in A) --- --- Bob adds Bob2: /add-to-conversation(bob2)@B --- B -> A: add Bob2 to your conversation --- --- --- Bob adds Charlie@C /add-to-conversation(charlie)@B --- B -> C check Charlie exists? --- B -> A: Add Charlie@C to your conversation 1. --- --- --- Galley conversation client-server API: --- --- yes - get conversation (self, cnvId) --- yes - get conversation roles (self, cnvId) --- yes - join conversation by id --- yes - add users to existing conv --- yes - rename conversation --- [yes] delete member of a conversation --- [yes] send a message! (cnvId/otr/messages) --- --- [yes] other member update (e.g. make someone conv admin) --- [yes? low prio] - join conversation by reusable code --- [yes? low prio] code check, get conversation code --- [yes? low prio] update conversation access mode (e.g. allow guests into a conv) --- [yes? low prio] - change read receipts mode on a conv --- [yes? low prio] - change timer settings on a conv --- --- [no] get a user's conversation IDs (self) --- [no] get a user's conversation by ID/start (self) --- [no] create group conversation (self, newConvData) --- [no] create self conversation (self) --- [?] create one2one conversation (self, newConvData) --- [no] update/delete conversation code --- [no] get/put self conv --- [skip it not useful?] typing notifications --- [maybe?] otr/broadcast (i.e. account status updates) --- --- [?] teams/:tid/conversations/ endpoints: --- - get (by id, all) --- - get roles --- - delete +data RenameConversation = RenameConversation + { renameConv :: ConvId, + renameNewName :: Text + } + deriving (Show, Eq, Generic, Typeable) + deriving (Arbitrary) via (GenericUniform RenameConversation) + +newtype RenameConversationResponse = RenameConversationResponse + { renameEvent :: Public.Event + } + deriving (Show, Eq, Generic, Typeable) + deriving (Arbitrary) via (GenericUniform RenameConversationResponse) + +-- FUTUREWORK: data types, json instances, more endpoints. See https://wearezeta.atlassian.net/wiki/spaces/CORE/pages/356090113/Federation+Galley+Conversation+API for the current list we need. +type ConversationMemberChange = () + +type ConversationMemberChangeResponse = () + +type JoinConversation = () + +type JoinConversationResponse = () From ef036f1be72b2250fe7251e2b3f5bffd33f39bfd Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Wed, 28 Apr 2021 14:35:57 +0200 Subject: [PATCH 6/8] Generalize with MonadFederation --- .../src/Wire/API/Federation/Client.hs | 36 ++++++++++++- services/brig/src/Brig/API/Types.hs | 2 +- services/brig/src/Brig/App.hs | 5 ++ services/brig/src/Brig/Federation/Client.hs | 32 ++--------- services/galley/galley.cabal | 3 +- services/galley/src/Galley/App.hs | 5 ++ .../galley/src/Galley/Federation/Client.hs | 53 ------------------- 7 files changed, 49 insertions(+), 87 deletions(-) delete mode 100644 services/galley/src/Galley/Federation/Client.hs diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Client.hs b/libs/wire-api-federation/src/Wire/API/Federation/Client.hs index 6d96fb69f51..9ee4fc09d94 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Client.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Client.hs @@ -3,17 +3,19 @@ module Wire.API.Federation.Client where -import Control.Monad.Except (MonadError (..)) +import Control.Monad.Except (ExceptT, MonadError (..), withExceptT) import Data.ByteString.Builder (toLazyByteString) import qualified Data.ByteString.Lazy as LBS import Data.Domain (Domain, domainText) import qualified Data.Text as T import Imports -import Mu.GRpc.Client.TyApps (GRpcMessageProtocol (MsgProtoBuf), GRpcReply (..), GrpcClient, gRpcCall) +import Mu.GRpc.Client.TyApps (GRpcMessageProtocol (MsgProtoBuf), GRpcReply (..), GrpcClient, gRpcCall, grpcClientConfigSimple) import qualified Network.HTTP.Types as HTTP import Servant.Client (ResponseF (..)) import qualified Servant.Client as Servant import Servant.Client.Core (RequestBody (..), RequestF (..), RunClient (..)) +import Util.Options (Endpoint (..)) +import Wire.API.Federation.GRPC.Client (createGrpcClient, reason) import qualified Wire.API.Federation.GRPC.Types as Proto data FederatorClientEnv = FederatorClientEnv @@ -95,3 +97,33 @@ data FederationClientError callRemote :: MonadIO m => GrpcClient -> Proto.ValidatedFederatedRequest -> m (GRpcReply Proto.OutwardResponse) callRemote fedClient call = liftIO $ gRpcCall @'MsgProtoBuf @Proto.Outward @"Outward" @"call" fedClient (Proto.validatedFederatedRequestToFederatedRequest call) + +class MonadFederation m where + federatorEndpoint :: m (Maybe Endpoint) + federationDomain :: m Domain + +-- FUTUREWORK: It would be nice to share the client across all calls to +-- federator and not call this function on every invocation of federated +-- requests, but there are some issues in http2-client which might need some +-- fixing first. More context here: +-- https://github.com/lucasdicioccio/http2-client/issues/37 +-- https://github.com/lucasdicioccio/http2-client/issues/49 +mkFederatorClient :: + (MonadIO m, MonadFederation m) => + ExceptT FederationError m GrpcClient +mkFederatorClient = do + mbFedEndpoint <- lift federatorEndpoint + Endpoint host port <- maybe (throwError FederationNotConfigured) pure mbFedEndpoint + let cfg = grpcClientConfigSimple (T.unpack host) (fromIntegral port) False + createGrpcClient cfg + >>= either (throwError . FederationUnavailable . reason) pure + +executeFederated :: + (MonadIO m, MonadFederation m) => + Domain -> + FederatorClient component (ExceptT FederationClientError m) a -> + ExceptT FederationError m a +executeFederated targetDomain action = do + federatorClient <- mkFederatorClient + originDomain <- lift federationDomain + withExceptT FederationCallFailure (runFederatorClientWith federatorClient targetDomain originDomain action) diff --git a/services/brig/src/Brig/API/Types.hs b/services/brig/src/Brig/API/Types.hs index 0af41cbdc6d..a37729ef33f 100644 --- a/services/brig/src/Brig/API/Types.hs +++ b/services/brig/src/Brig/API/Types.hs @@ -43,7 +43,7 @@ import Brig.User.Auth.Cookie (RetryAfter (..)) import Data.Id import Imports import qualified Network.Wai.Utilities.Error as Wai -import Wire.API.Federation.Client (FederationClientError, FederationError) +import Wire.API.Federation.Client (FederationError) ------------------------------------------------------------------------------- -- Successes diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index 5f3194dc242..7f013bd7f23 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -131,6 +131,7 @@ import System.Logger.Class hiding (Settings, settings) import qualified System.Logger.Class as LC import qualified System.Logger.Extended as Log import Util.Options +import Wire.API.Federation.Client (MonadFederation (..)) import Wire.API.User.Identity (Email) schemaVersion :: Int32 @@ -494,6 +495,10 @@ instance MonadUnliftIO m => MonadUnliftIO (AppT m) where withRunInIO $ \run -> inner (run . flip runReaderT r . unAppT) +instance MonadFederation AppIO where + federatorEndpoint = view federator + federationDomain = viewFederationDomain + runAppT :: Env -> AppT m a -> m a runAppT e (AppT ma) = runReaderT ma e diff --git a/services/brig/src/Brig/Federation/Client.hs b/services/brig/src/Brig/Federation/Client.hs index dd421be722c..f4e463803cd 100644 --- a/services/brig/src/Brig/Federation/Client.hs +++ b/services/brig/src/Brig/Federation/Client.hs @@ -20,26 +20,20 @@ module Brig.Federation.Client where -import Brig.App (AppIO, federator, viewFederationDomain) +import Brig.App (AppIO) import Brig.Types (Prekey, PrekeyBundle) import qualified Brig.Types.Search as Public import Brig.Types.User -import Control.Error.Util ((!?)) -import Control.Lens (view, (^.)) -import Control.Monad.Except (runExceptT) -import Control.Monad.Trans.Except (ExceptT (..), throwE) +import Control.Monad.Trans.Except (ExceptT (..)) import Data.Domain import Data.Handle import Data.Id (ClientId, UserId) import Data.Qualified import qualified Data.Text as T import Imports -import Mu.GRpc.Client.TyApps import qualified System.Logger.Class as Log -import Util.Options (epHost, epPort) import Wire.API.Federation.API.Brig as FederatedBrig -import Wire.API.Federation.Client (FederationClientError, FederationError (..), FederatorClient, runFederatorClientWith) -import Wire.API.Federation.GRPC.Client +import Wire.API.Federation.Client (FederationError (..), executeFederated) import Wire.API.Message (UserClientMap, UserClients) import Wire.API.User.Client.Prekey (ClientPrekey) @@ -85,23 +79,3 @@ searchUsers :: Domain -> SearchRequest -> FederationAppIO (Public.SearchResult P searchUsers domain searchTerm = do Log.warn $ Log.msg $ T.pack "Brig-federation: search call on remote backend" executeFederated domain $ FederatedBrig.searchUsers clientRoutes searchTerm - --- FUTUREWORK: It would be nice to share the client across all calls to --- federator and not call this function on every invocation of federated --- requests, but there are some issues in http2-client which might need some --- fixing first. More context here: --- https://github.com/lucasdicioccio/http2-client/issues/37 --- https://github.com/lucasdicioccio/http2-client/issues/49 -mkFederatorClient :: FederationAppIO GrpcClient -mkFederatorClient = do - federatorEndpoint <- view federator !? FederationNotConfigured - let cfg = grpcClientConfigSimple (T.unpack (federatorEndpoint ^. epHost)) (fromIntegral (federatorEndpoint ^. epPort)) False - createGrpcClient cfg - >>= either (throwE . FederationUnavailable . reason) pure - -executeFederated :: Domain -> FederatorClient component (ExceptT FederationClientError FederationAppIO) a -> FederationAppIO a -executeFederated targetDomain action = do - federatorClient <- mkFederatorClient - originDomain <- viewFederationDomain - runExceptT (runFederatorClientWith federatorClient targetDomain originDomain action) - >>= either (throwE . FederationCallFailure) pure diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index d9a475dd6b0..8e71917e259 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: ebe33c033b7a06a7e58be32fdadbad8a7441a3e5619b2d517bfe15acb3f84aaf +-- hash: 6b8bbc40705147b2cb4025609e4b8efbd3c91a97f426f13cc34530d11041a393 name: galley version: 0.83.0 @@ -55,7 +55,6 @@ library Galley.Data.Types Galley.External Galley.External.LegalHoldService - Galley.Federation.Client Galley.Intra.Client Galley.Intra.Journal Galley.Intra.Push diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index c01e870b076..21894c111c6 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -89,6 +89,7 @@ import Ssl.Util import System.Logger.Class hiding (Error, info) import qualified System.Logger.Extended as Logger import Util.Options +import Wire.API.Federation.Client (MonadFederation (..)) data DeleteItem = TeamItem TeamId UserId (Maybe ConnId) deriving (Eq, Ord, Show) @@ -132,6 +133,10 @@ newtype Galley a = Galley MonadClient ) +instance MonadFederation Galley where + federatorEndpoint = view federator + federationDomain = view (options . optSettings . setFederationDomain) + fanoutLimit :: Galley (Range 1 Teams.HardTruncationLimit Int32) fanoutLimit = view options >>= return . currentFanoutLimit diff --git a/services/galley/src/Galley/Federation/Client.hs b/services/galley/src/Galley/Federation/Client.hs deleted file mode 100644 index 1ae3e083ae8..00000000000 --- a/services/galley/src/Galley/Federation/Client.hs +++ /dev/null @@ -1,53 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2020 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . -module Galley.Federation.Client where - -import Control.Error (throwE) -import Control.Error.Util ((!?)) -import Control.Lens (view, (^.)) -import Control.Monad.Except (ExceptT, runExceptT) -import Data.Domain -import qualified Data.Text as T -import Galley.API.Util (viewFederationDomain) -import Galley.App (Galley, federator) -import Imports -import Network.GRPC.Client.Helpers (GrpcClient, grpcClientConfigSimple) -import Util.Options (epHost, epPort) -import Wire.API.Federation.Client (FederationClientError, FederationError (..), FederatorClient, runFederatorClientWith) -import Wire.API.Federation.GRPC.Client - -type FederationAppIO = ExceptT FederationError Galley - --- FUTUREWORK: It would be nice to share the client across all calls to --- federator and not call this function on every invocation of federated --- requests, but there are some issues in http2-client which might need some --- fixing first. More context here: --- https://github.com/lucasdicioccio/http2-client/issues/37 --- https://github.com/lucasdicioccio/http2-client/issues/49 -mkFederatorClient :: FederationAppIO GrpcClient -mkFederatorClient = do - federatorEndpoint <- view federator !? FederationNotConfigured - let cfg = grpcClientConfigSimple (T.unpack (federatorEndpoint ^. epHost)) (fromIntegral (federatorEndpoint ^. epPort)) False - createGrpcClient cfg - >>= either (throwE . FederationUnavailable . reason) pure - -executeFederated :: Domain -> FederatorClient component (ExceptT FederationClientError FederationAppIO) a -> FederationAppIO a -executeFederated targetDomain action = do - federatorClient <- mkFederatorClient - originDomain <- viewFederationDomain - runExceptT (runFederatorClientWith federatorClient targetDomain originDomain action) - >>= either (throwE . FederationCallFailure) pure From 4de43f43e2038d7722cc72447756ff6149fa9220 Mon Sep 17 00:00:00 2001 From: jschaul Date: Thu, 29 Apr 2021 15:03:19 +0200 Subject: [PATCH 7/8] rename MonadFederation -> HasFederatorConfig --- libs/wire-api-federation/src/Wire/API/Federation/Client.hs | 6 +++--- services/brig/src/Brig/App.hs | 4 ++-- services/galley/src/Galley/App.hs | 4 ++-- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Client.hs b/libs/wire-api-federation/src/Wire/API/Federation/Client.hs index 9ee4fc09d94..0366ce1fad6 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Client.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Client.hs @@ -98,7 +98,7 @@ data FederationClientError callRemote :: MonadIO m => GrpcClient -> Proto.ValidatedFederatedRequest -> m (GRpcReply Proto.OutwardResponse) callRemote fedClient call = liftIO $ gRpcCall @'MsgProtoBuf @Proto.Outward @"Outward" @"call" fedClient (Proto.validatedFederatedRequestToFederatedRequest call) -class MonadFederation m where +class HasFederatorConfig m where federatorEndpoint :: m (Maybe Endpoint) federationDomain :: m Domain @@ -109,7 +109,7 @@ class MonadFederation m where -- https://github.com/lucasdicioccio/http2-client/issues/37 -- https://github.com/lucasdicioccio/http2-client/issues/49 mkFederatorClient :: - (MonadIO m, MonadFederation m) => + (MonadIO m, HasFederatorConfig m) => ExceptT FederationError m GrpcClient mkFederatorClient = do mbFedEndpoint <- lift federatorEndpoint @@ -119,7 +119,7 @@ mkFederatorClient = do >>= either (throwError . FederationUnavailable . reason) pure executeFederated :: - (MonadIO m, MonadFederation m) => + (MonadIO m, HasFederatorConfig m) => Domain -> FederatorClient component (ExceptT FederationClientError m) a -> ExceptT FederationError m a diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index 7f013bd7f23..354d17f9d19 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -131,7 +131,7 @@ import System.Logger.Class hiding (Settings, settings) import qualified System.Logger.Class as LC import qualified System.Logger.Extended as Log import Util.Options -import Wire.API.Federation.Client (MonadFederation (..)) +import Wire.API.Federation.Client (HasFederatorConfig (..)) import Wire.API.User.Identity (Email) schemaVersion :: Int32 @@ -495,7 +495,7 @@ instance MonadUnliftIO m => MonadUnliftIO (AppT m) where withRunInIO $ \run -> inner (run . flip runReaderT r . unAppT) -instance MonadFederation AppIO where +instance HasFederatorConfig AppIO where federatorEndpoint = view federator federationDomain = viewFederationDomain diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index 21894c111c6..abe3a7a470c 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -89,7 +89,7 @@ import Ssl.Util import System.Logger.Class hiding (Error, info) import qualified System.Logger.Extended as Logger import Util.Options -import Wire.API.Federation.Client (MonadFederation (..)) +import Wire.API.Federation.Client (HasFederatorConfig (..)) data DeleteItem = TeamItem TeamId UserId (Maybe ConnId) deriving (Eq, Ord, Show) @@ -133,7 +133,7 @@ newtype Galley a = Galley MonadClient ) -instance MonadFederation Galley where +instance HasFederatorConfig Galley where federatorEndpoint = view federator federationDomain = view (options . optSettings . setFederationDomain) From 8af3f3cbec7c5b1f9a0941ab47c185274ca353c6 Mon Sep 17 00:00:00 2001 From: jschaul Date: Thu, 29 Apr 2021 15:12:14 +0200 Subject: [PATCH 8/8] re-work the API stubs to start with the two most useful ones --- .../src/Wire/API/Federation/API/Galley.hs | 50 ++++--------------- 1 file changed, 9 insertions(+), 41 deletions(-) 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 e81eef749e7..16c9b414f27 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 @@ -19,23 +19,19 @@ module Wire.API.Federation.API.Galley where -import Data.Id (ConvId) -import Data.Text -import Imports import Servant.API (JSON, Post, ReqBody, (:>)) import Servant.API.Generic ((:-)) -import Wire.API.Arbitrary -import qualified Wire.API.Event.Conversation as Public data Api routes = Api - { conversationRename :: + { getConversation :: routes :- "federation" :> "conversations" - -- usecase: Alice@A wants to change the title of a conversation containing her but hosted in B. - :> "rename" - :> ReqBody '[JSON] RenameConversation - :> Post '[JSON] RenameConversationResponse, + -- usecases: + -- - e.g. upon registering a new client to your account, get the list of your conversations + :> "list-conversations" + :> ReqBody '[JSON] ListConversations + :> Post '[JSON] ListConversationsResponse, conversationMemberChange :: routes :- "federation" @@ -49,42 +45,14 @@ data Api routes = Api -- (B writes this in its DB: "Bob exists in a conversation with ID 1 in A) :> "member-change" :> ReqBody '[JSON] ConversationMemberChange - :> Post '[JSON] ConversationMemberChangeResponse, - addToConversation :: - routes - :- "federation" - :> "conversations" - -- can we merge the "add member to conversation" (claiming to be a user already in that conv) - -- with "join conversation by id" (where we only look at the conv id, not at a user id. - -- ? Question of trust and/or possibility for bugs? - -- - -- Usecase: given conversation-1@A with members Alice@A, Bob@B - -- - -- Bob@B adds BobTwo@B: /add-to-conversation(bob2)@B - -- B -> A: add Bob2 to your conversation, please - :> "join" - :> ReqBody '[JSON] JoinConversation - :> Post '[JSON] JoinConversationResponse - } - -data RenameConversation = RenameConversation - { renameConv :: ConvId, - renameNewName :: Text - } - deriving (Show, Eq, Generic, Typeable) - deriving (Arbitrary) via (GenericUniform RenameConversation) - -newtype RenameConversationResponse = RenameConversationResponse - { renameEvent :: Public.Event + :> Post '[JSON] ConversationMemberChangeResponse } - deriving (Show, Eq, Generic, Typeable) - deriving (Arbitrary) via (GenericUniform RenameConversationResponse) -- FUTUREWORK: data types, json instances, more endpoints. See https://wearezeta.atlassian.net/wiki/spaces/CORE/pages/356090113/Federation+Galley+Conversation+API for the current list we need. type ConversationMemberChange = () type ConversationMemberChangeResponse = () -type JoinConversation = () +type ListConversations = () -type JoinConversationResponse = () +type ListConversationsResponse = ()