diff --git a/cassandra-schema.cql b/cassandra-schema.cql index a3b1e345be..f0c76947c0 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -1290,31 +1290,6 @@ CREATE TABLE brig_test.service_team ( AND read_repair_chance = 0.0 AND speculative_retry = '99PERCENTILE'; -CREATE TABLE brig_test.invitation ( - inviter uuid, - id uuid, - code ascii, - created_at timestamp, - email text, - name text, - phone text, - PRIMARY KEY (inviter, id) -) WITH CLUSTERING ORDER BY (id ASC) - AND bloom_filter_fp_chance = 0.01 - AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'} - AND comment = '' - AND compaction = {'class': 'org.apache.cassandra.db.compaction.SizeTieredCompactionStrategy', 'max_threshold': '32', 'min_threshold': '4'} - AND compression = {'chunk_length_in_kb': '64', 'class': 'org.apache.cassandra.io.compress.LZ4Compressor'} - AND crc_check_chance = 1.0 - AND dclocal_read_repair_chance = 0.1 - AND default_time_to_live = 0 - AND gc_grace_seconds = 864000 - AND max_index_interval = 2048 - AND memtable_flush_period_in_ms = 0 - AND min_index_interval = 128 - AND read_repair_chance = 0.0 - AND speculative_retry = '99PERCENTILE'; - CREATE TABLE brig_test.blacklist ( key text PRIMARY KEY ) WITH bloom_filter_fp_chance = 0.1 @@ -1665,6 +1640,49 @@ CREATE TABLE brig_test.password_reset ( AND read_repair_chance = 0.0 AND speculative_retry = '99PERCENTILE'; +CREATE TABLE brig_test.federation_remotes ( + domain text PRIMARY KEY, + search_policy int +) WITH bloom_filter_fp_chance = 0.01 + AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'} + AND comment = '' + AND compaction = {'class': 'org.apache.cassandra.db.compaction.SizeTieredCompactionStrategy', 'max_threshold': '32', 'min_threshold': '4'} + AND compression = {'chunk_length_in_kb': '64', 'class': 'org.apache.cassandra.io.compress.LZ4Compressor'} + AND crc_check_chance = 1.0 + AND dclocal_read_repair_chance = 0.1 + AND default_time_to_live = 0 + AND gc_grace_seconds = 864000 + AND max_index_interval = 2048 + AND memtable_flush_period_in_ms = 0 + AND min_index_interval = 128 + AND read_repair_chance = 0.0 + AND speculative_retry = '99PERCENTILE'; + +CREATE TABLE brig_test.invitation ( + inviter uuid, + id uuid, + code ascii, + created_at timestamp, + email text, + name text, + phone text, + PRIMARY KEY (inviter, id) +) WITH CLUSTERING ORDER BY (id ASC) + AND bloom_filter_fp_chance = 0.01 + AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'} + AND comment = '' + AND compaction = {'class': 'org.apache.cassandra.db.compaction.SizeTieredCompactionStrategy', 'max_threshold': '32', 'min_threshold': '4'} + AND compression = {'chunk_length_in_kb': '64', 'class': 'org.apache.cassandra.io.compress.LZ4Compressor'} + AND crc_check_chance = 1.0 + AND dclocal_read_repair_chance = 0.1 + AND default_time_to_live = 0 + AND gc_grace_seconds = 864000 + AND max_index_interval = 2048 + AND memtable_flush_period_in_ms = 0 + AND min_index_interval = 128 + AND read_repair_chance = 0.0 + AND speculative_retry = '99PERCENTILE'; + CREATE TABLE brig_test.activation_keys ( key ascii PRIMARY KEY, challenge ascii, diff --git a/libs/wire-api/src/Wire/API/Routes/FederationDomainConfig.hs b/libs/wire-api/src/Wire/API/Routes/FederationDomainConfig.hs new file mode 100644 index 0000000000..725a48b71e --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/FederationDomainConfig.hs @@ -0,0 +1,55 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 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.Routes.FederationDomainConfig + ( FederationDomainConfig (..), + FederationDomainConfigs (..), + ) +where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Domain (Domain) +import Data.Schema +import qualified Data.Swagger as S +import GHC.Generics +import Imports +import Wire.API.User.Search (FederatedUserSearchPolicy) + +data FederationDomainConfig = FederationDomainConfig + { domain :: Domain, + cfgSearchPolicy :: FederatedUserSearchPolicy + } + deriving (Eq, Ord, Show, Generic) + deriving (ToJSON, FromJSON, S.ToSchema) via Schema FederationDomainConfig + +instance ToSchema FederationDomainConfig where + schema = + object "FederationDomainConfig" $ + FederationDomainConfig + <$> domain .= field "domain" schema + <*> cfgSearchPolicy .= field "search_policy" schema + +newtype FederationDomainConfigs = FederationDomainConfigs + {fromFederationDomainConfigs :: [FederationDomainConfig]} + deriving (Show, Generic) + deriving (ToJSON, FromJSON, S.ToSchema) via Schema FederationDomainConfigs + +instance ToSchema FederationDomainConfigs where + schema = + object "FederationDomainConfigs" $ + FederationDomainConfigs + <$> fromFederationDomainConfigs .= field "remotes" (array schema) diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index e6de219115..3e9330a377 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -23,6 +23,7 @@ module Wire.API.Routes.Internal.Brig TeamsAPI, UserAPI, AuthAPI, + FederationRemotesAPI, EJPDRequest, GetAccountConferenceCallingConfig, PutAccountConferenceCallingConfig, @@ -38,6 +39,7 @@ where import Control.Lens ((.~)) import Data.Aeson (FromJSON, ToJSON) import qualified Data.Code as Code +import Data.Domain (Domain) import Data.Id as Id import Data.Qualified (Qualified) import Data.Schema hiding (swaggerDoc) @@ -53,6 +55,7 @@ import Wire.API.Error.Brig import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage import Wire.API.MakesFederatedCall +import Wire.API.Routes.FederationDomainConfig import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.Internal.Brig.EJPD import Wire.API.Routes.Internal.Brig.OAuth (OAuthAPI) @@ -327,6 +330,7 @@ type API = :<|> UserAPI :<|> AuthAPI :<|> OAuthAPI + :<|> FederationRemotesAPI ) type TeamsAPI = @@ -397,6 +401,31 @@ type AuthAPI = :> MultiVerb1 'GET '[JSON] (RespondEmpty 200 "OK") ) +-- | This is located in brig, not in federator, because brig has a cassandra instance. This +-- is not ideal, but since all services have a local in-ram copy of this table and keep track +-- of changes via rabbitmq, we argue it's "fine" for federators to ask brig once on startup. +type FederationRemotesAPI = + Named + "get-federation-remotes" + ( "federation" + :> "remotes" + :> Get '[JSON] FederationDomainConfigs + ) + :<|> Named + "add-federation-remotes" + ( "federation" + :> "remotes" + :> ReqBody '[JSON] FederationDomainConfig + :> Post '[JSON] () + ) + :<|> Named + "delete-federation-remotes" + ( "federation" + :> "remotes" + :> Capture "domain" Domain + :> Delete '[JSON] () + ) + swaggerDoc :: Swagger swaggerDoc = toSwagger (Proxy @API) diff --git a/libs/wire-api/src/Wire/API/User/Search.hs b/libs/wire-api/src/Wire/API/User/Search.hs index 90cddf0cea..7398625dbb 100644 --- a/libs/wire-api/src/Wire/API/User/Search.hs +++ b/libs/wire-api/src/Wire/API/User/Search.hs @@ -307,7 +307,7 @@ data FederatedUserSearchPolicy = NoSearch | ExactHandleSearch | FullSearch - deriving (Show, Eq, Generic, Enum, Bounded) + deriving (Show, Eq, Ord, Generic, Enum, Bounded) deriving (Arbitrary) via (GenericUniform FederatedUserSearchPolicy) deriving (ToJSON, FromJSON) via (Schema FederatedUserSearchPolicy) diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 5e7afe420f..cc6e76f5e9 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -79,6 +79,7 @@ library Wire.API.Routes.ClientAlgebra Wire.API.Routes.Cookies Wire.API.Routes.CSV + Wire.API.Routes.FederationDomainConfig Wire.API.Routes.Internal.Brig Wire.API.Routes.Internal.Brig.Connection Wire.API.Routes.Internal.Brig.EJPD diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 00a464df5c..d0ae7a57ee 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -51,6 +51,7 @@ library Brig.Data.Activation Brig.Data.Client Brig.Data.Connection + Brig.Data.Federation Brig.Data.Instances Brig.Data.LoginCode Brig.Data.MLS.KeyPackage @@ -668,6 +669,7 @@ executable brig-schema V73_ReplaceNonceTable V74_AddOAuthTables V75_AddOAuthCodeChallenge + V76_FederationRemotes V_FUTUREWORK hs-source-dirs: schema/src diff --git a/services/brig/schema/src/Main.hs b/services/brig/schema/src/Main.hs index f1f35ccd37..db41e48eab 100644 --- a/services/brig/schema/src/Main.hs +++ b/services/brig/schema/src/Main.hs @@ -55,6 +55,7 @@ import qualified V72_AddNonceTable import qualified V73_ReplaceNonceTable import qualified V74_AddOAuthTables import qualified V75_AddOAuthCodeChallenge +import qualified V76_FederationRemotes main :: IO () main = do @@ -97,7 +98,8 @@ main = do V72_AddNonceTable.migration, V73_ReplaceNonceTable.migration, V74_AddOAuthTables.migration, - V75_AddOAuthCodeChallenge.migration + V75_AddOAuthCodeChallenge.migration, + V76_FederationRemotes.migration -- When adding migrations here, don't forget to update -- 'schemaVersion' in Brig.App diff --git a/services/brig/schema/src/V76_FederationRemotes.hs b/services/brig/schema/src/V76_FederationRemotes.hs new file mode 100644 index 0000000000..b1cc1db35c --- /dev/null +++ b/services/brig/schema/src/V76_FederationRemotes.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE QuasiQuotes #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 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 V76_FederationRemotes + ( migration, + ) +where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = + Migration 76 "Table for keeping track of instances we federate with" $ + schema' + [r| CREATE TABLE federation_remotes ( + domain text PRIMARY KEY, + search_policy int + ) + |] diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index f08c9cd651..035f30ee0d 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -38,6 +38,7 @@ import qualified Brig.Code as Code import Brig.Data.Activation import qualified Brig.Data.Client as Data import qualified Brig.Data.Connection as Data +import qualified Brig.Data.Federation as Data import qualified Brig.Data.MLS.KeyPackage as Data import qualified Brig.Data.User as Data import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) @@ -89,6 +90,7 @@ import Wire.API.Federation.API import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage import Wire.API.MLS.Serialisation +import Wire.API.Routes.FederationDomainConfig import Wire.API.Routes.Internal.Brig import qualified Wire.API.Routes.Internal.Brig as BrigIRoutes import Wire.API.Routes.Internal.Brig.Connection @@ -119,6 +121,7 @@ servantSitemap = :<|> userAPI :<|> authAPI :<|> internalOauthAPI + :<|> federationRemotesAPI ejpdAPI :: Member GalleyProvider r => @@ -171,6 +174,12 @@ authAPI = :<|> Named @"login-code" getLoginCode :<|> Named @"reauthenticate" reauthenticate +federationRemotesAPI :: ServerT BrigIRoutes.FederationRemotesAPI (Handler r) +federationRemotesAPI = + Named @"get-federation-remotes" (lift $ FederationDomainConfigs <$> wrapClient Data.getFederationRemotes) -- TODO: get this from TVar! also merge in config file! + :<|> Named @"add-federation-remotes" (lift . wrapClient . Data.addFederationRemote) + :<|> Named @"delete-federation-remotes" (lift . wrapClient . Data.deleteFederationRemote) + -- | Responds with 'Nothing' if field is NULL in existing user or user does not exist. getAccountConferenceCallingConfig :: UserId -> (Handler r) (ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig) getAccountConferenceCallingConfig uid = diff --git a/services/brig/src/Brig/API/Util.hs b/services/brig/src/Brig/API/Util.hs index 46f286d6a1..7fe181c157 100644 --- a/services/brig/src/Brig/API/Util.hs +++ b/services/brig/src/Brig/API/Util.hs @@ -40,8 +40,7 @@ import Brig.API.Types import Brig.App import qualified Brig.Code as Code import qualified Brig.Data.User as Data -import Brig.Options (FederationDomainConfig, federationDomainConfigs, set2FACodeGenerationDelaySecs) -import qualified Brig.Options as Opts +import Brig.Options (federationDomainConfigs, set2FACodeGenerationDelaySecs) import Brig.Types.Intra (accountUser) import Control.Lens (view) import Control.Monad.Catch (throwM) @@ -65,6 +64,7 @@ import Util.Logging (sha256String) import Wire.API.Error import Wire.API.Error.Brig import Wire.API.Federation.Error +import Wire.API.Routes.FederationDomainConfig as FD import Wire.API.User import Wire.API.User.Search (FederatedUserSearchPolicy (NoSearch)) import qualified Wire.Sem.Concurrency as C @@ -171,11 +171,11 @@ exceptTToMaybe = (pure . either Just (const Nothing)) <=< runExceptT lookupDomainConfig :: MonadReader Env m => Domain -> m (Maybe FederationDomainConfig) lookupDomainConfig domain = do domainConfigs <- fromMaybe [] <$> view (settings . federationDomainConfigs) - pure $ find ((== domain) . Opts.domain) domainConfigs + pure $ find ((== domain) . FD.domain) domainConfigs -- | If domain is not configured fall back to `FullSearch` lookupSearchPolicy :: MonadReader Env m => Domain -> m FederatedUserSearchPolicy -lookupSearchPolicy domain = fromMaybe NoSearch <$> (Opts.cfgSearchPolicy <$$> lookupDomainConfig domain) +lookupSearchPolicy domain = fromMaybe NoSearch <$> (FD.cfgSearchPolicy <$$> lookupDomainConfig domain) -- | Convert a qualified value into a local one. Throw if the value is not actually local. ensureLocal :: Qualified a -> AppT r (Local a) diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index 584eb4deaf..00fa0ea438 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -152,7 +152,7 @@ import Wire.API.User.Identity (Email) import Wire.API.User.Profile (Locale) schemaVersion :: Int32 -schemaVersion = 75 +schemaVersion = 76 ------------------------------------------------------------------------------- -- Environment diff --git a/services/brig/src/Brig/Data/Federation.hs b/services/brig/src/Brig/Data/Federation.hs new file mode 100644 index 0000000000..23bb1f2e86 --- /dev/null +++ b/services/brig/src/Brig/Data/Federation.hs @@ -0,0 +1,58 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 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 Brig.Data.Federation + ( getFederationRemotes, + addFederationRemote, + deleteFederationRemote, + ) +where + +import Brig.Data.Instances () +import Cassandra +import Data.Domain +import Imports +import Wire.API.Routes.FederationDomainConfig +import Wire.API.User.Search + +maxKnownNodes :: Int +maxKnownNodes = 10000 + +getFederationRemotes :: forall m. MonadClient m => m [FederationDomainConfig] +getFederationRemotes = uncurry FederationDomainConfig <$$> qry + where + qry :: m [(Domain, FederatedUserSearchPolicy)] + qry = retry x1 . query get $ params LocalQuorum () + + get :: PrepQuery R () (Domain, FederatedUserSearchPolicy) + get = fromString $ "SELECT domain, search_policy FROM federation_remotes LIMIT " <> show maxKnownNodes + +addFederationRemote :: MonadClient m => FederationDomainConfig -> m () +addFederationRemote (FederationDomainConfig rdom searchpolicy) = do + l <- length <$> getFederationRemotes + when (l >= maxKnownNodes) $ error "TODO: make this error better" + retry x5 $ write add (params LocalQuorum (rdom, searchpolicy)) + where + add :: PrepQuery W (Domain, FederatedUserSearchPolicy) () + add = "INSERT INTO federation_remotes (domain, search_policy) VALUES (?, ?)" + +deleteFederationRemote :: MonadClient m => Domain -> m () +deleteFederationRemote rdom = + retry x1 $ write delete (params LocalQuorum (Identity rdom)) + where + delete :: PrepQuery W (Identity Domain) () + delete = "DELETE FROM federation_remotes WHERE domain = ?" diff --git a/services/brig/src/Brig/Data/Instances.hs b/services/brig/src/Brig/Data/Instances.hs index 4ec4e3890c..0e3dba9276 100644 --- a/services/brig/src/Brig/Data/Instances.hs +++ b/services/brig/src/Brig/Data/Instances.hs @@ -47,6 +47,7 @@ import Wire.API.User.Activation import Wire.API.User.Client import Wire.API.User.Password import Wire.API.User.RichInfo +import Wire.API.User.Search deriving instance Cql Name @@ -288,3 +289,15 @@ instance Cql SearchVisibilityInbound where fromCql (CqlInt 0) = pure SearchableByOwnTeam fromCql (CqlInt 1) = pure SearchableByAllTeams fromCql n = Left $ "Unexpected SearchVisibilityInbound: " ++ show n + +instance Cql FederatedUserSearchPolicy where + ctype = Tagged IntColumn + + toCql NoSearch = CqlInt 0 + toCql ExactHandleSearch = CqlInt 1 + toCql FullSearch = CqlInt 2 + + fromCql (CqlInt 0) = pure NoSearch + fromCql (CqlInt 1) = pure ExactHandleSearch + fromCql (CqlInt 2) = pure FullSearch + fromCql n = Left $ "Unexpected SearchVisibilityInbound: " ++ show n diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 66904d3ce0..89b49b8dfa 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -54,10 +54,10 @@ import Imports import qualified Network.DNS as DNS import System.Logger.Extended (Level, LogFormat) import Util.Options +import Wire.API.Routes.FederationDomainConfig import Wire.API.Routes.Version import qualified Wire.API.Team.Feature as Public import Wire.API.User -import Wire.API.User.Search (FederatedUserSearchPolicy) import Wire.Arbitrary (Arbitrary, arbitrary) newtype Timeout = Timeout @@ -400,20 +400,6 @@ instance ToSchema ListAllSFTServers where element "disabled" HideAllSFTServers ] -data FederationDomainConfig = FederationDomainConfig - { domain :: Domain, - cfgSearchPolicy :: FederatedUserSearchPolicy - } - deriving (Show, Generic) - deriving (ToJSON, FromJSON) via Schema FederationDomainConfig - -instance ToSchema FederationDomainConfig where - schema = - object "FederationDomainConfig" $ - FederationDomainConfig - <$> domain .= field "domain" schema - <*> cfgSearchPolicy .= field "search_policy" schema - -- | Options that are consumed on startup data Opts = Opts -- services @@ -562,7 +548,8 @@ data Settings = Settings -- - wire.com -- - example.com setFederationDomain :: !Domain, - setFederationDomainConfigs :: !(Maybe [FederationDomainConfig]), + setFederationDomainConfigs :: !(Maybe [FederationDomainConfig]), -- TODO: deprecate this in docs and config file samples. + -- | The amount of time in milliseconds to wait after reading from an SQS queue -- returns no message, before asking for messages from SQS again. -- defaults to 'defSqsThrottleMillis'. diff --git a/services/brig/test/integration/API/Federation.hs b/services/brig/test/integration/API/Federation.hs index af65db356b..9c01cd1aa7 100644 --- a/services/brig/test/integration/API/Federation.hs +++ b/services/brig/test/integration/API/Federation.hs @@ -56,6 +56,7 @@ import Wire.API.Federation.Component import Wire.API.Federation.Version import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage +import Wire.API.Routes.FederationDomainConfig as FD import Wire.API.User import Wire.API.User.Client import Wire.API.User.Client.Prekey @@ -88,12 +89,13 @@ tests m opts brig cannon fedBrigClient = test m "POST /federation/on-user-deleted-connections : 200" (testRemoteUserGetsDeleted opts brig cannon fedBrigClient), test m "POST /federation/api-version : 200" (testAPIVersion brig fedBrigClient), test m "POST /federation/claim-key-packages : 200" (testClaimKeyPackages brig fedBrigClient), - test m "POST /federation/claim-key-packages (MLS disabled) : 200" (testClaimKeyPackagesMLSDisabled opts brig) + test m "POST /federation/claim-key-packages (MLS disabled) : 200" (testClaimKeyPackagesMLSDisabled opts brig), + test m "CRUD /i/federation/remotes" (crudFederationRemotes opts brig) ] allowFullSearch :: Domain -> Opt.Opts -> Opt.Opts allowFullSearch domain opts = - opts & Opt.optionSettings . Opt.federationDomainConfigs ?~ [Opt.FederationDomainConfig domain FullSearch] + opts & Opt.optionSettings . Opt.federationDomainConfigs ?~ [FD.FederationDomainConfig domain FullSearch] testSearchSuccess :: Opt.Opts -> Brig -> Http () testSearchSuccess opts brig = do @@ -192,9 +194,9 @@ testSearchRestrictions opts brig = do let opts' = opts & Opt.optionSettings . Opt.federationDomainConfigs - ?~ [ Opt.FederationDomainConfig domainNoSearch NoSearch, - Opt.FederationDomainConfig domainExactHandle ExactHandleSearch, - Opt.FederationDomainConfig domainFullSearch FullSearch + ?~ [ FD.FederationDomainConfig domainNoSearch NoSearch, + FD.FederationDomainConfig domainExactHandle ExactHandleSearch, + FD.FederationDomainConfig domainFullSearch FullSearch ] let expectSearch :: HasCallStack => Domain -> Text -> [Qualified UserId] -> FederatedUserSearchPolicy -> WaiTest.Session () @@ -228,9 +230,9 @@ testGetUserByHandleRestrictions opts brig = do let opts' = opts & Opt.optionSettings . Opt.federationDomainConfigs - ?~ [ Opt.FederationDomainConfig domainNoSearch NoSearch, - Opt.FederationDomainConfig domainExactHandle ExactHandleSearch, - Opt.FederationDomainConfig domainFullSearch FullSearch + ?~ [ FD.FederationDomainConfig domainNoSearch NoSearch, + FD.FederationDomainConfig domainExactHandle ExactHandleSearch, + FD.FederationDomainConfig domainFullSearch FullSearch ] let expectSearch domain expectedUser = do @@ -457,3 +459,28 @@ testClaimKeyPackagesMLSDisabled opts brig = do ClaimKeyPackageRequest (qUnqualified alice) (qUnqualified bob) liftIO $ mbundle @?= Nothing + +crudFederationRemotes :: HasCallStack => Opt.Opts -> Brig -> Http () +crudFederationRemotes _opts brig = do + resetFederationRemotes brig + + res1 <- getFederationRemotes brig + liftIO $ assertEqual "should return nothing" [] res1 + + let remote1 = FederationDomainConfig (Domain "good.example.com") NoSearch + addFederationRemote brig remote1 + res2 <- getFederationRemotes brig + liftIO $ assertEqual "should return good.example.com" [remote1] res2 + + let remote2 = FederationDomainConfig (Domain "evil.example.com") ExactHandleSearch + addFederationRemote brig remote2 + res3 <- getFederationRemotes brig + liftIO $ assertEqual "should return {good,evil}.example.com" (sort [remote1, remote2]) (sort res3) + + deleteFederationRemote brig (domain remote1) + res4 <- getFederationRemotes brig + liftIO $ assertEqual "should return evil.example.com" (sort [remote2]) (sort res4) + + -- TODO: how do we test that the TVar is updated in all services? some fancy unit test? + -- duplicate internal end-point to all services, and implement the hanlers in a library? + pure () diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index dd8368dba2..51f525ef8a 100644 --- a/services/brig/test/integration/Util.hs +++ b/services/brig/test/integration/Util.hs @@ -111,6 +111,7 @@ import Wire.API.Conversation.Role (roleNameWireAdmin) import Wire.API.Federation.API import Wire.API.Federation.Domain import Wire.API.Internal.Notification +import Wire.API.Routes.FederationDomainConfig import Wire.API.Routes.MultiTablePaging import Wire.API.Team.Member hiding (userId) import Wire.API.User @@ -1074,6 +1075,24 @@ withDomainsBlockedForRegistration opts domains sess = do unsafeMkDomain = either error id . mkDomain withSettingsOverrides opts' sess +getFederationRemotes :: Brig -> Http [FederationDomainConfig] +getFederationRemotes brig = + fromFederationDomainConfigs . responseJsonUnsafe <$> do + get (brig . paths ["i", "federation", "remotes"] . contentJson . expect2xx) + +addFederationRemote :: Brig -> FederationDomainConfig -> Http () +addFederationRemote brig remote = + void $ post (brig . paths ["i", "federation", "remotes"] . contentJson . json remote . expect2xx) + +deleteFederationRemote :: Brig -> Domain -> Http () +deleteFederationRemote brig rdom = + void $ delete (brig . paths ["i", "federation", "remotes", toByteString' rdom] . contentJson . expect2xx) + +resetFederationRemotes :: Brig -> Http () +resetFederationRemotes brig = do + rs <- getFederationRemotes brig + forM_ rs $ \(FederationDomainConfig rdom _) -> deleteFederationRemote brig rdom + -- | Run a probe several times, until a "good" value materializes or until patience runs out aFewTimes :: (HasCallStack, MonadIO m) =>