From a36cb0aa674b8d2df532d821c86fbba2c29d2bde Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 9 Jun 2026 12:43:23 +0200 Subject: [PATCH 1/9] WIP --- .../src/Wire/Options/Galley.hs | 2 +- services/brig/src/Brig/Options.hs | 158 +++++++++++++++++- 2 files changed, 156 insertions(+), 4 deletions(-) diff --git a/libs/wire-subsystems/src/Wire/Options/Galley.hs b/libs/wire-subsystems/src/Wire/Options/Galley.hs index 6b30fff0976..76d25b5bc64 100644 --- a/libs/wire-subsystems/src/Wire/Options/Galley.hs +++ b/libs/wire-subsystems/src/Wire/Options/Galley.hs @@ -221,7 +221,7 @@ data Opts = Opts _federator :: !(Maybe Endpoint), -- | RabbitMQ settings, required when federation is enabled. _rabbitmq :: !(Maybe AmqpEndpoint), - -- | Disco URL + -- | Disco URL. TODO: Remove _discoUrl :: !(Maybe Text), -- | Other settings _settings :: !Settings, diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index da75b90138a..34ebb354406 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -24,6 +24,7 @@ module Brig.Options where +import Amazonka.Types (S3AddressingStyle) import Brig.Queue.Types (QueueOpts (..)) import Control.Applicative import Control.Lens hiding (Level, element, enum) @@ -355,6 +356,157 @@ instance ToSchema ListAllSFTServers where element "disabled" HideAllSFTServers ] +data WireConfig = WireConfig + { internalServices :: InternalServices, + externalServices :: ExternalServices, + settings :: WireSettings + } + +data InternalServices = InternalServices + { brig :: !Endpoint, + cargohold :: !Endpoint, + galley :: !Endpoint, + spar :: !Endpoint, + gundeck :: !Endpoint, + federatorInternal :: !(Maybe Endpoint), + wireServerEnterprise :: !(Maybe Endpoint) + } + +data ExternalServices = ExternalServices + { cassandraBrig :: !CassandraOpts, + cassandraGalley :: !CassandraOpts, + cassandraGundeck :: !CassandraOpts, + cassandraSpar :: !CassandraOpts, + elasticsearch :: !ElasticSearchOpts, + redis :: !RedisEndpoint, + redisAdditionalWrite :: !(Maybe RedisEndpoint), + -- | Postgresql settings, the key values must be in libpq format. + -- https://www.postgresql.org/docs/17/libpq-connect.html#LIBPQ-PARAMKEYWORDS + postgresql :: !(Map Text Text), + postgresqlPassword :: !(Maybe FilePathSecrets), + postgresqlPool :: !PoolConfig, + rabbitmq :: !AmqpEndpoint, + email :: !EmailOpts, + prekeySelection :: !PrekeySelectionOpts, + -- TODO: See if user and team journal can even be configured differently. If + -- everything is supposed to be used by ibis, we cannot actually configure + -- them seperately anyway. + userJournal :: !(Maybe SqsOpts), + teamJournal :: !(Maybe SqsOpts), + internalEvents :: !SqsOpts, + assets :: !AssetOpts + } + +data RedisConnectionMode + = Master + | Cluster + +data RedisEndpoint = RedisEndpoint + { _host :: !Text, + _port :: !Word16, + _connectionMode :: !RedisConnectionMode, + _enableTls :: !Bool, + -- | When not specified, use system CA bundle + _tlsCa :: !(Maybe FilePath), + -- | When 'True', uses TLS but does not verify hostname or CA or validity of + -- the cert. Not recommended to set to 'True'. + _insecureSkipVerifyTls :: !Bool + } + +data PrekeySelectionOpts + = RandomPrekeySelection + | DynamoDBPrekeySelection !DynamoDBPrekeySelectionOpts + +data DynamoDBPrekeySelectionOpts = DynamoDBPrekeySelectionOpts + { dynamoDBEndpoint :: !AWSEndpoint, + tableName :: !Text + } + +data SqsOpts = SqsOpts + { sqsEndpoint :: !AWSEndpoint, + queueName :: !Text + } + +data AssetOpts = AssetOpts + { s3Endpoint :: !AWSEndpoint, + -- | S3 can either by addressed in path style, i.e. + -- https:////, or vhost style, i.e. + -- https://./. AWS's S3 offering has + -- deprecated path style addressing for S3 and completely disabled it for + -- buckets created after 30 Sep 2020: + -- https://aws.amazon.com/blogs/aws/amazon-s3-path-deprecation-plan-the-rest-of-the-story/ + -- + -- However other object storage providers (specially self-deployed ones like + -- MinIO) may not support vhost style addressing yet (or ever?). Users of + -- such buckets should configure this option to "path". + -- + -- Installations using S3 service provided by AWS, should use "auto", this + -- option will ensure that vhost style is only used when it is possible to + -- construct a valid hostname from the bucket name and the bucket name + -- doesn't contain a '.'. Having a '.' in the bucket name causes TLS + -- validation to fail, hence it is not used by default. + -- + -- Using "virtual" as an option is only useful in situations where vhost + -- style addressing must be used even if it is not possible to construct a + -- valid hostname from the bucket name or the S3 service provider can ensure + -- correct certificate is issued for bucket which contain one or more '.'s + -- in the name. + -- + -- When this option is unspecified, we default to path style addressing to + -- ensure smooth transition for older deployments. + s3AddressingStyle :: !(Maybe OptS3AddressingStyle), + -- | S3 endpoint for generating download links. Useful if Cargohold is configured to use + -- an S3 replacement running inside the internal network (in which case internally we + -- would use one hostname for S3, and when generating an asset link for a client app, we + -- would use another hostname). + s3DownloadEndpoint :: !(Maybe AWSEndpoint), + s3Bucket :: !Text, + -- | Enable this option for compatibility with specific S3 backends. + s3Compatibility :: !(Maybe S3Compatibility), + cloudFront :: !(Maybe CloudFrontOpts), + -- | @Z-Host@ header to s3 download endpoint `Map` + -- + -- This logic is: If the @Z-Host@ header is provided and found in this map, + -- the map's values is taken as s3 download endpoint to redirect to; + -- otherwise a 404 is retuned. This option is only useful + -- in the context of multi-ingress setups where one backend / deployment is + -- reachable under several domains. + multiIngress :: !(Maybe (Map String AWSEndpoint)) + } + +newtype OptS3AddressingStyle = OptS3AddressingStyle + { unwrapS3AddressingStyle :: S3AddressingStyle + } + +data WireSettings = WireSettings + { turn :: !TurnOpts, + sft :: !(Maybe SFTOptions) + } + +data S3Compatibility + = -- | Scality RING, might also work for Zenko CloudServer + -- + S3CompatibilityScalityRing + +-- | AWS CloudFront settings. +data CloudFrontOpts = CloudFrontOpts + { -- | Domain + domain :: CFDomain, + -- | Keypair ID + keyPairId :: CFKeyPairId, + -- | Path to private key + privateKey :: FilePath + } + deriving (Show, Generic) + +-- TODO: This is copied from cargohold, dedupe +newtype CFKeyPairId = CFKeyPairId Text + deriving (Eq, Show, Generic) + +-- TODO: This is copied from cargohold, dedupe +newtype CFDomain = CFDomain Text + deriving (Eq, Show, Generic) + -- | Options that are consumed on startup data Opts = Opts -- services @@ -404,7 +556,7 @@ data Opts = Opts zauth :: !ZAuthOpts, -- Misc. - -- | Disco URL + -- | Disco URL, TODO: Remove. discoUrl :: !(Maybe Text), -- | Event queue for -- Brig-generated events (e.g. @@ -415,7 +567,7 @@ data Opts = Opts -- | Log level (Debug, Info, etc) logLevel :: !Level, -- | Use netstrings encoding (see - -- ) + -- ). TODO: Remove. logNetStrings :: !(Maybe (Last Bool)), -- | Logformat to use -- TURN @@ -440,7 +592,7 @@ data Settings = Settings teamInvitationTimeout :: !Timeout, -- | Check for expired users every so often, in seconds expiredUserCleanupTimeout :: !(Maybe Timeout), - -- | STOMP broker credentials + -- | STOMP broker credentials. TODO: Remove. stomp :: !(Maybe FilePathSecrets), -- | Whitelist of allowed emails/phones allowlistEmailDomains :: !(Maybe AllowlistEmailDomains), From 10d49796a8c85286bd35821fd6c76930de84a13e Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 9 Jun 2026 16:20:46 +0200 Subject: [PATCH 2/9] More WIP --- services/brig/src/Brig/Options.hs | 325 ++++++++++++------------ services/gundeck/src/Gundeck/Options.hs | 1 + services/spar/src/Spar/Options.hs | 2 +- 3 files changed, 158 insertions(+), 170 deletions(-) diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 34ebb354406..c97b031d73c 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -24,6 +24,7 @@ module Brig.Options where +import Amazonka (Region) import Amazonka.Types (S3AddressingStyle) import Brig.Queue.Types (QueueOpts (..)) import Control.Applicative @@ -55,6 +56,7 @@ import Wire.API.Allowlists (AllowlistEmailDomains (..)) import Wire.API.Routes.FederationDomainConfig import Wire.API.Routes.Version import Wire.API.Team.Feature +import Wire.API.Team.FeatureFlags import Wire.API.User import Wire.AuthenticationSubsystem.Config (ZAuthSettings) import Wire.AuthenticationSubsystem.Cookie.Limit @@ -235,16 +237,15 @@ instance FromJSON EmailOpts where EmailAWS <$> parseJSON o <|> EmailSMTP <$> parseJSON o -data EmailSMSOpts = EmailSMSOpts - { email :: !EmailOpts, - general :: !EmailSMSGeneralOpts, +data EmailSettings = EmailSettings + { general :: !EmailSMSGeneralOpts, user :: !EmailUserOpts, provider :: !ProviderOpts, team :: !TeamOpts } deriving (Show, Generic) -instance FromJSON EmailSMSOpts +instance FromJSON EmailSettings -- | Login retry limit. In contrast to 'setUserCookieThrottle', this is not about mitigating -- DOS attacks, but about preventing dictionary attacks. This introduces the orthogonal risk @@ -369,6 +370,7 @@ data InternalServices = InternalServices spar :: !Endpoint, gundeck :: !Endpoint, federatorInternal :: !(Maybe Endpoint), + backgroundWorker :: !Endpoint, wireServerEnterprise :: !(Maybe Endpoint) } @@ -394,7 +396,8 @@ data ExternalServices = ExternalServices userJournal :: !(Maybe SqsOpts), teamJournal :: !(Maybe SqsOpts), internalEvents :: !SqsOpts, - assets :: !AssetOpts + assets :: !AssetOpts, + pushNotifications :: !PushNotifiactionOpts } data RedisConnectionMode @@ -479,121 +482,42 @@ newtype OptS3AddressingStyle = OptS3AddressingStyle } data WireSettings = WireSettings - { turn :: !TurnOpts, - sft :: !(Maybe SFTOptions) - } - -data S3Compatibility - = -- | Scality RING, might also work for Zenko CloudServer - -- - S3CompatibilityScalityRing - --- | AWS CloudFront settings. -data CloudFrontOpts = CloudFrontOpts - { -- | Domain - domain :: CFDomain, - -- | Keypair ID - keyPairId :: CFKeyPairId, - -- | Path to private key - privateKey :: FilePath + { users :: UserSettings, + search :: SearchSettings, + teams :: TeamSettings, + conversations :: ConversationSettings, + auth :: AuthSettings, + calling :: CallingSettings, + notifications :: NotificationSettings, + federation :: FederationSettings, + email :: EmailSettings, + featureFlags :: FeatureFlags, + assets :: AssetSettings, + bots :: BotSettings, + postgresMigration :: PostgresMigrationOpts, + logSettings :: LogSettings + } + +data SearchSettings = SearchSettings + { emailVisibility :: !EmailVisibilityConfig, + -- | When true, search only + -- returns users from the same team + searchSameTeamOnly :: !(Maybe Bool) } - deriving (Show, Generic) - --- TODO: This is copied from cargohold, dedupe -newtype CFKeyPairId = CFKeyPairId Text - deriving (Eq, Show, Generic) - --- TODO: This is copied from cargohold, dedupe -newtype CFDomain = CFDomain Text - deriving (Eq, Show, Generic) - --- | Options that are consumed on startup -data Opts = Opts - -- services - { -- | Host and port to bind to - brig :: !Endpoint, - -- | Cargohold address - cargohold :: !Endpoint, - -- | Galley address - galley :: !Endpoint, - -- | Spar address - spar :: !Endpoint, - -- | Gundeck address - gundeck :: !Endpoint, - -- | Federator address - federatorInternal :: !(Maybe Endpoint), - -- | Wire Server Enterprise address - wireServerEnterprise :: !(Maybe Endpoint), - -- external - -- | Cassandra settings - cassandra :: !CassandraOpts, - -- | ElasticSearch settings - elasticsearch :: !ElasticSearchOpts, - -- | Postgresql settings, the key values must be in libpq format. - -- https://www.postgresql.org/docs/17/libpq-connect.html#LIBPQ-PARAMKEYWORDS - postgresql :: !(Map Text Text), - postgresqlPassword :: !(Maybe FilePathSecrets), - postgresqlPool :: !PoolConfig, - postgresMigration :: !PostgresMigrationOpts, - -- | SFT Federation - multiSFT :: !(Maybe Bool), - -- | RabbitMQ settings, required when federation is enabled. - rabbitmq :: !AmqpEndpoint, - -- | AWS settings - aws :: !AWSOpts, - -- | Enable Random Prekey Strategy - randomPrekeys :: !(Maybe Bool), - -- | STOMP broker settings - stompOptions :: !(Maybe StompOpts), - -- Email & SMS - - -- | Email and SMS settings - emailSMS :: !EmailSMSOpts, - -- ZAuth - - -- | ZAuth settings - zauth :: !ZAuthOpts, - -- Misc. - - -- | Disco URL, TODO: Remove. - discoUrl :: !(Maybe Text), - -- | Event queue for - -- Brig-generated events (e.g. - -- user deletion) - internalEvents :: !InternalEventsOpts, - -- Logging - - -- | Log level (Debug, Info, etc) - logLevel :: !Level, - -- | Use netstrings encoding (see - -- ). TODO: Remove. - logNetStrings :: !(Maybe (Last Bool)), - -- | Logformat to use - -- TURN - logFormat :: !(Maybe (Last LogFormat)), - -- | TURN server settings - turn :: !TurnOpts, - -- | SFT Settings - sft :: !(Maybe SFTOptions), - -- | Runtime settings - settings :: !Settings +data LogSettings = LogSettings + { logLevel :: !Level, + logFormat :: !(Maybe LogFormat) } - deriving (Show, Generic) --- | Options that persist as runtime settings. -data Settings = Settings - { -- | Activation timeout, in seconds +data UserSettings = UserSettings + { -- \| Activation timeout, in seconds activationTimeout :: !Timeout, -- | Default verification code timeout, in seconds -- use `verificationTimeout` as the getter function which always provides a default value verificationCodeTimeoutInternal :: !(Maybe Code.Timeout), - -- | Team invitation timeout, in seconds - teamInvitationTimeout :: !Timeout, -- | Check for expired users every so often, in seconds expiredUserCleanupTimeout :: !(Maybe Timeout), - -- | STOMP broker credentials. TODO: Remove. - stomp :: !(Maybe FilePathSecrets), -- | Whitelist of allowed emails/phones allowlistEmailDomains :: !(Maybe AllowlistEmailDomains), -- | Max. number of sent/accepted @@ -601,55 +525,68 @@ data Settings = Settings userMaxConnections :: !Int64, -- | Max. number of permanent clients per user userMaxPermClients :: !(Maybe Int), - -- | Whether to allow plain HTTP transmission - -- of cookies (for testing purposes only) - cookieInsecure :: !Bool, - -- | Minimum age of a user cookie before - -- it is renewed during token refresh - userCookieRenewAge :: !Integer, - -- | Max. # of cookies per user and cookie type - userCookieLimit :: !Int, - -- | Throttling tings (not to be confused - -- with 'LoginRetryOpts') - userCookieThrottle :: !CookieThrottle, - -- | Block user from logging in - -- for m minutes after n failed - -- logins - limitFailedLogins :: !(Maybe LimitFailedLogins), - -- | If last cookie renewal is too long ago, - -- suspend the user. suspendInactiveUsers :: !(Maybe SuspendInactiveUsers), -- | Max size of rich info (number of chars in -- field names and values), should be in sync -- with Spar richInfoLimit :: !Int, - -- | Default locale to use when selecting templates - -- use `defaultTemplateLocale` as the getter function which always provides a default value + -- | Default locale to use when selecting templates use + -- `defaultTemplateLocale` as the getter function which always provides a + -- default value. TODO: Merge this and next. defaultTemplateLocaleInternal :: !(Maybe Locale), -- | Default locale to use for users -- use `defaultUserLocale` as the getter function which always provides a default value defaultUserLocaleInternal :: !(Maybe Locale), - -- | Max. # of members in a team. - -- NOTE: This must be in sync with galley - maxTeamSize :: !Word32, - -- | Max. # of members in a conversation. - -- NOTE: This must be in sync with galley - maxConvSize :: !Word16, - -- | Filter ONLY services with - -- the given provider id - providerSearchFilter :: !(Maybe ProviderId), - -- | Whether to expose user emails and to whom - emailVisibility :: !EmailVisibilityConfig, propertyMaxKeyLen :: !(Maybe Int64), propertyMaxValueLen :: !(Maybe Int64), - -- | How long, in milliseconds, to wait - -- in between processing delete events + -- | How long, in milliseconds, to wait in between processing delete events -- from the internal delete queue deleteThrottleMillis :: !(Maybe Int), - -- | When true, search only - -- returns users from the same team - searchSameTeamOnly :: !(Maybe Bool), - -- | FederationDomain is required, even when not wanting to federate with other backends + -- | 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'. + -- When using real SQS from AWS, throttling isn't needed as much, since using + -- >>> SQS.rmWaitTimeSeconds (Just 20) in Brig.AWS.listen + -- ensures that there is only one request every 20 seconds. + -- However, that parameter is not honoured when using fake-sqs + -- (where throttling can thus make sense) + sqsThrottleMillis :: !(Maybe Int), + -- | Do not allow certain user creation flows. + -- docs/reference/user/registration.md {#RefRestrictRegistration}. + restrictUserCreation :: !(Maybe Bool) + } + +data TeamSettings = TeamSettings + { -- \| Team invitation timeout, in seconds + teamInvitationTimeout :: !Timeout, + -- | Max. # of members in a team. + maxTeamSize :: !Word32 + } + +data ConversationSettings = ConversationSettings + { -- | Max. # of members in a conversation. + maxConvSize :: !Word16 + } + +data AuthSettings = AuthSettings + { zauth :: !ZAuthOpts, + -- | Whether to allow plain HTTP transmission of cookies (for testing + -- purposes only) + cookieInsecure :: !Bool, + -- | Minimum age of a user cookie before it is renewed during token refresh + userCookieRenewAge :: !Integer, + -- | Max. # of cookies per user and cookie type + userCookieLimit :: !Int, + -- | Throttling tings (not to be confused with 'LoginRetryOpts') + userCookieThrottle :: !CookieThrottle, + -- | Block user from logging in for m minutes after n failed logins + limitFailedLogins :: !(Maybe LimitFailedLogins) + } + +data NotificationSettings = NotificationSettings {} + +data FederationSettings = FederationSettings + { -- \| FederationDomain is required, even when not wanting to federate with other backends -- (in that case the 'federationStrategy' can be set to `allowNone` below, or to -- `allowDynamic` while keeping the list of allowed domains empty, see -- https://docs.wire.com/understand/federation/backend-communication.html#configuring-remote-connections) @@ -672,20 +609,70 @@ data Settings = Settings federationDomainConfigs :: !(Maybe [ImplicitNoFederationRestriction]), -- | In seconds. Default: 10 seconds. Values <1 are silently replaced by 1. See -- https://docs.wire.com/understand/federation/backend-communication.html#configuring-remote-connections - federationDomainConfigsUpdateFreq :: !(Maybe Int), - -- | 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'. - -- When using real SQS from AWS, throttling isn't needed as much, since using - -- >>> SQS.rmWaitTimeSeconds (Just 20) in Brig.AWS.listen - -- ensures that there is only one request every 20 seconds. - -- However, that parameter is not honoured when using fake-sqs - -- (where throttling can thus make sense) - sqsThrottleMillis :: !(Maybe Int), - -- | Do not allow certain user creation flows. - -- docs/reference/user/registration.md {#RefRestrictRegistration}. - restrictUserCreation :: !(Maybe Bool), - -- | The analog to `Galley.Options.featureFlags`. See 'AccountFeatureConfigs'. + federationDomainConfigsUpdateFreq :: !(Maybe Int) + } + +data AssetSettings = AssetSettings {} + +data CallingSettings = CallingSettings + { turn :: !TurnOpts, + sft :: !(Maybe SFTOptions), + multiSFT :: !(Maybe Bool) + } + +data BotSettings = BotSettings + { -- \| Filter ONLY services with + -- the given provider id + providerSearchFilter :: !(Maybe ProviderId) + } + +data S3Compatibility + = -- | Scality RING, might also work for Zenko CloudServer + -- + S3CompatibilityScalityRing + +-- | AWS CloudFront settings. +data CloudFrontOpts = CloudFrontOpts + { -- | Domain + domain :: CFDomain, + -- | Keypair ID + keyPairId :: CFKeyPairId, + -- | Path to private key + privateKey :: FilePath + } + deriving (Show, Generic) + +-- TODO: This is copied from cargohold, dedupe +newtype CFKeyPairId = CFKeyPairId Text + deriving (Eq, Show, Generic) + +-- TODO: This is copied from cargohold, dedupe +newtype CFDomain = CFDomain Text + deriving (Eq, Show, Generic) + +data PushNotifiactionOpts = PushNotifiactionOpts + { -- \| AWS account + _account :: !Text, + -- | AWS region name + _region :: !Region, + -- | Environment name to scope ARNs to. TODO: Add explanation for on-prem operators. + _arnEnv :: !Text, + -- | SQS queue name + _queueName :: !Text, + _sqsEndpoint :: !AWSEndpoint, + _snsEndpoint :: !AWSEndpoint + } + +-- | Options that are consumed on startup +data Opts = Opts + -- services + { settings :: !Settings + } + deriving (Show, Generic) + +-- | Options that persist as runtime settings. +data Settings = Settings + { -- | The analog to `Galley.Options.featureFlags`. See 'AccountFeatureConfigs'. featureFlags :: !(Maybe UserFeatureFlags), -- | Customer extensions. Read 'CustomerExtensions' docs carefully! customerExtensions :: !(Maybe CustomerExtensions), @@ -769,17 +756,17 @@ instance FromJSON ImplicitNoFederationRestriction where defaultLocale :: Locale defaultLocale = Locale (Language EN) Nothing -defaultUserLocale :: Settings -> Locale -defaultUserLocale = fromMaybe defaultLocale . defaultUserLocaleInternal +-- defaultUserLocale :: Settings -> Locale +-- defaultUserLocale = fromMaybe defaultLocale . defaultUserLocaleInternal -defaultTemplateLocale :: Settings -> Locale -defaultTemplateLocale = fromMaybe defaultLocale . defaultTemplateLocaleInternal +-- defaultTemplateLocale :: Settings -> Locale +-- defaultTemplateLocale = fromMaybe defaultLocale . defaultTemplateLocaleInternal -verificationTimeout :: Settings -> Code.Timeout -verificationTimeout = fromMaybe defVerificationTimeout . verificationCodeTimeoutInternal - where - defVerificationTimeout :: Code.Timeout - defVerificationTimeout = Code.Timeout (60 * 10) -- 10 minutes +-- verificationTimeout :: Settings -> Code.Timeout +-- verificationTimeout = fromMaybe defVerificationTimeout . verificationCodeTimeoutInternal +-- where +-- defVerificationTimeout :: Code.Timeout +-- defVerificationTimeout = Code.Timeout (60 * 10) -- 10 minutes twoFACodeGenerationDelaySecs :: Settings -> Int twoFACodeGenerationDelaySecs = fromMaybe def2FACodeGenerationDelaySecs . twoFACodeGenerationDelaySecsInternal diff --git a/services/gundeck/src/Gundeck/Options.hs b/services/gundeck/src/Gundeck/Options.hs index d70bbc4f91d..8c9b86728e1 100644 --- a/services/gundeck/src/Gundeck/Options.hs +++ b/services/gundeck/src/Gundeck/Options.hs @@ -139,6 +139,7 @@ data Opts = Opts _redisAdditionalWrite :: !(Maybe RedisEndpoint), _aws :: !AWSOpts, _rabbitmq :: !AmqpEndpoint, + -- TODO: Delete. _discoUrl :: !(Maybe Text), _settings :: !Settings, -- Logging diff --git a/services/spar/src/Spar/Options.hs b/services/spar/src/Spar/Options.hs index 887933a0a9f..434db6f2e52 100644 --- a/services/spar/src/Spar/Options.hs +++ b/services/spar/src/Spar/Options.hs @@ -58,7 +58,7 @@ data Opts = Opts -- | The maximum size of rich info. richInfoLimit :: !Int, -- | Wire/AWS specific; optional; used to discover Cassandra instance - -- IPs using describe-instances. + -- IPs using describe-instances. TODO Delete. discoUrl :: !(Maybe Text), logNetStrings :: !(Maybe (Last Bool)), logFormat :: !(Maybe (Last LogFormat)), From f31eabde9b694537139290dfc7b2c6c7c10ff744 Mon Sep 17 00:00:00 2001 From: sghosh23 Date: Mon, 15 Jun 2026 14:03:44 +0200 Subject: [PATCH 3/9] common configs in the wire-subsystem --- .../wire-subsystems/src/Wire/ConfigOptions.hs | 598 ++++++++++++++++++ libs/wire-subsystems/wire-subsystems.cabal | 2 + 2 files changed, 600 insertions(+) create mode 100644 libs/wire-subsystems/src/Wire/ConfigOptions.hs diff --git a/libs/wire-subsystems/src/Wire/ConfigOptions.hs b/libs/wire-subsystems/src/Wire/ConfigOptions.hs new file mode 100644 index 00000000000..bd6c6165443 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/ConfigOptions.hs @@ -0,0 +1,598 @@ +{-# LANGUAGE TemplateHaskell #-} + + +module Wire.ConfigOptions where + +import Amazonka (Region) +import Amazonka.Types (S3AddressingStyle) +import Data.Aeson (FromJSON (..), Value (..), parseJSON, withObject, (.:), (.:?)) +import Data.Aeson.TH (Options (..), defaultOptions, deriveFromJSON, deriveJSON) +import Data.Aeson.Types qualified as A +import Data.Char qualified as Char +import Data.Code qualified as Code +import Data.Domain (Domain (..)) +import Data.Id (ProviderId) +import Data.LanguageCodes (ISO639_1 (EN)) +import Data.Range (Range) +import Data.Text qualified as Text +import Data.Text.Encoding qualified as Text +import Data.Time (DiffTime, secondsToDiffTime) +import Database.Bloodhound.Types qualified as ES +import Hasql.Pool.Extended (PoolConfig) +import Imports +import Network.AMQP.Extended (AmqpEndpoint) +import Network.DNS qualified as DNS +import System.Logger.Extended (Level, LogFormat) +import Util.Options +import Util.Options.Common (toOptionFieldName) +import Util.Timeout (Timeout) +import Wire.API.Allowlists (AllowlistEmailDomains (..)) +import Wire.API.Routes.FederationDomainConfig (FederationDomainConfig (..), FederationRestriction (..), FederationStrategy) +import Wire.API.Team.FeatureFlags (FeatureFlags) +import Wire.API.User +import Wire.AuthenticationSubsystem.Config (ZAuthSettings) +import Wire.AuthenticationSubsystem.Cookie.Limit (CookieThrottle) +import Wire.EmailSending.SMTP (SMTPConnType (..)) +import Wire.EmailSubsystem.Template (TeamOpts) +import Wire.PostgresMigrationOpts (PostgresMigrationOpts) + +asciiOnly :: Text -> A.Parser ByteString +asciiOnly t = + if Text.all Char.isAscii t + then pure $ Text.encodeUtf8 t + else fail $ "Expected ascii string only, found: " <> Text.unpack t + +defaultLocale :: Locale +defaultLocale = Locale (Language EN) Nothing + +data WireConfig = WireConfig + { internalServices :: InternalServices, + externalServices :: ExternalServices, + settings :: WireSettings + } + +data InternalServices = InternalServices + { brig :: !Endpoint, + cargohold :: !Endpoint, + galley :: !Endpoint, + spar :: !Endpoint, + gundeck :: !Endpoint, + federatorInternal :: !(Maybe Endpoint), + backgroundWorker :: !Endpoint, + wireServerEnterprise :: !(Maybe Endpoint) + } + +data ExternalServices = ExternalServices + { cassandraBrig :: !CassandraOpts, + cassandraGalley :: !CassandraOpts, + cassandraGundeck :: !CassandraOpts, + cassandraSpar :: !CassandraOpts, + elasticsearch :: !ElasticSearchOpts, + redis :: !RedisEndpoint, + redisAdditionalWrite :: !(Maybe RedisEndpoint), + -- | Postgresql settings, the key values must be in libpq format. + -- https://www.postgresql.org/docs/17/libpq-connect.html#LIBPQ-PARAMKEYWORDS + postgresql :: !(Map Text Text), + postgresqlPassword :: !(Maybe FilePathSecrets), + postgresqlPool :: !PoolConfig, + rabbitmq :: !AmqpEndpoint, + email :: !EmailOpts, + prekeySelection :: !PrekeySelectionOpts, + -- TODO: See if user and team journal can even be configured differently. If + -- everything is supposed to be used by ibis, we cannot actually configure + -- them seperately anyway. + userJournal :: !(Maybe SqsOpts), + teamJournal :: !(Maybe SqsOpts), + internalEvents :: !SqsOpts, + assets :: !AssetOpts, + pushNotifications :: !PushNotifiactionOpts + } + +data RedisConnectionMode + = Master + | Cluster + deriving (Show, Generic) + +data RedisEndpoint = RedisEndpoint + { _host :: !Text, + _port :: !Word16, + _connectionMode :: !RedisConnectionMode, + _enableTls :: !Bool, + -- | When not specified, use system CA bundle + _tlsCa :: !(Maybe FilePath), + -- | When 'True', uses TLS but does not verify hostname or CA or validity of + -- the cert. Not recommended to set to 'True'. + _insecureSkipVerifyTls :: !Bool + } + deriving (Show, Generic) + +data PrekeySelectionOpts + = RandomPrekeySelection + | DynamoDBPrekeySelection !DynamoDBPrekeySelectionOpts + +data DynamoDBPrekeySelectionOpts = DynamoDBPrekeySelectionOpts + { dynamoDBEndpoint :: !AWSEndpoint, + tableName :: !Text + } + +data SqsOpts = SqsOpts + { sqsEndpoint :: !AWSEndpoint, + queueName :: !Text + } + +data AssetOpts = AssetOpts + { s3Endpoint :: !AWSEndpoint, + -- | S3 can either by addressed in path style, i.e. + -- https:////, or vhost style, i.e. + -- https://./. AWS's S3 offering has + -- deprecated path style addressing for S3 and completely disabled it for + -- buckets created after 30 Sep 2020: + -- https://aws.amazon.com/blogs/aws/amazon-s3-path-deprecation-plan-the-rest-of-the-story/ + -- + -- However other object storage providers (specially self-deployed ones like + -- MinIO) may not support vhost style addressing yet (or ever?). Users of + -- such buckets should configure this option to "path". + -- + -- Installations using S3 service provided by AWS, should use "auto", this + -- option will ensure that vhost style is only used when it is possible to + -- construct a valid hostname from the bucket name and the bucket name + -- doesn't contain a '.'. Having a '.' in the bucket name causes TLS + -- validation to fail, hence it is not used by default. + -- + -- Using "virtual" as an option is only useful in situations where vhost + -- style addressing must be used even if it is not possible to construct a + -- valid hostname from the bucket name or the S3 service provider can ensure + -- correct certificate is issued for bucket which contain one or more '.'s + -- in the name. + -- + -- When this option is unspecified, we default to path style addressing to + -- ensure smooth transition for older deployments. + s3AddressingStyle :: !(Maybe OptS3AddressingStyle), + -- | S3 endpoint for generating download links. Useful if Cargohold is configured to use + -- an S3 replacement running inside the internal network (in which case internally we + -- would use one hostname for S3, and when generating an asset link for a client app, we + -- would use another hostname). + s3DownloadEndpoint :: !(Maybe AWSEndpoint), + s3Bucket :: !Text, + -- | Enable this option for compatibility with specific S3 backends. + s3Compatibility :: !(Maybe S3Compatibility), + cloudFront :: !(Maybe CloudFrontOpts), + -- | @Z-Host@ header to s3 download endpoint `Map` + -- + -- This logic is: If the @Z-Host@ header is provided and found in this map, + -- the map's values is taken as s3 download endpoint to redirect to; + -- otherwise a 404 is retuned. This option is only useful + -- in the context of multi-ingress setups where one backend / deployment is + -- reachable under several domains. + multiIngress :: !(Maybe (Map String AWSEndpoint)) + } + +newtype OptS3AddressingStyle = OptS3AddressingStyle + { unwrapS3AddressingStyle :: S3AddressingStyle + } + +data WireSettings = WireSettings + { users :: UserSettings, + search :: SearchSettings, + teams :: TeamSettings, + conversations :: ConversationSettings, + auth :: AuthSettings, + calling :: CallingSettings, + notifications :: NotificationSettings, + federation :: FederationSettings, + email :: EmailSettings, + featureFlags :: FeatureFlags, + assets :: AssetSettings, + bots :: BotSettings, + postgresMigration :: PostgresMigrationOpts, + logSettings :: LogSettings + } + +data SearchSettings = SearchSettings + { emailVisibility :: !EmailVisibilityConfig, + -- | When true, search only + -- returns users from the same team + searchSameTeamOnly :: !(Maybe Bool) + } + +data LogSettings = LogSettings + { logLevel :: !Level, + logFormat :: !(Maybe LogFormat) + } + +data UserSettings = UserSettings + { -- \| Activation timeout, in seconds + activationTimeout :: !Timeout, + -- | Default verification code timeout, in seconds + -- use `verificationTimeout` as the getter function which always provides a default value + verificationCodeTimeoutInternal :: !(Maybe Code.Timeout), + -- | Check for expired users every so often, in seconds + expiredUserCleanupTimeout :: !(Maybe Timeout), + -- | Whitelist of allowed emails/phones + allowlistEmailDomains :: !(Maybe AllowlistEmailDomains), + -- | Max. number of sent/accepted + -- connections per user + userMaxConnections :: !Int64, + -- | Max. number of permanent clients per user + userMaxPermClients :: !(Maybe Int), + suspendInactiveUsers :: !(Maybe SuspendInactiveUsers), + -- | Max size of rich info (number of chars in + -- field names and values), should be in sync + -- with Spar + richInfoLimit :: !Int, + -- | Default locale to use when selecting templates use + -- `defaultTemplateLocale` as the getter function which always provides a + -- default value. TODO: Merge this and next. + defaultTemplateLocaleInternal :: !(Maybe Locale), + -- | Default locale to use for users + -- use `defaultUserLocale` as the getter function which always provides a default value + defaultUserLocaleInternal :: !(Maybe Locale), + propertyMaxKeyLen :: !(Maybe Int64), + propertyMaxValueLen :: !(Maybe Int64), + -- | How long, in milliseconds, to wait in between processing delete events + -- from the internal delete queue + deleteThrottleMillis :: !(Maybe Int), + -- | 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'. + -- When using real SQS from AWS, throttling isn't needed as much, since using + -- >>> SQS.rmWaitTimeSeconds (Just 20) in Brig.AWS.listen + -- ensures that there is only one request every 20 seconds. + -- However, that parameter is not honoured when using fake-sqs + -- (where throttling can thus make sense) + sqsThrottleMillis :: !(Maybe Int), + -- | Do not allow certain user creation flows. + -- docs/reference/user/registration.md {#RefRestrictRegistration}. + restrictUserCreation :: !(Maybe Bool) + } + +data TeamSettings = TeamSettings + { -- \| Team invitation timeout, in seconds + teamInvitationTimeout :: !Timeout, + -- | Max. # of members in a team. + maxTeamSize :: !Word32 + } + +data ConversationSettings = ConversationSettings + { -- | Max. # of members in a conversation. + maxConvSize :: !Word16 + } + +data AuthSettings = AuthSettings + { zauth :: !ZAuthOpts, + -- | Whether to allow plain HTTP transmission of cookies (for testing + -- purposes only) + cookieInsecure :: !Bool, + -- | Minimum age of a user cookie before it is renewed during token refresh + userCookieRenewAge :: !Integer, + -- | Max. # of cookies per user and cookie type + userCookieLimit :: !Int, + -- | Throttling tings (not to be confused with 'LoginRetryOpts') + userCookieThrottle :: !CookieThrottle, + -- | Block user from logging in for m minutes after n failed logins + limitFailedLogins :: !(Maybe LimitFailedLogins) + } + +data NotificationSettings = NotificationSettings {} + +data FederationSettings = FederationSettings + { -- \| FederationDomain is required, even when not wanting to federate with other backends + -- (in that case the 'federationStrategy' can be set to `allowNone` below, or to + -- `allowDynamic` while keeping the list of allowed domains empty, see + -- https://docs.wire.com/understand/federation/backend-communication.html#configuring-remote-connections) + -- Federation domain is used to qualify local IDs and handles, + -- e.g. 0c4d8944-70fa-480e-a8b7-9d929862d18c@wire.com and somehandle@wire.com. + -- It should also match the SRV DNS records under which other wire-server installations can find this backend: + -- >>> _wire-server-federator._tcp. + -- Once set, DO NOT change it: if you do, existing users may have a broken experience and/or stop working. + -- Remember to keep it the same in all services. + federationDomain :: !Domain, + -- | See https://docs.wire.com/understand/federation/backend-communication.html#configuring-remote-connections + -- default: AllowNone + federationStrategy :: !(Maybe FederationStrategy), + -- | 'federationDomainConfigs' is introduced in + -- https://github.com/wireapp/wire-server/pull/3260 for the sole purpose of transitioning + -- to dynamic federation remote configuration. See + -- https://docs.wire.com/understand/federation/backend-communication.html#configuring-remote-connections + -- for details. + -- default: [] + federationDomainConfigs :: !(Maybe [ImplicitNoFederationRestriction]), + -- | In seconds. Default: 10 seconds. Values <1 are silently replaced by 1. See + -- https://docs.wire.com/understand/federation/backend-communication.html#configuring-remote-connections + federationDomainConfigsUpdateFreq :: !(Maybe Int) + } + +data AssetSettings = AssetSettings {} + +data CallingSettings = CallingSettings + { turn :: !TurnOpts, + sft :: !(Maybe SFTOptions), + multiSFT :: !(Maybe Bool) + } + +data BotSettings = BotSettings + { -- \| Filter ONLY services with + -- the given provider id + providerSearchFilter :: !(Maybe ProviderId) + } + +data S3Compatibility + = -- | Scality RING, might also work for Zenko CloudServer + -- + S3CompatibilityScalityRing + +-- | AWS CloudFront settings. +data CloudFrontOpts = CloudFrontOpts + { -- | Domain + domain :: CFDomain, + -- | Keypair ID + keyPairId :: CFKeyPairId, + -- | Path to private key + privateKey :: FilePath + } + deriving (Show, Generic) + +-- TODO: This is copied from cargohold, dedupe +newtype CFKeyPairId = CFKeyPairId Text + deriving (Eq, Show, Generic) + +-- TODO: This is copied from cargohold, dedupe +newtype CFDomain = CFDomain Text + deriving (Eq, Show, Generic) + +data PushNotifiactionOpts = PushNotifiactionOpts + { -- \| AWS account + _account :: !Text, + -- | AWS region name + _region :: !Region, + -- | Environment name to scope ARNs to. TODO: Add explanation for on-prem operators. + _arnEnv :: !Text, + -- | SQS queue name + _queueName :: !Text, + _sqsEndpoint :: !AWSEndpoint, + _snsEndpoint :: !AWSEndpoint + } + +-- | Wraps 'FederationDomainConfig' with a 'FromJSON' instance that defaults +-- 'FederationRestriction' to 'FederationRestrictionAllowAll' when absent. +newtype ImplicitNoFederationRestriction = ImplicitNoFederationRestriction + {federationDomainConfig :: FederationDomainConfig} + deriving (Show, Eq, Generic) + +instance FromJSON ImplicitNoFederationRestriction where + parseJSON = + withObject + "ImplicitNoFederationRestriction" + ( \obj -> do + domain <- obj .: "domain" + searchPolicy <- obj .: "search_policy" + pure . ImplicitNoFederationRestriction $ + FederationDomainConfig domain searchPolicy FederationRestrictionAllowAll + ) + +-- --------------------------------------------------------------------------- +-- Types moved from Brig.Options +-- --------------------------------------------------------------------------- + +data ElasticSearchOpts = ElasticSearchOpts + { url :: !ES.Server, + index :: !ES.IndexName, + additionalWriteIndex :: !(Maybe ES.IndexName), + additionalWriteIndexUrl :: !(Maybe ES.Server), + credentials :: !(Maybe FilePathSecrets), + additionalCredentials :: !(Maybe FilePathSecrets), + insecureSkipVerifyTls :: Bool, + caCert :: Maybe FilePath, + additionalInsecureSkipVerifyTls :: Bool, + additionalCaCert :: Maybe FilePath + } + deriving (Show, Generic) + +instance FromJSON ElasticSearchOpts + +data EmailAWSOpts = EmailAWSOpts + { -- | Event feedback queue for SES (e.g. for email bounces and complaints) + sesQueue :: !Text, + -- | AWS SES endpoint + sesEndpoint :: !AWSEndpoint + } + deriving (Show, Generic) + +instance FromJSON EmailAWSOpts + +data EmailSMTPCredentials = EmailSMTPCredentials + { smtpUsername :: !Text, + smtpPassword :: !FilePathSecrets + } + deriving (Show, Generic) + +instance FromJSON EmailSMTPCredentials + +data EmailSMTPOpts = EmailSMTPOpts + { smtpEndpoint :: !Endpoint, + smtpCredentials :: !(Maybe EmailSMTPCredentials), + smtpConnType :: !SMTPConnType + } + deriving (Show, Generic) + +instance FromJSON EmailSMTPOpts + +data EmailOpts + = EmailAWS EmailAWSOpts + | EmailSMTP EmailSMTPOpts + deriving (Show, Generic) + +instance FromJSON EmailOpts where + parseJSON o = + EmailAWS <$> parseJSON o + <|> EmailSMTP <$> parseJSON o + +data BrandingOpts = BrandingOpts + { brand :: !Text, + brandUrl :: !Text, + brandLabelUrl :: !Text, + brandLogoUrl :: !Text, + brandService :: !Text, + copyright :: !Text, + misuse :: !Text, + legal :: !Text, + forgot :: !Text, + support :: !Text + } + deriving (Show, Generic) + +instance FromJSON BrandingOpts + +data EmailSMSGeneralOpts = EmailSMSGeneralOpts + { templateDir :: !FilePath, + emailSender :: !EmailAddress, + smsSender :: !Text, + templateBranding :: !BrandingOpts + } + deriving (Show, Generic) + +instance FromJSON EmailSMSGeneralOpts + +data EmailUserOpts = EmailUserOpts + { activationUrl :: !Text, + smsActivationUrl :: !Text, + passwordResetUrl :: !Text, + deletionUrl :: !Text + } + deriving (Show, Generic) + +instance FromJSON EmailUserOpts + +data ProviderOpts = ProviderOpts + { homeUrl :: !Text, + providerActivationUrl :: !Text, + approvalUrl :: !Text, + approvalTo :: !EmailAddress, + providerPwResetUrl :: !Text + } + deriving (Show, Generic) + +instance FromJSON ProviderOpts + +data EmailSettings = EmailSettings + { general :: !EmailSMSGeneralOpts, + user :: !EmailUserOpts, + provider :: !ProviderOpts, + team :: !TeamOpts + } + deriving (Show, Generic) + +instance FromJSON EmailSettings + +data LimitFailedLogins = LimitFailedLogins + { timeout :: !Timeout, + retryLimit :: !Int + } + deriving (Eq, Show, Generic) + +instance FromJSON LimitFailedLogins + +data SuspendInactiveUsers = SuspendInactiveUsers + { suspendTimeout :: !Timeout + } + deriving (Eq, Show, Generic) + +instance FromJSON SuspendInactiveUsers + +data ZAuthOpts = ZAuthOpts + { privateKeys :: !FilePath, + publicKeys :: !FilePath, + authSettings :: !ZAuthSettings + } + deriving (Show, Generic) + +instance FromJSON ZAuthOpts + +data TurnServersFiles = TurnServersFiles + { tsfServers :: !FilePath, + tsfServersV2 :: !FilePath + } + deriving (Show) + +instance FromJSON TurnServersFiles where + parseJSON = withObject "TurnServersFiles" $ \o -> + TurnServersFiles + <$> o .: "servers" + <*> o .: "serversV2" + +data TurnDnsOpts = TurnDnsOpts + { tdoBaseDomain :: DNS.Domain, + tdoDiscoveryIntervalSeconds :: !(Maybe DiffTime) + } + deriving (Show) + +instance FromJSON TurnDnsOpts where + parseJSON = withObject "TurnDnsOpts" $ \o -> + TurnDnsOpts + <$> (asciiOnly =<< o .: "baseDomain") + <*> o .:? "discoveryIntervalSeconds" + +data TurnServersSource + = TurnSourceDNS TurnDnsOpts + | TurnSourceFiles TurnServersFiles + deriving (Show) + +data TurnOpts = TurnOpts + { serversSource :: !TurnServersSource, + secret :: !FilePath, + tokenTTL :: !Word32, + configTTL :: !Word32 + } + deriving (Show) + +instance FromJSON TurnOpts where + parseJSON = withObject "TurnOpts" $ \o -> do + sourceName <- o .: "serversSource" + source <- + case sourceName of + "files" -> TurnSourceFiles <$> parseJSON (Object o) + "dns" -> TurnSourceDNS <$> parseJSON (Object o) + _ -> fail $ "TurnOpts: Invalid sourceType, expected one of [files, dns] but got: " <> Text.unpack sourceName + TurnOpts source + <$> o .: "secret" + <*> o .: "tokenTTL" + <*> o .: "configTTL" + +data SFTTokenOptions = SFTTokenOptions + { sttTTL :: !Word32, + sttSecret :: !FilePath + } + deriving (Show, Generic) + +instance FromJSON SFTTokenOptions where + parseJSON = withObject "SFTTokenOptions" $ \o -> + SFTTokenOptions + <$> o .: "ttl" + <*> o .: "secret" + +data SFTOptions = SFTOptions + { sftBaseDomain :: !DNS.Domain, + sftSRVServiceName :: !(Maybe ByteString), + sftDiscoveryIntervalSeconds :: !(Maybe DiffTime), + sftListLength :: !(Maybe (Range 1 100 Int)), + sftTokenOptions :: !(Maybe SFTTokenOptions) + } + deriving (Show, Generic) + +instance FromJSON SFTOptions where + parseJSON = withObject "SFTOptions" $ \o -> + SFTOptions + <$> (asciiOnly =<< o .: "sftBaseDomain") + <*> (mapM asciiOnly =<< o .:? "sftSRVServiceName") + <*> (fmap . fmap) secondsToDiffTime (o .:? "sftDiscoveryIntervalSeconds") + <*> o .:? "sftListLength" + <*> o .:? "sftToken" + +-- --------------------------------------------------------------------------- +-- TH splices — must come after all data declarations due to stage restrictions +-- --------------------------------------------------------------------------- + +deriveJSON defaultOptions {constructorTagModifier = map toLower} ''RedisConnectionMode + +deriveFromJSON toOptionFieldName ''RedisEndpoint + diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index 680a8e71519..ed76b7cc846 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -116,6 +116,7 @@ common common-all , currency-codes , data-default , data-timeout + , dns , email-validate , errors , exceptions @@ -234,6 +235,7 @@ library Wire.BlockListStore Wire.BlockListStore.Cassandra Wire.BrigAPIAccess + Wire.ConfigOptions Wire.BrigAPIAccess.Rpc Wire.ClientStore Wire.ClientStore.Cassandra From 661af09901d0bdab9c187df8049e2a2d2e3f829c Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Mon, 22 Jun 2026 11:36:50 +0200 Subject: [PATCH 4/9] Rename Wire.ConfigOptions -> Wire.Options --- .../src/Wire/{ConfigOptions.hs => Options.hs} | 14 +++++++------- libs/wire-subsystems/wire-subsystems.cabal | 2 +- 2 files changed, 8 insertions(+), 8 deletions(-) rename libs/wire-subsystems/src/Wire/{ConfigOptions.hs => Options.hs} (99%) diff --git a/libs/wire-subsystems/src/Wire/ConfigOptions.hs b/libs/wire-subsystems/src/Wire/Options.hs similarity index 99% rename from libs/wire-subsystems/src/Wire/ConfigOptions.hs rename to libs/wire-subsystems/src/Wire/Options.hs index bd6c6165443..f83dcb72354 100644 --- a/libs/wire-subsystems/src/Wire/ConfigOptions.hs +++ b/libs/wire-subsystems/src/Wire/Options.hs @@ -1,7 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} - -module Wire.ConfigOptions where +module Wire.Options where import Amazonka (Region) import Amazonka.Types (S3AddressingStyle) @@ -107,8 +106,8 @@ data RedisEndpoint = RedisEndpoint deriving (Show, Generic) data PrekeySelectionOpts - = RandomPrekeySelection - | DynamoDBPrekeySelection !DynamoDBPrekeySelectionOpts + = RandomPrekeySelection + | DynamoDBPrekeySelection !DynamoDBPrekeySelectionOpts data DynamoDBPrekeySelectionOpts = DynamoDBPrekeySelectionOpts { dynamoDBEndpoint :: !AWSEndpoint, @@ -424,8 +423,10 @@ data EmailOpts instance FromJSON EmailOpts where parseJSON o = - EmailAWS <$> parseJSON o - <|> EmailSMTP <$> parseJSON o + EmailAWS + <$> parseJSON o + <|> EmailSMTP + <$> parseJSON o data BrandingOpts = BrandingOpts { brand :: !Text, @@ -595,4 +596,3 @@ instance FromJSON SFTOptions where deriveJSON defaultOptions {constructorTagModifier = map toLower} ''RedisConnectionMode deriveFromJSON toOptionFieldName ''RedisEndpoint - diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index ed76b7cc846..b525a4027e2 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -235,7 +235,6 @@ library Wire.BlockListStore Wire.BlockListStore.Cassandra Wire.BrigAPIAccess - Wire.ConfigOptions Wire.BrigAPIAccess.Rpc Wire.ClientStore Wire.ClientStore.Cassandra @@ -380,6 +379,7 @@ library Wire.MigrationLock Wire.NotificationSubsystem Wire.NotificationSubsystem.Interpreter + Wire.Options Wire.Options.Galley Wire.Options.Keys Wire.PaginationState From b271eb6a2dfea215595a0262794434518f2c05aa Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Mon, 22 Jun 2026 16:29:15 +0200 Subject: [PATCH 5/9] Brig: Fix some compile errors by de-duplicating types between Brig.Options and Wire.Options --- libs/wire-api/src/Wire/API/SystemSettings.hs | 2 +- libs/wire-subsystems/src/Wire/Options.hs | 43 +- services/brig/brig.cabal | 2 - services/brig/src/Brig/API/Auth.hs | 2 +- services/brig/src/Brig/API/Connection.hs | 2 +- .../brig/src/Brig/API/Connection/Remote.hs | 2 +- services/brig/src/Brig/API/Connection/Util.hs | 2 +- services/brig/src/Brig/API/Federation.hs | 2 +- services/brig/src/Brig/API/Handler.hs | 2 +- services/brig/src/Brig/API/Internal.hs | 2 +- .../Brig/API/MLS/KeyPackages/Validation.hs | 2 +- services/brig/src/Brig/API/MLS/Util.hs | 2 +- services/brig/src/Brig/API/OAuth.hs | 2 +- services/brig/src/Brig/API/Public.hs | 2 +- services/brig/src/Brig/API/User.hs | 2 +- services/brig/src/Brig/AWS.hs | 22 +- services/brig/src/Brig/App.hs | 4 +- services/brig/src/Brig/Calling.hs | 4 +- services/brig/src/Brig/Calling/API.hs | 4 +- .../brig/src/Brig/CanonicalInterpreter.hs | 4 +- services/brig/src/Brig/Data/MLS/KeyPackage.hs | 2 +- services/brig/src/Brig/Data/User.hs | 2 +- services/brig/src/Brig/Index/Eval.hs | 2 +- services/brig/src/Brig/Index/Options.hs | 14 +- .../brig/src/Brig/InternalEvent/Process.hs | 2 +- services/brig/src/Brig/Main.hs | 2 +- services/brig/src/Brig/Options.hs | 993 ------------------ services/brig/src/Brig/Provider/API.hs | 4 +- services/brig/src/Brig/Provider/Template.hs | 10 +- services/brig/src/Brig/Queue/Stomp.hs | 2 +- services/brig/src/Brig/Run.hs | 2 +- services/brig/src/Brig/Team/Template.hs | 12 +- services/brig/src/Brig/Template.hs | 2 +- services/brig/src/Brig/User/API/Handle.hs | 2 +- services/brig/src/Brig/User/Auth.hs | 2 +- services/brig/src/Brig/User/Auth/Cookie.hs | 2 +- services/brig/src/Brig/User/Client.hs | 2 +- services/brig/src/Brig/User/Template.hs | 12 +- services/brig/test/integration/API/Calling.hs | 2 +- .../brig/test/integration/API/Federation.hs | 2 +- services/brig/test/integration/API/Metrics.hs | 2 +- services/brig/test/integration/API/OAuth.hs | 4 +- .../brig/test/integration/API/Provider.hs | 2 +- services/brig/test/integration/API/Search.hs | 8 +- .../brig/test/integration/API/Settings.hs | 4 +- services/brig/test/integration/API/Team.hs | 2 +- .../test/integration/API/TeamUserSearch.hs | 2 +- .../brig/test/integration/API/Template.hs | 2 +- services/brig/test/integration/API/User.hs | 2 +- .../brig/test/integration/API/User/Account.hs | 2 +- .../brig/test/integration/API/User/Auth.hs | 5 +- .../brig/test/integration/API/User/Client.hs | 2 +- .../brig/test/integration/API/User/Handles.hs | 2 +- .../test/integration/API/User/RichInfo.hs | 4 +- .../test/integration/Federation/End2end.hs | 2 +- .../brig/test/integration/Federation/Util.hs | 2 +- .../brig/test/integration/Index/Create.hs | 4 +- services/brig/test/integration/Run.hs | 2 +- services/brig/test/integration/Util.hs | 2 +- services/brig/test/unit/Test/Brig/Calling.hs | 2 +- 60 files changed, 142 insertions(+), 1097 deletions(-) delete mode 100644 services/brig/src/Brig/Options.hs diff --git a/libs/wire-api/src/Wire/API/SystemSettings.hs b/libs/wire-api/src/Wire/API/SystemSettings.hs index b41a17acc59..c3860d69083 100644 --- a/libs/wire-api/src/Wire/API/SystemSettings.hs +++ b/libs/wire-api/src/Wire/API/SystemSettings.hs @@ -26,7 +26,7 @@ import Servant.OpenApi.Internal.Orphans () import Test.QuickCheck import Wire.Arbitrary --- | Subset of `Brig.Options.Settings` that is safe to be shown in public. +-- | Subset of `Wire.Options.Settings` that is safe to be shown in public. -- -- Used to expose settings via the @/system/settings/unauthorized@ endpoint. -- ALWAYS CHECK WITH SECURITY IF YOU WANT TO ADD SETTINGS HERE. diff --git a/libs/wire-subsystems/src/Wire/Options.hs b/libs/wire-subsystems/src/Wire/Options.hs index f83dcb72354..d3229c393f4 100644 --- a/libs/wire-subsystems/src/Wire/Options.hs +++ b/libs/wire-subsystems/src/Wire/Options.hs @@ -12,7 +12,8 @@ import Data.Code qualified as Code import Data.Domain (Domain (..)) import Data.Id (ProviderId) import Data.LanguageCodes (ISO639_1 (EN)) -import Data.Range (Range) +import Data.Proxy (Proxy (..)) +import Data.Range (Range, toRange) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Data.Time (DiffTime, secondsToDiffTime) @@ -80,9 +81,9 @@ data ExternalServices = ExternalServices -- TODO: See if user and team journal can even be configured differently. If -- everything is supposed to be used by ibis, we cannot actually configure -- them seperately anyway. - userJournal :: !(Maybe SqsOpts), - teamJournal :: !(Maybe SqsOpts), - internalEvents :: !SqsOpts, + -- userJournal :: !(Maybe SqsOpts), + -- teamJournal :: !(Maybe SqsOpts), + sqs :: !SqsOpts, assets :: !AssetOpts, pushNotifications :: !PushNotifiactionOpts } @@ -116,7 +117,9 @@ data DynamoDBPrekeySelectionOpts = DynamoDBPrekeySelectionOpts data SqsOpts = SqsOpts { sqsEndpoint :: !AWSEndpoint, - queueName :: !Text + internalEventsQueue :: !Text, + userJournalQueue :: !(Maybe Text), + teamJournalQueue :: !(Maybe Text) } data AssetOpts = AssetOpts @@ -245,6 +248,10 @@ data UserSettings = UserSettings restrictUserCreation :: !(Maybe Bool) } +-- TODO: Make this the actual default when the YAML doesn't specify a value. +defaultTemplateLocale :: UserSettings -> Locale +defaultTemplateLocale = fromMaybe defaultLocale . defaultTemplateLocaleInternal + data TeamSettings = TeamSettings { -- \| Team invitation timeout, in seconds teamInvitationTimeout :: !Timeout, @@ -370,7 +377,7 @@ instance FromJSON ImplicitNoFederationRestriction where ) -- --------------------------------------------------------------------------- --- Types moved from Brig.Options +-- Types moved from Wire.Options -- --------------------------------------------------------------------------- data ElasticSearchOpts = ElasticSearchOpts @@ -596,3 +603,27 @@ instance FromJSON SFTOptions where deriveJSON defaultOptions {constructorTagModifier = map toLower} ''RedisConnectionMode deriveFromJSON toOptionFieldName ''RedisEndpoint + +defMaxKeyLen :: Int64 +defMaxKeyLen = 1024 + +defMaxValueLen :: Int64 +defMaxValueLen = 524288 + +defDeleteThrottleMillis :: Int +defDeleteThrottleMillis = 100 + +defSqsThrottleMillis :: Int +defSqsThrottleMillis = 500 + +defUserMaxPermClients :: Int +defUserMaxPermClients = 7 + +defSftServiceName :: ByteString +defSftServiceName = "_sft" + +defSrvDiscoveryIntervalSeconds :: DiffTime +defSrvDiscoveryIntervalSeconds = secondsToDiffTime 10 + +defSftListLength :: Range 1 100 Int +defSftListLength = toRange (Proxy @5) diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 2f7ab0b0789..921f806345f 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -126,7 +126,6 @@ library Brig.IO.Journal Brig.IO.Logging Brig.Main - Brig.Options Brig.Provider.API Brig.Provider.DB Brig.Provider.Email @@ -257,7 +256,6 @@ library , imports , insert-ordered-containers , iproute >=1.5 - , iso639 >=0.1 , jose , jwt-tools , lens >=3.8 diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index b47366621fc..9b41894b42c 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -21,7 +21,7 @@ import Brig.API.Error import Brig.API.Handler import Brig.API.Types import Brig.App -import Brig.Options +import Wire.Options import Brig.User.Auth qualified as Auth import Control.Monad.Trans.Except import Data.CommaSeparatedList diff --git a/services/brig/src/Brig/API/Connection.hs b/services/brig/src/Brig/API/Connection.hs index 375a5300f93..bb11fcde9dd 100644 --- a/services/brig/src/Brig/API/Connection.hs +++ b/services/brig/src/Brig/API/Connection.hs @@ -42,7 +42,7 @@ import Brig.Data.Connection qualified as Data import Brig.Data.Types (resultHasMore, resultList) import Brig.IO.Intra qualified as Intra import Brig.IO.Logging -import Brig.Options +import Wire.Options import Control.Error import Control.Monad.Catch (throwM) import Data.Id as Id diff --git a/services/brig/src/Brig/API/Connection/Remote.hs b/services/brig/src/Brig/API/Connection/Remote.hs index 09d8e11e086..23613e04e82 100644 --- a/services/brig/src/Brig/API/Connection/Remote.hs +++ b/services/brig/src/Brig/API/Connection/Remote.hs @@ -28,7 +28,7 @@ import Brig.API.Types (ConnectionError (..)) import Brig.App import Brig.Data.Connection qualified as Data import Brig.IO.Intra qualified as Intra -import Brig.Options +import Wire.Options import Control.Comonad import Control.Error.Util ((??)) import Control.Monad.Trans.Except diff --git a/services/brig/src/Brig/API/Connection/Util.hs b/services/brig/src/Brig/API/Connection/Util.hs index ccbba0284c1..38cce87aa36 100644 --- a/services/brig/src/Brig/API/Connection/Util.hs +++ b/services/brig/src/Brig/API/Connection/Util.hs @@ -28,7 +28,7 @@ where import Brig.API.Types import Brig.App import Brig.Data.Connection qualified as Data -import Brig.Options (Settings (userMaxConnections)) +import Wire.Options (Settings (userMaxConnections)) import Control.Error (MaybeT, noteT) import Control.Monad.Trans.Except import Data.Id (UserId) diff --git a/services/brig/src/Brig/API/Federation.hs b/services/brig/src/Brig/API/Federation.hs index 3641348b490..6c87f4004a7 100644 --- a/services/brig/src/Brig/API/Federation.hs +++ b/services/brig/src/Brig/API/Federation.hs @@ -29,7 +29,7 @@ import Brig.API.User qualified as API import Brig.App import Brig.Data.Connection qualified as Data import Brig.IO.Intra (notify) -import Brig.Options +import Wire.Options import Brig.User.API.Handle import Brig.User.Search.SearchIndex qualified as Q import Control.Error.Util diff --git a/services/brig/src/Brig/API/Handler.hs b/services/brig/src/Brig/API/Handler.hs index 5eb9c2b4643..6c645577e93 100644 --- a/services/brig/src/Brig/API/Handler.hs +++ b/services/brig/src/Brig/API/Handler.hs @@ -33,7 +33,7 @@ import Brig.API.Error import Brig.AWS qualified as AWS import Brig.App import Brig.CanonicalInterpreter (BrigCanonicalEffects, runBrigToIO) -import Brig.Options (allowlistEmailDomains) +import Wire.Options (allowlistEmailDomains) import Control.Error import Control.Exception (throwIO) import Control.Monad.Catch (catches, throwM) diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 6a6f17dbb80..5d5bb0bfc20 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -36,7 +36,7 @@ import Brig.Data.Activation import Brig.Data.Connection qualified as Data import Brig.Data.MLS.KeyPackage qualified as Data import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) -import Brig.Options hiding (internalEvents) +import Wire.Options hiding (internalEvents) import Brig.Provider.API qualified as Provider import Brig.Team.API qualified as Team import Brig.User.EJPD qualified diff --git a/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs b/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs index 45173c9eb66..9dea19ba8a6 100644 --- a/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs +++ b/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs @@ -26,7 +26,7 @@ where import Brig.API.Error import Brig.API.Handler import Brig.App -import Brig.Options +import Wire.Options import Control.Applicative import Data.ByteString qualified as LBS import Data.Qualified diff --git a/services/brig/src/Brig/API/MLS/Util.hs b/services/brig/src/Brig/API/MLS/Util.hs index d489be84592..129c52ae1c0 100644 --- a/services/brig/src/Brig/API/MLS/Util.hs +++ b/services/brig/src/Brig/API/MLS/Util.hs @@ -19,7 +19,7 @@ module Brig.API.MLS.Util where import Brig.API.Handler import Brig.App -import Brig.Options +import Wire.Options import Control.Error import Imports import Wire.ClientSubsystem.Error diff --git a/services/brig/src/Brig/API/OAuth.hs b/services/brig/src/Brig/API/OAuth.hs index b84df3d0a62..c3cbe7f8310 100644 --- a/services/brig/src/Brig/API/OAuth.hs +++ b/services/brig/src/Brig/API/OAuth.hs @@ -26,7 +26,7 @@ where import Brig.API.Error (throwStd) import Brig.API.Handler (Handler) import Brig.App -import Brig.Options qualified as Opt +import Wire.Options qualified as Opt import Cassandra hiding (Set) import Cassandra qualified as C import Control.Error diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 8173ad1568c..656efda4a5e 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -47,7 +47,7 @@ import Brig.Effects.JwtTools (JwtTools) import Brig.Effects.PublicKeyBundle (PublicKeyBundle) import Brig.Effects.SFT import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) -import Brig.Options hiding (internalEvents) +import Wire.Options hiding (internalEvents) import Brig.Provider.API import Brig.Team.API qualified as Team import Brig.Template (InvitationUrlTemplates) diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 26e69fd6f23..b66117f494b 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -75,7 +75,7 @@ import Brig.Effects.ConnectionStore import Brig.Effects.UserPendingActivationStore (UserPendingActivation (..), UserPendingActivationStore) import Brig.Effects.UserPendingActivationStore qualified as UserPendingActivationStore import Brig.IO.Intra qualified as Intra -import Brig.Options hiding (internalEvents) +import Wire.Options hiding (internalEvents) import Brig.User.Auth.Cookie qualified as Auth import Cassandra hiding (Set) import Control.Error diff --git a/services/brig/src/Brig/AWS.hs b/services/brig/src/Brig/AWS.hs index 5bcbf90ecd5..41cccd701b7 100644 --- a/services/brig/src/Brig/AWS.hs +++ b/services/brig/src/Brig/AWS.hs @@ -48,7 +48,6 @@ import Amazonka.DynamoDB qualified as DDB import Amazonka.SES qualified as SES import Amazonka.SQS qualified as SQS import Amazonka.SQS.Lens qualified as SQS -import Brig.Options qualified as Opt import Control.Exception.Lens import Control.Lens hiding ((.=)) import Control.Monad.Catch @@ -69,12 +68,13 @@ import UnliftIO.Async import UnliftIO.Exception import Util.Options import Wire.AWS (canRetry, sendCatch) +import Wire.Options qualified as Opt data Env = Env { _logger :: !Logger, _sesQueue :: !(Maybe Text), _userJournalQueue :: !(Maybe Text), - _prekeyTable :: !Text, + _prekeyTable :: !(Maybe Text), _amazonkaEnv :: !AWS.Env } @@ -99,20 +99,26 @@ newtype Amazon a = Amazon instance MonadLogger Amazon where log l m = view logger >>= \g -> Logger.log g l m -mkEnv :: Logger -> Opt.AWSOpts -> Maybe Opt.EmailAWSOpts -> Manager -> IO Env -mkEnv lgr opts emailOpts mgr = do +mkEnv :: + Logger -> + Opt.SqsOpts -> + Maybe Opt.DynamoDBPrekeySelectionOpts -> + Maybe Opt.EmailAWSOpts -> + Manager -> + IO Env +mkEnv lgr sqsOpts dynamoDBOpts emailOpts mgr = do let g = Logger.clone (Just "aws.brig") lgr - let pk = Opt.prekeyTable opts + let pk = Opt.tableName <$> dynamoDBOpts let sesEndpoint = mkEndpoint SES.defaultService . Opt.sesEndpoint <$> emailOpts - let dynamoEndpoint = mkEndpoint DDB.defaultService <$> Opt.dynamoDBEndpoint opts + let dynamoEndpoint = mkEndpoint DDB.defaultService . Opt.dynamoDBEndpoint <$> dynamoDBOpts e <- mkAwsEnv g sesEndpoint dynamoEndpoint - (mkEndpoint SQS.defaultService (Opt.sqsEndpoint opts)) + (mkEndpoint SQS.defaultService (Opt.sqsEndpoint sqsOpts)) sq <- maybe (pure Nothing) (fmap Just . getQueueUrl e . Opt.sesQueue) emailOpts - jq <- maybe (pure Nothing) (fmap Just . getQueueUrl e) (Opt.userJournalQueue opts) + jq <- maybe (pure Nothing) (fmap Just . getQueueUrl e) (Opt.userJournalQueue sqsOpts) pure (Env g sq jq pk e) where mkEndpoint svc e = AWS.setEndpoint (e ^. awsSecure) (e ^. awsHost) (e ^. awsPort) svc diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index 1e50c5179ed..5218a98b410 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -107,8 +107,8 @@ import Bilge.RPC (HasRequestId (..)) import Brig.AWS qualified as AWS import Brig.Calling qualified as Calling import Brig.DeleteQueue.Interpreter -import Brig.Options (ElasticSearchOpts, Opts, Settings (..)) -import Brig.Options qualified as Opt +import Wire.Options (ElasticSearchOpts, Opts, Settings (..)) +import Wire.Options qualified as Opt import Brig.Provider.Template import Brig.Queue.Stomp qualified as Stomp import Brig.Queue.Types diff --git a/services/brig/src/Brig/Calling.hs b/services/brig/src/Brig/Calling.hs index 8c1c2749d32..bc530073e62 100644 --- a/services/brig/src/Brig/Calling.hs +++ b/services/brig/src/Brig/Calling.hs @@ -48,8 +48,6 @@ module Brig.Calling ) where -import Brig.Options (SFTOptions (..), defSftListLength, defSftServiceName, defSrvDiscoveryIntervalSeconds) -import Brig.Options qualified as Opts import Control.Exception.Enclosed (handleAny) import Control.Lens import Control.Monad.Random.Class (MonadRandom) @@ -79,6 +77,8 @@ import UnliftIO.Async qualified as Async import Wire.API.Call.Config import Wire.Network.DNS.Effect import Wire.Network.DNS.SRV +import Wire.Options (SFTOptions (..), defSftListLength, defSftServiceName, defSrvDiscoveryIntervalSeconds) +import Wire.Options qualified as Opts import Wire.Sem.Delay import Wire.Sem.Logger.TinyLog diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs index 78588a606d3..82d5a00411a 100644 --- a/services/brig/src/Brig/Calling/API.hs +++ b/services/brig/src/Brig/Calling/API.hs @@ -37,8 +37,8 @@ import Brig.Calling import Brig.Calling qualified as Calling import Brig.Calling.Internal import Brig.Effects.SFT -import Brig.Options (ListAllSFTServers (..)) -import Brig.Options qualified as Opt +import Wire.Options (ListAllSFTServers (..)) +import Wire.Options qualified as Opt import Control.Error (hush, throwE) import Control.Lens import Crypto.Hash qualified as Crypto diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index afa2ecc20e3..6b5cbc1fb3f 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -28,8 +28,8 @@ import Brig.Effects.SFT (SFT, interpretSFT) import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import Brig.Effects.UserPendingActivationStore.Cassandra (userPendingActivationStoreToCassandra) import Brig.IO.Intra (runEvents) -import Brig.Options (Settings (consumableNotifications), federationDomainConfigs, federationStrategy) -import Brig.Options qualified as Opt +import Wire.Options (Settings (consumableNotifications), federationDomainConfigs, federationStrategy) +import Wire.Options qualified as Opt import Brig.Template (InvitationUrlTemplates) import Brig.User.Search.Index (IndexEnv (..)) import Cassandra qualified as Cas diff --git a/services/brig/src/Brig/Data/MLS/KeyPackage.hs b/services/brig/src/Brig/Data/MLS/KeyPackage.hs index 20f95a40afa..138ccf8cc67 100644 --- a/services/brig/src/Brig/Data/MLS/KeyPackage.hs +++ b/services/brig/src/Brig/Data/MLS/KeyPackage.hs @@ -26,7 +26,7 @@ where import Brig.API.MLS.KeyPackages.Validation import Brig.App -import Brig.Options +import Wire.Options import Cassandra import Control.Arrow import Control.Error diff --git a/services/brig/src/Brig/Data/User.hs b/services/brig/src/Brig/Data/User.hs index 3a36c4c3054..76c645ff56c 100644 --- a/services/brig/src/Brig/Data/User.hs +++ b/services/brig/src/Brig/Data/User.hs @@ -27,7 +27,7 @@ module Brig.Data.User where import Brig.App -import Brig.Options +import Wire.Options import Control.Error import Data.Handle (Handle) import Data.Id diff --git a/services/brig/src/Brig/Index/Eval.hs b/services/brig/src/Brig/Index/Eval.hs index f3b8f1c83b4..ffafb535560 100644 --- a/services/brig/src/Brig/Index/Eval.hs +++ b/services/brig/src/Brig/Index/Eval.hs @@ -23,7 +23,7 @@ where import Brig.App (initHttpManagerWithTLSConfig, mkIndexEnv) import Brig.Index.Options as IxOpts -import Brig.Options as Opt +import Wire.Options as Opt import Brig.User.Search.Index import Cassandra (ClientState) import Cassandra.Options diff --git a/services/brig/src/Brig/Index/Options.hs b/services/brig/src/Brig/Index/Options.hs index bbf0c9880ed..a4002bcb2f8 100644 --- a/services/brig/src/Brig/Index/Options.hs +++ b/services/brig/src/Brig/Index/Options.hs @@ -37,7 +37,7 @@ module Brig.Index.Options PostgresSettings (..), UserStorageLocation (..), localElasticSettings, - brigOptsToPostgresSettings, + wireConfigToPostgresSettings, localCassandraSettings, commandParser, mkCreateIndexSettings, @@ -50,7 +50,6 @@ module Brig.Index.Options where import Brig.Index.Types (CreateIndexSettings (..)) -import Brig.Options qualified as Opts import Cassandra qualified as C import Control.Lens import Data.Aeson as Aeson @@ -72,6 +71,7 @@ import Options.Applicative import URI.ByteString import URI.ByteString.QQ import Util.Options (CassandraOpts (..), Endpoint (..), FilePathSecrets) +import Wire.Options qualified as Opts import Wire.PostgresMigrationOpts data Command @@ -173,12 +173,12 @@ localElasticSettings = _esDeleteTemplate = Nothing } -brigOptsToPostgresSettings :: Opts.Opts -> PostgresSettings -brigOptsToPostgresSettings opts = +wireConfigToPostgresSettings :: Opts.WireConfig -> PostgresSettings +wireConfigToPostgresSettings opts = PostgresSettings - { pool = opts.postgresqlPool, - passwordFile = opts.postgresqlPassword, - settings = opts.postgresql + { pool = opts.externalServices.postgresqlPool, + passwordFile = opts.externalServices.postgresqlPassword, + settings = opts.externalServices.postgresql } localCassandraSettings :: CassandraSettings diff --git a/services/brig/src/Brig/InternalEvent/Process.hs b/services/brig/src/Brig/InternalEvent/Process.hs index af018889184..41de186de40 100644 --- a/services/brig/src/Brig/InternalEvent/Process.hs +++ b/services/brig/src/Brig/InternalEvent/Process.hs @@ -22,7 +22,7 @@ import Brig.App import Brig.IO.Intra (rmClient) import Brig.IO.Intra qualified as Intra import Brig.InternalEvent.Types -import Brig.Options (defDeleteThrottleMillis, deleteThrottleMillis) +import Wire.Options (defDeleteThrottleMillis, deleteThrottleMillis) import Brig.Provider.API qualified as API import Control.Monad.Catch import Data.ByteString.Conversion diff --git a/services/brig/src/Brig/Main.hs b/services/brig/src/Brig/Main.hs index fc874c4ef2c..e96a2b0c8de 100644 --- a/services/brig/src/Brig/Main.hs +++ b/services/brig/src/Brig/Main.hs @@ -17,7 +17,7 @@ module Brig.Main where -import Brig.Options (Opts (postgresql)) +import Wire.Options (Opts (postgresql)) import Brig.Run import Data.Map qualified as Map import Data.Yaml qualified as Yaml diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs deleted file mode 100644 index c97b031d73c..00000000000 --- a/services/brig/src/Brig/Options.hs +++ /dev/null @@ -1,993 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -Wno-ambiguous-fields #-} --- Disabling to stop errors on Getters -{-# OPTIONS_GHC -Wno-redundant-constraints #-} - --- 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.Options where - -import Amazonka (Region) -import Amazonka.Types (S3AddressingStyle) -import Brig.Queue.Types (QueueOpts (..)) -import Control.Applicative -import Control.Lens hiding (Level, element, enum) -import Data.Aeson -import Data.Aeson.Types qualified as A -import Data.Char qualified as Char -import Data.Code qualified as Code -import Data.Default -import Data.Domain (Domain (..)) -import Data.Id -import Data.LanguageCodes (ISO639_1 (EN)) -import Data.Misc (HttpsUrl) -import Data.Nonce -import Data.Range -import Data.Schema -import Data.Text qualified as Text -import Data.Text.Encoding qualified as Text -import Database.Bloodhound.Types qualified as ES -import Hasql.Pool.Extended -import Imports -import Network.AMQP.Extended -import Network.DNS qualified as DNS -import System.Logger.Extended (Level, LogFormat) -import Util.Options -import Util.SuffixNamer -import Util.Timeout -import Wire.API.Allowlists (AllowlistEmailDomains (..)) -import Wire.API.Routes.FederationDomainConfig -import Wire.API.Routes.Version -import Wire.API.Team.Feature -import Wire.API.Team.FeatureFlags -import Wire.API.User -import Wire.AuthenticationSubsystem.Config (ZAuthSettings) -import Wire.AuthenticationSubsystem.Cookie.Limit -import Wire.EmailSending.SMTP (SMTPConnType (..)) -import Wire.EmailSubsystem.Template (TeamOpts) -import Wire.PostgresMigrationOpts -import Wire.RateLimit.Interpreter - -data ElasticSearchOpts = ElasticSearchOpts - { -- | ElasticSearch URL - url :: !ES.Server, - -- | The name of the ElasticSearch user index - index :: !ES.IndexName, - -- | An additional index to write user data, useful while migrating to a new - -- index. - -- There is a bug hidden when using this option. Sometimes a user won't get - -- deleted from the index. Attempts at reproducing this issue in a simpler - -- environment have failed. As a workaround, there is a tool in - -- tools/db/find-undead which can be used to find the undead users right - -- after the migration, if they exist, we can run the reindexing to get data - -- in elasticsearch in a consistent state. - additionalWriteIndex :: !(Maybe ES.IndexName), - -- | An additional ES URL to write user data, useful while migrating to a - -- new instance of ES. It is necessary to provide 'additionalWriteIndex' for - -- this to be used. If this is 'Nothing' and 'additionalWriteIndex' is - -- configured, the 'url' field will be used. - additionalWriteIndexUrl :: !(Maybe ES.Server), - -- | Elasticsearch credentials - credentials :: !(Maybe FilePathSecrets), - -- | Credentials for additional ES index (maily used for migrations) - additionalCredentials :: !(Maybe FilePathSecrets), - insecureSkipVerifyTls :: Bool, - caCert :: Maybe FilePath, - additionalInsecureSkipVerifyTls :: Bool, - additionalCaCert :: Maybe FilePath - } - deriving (Show, Generic) - -instance FromJSON ElasticSearchOpts - -data AWSOpts = AWSOpts - { -- | Event journal queue for user events - -- (e.g. user deletion) - userJournalQueue :: !(Maybe Text), - -- | Dynamo table for storing prekey data - prekeyTable :: !Text, - -- | AWS SQS endpoint - sqsEndpoint :: !AWSEndpoint, - -- | DynamoDB endpoint - dynamoDBEndpoint :: !(Maybe AWSEndpoint) - } - deriving (Show, Generic) - -instance FromJSON AWSOpts - -data EmailAWSOpts = EmailAWSOpts - { -- | Event feedback queue for SES - -- (e.g. for email bounces and complaints) - sesQueue :: !Text, - -- | AWS SES endpoint - sesEndpoint :: !AWSEndpoint - } - deriving (Show, Generic) - -instance FromJSON EmailAWSOpts - -data EmailSMTPCredentials = EmailSMTPCredentials - { -- | Username to authenticate - -- against the SMTP server - smtpUsername :: !Text, - -- | File containing password to - -- authenticate against the SMTP server - smtpPassword :: !FilePathSecrets - } - deriving (Show, Generic) - -instance FromJSON EmailSMTPCredentials - -data EmailSMTPOpts = EmailSMTPOpts - { -- | Hostname of the SMTP server to connect to - smtpEndpoint :: !Endpoint, - smtpCredentials :: !(Maybe EmailSMTPCredentials), - -- | Which type of connection to use - -- against the SMTP server {tls,ssl,plain} - smtpConnType :: !SMTPConnType - } - deriving (Show, Generic) - -instance FromJSON EmailSMTPOpts - -data StompOpts = StompOpts - { host :: !Text, - port :: !Int, - tls :: !Bool - } - deriving (Show, Generic) - -data InternalEventsOpts = InternalEventsOpts - { internalEventsQueue :: !QueueOpts - } - deriving (Show) - -instance FromJSON InternalEventsOpts where - parseJSON = withObject "InternalEventsOpts" $ \o -> - InternalEventsOpts <$> parseJSON (Object o) - -data EmailSMSGeneralOpts = EmailSMSGeneralOpts - { -- | Email, SMS, ... template directory - templateDir :: !FilePath, - -- | Email sender address - emailSender :: !EmailAddress, - -- | Twilio sender identifier (sender phone number in E.104 format) - -- or twilio messaging sender ID - see - -- https://www.twilio.com/docs/sms/send-messages#use-an-alphanumeric-sender-id - smsSender :: !Text, - -- | Customizable branding text for - -- emails/sms/calls - templateBranding :: !BrandingOpts - } - deriving (Show, Generic) - -instance FromJSON EmailSMSGeneralOpts - -data BrandingOpts = BrandingOpts - { brand :: !Text, - brandUrl :: !Text, - brandLabelUrl :: !Text, - brandLogoUrl :: !Text, - brandService :: !Text, - copyright :: !Text, - misuse :: !Text, - legal :: !Text, - forgot :: !Text, - support :: !Text - } - deriving (Show, Generic) - -instance FromJSON BrandingOpts - -data EmailUserOpts = EmailUserOpts - { -- | Activation URL template - activationUrl :: !Text, - -- | SMS activation URL template - smsActivationUrl :: !Text, - -- | Password reset URL template - passwordResetUrl :: !Text, - -- | Deletion URL template - deletionUrl :: !Text - } - deriving (Show, Generic) - -instance FromJSON EmailUserOpts - --- | Provider settings -data ProviderOpts = ProviderOpts - { -- | Homepage URL - homeUrl :: !Text, - -- | Activation URL template - providerActivationUrl :: !Text, - -- | Approval URL template - approvalUrl :: !Text, - -- | Approval email recipient - approvalTo :: !EmailAddress, - -- | Password reset URL template - providerPwResetUrl :: !Text - } - deriving (Show, Generic) - -instance FromJSON ProviderOpts - -data EmailOpts - = EmailAWS EmailAWSOpts - | EmailSMTP EmailSMTPOpts - deriving (Show, Generic) - -instance FromJSON EmailOpts where - parseJSON o = - EmailAWS <$> parseJSON o - <|> EmailSMTP <$> parseJSON o - -data EmailSettings = EmailSettings - { general :: !EmailSMSGeneralOpts, - user :: !EmailUserOpts, - provider :: !ProviderOpts, - team :: !TeamOpts - } - deriving (Show, Generic) - -instance FromJSON EmailSettings - --- | Login retry limit. In contrast to 'setUserCookieThrottle', this is not about mitigating --- DOS attacks, but about preventing dictionary attacks. This introduces the orthogonal risk --- of an attacker blocking legitimate login attempts of a user by constantly keeping the retry --- limit for that user exhausted with failed login attempts. --- --- If in doubt, do not ues retry options and worry about encouraging / enforcing a good --- password policy. -data LimitFailedLogins = LimitFailedLogins - { -- | Time the user is blocked when retry limit is reached (in - -- seconds mostly for making it easier to write a fast-ish - -- integration test.) - timeout :: !Timeout, - -- | Maximum number of failed login attempts for one user. - retryLimit :: !Int - } - deriving (Eq, Show, Generic) - -instance FromJSON LimitFailedLogins - -data SuspendInactiveUsers = SuspendInactiveUsers - { suspendTimeout :: !Timeout - } - deriving (Eq, Show, Generic) - -instance FromJSON SuspendInactiveUsers - --- | ZAuth options -data ZAuthOpts = ZAuthOpts - { -- | Private key file - privateKeys :: !FilePath, - -- | Public key file - publicKeys :: !FilePath, - -- | Other settings - authSettings :: !ZAuthSettings - } - deriving (Show, Generic) - -instance FromJSON ZAuthOpts - --- | TURN server options -data TurnOpts = TurnOpts - { -- | Where to get list of turn servers from - serversSource :: !TurnServersSource, - -- | TURN shared secret file path - secret :: !FilePath, - -- | For how long TURN credentials should be - -- valid, in seconds - tokenTTL :: !Word32, - -- | How long until a new TURN configuration - -- should be fetched, in seconds - configTTL :: !Word32 - } - deriving (Show) - -instance FromJSON TurnOpts where - parseJSON = withObject "TurnOpts" $ \o -> do - sourceName <- o .: "serversSource" - source <- - case sourceName of - "files" -> TurnSourceFiles <$> parseJSON (Object o) - "dns" -> TurnSourceDNS <$> parseJSON (Object o) - _ -> fail $ "TurnOpts: Invalid sourceType, expected one of [files, dns] but got: " <> Text.unpack sourceName - TurnOpts source - <$> o .: "secret" - <*> o .: "tokenTTL" - <*> o .: "configTTL" - -data TurnServersSource - = TurnSourceDNS TurnDnsOpts - | TurnSourceFiles TurnServersFiles - deriving (Show) - -data TurnServersFiles = TurnServersFiles - { tsfServers :: !FilePath, - tsfServersV2 :: !FilePath - } - deriving (Show) - -instance FromJSON TurnServersFiles where - parseJSON = withObject "TurnServersFiles" $ \o -> - TurnServersFiles - <$> o .: "servers" - <*> o .: "serversV2" - -data TurnDnsOpts = TurnDnsOpts - { tdoBaseDomain :: DNS.Domain, - tdoDiscoveryIntervalSeconds :: !(Maybe DiffTime) - } - deriving (Show) - -instance FromJSON TurnDnsOpts where - parseJSON = withObject "TurnDnsOpts" $ \o -> - TurnDnsOpts - <$> (asciiOnly =<< o .: "baseDomain") - <*> o .:? "discoveryIntervalSeconds" - -data ListAllSFTServers - = ListAllSFTServers - | HideAllSFTServers - deriving (Show, Eq, Ord) - deriving (FromJSON) via Schema ListAllSFTServers - -instance ToSchema ListAllSFTServers where - schema = - enum @Text $ - mconcat - [ element "enabled" ListAllSFTServers, - element "disabled" HideAllSFTServers - ] - -data WireConfig = WireConfig - { internalServices :: InternalServices, - externalServices :: ExternalServices, - settings :: WireSettings - } - -data InternalServices = InternalServices - { brig :: !Endpoint, - cargohold :: !Endpoint, - galley :: !Endpoint, - spar :: !Endpoint, - gundeck :: !Endpoint, - federatorInternal :: !(Maybe Endpoint), - backgroundWorker :: !Endpoint, - wireServerEnterprise :: !(Maybe Endpoint) - } - -data ExternalServices = ExternalServices - { cassandraBrig :: !CassandraOpts, - cassandraGalley :: !CassandraOpts, - cassandraGundeck :: !CassandraOpts, - cassandraSpar :: !CassandraOpts, - elasticsearch :: !ElasticSearchOpts, - redis :: !RedisEndpoint, - redisAdditionalWrite :: !(Maybe RedisEndpoint), - -- | Postgresql settings, the key values must be in libpq format. - -- https://www.postgresql.org/docs/17/libpq-connect.html#LIBPQ-PARAMKEYWORDS - postgresql :: !(Map Text Text), - postgresqlPassword :: !(Maybe FilePathSecrets), - postgresqlPool :: !PoolConfig, - rabbitmq :: !AmqpEndpoint, - email :: !EmailOpts, - prekeySelection :: !PrekeySelectionOpts, - -- TODO: See if user and team journal can even be configured differently. If - -- everything is supposed to be used by ibis, we cannot actually configure - -- them seperately anyway. - userJournal :: !(Maybe SqsOpts), - teamJournal :: !(Maybe SqsOpts), - internalEvents :: !SqsOpts, - assets :: !AssetOpts, - pushNotifications :: !PushNotifiactionOpts - } - -data RedisConnectionMode - = Master - | Cluster - -data RedisEndpoint = RedisEndpoint - { _host :: !Text, - _port :: !Word16, - _connectionMode :: !RedisConnectionMode, - _enableTls :: !Bool, - -- | When not specified, use system CA bundle - _tlsCa :: !(Maybe FilePath), - -- | When 'True', uses TLS but does not verify hostname or CA or validity of - -- the cert. Not recommended to set to 'True'. - _insecureSkipVerifyTls :: !Bool - } - -data PrekeySelectionOpts - = RandomPrekeySelection - | DynamoDBPrekeySelection !DynamoDBPrekeySelectionOpts - -data DynamoDBPrekeySelectionOpts = DynamoDBPrekeySelectionOpts - { dynamoDBEndpoint :: !AWSEndpoint, - tableName :: !Text - } - -data SqsOpts = SqsOpts - { sqsEndpoint :: !AWSEndpoint, - queueName :: !Text - } - -data AssetOpts = AssetOpts - { s3Endpoint :: !AWSEndpoint, - -- | S3 can either by addressed in path style, i.e. - -- https:////, or vhost style, i.e. - -- https://./. AWS's S3 offering has - -- deprecated path style addressing for S3 and completely disabled it for - -- buckets created after 30 Sep 2020: - -- https://aws.amazon.com/blogs/aws/amazon-s3-path-deprecation-plan-the-rest-of-the-story/ - -- - -- However other object storage providers (specially self-deployed ones like - -- MinIO) may not support vhost style addressing yet (or ever?). Users of - -- such buckets should configure this option to "path". - -- - -- Installations using S3 service provided by AWS, should use "auto", this - -- option will ensure that vhost style is only used when it is possible to - -- construct a valid hostname from the bucket name and the bucket name - -- doesn't contain a '.'. Having a '.' in the bucket name causes TLS - -- validation to fail, hence it is not used by default. - -- - -- Using "virtual" as an option is only useful in situations where vhost - -- style addressing must be used even if it is not possible to construct a - -- valid hostname from the bucket name or the S3 service provider can ensure - -- correct certificate is issued for bucket which contain one or more '.'s - -- in the name. - -- - -- When this option is unspecified, we default to path style addressing to - -- ensure smooth transition for older deployments. - s3AddressingStyle :: !(Maybe OptS3AddressingStyle), - -- | S3 endpoint for generating download links. Useful if Cargohold is configured to use - -- an S3 replacement running inside the internal network (in which case internally we - -- would use one hostname for S3, and when generating an asset link for a client app, we - -- would use another hostname). - s3DownloadEndpoint :: !(Maybe AWSEndpoint), - s3Bucket :: !Text, - -- | Enable this option for compatibility with specific S3 backends. - s3Compatibility :: !(Maybe S3Compatibility), - cloudFront :: !(Maybe CloudFrontOpts), - -- | @Z-Host@ header to s3 download endpoint `Map` - -- - -- This logic is: If the @Z-Host@ header is provided and found in this map, - -- the map's values is taken as s3 download endpoint to redirect to; - -- otherwise a 404 is retuned. This option is only useful - -- in the context of multi-ingress setups where one backend / deployment is - -- reachable under several domains. - multiIngress :: !(Maybe (Map String AWSEndpoint)) - } - -newtype OptS3AddressingStyle = OptS3AddressingStyle - { unwrapS3AddressingStyle :: S3AddressingStyle - } - -data WireSettings = WireSettings - { users :: UserSettings, - search :: SearchSettings, - teams :: TeamSettings, - conversations :: ConversationSettings, - auth :: AuthSettings, - calling :: CallingSettings, - notifications :: NotificationSettings, - federation :: FederationSettings, - email :: EmailSettings, - featureFlags :: FeatureFlags, - assets :: AssetSettings, - bots :: BotSettings, - postgresMigration :: PostgresMigrationOpts, - logSettings :: LogSettings - } - -data SearchSettings = SearchSettings - { emailVisibility :: !EmailVisibilityConfig, - -- | When true, search only - -- returns users from the same team - searchSameTeamOnly :: !(Maybe Bool) - } - -data LogSettings = LogSettings - { logLevel :: !Level, - logFormat :: !(Maybe LogFormat) - } - -data UserSettings = UserSettings - { -- \| Activation timeout, in seconds - activationTimeout :: !Timeout, - -- | Default verification code timeout, in seconds - -- use `verificationTimeout` as the getter function which always provides a default value - verificationCodeTimeoutInternal :: !(Maybe Code.Timeout), - -- | Check for expired users every so often, in seconds - expiredUserCleanupTimeout :: !(Maybe Timeout), - -- | Whitelist of allowed emails/phones - allowlistEmailDomains :: !(Maybe AllowlistEmailDomains), - -- | Max. number of sent/accepted - -- connections per user - userMaxConnections :: !Int64, - -- | Max. number of permanent clients per user - userMaxPermClients :: !(Maybe Int), - suspendInactiveUsers :: !(Maybe SuspendInactiveUsers), - -- | Max size of rich info (number of chars in - -- field names and values), should be in sync - -- with Spar - richInfoLimit :: !Int, - -- | Default locale to use when selecting templates use - -- `defaultTemplateLocale` as the getter function which always provides a - -- default value. TODO: Merge this and next. - defaultTemplateLocaleInternal :: !(Maybe Locale), - -- | Default locale to use for users - -- use `defaultUserLocale` as the getter function which always provides a default value - defaultUserLocaleInternal :: !(Maybe Locale), - propertyMaxKeyLen :: !(Maybe Int64), - propertyMaxValueLen :: !(Maybe Int64), - -- | How long, in milliseconds, to wait in between processing delete events - -- from the internal delete queue - deleteThrottleMillis :: !(Maybe Int), - -- | 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'. - -- When using real SQS from AWS, throttling isn't needed as much, since using - -- >>> SQS.rmWaitTimeSeconds (Just 20) in Brig.AWS.listen - -- ensures that there is only one request every 20 seconds. - -- However, that parameter is not honoured when using fake-sqs - -- (where throttling can thus make sense) - sqsThrottleMillis :: !(Maybe Int), - -- | Do not allow certain user creation flows. - -- docs/reference/user/registration.md {#RefRestrictRegistration}. - restrictUserCreation :: !(Maybe Bool) - } - -data TeamSettings = TeamSettings - { -- \| Team invitation timeout, in seconds - teamInvitationTimeout :: !Timeout, - -- | Max. # of members in a team. - maxTeamSize :: !Word32 - } - -data ConversationSettings = ConversationSettings - { -- | Max. # of members in a conversation. - maxConvSize :: !Word16 - } - -data AuthSettings = AuthSettings - { zauth :: !ZAuthOpts, - -- | Whether to allow plain HTTP transmission of cookies (for testing - -- purposes only) - cookieInsecure :: !Bool, - -- | Minimum age of a user cookie before it is renewed during token refresh - userCookieRenewAge :: !Integer, - -- | Max. # of cookies per user and cookie type - userCookieLimit :: !Int, - -- | Throttling tings (not to be confused with 'LoginRetryOpts') - userCookieThrottle :: !CookieThrottle, - -- | Block user from logging in for m minutes after n failed logins - limitFailedLogins :: !(Maybe LimitFailedLogins) - } - -data NotificationSettings = NotificationSettings {} - -data FederationSettings = FederationSettings - { -- \| FederationDomain is required, even when not wanting to federate with other backends - -- (in that case the 'federationStrategy' can be set to `allowNone` below, or to - -- `allowDynamic` while keeping the list of allowed domains empty, see - -- https://docs.wire.com/understand/federation/backend-communication.html#configuring-remote-connections) - -- Federation domain is used to qualify local IDs and handles, - -- e.g. 0c4d8944-70fa-480e-a8b7-9d929862d18c@wire.com and somehandle@wire.com. - -- It should also match the SRV DNS records under which other wire-server installations can find this backend: - -- >>> _wire-server-federator._tcp. - -- Once set, DO NOT change it: if you do, existing users may have a broken experience and/or stop working. - -- Remember to keep it the same in all services. - federationDomain :: !Domain, - -- | See https://docs.wire.com/understand/federation/backend-communication.html#configuring-remote-connections - -- default: AllowNone - federationStrategy :: !(Maybe FederationStrategy), - -- | 'federationDomainConfigs' is introduced in - -- https://github.com/wireapp/wire-server/pull/3260 for the sole purpose of transitioning - -- to dynamic federation remote configuration. See - -- https://docs.wire.com/understand/federation/backend-communication.html#configuring-remote-connections - -- for details. - -- default: [] - federationDomainConfigs :: !(Maybe [ImplicitNoFederationRestriction]), - -- | In seconds. Default: 10 seconds. Values <1 are silently replaced by 1. See - -- https://docs.wire.com/understand/federation/backend-communication.html#configuring-remote-connections - federationDomainConfigsUpdateFreq :: !(Maybe Int) - } - -data AssetSettings = AssetSettings {} - -data CallingSettings = CallingSettings - { turn :: !TurnOpts, - sft :: !(Maybe SFTOptions), - multiSFT :: !(Maybe Bool) - } - -data BotSettings = BotSettings - { -- \| Filter ONLY services with - -- the given provider id - providerSearchFilter :: !(Maybe ProviderId) - } - -data S3Compatibility - = -- | Scality RING, might also work for Zenko CloudServer - -- - S3CompatibilityScalityRing - --- | AWS CloudFront settings. -data CloudFrontOpts = CloudFrontOpts - { -- | Domain - domain :: CFDomain, - -- | Keypair ID - keyPairId :: CFKeyPairId, - -- | Path to private key - privateKey :: FilePath - } - deriving (Show, Generic) - --- TODO: This is copied from cargohold, dedupe -newtype CFKeyPairId = CFKeyPairId Text - deriving (Eq, Show, Generic) - --- TODO: This is copied from cargohold, dedupe -newtype CFDomain = CFDomain Text - deriving (Eq, Show, Generic) - -data PushNotifiactionOpts = PushNotifiactionOpts - { -- \| AWS account - _account :: !Text, - -- | AWS region name - _region :: !Region, - -- | Environment name to scope ARNs to. TODO: Add explanation for on-prem operators. - _arnEnv :: !Text, - -- | SQS queue name - _queueName :: !Text, - _sqsEndpoint :: !AWSEndpoint, - _snsEndpoint :: !AWSEndpoint - } - --- | Options that are consumed on startup -data Opts = Opts - -- services - { settings :: !Settings - } - deriving (Show, Generic) - --- | Options that persist as runtime settings. -data Settings = Settings - { -- | The analog to `Galley.Options.featureFlags`. See 'AccountFeatureConfigs'. - featureFlags :: !(Maybe UserFeatureFlags), - -- | Customer extensions. Read 'CustomerExtensions' docs carefully! - customerExtensions :: !(Maybe CustomerExtensions), - -- | When set; instead of using SRV lookups to discover SFTs the calls - -- config will always return this entry. This is useful in Kubernetes - -- where SFTs are deployed behind a load-balancer. In the long-run the SRV - -- fetching logic can go away completely - sftStaticUrl :: !(Maybe HttpsUrl), - -- | When set the /calls/config/v2 endpoint will include all the - -- loadbalanced servers of `sftStaticUrl` under the @sft_servers_all@ - -- field. The default ting is to exclude and omit the field from the - -- response. - sftListAllServers :: Maybe ListAllSFTServers, - enableMLS :: Maybe Bool, - keyPackageMaximumLifetime :: Maybe NominalDiffTime, - -- | Disabled versions are not advertised and are completely disabled. - disabledAPIVersions :: !(Set VersionExp), - -- | Minimum delay in seconds between consecutive attempts to generate a new verification code. - -- use `2FACodeGenerationDelaySecs` as the getter function which always provides a default value - twoFACodeGenerationDelaySecsInternal :: !(Maybe Int), - -- | The time-to-live of a nonce in seconds. - -- use `nonceTtlSecs` as the getter function which always provides a default value - nonceTtlSecsInternal :: !(Maybe NonceTtlSecs), - -- | The maximum number of seconds of clock skew the implementation of generate_dpop_access_token in jwt-tools will allow - -- use `dpopMaxSkewSecs` as the getter function which always provides a default value - dpopMaxSkewSecsInternal :: !(Maybe Word16), - -- | The expiration time of a JWT DPoP token in seconds. - -- use `dpopTokenExpirationTimeSecs` as the getter function which always provides a default value - dpopTokenExpirationTimeSecsInternal :: !(Maybe Word64), - -- | Path to a .pem file containing the server's public key and private key - -- e.g. to sign JWT tokens - publicKeyBundle :: !(Maybe FilePath), - -- | Path to the public and private JSON web key pair used to sign OAuth access tokens - oAuthJwkKeyPair :: !(Maybe FilePath), - -- | The expiration time of an OAuth access token in seconds. - -- use `oAuthAccessTokenExpirationTimeSecs` as the getter function which always provides a default value - oAuthAccessTokenExpirationTimeSecsInternal :: !(Maybe Word64), - -- | The expiration time of an OAuth authorization code in seconds. - -- use `oAuthAuthorizationCodeExpirationTimeSecs` as the getter function which always provides a default value - oAuthAuthorizationCodeExpirationTimeSecsInternal :: !(Maybe Word64), - -- | En-/Disable OAuth - -- use `oAuthEnabled` as the getter function which always provides a default value - oAuthEnabledInternal :: !(Maybe Bool), - -- | The expiration time of an OAuth refresh token in seconds. - -- use `oAuthRefreshTokenExpirationTimeSecs` as the getter function which always provides a default value - oAuthRefreshTokenExpirationTimeSecsInternal :: !(Maybe Word64), - -- | The maximum number of active OAuth refresh tokens a user is allowed to have. - -- use `oAuthMaxActiveRefreshTokens` as the getter function which always provides a default value - oAuthMaxActiveRefreshTokensInternal :: !(Maybe Word32), - -- | Options to override the default Argon2id settings for specific operators. - passwordHashingOptions :: !(PasswordHashingOptions), - passwordHashingRateLimit :: !RateLimitConfig, - -- | Optional recipient email address for email domain registration audit logs - auditLogEmailRecipient :: !(Maybe EmailAddress), - -- | Time-to-live for new domain verification challenges, in seconds - challengeTTL :: !Timeout, - -- | Whether to allow ephemeral user creation - ephemeralUserCreationEnabled :: !Bool, - -- | Determines if this backend supports nomad profiles. - nomadProfiles :: !(Maybe Bool), - -- | Determines if consumable notifications are enabled - consumableNotifications :: !Bool - } - deriving (Show, Generic) - -newtype ImplicitNoFederationRestriction = ImplicitNoFederationRestriction - {federationDomainConfig :: FederationDomainConfig} - deriving (Show, Eq, Generic) - -instance FromJSON ImplicitNoFederationRestriction where - parseJSON = - withObject - "ImplicitNoFederationRestriction" - ( \obj -> do - domain <- obj .: "domain" - searchPolicy <- obj .: "search_policy" - pure . ImplicitNoFederationRestriction $ - FederationDomainConfig domain searchPolicy FederationRestrictionAllowAll - ) - -defaultLocale :: Locale -defaultLocale = Locale (Language EN) Nothing - --- defaultUserLocale :: Settings -> Locale --- defaultUserLocale = fromMaybe defaultLocale . defaultUserLocaleInternal - --- defaultTemplateLocale :: Settings -> Locale --- defaultTemplateLocale = fromMaybe defaultLocale . defaultTemplateLocaleInternal - --- verificationTimeout :: Settings -> Code.Timeout --- verificationTimeout = fromMaybe defVerificationTimeout . verificationCodeTimeoutInternal --- where --- defVerificationTimeout :: Code.Timeout --- defVerificationTimeout = Code.Timeout (60 * 10) -- 10 minutes - -twoFACodeGenerationDelaySecs :: Settings -> Int -twoFACodeGenerationDelaySecs = fromMaybe def2FACodeGenerationDelaySecs . twoFACodeGenerationDelaySecsInternal - where - def2FACodeGenerationDelaySecs :: Int - def2FACodeGenerationDelaySecs = 5 * 60 -- 5 minutes - -nonceTtlSecs :: Settings -> NonceTtlSecs -nonceTtlSecs = fromMaybe defaultNonceTtlSecs . nonceTtlSecsInternal - where - defaultNonceTtlSecs :: NonceTtlSecs - defaultNonceTtlSecs = NonceTtlSecs $ 5 * 60 -- 5 minutes - -setDpopMaxSkewSecs :: Settings -> Word16 -setDpopMaxSkewSecs = fromMaybe defaultDpopMaxSkewSecs . dpopMaxSkewSecsInternal - where - defaultDpopMaxSkewSecs :: Word16 - defaultDpopMaxSkewSecs = 1 - -dpopTokenExpirationTimeSecs :: Settings -> Word64 -dpopTokenExpirationTimeSecs = fromMaybe defaultDpopTokenExpirationTimeSecs . dpopTokenExpirationTimeSecsInternal - where - defaultDpopTokenExpirationTimeSecs :: Word64 - defaultDpopTokenExpirationTimeSecs = 30 - -oAuthAccessTokenExpirationTimeSecs :: Settings -> Word64 -oAuthAccessTokenExpirationTimeSecs = fromMaybe defaultOAuthAccessTokenExpirationTimeSecs . oAuthAccessTokenExpirationTimeSecsInternal - where - defaultOAuthAccessTokenExpirationTimeSecs :: Word64 - defaultOAuthAccessTokenExpirationTimeSecs = 60 * 60 * 24 * 7 * 3 -- 3 weeks - -oAuthAuthorizationCodeExpirationTimeSecs :: Settings -> Word64 -oAuthAuthorizationCodeExpirationTimeSecs = fromMaybe defaultOAuthAuthorizationCodeExpirationTimeSecs . oAuthAuthorizationCodeExpirationTimeSecsInternal - where - defaultOAuthAuthorizationCodeExpirationTimeSecs :: Word64 - defaultOAuthAuthorizationCodeExpirationTimeSecs = 300 -- 5 minutes - -oAuthEnabled :: Settings -> Bool -oAuthEnabled = fromMaybe defaultOAuthEnabled . oAuthEnabledInternal - where - defaultOAuthEnabled :: Bool - defaultOAuthEnabled = False - -oAuthRefreshTokenExpirationTimeSecs :: Settings -> Word64 -oAuthRefreshTokenExpirationTimeSecs = fromMaybe defaultOAuthRefreshTokenExpirationTimeSecs . oAuthRefreshTokenExpirationTimeSecsInternal - where - defaultOAuthRefreshTokenExpirationTimeSecs :: Word64 - defaultOAuthRefreshTokenExpirationTimeSecs = 60 * 60 * 24 * 7 * 4 * 6 -- 24 weeks - -oAuthMaxActiveRefreshTokens :: Settings -> Word32 -oAuthMaxActiveRefreshTokens = fromMaybe defaultOAuthMaxActiveRefreshTokens . oAuthMaxActiveRefreshTokensInternal - where - defaultOAuthMaxActiveRefreshTokens :: Word32 - defaultOAuthMaxActiveRefreshTokens = 10 - --- | The analog to `FeatureFlags`. At the moment, only status flags for --- conferenceCalling are stored. -data UserFeatureFlags = UserFeatureFlags - { conferenceCalling :: UserFeature ConferenceCallingConfig - } - deriving (Eq, Ord, Show) - -instance FromJSON UserFeatureFlags where - parseJSON = withObject "UserFeatureFlags" $ \obj -> do - UserFeatureFlags - <$> obj .:? "conferenceCalling" .!= def - -data family UserFeature cfg - -data instance UserFeature ConferenceCallingConfig = ConferenceCallingUserStatus - { -- | This will be set as the status of the feature for newly created users. - forNew :: Maybe FeatureStatus, - -- | How an unset status for this feature should be interpreted. - forNull :: FeatureStatus - } - deriving (Eq, Ord, Show) - -instance Default (UserFeature ConferenceCallingConfig) where - def = ConferenceCallingUserStatus Nothing FeatureStatusEnabled - -instance FromJSON (UserFeature ConferenceCallingConfig) where - parseJSON = withObject "UserFeatureConferenceCalling" $ \obj -> do - ConferenceCallingUserStatus - <$> A.explicitParseFieldMaybe parseUserFeatureStatus obj "defaultForNew" - <*> A.explicitParseFieldMaybe parseUserFeatureStatus obj "defaultForNull" .!= forNull def - -parseUserFeatureStatus :: A.Value -> A.Parser FeatureStatus -parseUserFeatureStatus = withObject "UserFeatureStatus" $ \obj -> obj .: "status" - --- | Customer extensions naturally are covered by the AGPL like everything else, but use them --- at your own risk! If you use the default server config and do not set --- @customerExtensions@, none of this will have any effect. --- --- This is code implemented to comply with particular contracts. It may change or be removed --- at any point in the future without any further notice. -data CustomerExtensions = CustomerExtensions - { -- | When a `Domain` is blocked, users cannot use email addresses of this domain. - -- - -- This includes: - -- - Account activations - -- - Team invitations - -- - Changes of the account's email address - domainsBlockedForRegistration :: DomainsBlockedForRegistration - } - deriving (Show, FromJSON, Generic) - --- | See also: "Galley.API.CustomBackend", `galley.custom_backend`. -newtype DomainsBlockedForRegistration = DomainsBlockedForRegistration (HashSet Domain) - deriving newtype (Show, FromJSON) - -deriving stock instance Generic DomainsBlockedForRegistration - -data SFTOptions = SFTOptions - { sftBaseDomain :: !DNS.Domain, - sftSRVServiceName :: !(Maybe ByteString), -- defaults to defSftServiceName if unset - sftDiscoveryIntervalSeconds :: !(Maybe DiffTime), -- defaults to defSftDiscoveryIntervalSeconds - sftListLength :: !(Maybe (Range 1 100 Int)), -- defaults to defSftListLength - sftTokenOptions :: !(Maybe SFTTokenOptions) - } - deriving (Show, Generic) - -instance FromJSON SFTOptions where - parseJSON = withObject "SFTOptions" $ \o -> - SFTOptions - <$> (asciiOnly =<< o .: "sftBaseDomain") - <*> (mapM asciiOnly =<< o .:? "sftSRVServiceName") - <*> (secondsToDiffTime <$$> o .:? "sftDiscoveryIntervalSeconds") - <*> (o .:? "sftListLength") - <*> (o .:? "sftToken") - -data SFTTokenOptions = SFTTokenOptions - { sttTTL :: !Word32, - sttSecret :: !FilePath - } - deriving (Show, Generic) - -instance FromJSON SFTTokenOptions where - parseJSON = withObject "SFTTokenOptions" $ \o -> - SFTTokenOptions - <$> (o .: "ttl") - <*> (o .: "secret") - -asciiOnly :: Text -> A.Parser ByteString -asciiOnly t = - if Text.all Char.isAscii t - then pure $ Text.encodeUtf8 t - else fail $ "Expected ascii string only, found: " <> Text.unpack t - -defMaxKeyLen :: Int64 -defMaxKeyLen = 1024 - -defMaxValueLen :: Int64 -defMaxValueLen = 524288 - -defDeleteThrottleMillis :: Int -defDeleteThrottleMillis = 100 - -defSqsThrottleMillis :: Int -defSqsThrottleMillis = 500 - -defUserMaxPermClients :: Int -defUserMaxPermClients = 7 - -defSftServiceName :: ByteString -defSftServiceName = "_sft" - -defSrvDiscoveryIntervalSeconds :: DiffTime -defSrvDiscoveryIntervalSeconds = secondsToDiffTime 10 - -defSftListLength :: Range 1 100 Int -defSftListLength = unsafeRange 5 - --- | Convert a word to title case by capitalising the first letter -capitalise :: String -> String -capitalise [] = [] -capitalise (c : cs) = toUpper c : cs - -instance FromJSON Settings where - parseJSON = genericParseJSON customOptions - where - customOptions = - defaultOptions - { fieldLabelModifier = \case - "defaultUserLocaleInternal" -> "setDefaultUserLocale" - "defaultTemplateLocaleInternal" -> "setDefaultTemplateLocale" - "verificationCodeTimeoutInternal" -> "setVerificationTimeout" - "twoFACodeGenerationDelaySecsInternal" -> "set2FACodeGenerationDelaySecs" - "nonceTtlSecsInternal" -> "setNonceTtlSecs" - "dpopMaxSkewSecsInternal" -> "setDpopMaxSkewSecs" - "dpopTokenExpirationTimeSecsInternal" -> "setDpopTokenExpirationTimeSecs" - "oAuthAuthorizationCodeExpirationTimeSecsInternal" -> "setOAuthAuthorizationCodeExpirationTimeSecs" - "oAuthAccessTokenExpirationTimeSecsInternal" -> "setOAuthAccessTokenExpirationTimeSecs" - "oAuthEnabledInternal" -> "setOAuthEnabled" - "oAuthRefreshTokenExpirationTimeSecsInternal" -> "setOAuthRefreshTokenExpirationTimeSecs" - "oAuthMaxActiveRefreshTokensInternal" -> "setOAuthMaxActiveRefreshTokens" - other -> "set" <> capitalise other - } - -instance FromJSON Opts where - parseJSON = genericParseJSON customOptions - where - customOptions = - defaultOptions - { fieldLabelModifier = \case - "settings" -> "optSettings" - "stompOptions" -> "stomp" - other -> other - } - -instance FromJSON StompOpts where - parseJSON = genericParseJSON customOptions - where - customOptions = - defaultOptions - { fieldLabelModifier = \a -> "stom" <> capitalise a - } - -makeLensesWith (lensRules & lensField .~ suffixNamer) ''Opts - -makeLensesWith (lensRules & lensField .~ suffixNamer) ''Settings - -makeLensesWith (lensRules & lensField .~ suffixNamer) ''ElasticSearchOpts - -makeLensesWith (lensRules & lensField .~ suffixNamer) ''TurnOpts diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index ae666e1f2b0..a514305dd0e 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -31,8 +31,8 @@ import Brig.API.Error import Brig.API.Handler import Brig.API.Types (PasswordResetError (..)) import Brig.App -import Brig.Options (Settings (..)) -import Brig.Options qualified as Opt +import Wire.Options (Settings (..)) +import Wire.Options qualified as Opt import Brig.Provider.DB (ServiceConn (..)) import Brig.Provider.DB qualified as DB import Brig.Provider.Email diff --git a/services/brig/src/Brig/Provider/Template.hs b/services/brig/src/Brig/Provider/Template.hs index 7de713abb89..f4a3a8fff51 100644 --- a/services/brig/src/Brig/Provider/Template.hs +++ b/services/brig/src/Brig/Provider/Template.hs @@ -25,7 +25,6 @@ module Brig.Provider.Template ) where -import Brig.Options import Data.ByteString.Conversion (fromByteString) import Data.Misc (HttpsUrl) import Data.Text.Encoding (encodeUtf8) @@ -34,6 +33,7 @@ import Imports import Wire.API.User.Identity import Wire.EmailSubsystem.Template hiding (readTemplate, readText) import Wire.EmailSubsystem.Templates.User +import Wire.Options data ProviderTemplates = ProviderTemplates { activationEmail :: !ActivationEmailTemplate, @@ -62,7 +62,7 @@ data ApprovalConfirmEmailTemplate = ApprovalConfirmEmailTemplate approvalConfirmEmailHomeUrl :: !HttpsUrl } -loadProviderTemplates :: Opts -> IO (Localised ProviderTemplates) +loadProviderTemplates :: WireConfig -> IO (Localised ProviderTemplates) loadProviderTemplates o = readLocalesDir defLocale (templateDir gOptions) "provider" $ \fp -> ProviderTemplates <$> ( ActivationEmailTemplate activationUrl' @@ -104,9 +104,9 @@ loadProviderTemplates o = readLocalesDir defLocale (templateDir gOptions) "provi ) where maybeUrl = fromByteString . encodeUtf8 $ pOptions.homeUrl - gOptions = o.emailSMS.general - pOptions = o.emailSMS.provider - defLocale = defaultTemplateLocale o.settings + gOptions = o.settings.email.general + pOptions = o.settings.email.provider + defLocale = defaultTemplateLocale o.settings.users readTemplate = readTemplateWithDefault gOptions.templateDir defLocale "provider" readText = readTextWithDefault gOptions.templateDir defLocale "provider" -- URL templates diff --git a/services/brig/src/Brig/Queue/Stomp.hs b/services/brig/src/Brig/Queue/Stomp.hs index 8fa9b04336a..d3237b37e4b 100644 --- a/services/brig/src/Brig/Queue/Stomp.hs +++ b/services/brig/src/Brig/Queue/Stomp.hs @@ -27,7 +27,7 @@ module Brig.Queue.Stomp where import BasePrelude hiding (Handler, throwIO) -import Brig.Options qualified as Opts +import Wire.Options qualified as Opts import Codec.MIME.Type qualified as MIME import Control.Monad.Catch (Handler (..), MonadMask) import Control.Retry hiding (retryPolicy) diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs index 5b5d0f96818..831ca03ed77 100644 --- a/services/brig/src/Brig/Run.hs +++ b/services/brig/src/Brig/Run.hs @@ -31,7 +31,7 @@ import Brig.CanonicalInterpreter import Brig.Effects.UserPendingActivationStore (UserPendingActivation (UserPendingActivation), UserPendingActivationStore) import Brig.Effects.UserPendingActivationStore qualified as UsersPendingActivationStore import Brig.InternalEvent.Process qualified as Internal -import Brig.Options hiding (internalEvents, sesQueue) +import Wire.Options hiding (internalEvents, sesQueue) import Brig.Queue qualified as Queue import Brig.Version import Control.Concurrent.Async qualified as Async diff --git a/services/brig/src/Brig/Team/Template.hs b/services/brig/src/Brig/Team/Template.hs index caffd40e85d..8459967600b 100644 --- a/services/brig/src/Brig/Team/Template.hs +++ b/services/brig/src/Brig/Team/Template.hs @@ -23,17 +23,17 @@ module Brig.Team.Template ) where -import Brig.Options import Imports import Wire.EmailSubsystem.Template import Wire.EmailSubsystem.Templates.Team +import Wire.Options -- FUTUREWORK: This can be inlined once the `API.Template` have been migrated -- to wire-subsystem unit tests. -loadTeamTemplatesWithBrigOpts :: Opts -> IO (Localised TeamTemplates) +loadTeamTemplatesWithBrigOpts :: WireConfig -> IO (Localised TeamTemplates) loadTeamTemplatesWithBrigOpts o = loadTeamTemplates - o.emailSMS.team - o.emailSMS.general.templateDir - (defaultTemplateLocale o.settings) - (emailSender o.emailSMS.general) + o.settings.email.team + o.settings.email.general.templateDir + (defaultTemplateLocale o.settings.users) + o.settings.email.general.emailSender diff --git a/services/brig/src/Brig/Template.hs b/services/brig/src/Brig/Template.hs index 0b530261d05..d7b3a1706ab 100644 --- a/services/brig/src/Brig/Template.hs +++ b/services/brig/src/Brig/Template.hs @@ -25,7 +25,7 @@ module Brig.Template ) where -import Brig.Options +import Wire.Options import Data.Map.Strict qualified as Map import Data.Text.Template (Template) import Imports diff --git a/services/brig/src/Brig/User/API/Handle.hs b/services/brig/src/Brig/User/API/Handle.hs index 4ff8f0a2b11..aa79f0b152c 100644 --- a/services/brig/src/Brig/User/API/Handle.hs +++ b/services/brig/src/Brig/User/API/Handle.hs @@ -27,7 +27,7 @@ import Brig.API.Error (fedError) import Brig.API.Handler (Handler) import Brig.API.User qualified as API import Brig.App -import Brig.Options (searchSameTeamOnly) +import Wire.Options (searchSameTeamOnly) import Data.Handle (Handle, fromHandle) import Data.Id (UserId) import Data.Qualified diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index d00b6340196..444fa222577 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -37,7 +37,7 @@ import Brig.API.Types import Brig.API.User (changeSingleAccountStatus) import Brig.App import Brig.Budget -import Brig.Options qualified as Opt +import Wire.Options qualified as Opt import Brig.User.Auth.Cookie import Cassandra import Control.Error hiding (bool) diff --git a/services/brig/src/Brig/User/Auth/Cookie.hs b/services/brig/src/Brig/User/Auth/Cookie.hs index 6288cf652e0..5a2b1a2da4b 100644 --- a/services/brig/src/Brig/User/Auth/Cookie.hs +++ b/services/brig/src/Brig/User/Auth/Cookie.hs @@ -39,7 +39,7 @@ module Brig.User.Auth.Cookie where import Brig.App -import Brig.Options hiding (user) +import Wire.Options hiding (user) import Cassandra import Control.Error import Control.Monad.Except diff --git a/services/brig/src/Brig/User/Client.hs b/services/brig/src/Brig/User/Client.hs index ed89f86db6d..233d77089f7 100644 --- a/services/brig/src/Brig/User/Client.hs +++ b/services/brig/src/Brig/User/Client.hs @@ -27,7 +27,7 @@ import Brig.Effects.JwtTools (JwtTools) import Brig.Effects.JwtTools qualified as JwtTools import Brig.Effects.PublicKeyBundle (PublicKeyBundle) import Brig.Effects.PublicKeyBundle qualified as PublicKeyBundle -import Brig.Options qualified as Opt +import Wire.Options qualified as Opt import Control.Error import Control.Monad.Trans.Except (except) import Data.ByteString (toStrict) diff --git a/services/brig/src/Brig/User/Template.hs b/services/brig/src/Brig/User/Template.hs index ea7193faadf..02dde2ffd63 100644 --- a/services/brig/src/Brig/User/Template.hs +++ b/services/brig/src/Brig/User/Template.hs @@ -17,13 +17,13 @@ module Brig.User.Template (loadUserTemplates) where -import Brig.Options qualified as Opt import Data.Text.Template import Imports import Wire.EmailSubsystem.Template hiding (readTemplate, readText) import Wire.EmailSubsystem.Templates.User +import Wire.Options qualified as Opt -loadUserTemplates :: Opt.Opts -> IO (Localised UserTemplates) +loadUserTemplates :: Opt.WireConfig -> IO (Localised UserTemplates) loadUserTemplates o = readLocalesDir defLocale templateDir "user" $ \fp -> UserTemplates <$> ( VerificationEmailTemplate activationUrl @@ -97,15 +97,15 @@ loadUserTemplates o = readLocalesDir defLocale templateDir "user" $ \fp -> <*> readText fp "email/sender.txt" ) where - gOptions = o.emailSMS.general - uOptions = o.emailSMS.user - tOptions = o.emailSMS.team + gOptions = o.settings.email.general + uOptions = o.settings.email.user + tOptions = o.settings.email.team emailSender = gOptions.emailSender activationUrl = template uOptions.activationUrl teamActivationUrl = template tOptions.tActivationUrl passwordResetUrl = template uOptions.passwordResetUrl deletionUserUrl = template uOptions.deletionUrl - defLocale = Opt.defaultTemplateLocale o.settings + defLocale = Opt.defaultTemplateLocale o.settings.users templateDir = gOptions.templateDir readTemplate = readTemplateWithDefault templateDir defLocale "user" readText = readTextWithDefault templateDir defLocale "user" diff --git a/services/brig/test/integration/API/Calling.hs b/services/brig/test/integration/API/Calling.hs index 1bbb92375a4..2a22aee6c65 100644 --- a/services/brig/test/integration/API/Calling.hs +++ b/services/brig/test/integration/API/Calling.hs @@ -22,7 +22,7 @@ module API.Calling where import Bilge import Bilge.Assert -import Brig.Options qualified as Opts +import Wire.Options qualified as Opts import Control.Lens (view, (.~), (?~), (^.)) import Control.Monad.Catch (MonadCatch) import Data.Bifunctor (Bifunctor (first)) diff --git a/services/brig/test/integration/API/Federation.hs b/services/brig/test/integration/API/Federation.hs index fe4173888eb..9d392670174 100644 --- a/services/brig/test/integration/API/Federation.hs +++ b/services/brig/test/integration/API/Federation.hs @@ -38,7 +38,7 @@ module API.Federation where import API.Search.Util (refreshIndex) import Bilge hiding (head) import Bilge.Assert -import Brig.Options qualified as Opt +import Wire.Options qualified as Opt import Control.Arrow (Arrow (first), (&&&)) import Control.Lens ((?~)) import Data.Aeson diff --git a/services/brig/test/integration/API/Metrics.hs b/services/brig/test/integration/API/Metrics.hs index cc93b37cca0..177a4864a8a 100644 --- a/services/brig/test/integration/API/Metrics.hs +++ b/services/brig/test/integration/API/Metrics.hs @@ -26,7 +26,7 @@ where import Bilge import Bilge.Assert -import Brig.Options qualified as Opt +import Wire.Options qualified as Opt import Data.Attoparsec.Text import Data.ByteString.Conversion import Imports diff --git a/services/brig/test/integration/API/OAuth.hs b/services/brig/test/integration/API/OAuth.hs index 7aa0f85d14f..95f64252bad 100644 --- a/services/brig/test/integration/API/OAuth.hs +++ b/services/brig/test/integration/API/OAuth.hs @@ -39,8 +39,8 @@ import API.Team.Util qualified as Team import Bilge import Bilge.Assert import Brig.API.OAuth hiding (verifyRefreshToken) -import Brig.Options -import Brig.Options qualified as Opt +import Wire.Options +import Wire.Options qualified as Opt import Cassandra qualified as C import Control.Lens import Control.Monad.Catch (MonadCatch) diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index 177e0a90bd8..c1ef94c51ec 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/services/brig/test/integration/API/Provider.hs @@ -27,7 +27,7 @@ where import API.Team.Util qualified as Team import Bilge hiding (accept, head, timeout) import Bilge.Assert -import Brig.Options qualified as Opts +import Wire.Options qualified as Opts import Cassandra qualified as DB import Control.Arrow ((&&&)) import Control.Concurrent.Async qualified as Async diff --git a/services/brig/test/integration/API/Search.hs b/services/brig/test/integration/API/Search.hs index 7729573dc7d..ba2a80b8118 100644 --- a/services/brig/test/integration/API/Search.hs +++ b/services/brig/test/integration/API/Search.hs @@ -40,9 +40,6 @@ import Brig.App (initHttpManagerWithTLSConfig) import Brig.Index.Eval (initIndex, runCommand) import Brig.Index.Options import Brig.Index.Options qualified as IndexOpts -import Brig.Options -import Brig.Options qualified as Opt -import Brig.Options qualified as Opts import Brig.User.Search.Index import Cassandra qualified as C import Cassandra.Options qualified as CassOpts @@ -89,6 +86,9 @@ import Wire.API.User.Search import Wire.API.User.Search qualified as Search import Wire.IndexedUserStore.ElasticSearch (mappingName) import Wire.IndexedUserStore.MigrationStore.ElasticSearch (defaultMigrationIndexName) +import Wire.Options +import Wire.Options qualified as Opt +import Wire.Options qualified as Opts import Wire.PostgresMigrationOpts tests :: Opt.Opts -> ES.Server -> Manager -> Galley -> Brig -> IO TestTree @@ -828,7 +828,7 @@ runReindexFromDatabase syncCommand logger opts newIndexName migrationIndexName p & IndexOpts.cPort .~ (opts.cassandra.endpoint.port) & IndexOpts.cKeyspace .~ (C.Keyspace opts.cassandra.keyspace) postgresSettings :: PostgresSettings = - brigOptsToPostgresSettings opts + wireConfigToPostgresSettings opts endpoint :: Endpoint = opts.galley in runCommand logger $ syncCommand elasticSettings cassandraSettings postgresSettings (UserStorageLocation opts.postgresMigration.user) endpoint pageSize diff --git a/services/brig/test/integration/API/Settings.hs b/services/brig/test/integration/API/Settings.hs index 25a4cff565f..d1df786645d 100644 --- a/services/brig/test/integration/API/Settings.hs +++ b/services/brig/test/integration/API/Settings.hs @@ -20,8 +20,8 @@ module API.Settings (tests) where import API.Team.Util import Bilge hiding (accept, timeout) import Bilge.Assert -import Brig.Options (Opts) -import Brig.Options qualified as Opt +import Wire.Options (Opts) +import Wire.Options qualified as Opt import Control.Arrow ((&&&)) import Control.Lens import Data.Aeson diff --git a/services/brig/test/integration/API/Team.hs b/services/brig/test/integration/API/Team.hs index 66e1ead9e28..f787ab5724d 100644 --- a/services/brig/test/integration/API/Team.hs +++ b/services/brig/test/integration/API/Team.hs @@ -28,7 +28,7 @@ import API.User.Util as Util import Bilge hiding (accept, head, timeout) import Bilge qualified import Bilge.Assert -import Brig.Options qualified as Opt +import Wire.Options qualified as Opt import Control.Arrow ((&&&)) import Control.Lens hiding ((.=)) import Control.Monad.Catch (MonadCatch) diff --git a/services/brig/test/integration/API/TeamUserSearch.hs b/services/brig/test/integration/API/TeamUserSearch.hs index d6ddbecfbf9..9beb0665757 100644 --- a/services/brig/test/integration/API/TeamUserSearch.hs +++ b/services/brig/test/integration/API/TeamUserSearch.hs @@ -22,7 +22,7 @@ import API.Search.Util (executeTeamUserSearch, executeTeamUserSearchWithMaybeSta import API.Team.Util (createPopulatedBindingTeamWithNamesAndHandles) import API.User.Util (initiateEmailUpdateAutoActivate) import Bilge (Manager, MonadHttp) -import Brig.Options qualified as Opt +import Wire.Options qualified as Opt import Control.Monad.Catch (MonadCatch) import Control.Retry () import Data.ByteString.Conversion (toByteString) diff --git a/services/brig/test/integration/API/Template.hs b/services/brig/test/integration/API/Template.hs index 4c697b88ed5..d541943086f 100644 --- a/services/brig/test/integration/API/Template.hs +++ b/services/brig/test/integration/API/Template.hs @@ -1,7 +1,7 @@ module API.Template (tests) where import Bilge -import Brig.Options +import Wire.Options import Brig.Team.Template (loadTeamTemplatesWithBrigOpts) import Brig.Template import Brig.User.Template (loadUserTemplates) diff --git a/services/brig/test/integration/API/User.hs b/services/brig/test/integration/API/User.hs index 5fd105f333c..02678cfd975 100644 --- a/services/brig/test/integration/API/User.hs +++ b/services/brig/test/integration/API/User.hs @@ -31,7 +31,7 @@ import API.User.Util import Bilge hiding (accept, timeout) import Brig.AWS qualified as AWS import Brig.App (initZAuth) -import Brig.Options qualified as Opt +import Wire.Options qualified as Opt import Cassandra qualified as DB import Data.Qualified import Imports diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index 6348fc1309c..3d190440ccc 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -29,7 +29,7 @@ import Bilge hiding (accept, timeout) import Bilge.Assert import Brig.AWS qualified as AWS import Brig.AWS.Types -import Brig.Options qualified as Opt +import Wire.Options qualified as Opt import Control.Arrow ((&&&)) import Control.Exception (throw) import Control.Lens (ix, preview, (^.), (^?)) diff --git a/services/brig/test/integration/API/User/Auth.hs b/services/brig/test/integration/API/User/Auth.hs index c63dd35e2de..3769abe9bca 100644 --- a/services/brig/test/integration/API/User/Auth.hs +++ b/services/brig/test/integration/API/User/Auth.hs @@ -28,7 +28,9 @@ import API.Team.Util import Bilge hiding (body) import Bilge qualified as Http import Bilge.Assert hiding (assert) -import Brig.Options qualified as Opts +import Cassandra hiding (Client, Value) +import Cassandra qualified as DB +import Control.Arrow ((&&&)) import Control.Retry import Data.Aeson as Aeson import Data.ByteString qualified as BS @@ -66,6 +68,7 @@ import Wire.API.User.Auth.Sso import Wire.API.User.Client import Wire.AuthenticationSubsystem.Config import Wire.AuthenticationSubsystem.ZAuth qualified as ZAuth +import Wire.Options qualified as Opts import Wire.Sem.Now (Now) import Wire.Sem.Now.IO import Wire.Sem.Random (Random) diff --git a/services/brig/test/integration/API/User/Client.hs b/services/brig/test/integration/API/User/Client.hs index 61d06eaf1a1..0fe1c6c8e5d 100644 --- a/services/brig/test/integration/API/User/Client.hs +++ b/services/brig/test/integration/API/User/Client.hs @@ -30,7 +30,7 @@ import API.User.Util import API.User.Util qualified as Util import Bilge hiding (accept, head, timeout) import Bilge.Assert -import Brig.Options as Opt +import Wire.Options as Opt import Cassandra qualified as DB import Control.Lens hiding (Wrapped, (#)) import Crypto.JWT hiding (Ed25519, header, params) diff --git a/services/brig/test/integration/API/User/Handles.hs b/services/brig/test/integration/API/User/Handles.hs index 289cb8113bd..93294e7b6e1 100644 --- a/services/brig/test/integration/API/User/Handles.hs +++ b/services/brig/test/integration/API/User/Handles.hs @@ -25,7 +25,7 @@ import API.Team.Util import API.User.Util import Bilge hiding (accept, timeout) import Bilge.Assert -import Brig.Options qualified as Opt +import Wire.Options qualified as Opt import Control.Lens hiding (from, (#)) import Control.Monad.Catch (MonadCatch) import Data.Aeson diff --git a/services/brig/test/integration/API/User/RichInfo.hs b/services/brig/test/integration/API/User/RichInfo.hs index ace12126fd5..497011cb77b 100644 --- a/services/brig/test/integration/API/User/RichInfo.hs +++ b/services/brig/test/integration/API/User/RichInfo.hs @@ -25,8 +25,8 @@ import API.Team.Util (createTeamMember, createUserWithTeam) import API.User.Util import Bilge hiding (accept, timeout) import Bilge.Assert -import Brig.Options -import Brig.Options qualified as Opt +import Wire.Options +import Wire.Options qualified as Opt import Data.CaseInsensitive qualified as CI import Data.List.NonEmpty qualified as NonEmpty import Data.Text qualified as Text diff --git a/services/brig/test/integration/Federation/End2end.hs b/services/brig/test/integration/Federation/End2end.hs index f2506cf2b04..5c34a65f9a4 100644 --- a/services/brig/test/integration/Federation/End2end.hs +++ b/services/brig/test/integration/Federation/End2end.hs @@ -21,7 +21,7 @@ import API.MLS.Util import API.User.Util import Bilge import Bilge.Assert ((!!!), ( Date: Mon, 6 Jul 2026 14:19:11 +0200 Subject: [PATCH 6/9] wire-subsystems: Update nix --- libs/wire-subsystems/default.nix | 3 +++ 1 file changed, 3 insertions(+) diff --git a/libs/wire-subsystems/default.nix b/libs/wire-subsystems/default.nix index 50b26ec421f..968ddff7faa 100644 --- a/libs/wire-subsystems/default.nix +++ b/libs/wire-subsystems/default.nix @@ -39,6 +39,7 @@ , currency-codes , data-default , data-timeout +, dns , email-validate , errors , exceptions @@ -179,6 +180,7 @@ mkDerivation { currency-codes data-default data-timeout + dns email-validate errors exceptions @@ -308,6 +310,7 @@ mkDerivation { currency-codes data-default data-timeout + dns email-validate errors exceptions From b4cae0b10d20b84fd7848faa7248e9078ce9bf27 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Mon, 6 Jul 2026 14:40:54 +0200 Subject: [PATCH 7/9] brig: Delete support for STOMP queues --- services/brig/brig.cabal | 4 - services/brig/brig.integration.yaml | 10 - services/brig/default.nix | 7 - services/brig/src/Brig/App.hs | 5 +- .../brig/src/Brig/DeleteQueue/Interpreter.hs | 8 +- services/brig/src/Brig/Queue.hs | 9 +- services/brig/src/Brig/Queue/Stomp.hs | 216 ------------------ services/brig/src/Brig/Queue/Types.hs | 3 +- 8 files changed, 5 insertions(+), 257 deletions(-) delete mode 100644 services/brig/src/Brig/Queue/Stomp.hs diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 921f806345f..ff196098b75 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -133,7 +133,6 @@ library Brig.Provider.Tag Brig.Provider.Template Brig.Queue - Brig.Queue.Stomp Brig.Queue.Types Brig.RPC Brig.Run @@ -261,13 +260,11 @@ library , lens >=3.8 , metrics-core >=0.3 , metrics-wai >=0.3 - , mime , mime-mail >=0.4 , mmorph , MonadRandom >=0.5 , mtl >=2.1 , network >=2.4 - , network-conduit-tls , openapi3 , optparse-applicative >=0.11 , polysemy @@ -289,7 +286,6 @@ library , servant-server , servant-swagger-ui , ssl-util - , stomp-queue >=0.3 , template >=0.2 , template-haskell , text >=0.11 diff --git a/services/brig/brig.integration.yaml b/services/brig/brig.integration.yaml index 05ec68a0213..132fcea877f 100644 --- a/services/brig/brig.integration.yaml +++ b/services/brig/brig.integration.yaml @@ -73,19 +73,10 @@ aws: # Uncomment to use the randomPrekey allocation strategy instead of dynamoDB randomPrekeys: true -# Uncomment this if you want STOMP. -# -# stomp: -# stompHost: localhost -# stompPort: 61613 -# stompTls: false - # TODO: possibly move 'userJournalQueue' to the top level as well internalEvents: queueType: sqs queueName: integration-brig-events-internal - # queueType: stomp - # queueName: /queue/integration-brig-events-internal emailSMS: # You can either use SES directly (in which case, ensure a feedback queue is configured) @@ -183,7 +174,6 @@ optSettings: setVerificationTimeout: 4 setTeamInvitationTimeout: 4 setExpiredUserCleanupTimeout: 1 - # setStomp: test/resources/stomp-credentials.yaml setUserMaxConnections: 16 setCookieInsecure: true setUserCookieRenewAge: 2 diff --git a/services/brig/default.nix b/services/brig/default.nix index 4ccc141c029..820c6064e3a 100644 --- a/services/brig/default.nix +++ b/services/brig/default.nix @@ -63,7 +63,6 @@ , imports , insert-ordered-containers , iproute -, iso639 , jose , jwt-tools , lens @@ -77,7 +76,6 @@ , MonadRandom , mtl , network -, network-conduit-tls , network-uri , openapi3 , optparse-applicative @@ -110,7 +108,6 @@ , servant-swagger-ui , spar , ssl-util -, stomp-queue , streaming-commons , string-conversions , tasty @@ -204,19 +201,16 @@ mkDerivation { imports insert-ordered-containers iproute - iso639 jose jwt-tools lens metrics-core metrics-wai - mime mime-mail mmorph MonadRandom mtl network - network-conduit-tls openapi3 optparse-applicative polysemy @@ -238,7 +232,6 @@ mkDerivation { servant-server servant-swagger-ui ssl-util - stomp-queue template template-haskell text diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index 5218a98b410..aad0ce2024c 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -107,10 +107,7 @@ import Bilge.RPC (HasRequestId (..)) import Brig.AWS qualified as AWS import Brig.Calling qualified as Calling import Brig.DeleteQueue.Interpreter -import Wire.Options (ElasticSearchOpts, Opts, Settings (..)) -import Wire.Options qualified as Opt import Brig.Provider.Template -import Brig.Queue.Stomp qualified as Stomp import Brig.Queue.Types import Brig.Schema.Run qualified as Migrations import Brig.Team.Template @@ -168,6 +165,8 @@ import Wire.EmailSending.SMTP qualified as SMTP import Wire.EmailSubsystem.Template (Localised, TemplateBranding, forLocale) import Wire.EmailSubsystem.Templates.User import Wire.ExternalAccess.External +import Wire.Options (ElasticSearchOpts, Opts, Settings (..)) +import Wire.Options qualified as Opt import Wire.PostgresMigrationOpts import Wire.RateLimit.Interpreter import Wire.SessionStore diff --git a/services/brig/src/Brig/DeleteQueue/Interpreter.hs b/services/brig/src/Brig/DeleteQueue/Interpreter.hs index 6c644839652..2ed2b913c66 100644 --- a/services/brig/src/Brig/DeleteQueue/Interpreter.hs +++ b/services/brig/src/Brig/DeleteQueue/Interpreter.hs @@ -23,7 +23,6 @@ where import Amazonka.SQS.Lens import Brig.AWS qualified as AWS -import Brig.Queue.Stomp qualified as Stomp import Control.Exception (ErrorCall (..)) import Control.Lens import Data.Aeson @@ -40,10 +39,7 @@ import Wire.DeleteQueue import Wire.InternalEvent import Wire.Sem.Logger --- | The queue environment constructed from `QueueOpts`. -data QueueEnv - = StompQueueEnv Stomp.Broker Text - | SqsQueueEnv AWS.Env Int Text +data QueueEnv = SqsQueueEnv AWS.Env Int Text runDeleteQueue :: ( Member (Embed IO) r, @@ -70,8 +66,6 @@ enqueue :: QueueEnv -> a -> Sem r () -enqueue (StompQueueEnv broker queue) message = - embed @IO $ Stomp.enqueue broker queue message enqueue (SqsQueueEnv awsEnv _ queue) message = do let body = encode message md5 <- embed @IO $ getDigestByName "MD5" diff --git a/services/brig/src/Brig/Queue.hs b/services/brig/src/Brig/Queue.hs index 3772b57fc08..0cd71b3e5e7 100644 --- a/services/brig/src/Brig/Queue.hs +++ b/services/brig/src/Brig/Queue.hs @@ -24,29 +24,22 @@ where import Brig.AWS qualified as AWS import Brig.DeleteQueue.Interpreter (QueueEnv (..)) -import Brig.Queue.Stomp qualified as Stomp import Brig.Queue.Types -import Control.Monad.Catch import Data.Aeson import Imports -import System.Logger.Class as Log hiding (settings) -- | Forever listen to messages coming from a queue and execute a callback -- for each incoming message. -- --- See documentation of underlying functions (e.g. 'Stomp.listen') for +-- See documentation of underlying functions (e.g. 'AWS.listen') for -- extra details. listen :: ( Show a, FromJSON a, - MonadLogger m, - MonadMask m, MonadUnliftIO m ) => QueueEnv -> (a -> m ()) -> m () -listen (StompQueueEnv env queue) callback = - Stomp.listen env queue callback listen (SqsQueueEnv env throttleMillis queue) callback = do withRunInIO $ \lower -> AWS.execute env $ AWS.listen throttleMillis queue $ lower . callback diff --git a/services/brig/src/Brig/Queue/Stomp.hs b/services/brig/src/Brig/Queue/Stomp.hs deleted file mode 100644 index d3237b37e4b..00000000000 --- a/services/brig/src/Brig/Queue/Stomp.hs +++ /dev/null @@ -1,216 +0,0 @@ --- 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 . - --- | Working with STOMP queues (targeting ActiveMQ specifically). -module Brig.Queue.Stomp - ( Env (..), - mkEnv, - Broker (..), - Credentials (..), - enqueue, - listen, - ) -where - -import BasePrelude hiding (Handler, throwIO) -import Wire.Options qualified as Opts -import Codec.MIME.Type qualified as MIME -import Control.Monad.Catch (Handler (..), MonadMask) -import Control.Retry hiding (retryPolicy) -import Data.Aeson as Aeson -import Data.ByteString.Lazy qualified as BL -import Data.Conduit.Network.TLS -import Data.Text hiding (show) -import Data.Text.Encoding -import Network.Mom.Stompl.Client.Queue hiding (try) -import System.Logger.Class as Log -import UnliftIO (MonadUnliftIO, throwIO, withRunInIO) - -data Env = Env - { -- | STOMP broker that we're using - broker :: Broker - } - -data Broker = Broker - { -- | Broker URL - host :: Text, - -- | Port - port :: Int, - -- | Username and password - auth :: Maybe Credentials, - -- | Whether to use TLS - tls :: Bool - } - deriving (Show) - -data Credentials = Credentials - { user :: Text, - pass :: Text - } - deriving (Eq, Show, Generic) - -instance FromJSON Credentials - --- | Construct an 'Env' with some default settings. -mkEnv :: - -- | Options that can be customized - Opts.StompOpts -> - -- | Credentials - Credentials -> - Env -mkEnv o cred = - Env - { broker = - Broker - { host = o.host, - port = o.port, - auth = Just cred, - tls = o.tls - } - } - --- | Send a message to a STOMP queue. --- --- In case of failure will try five more times. The timeout for each attempt --- is 500ms. -enqueue :: (ToJSON a, MonadIO m) => Broker -> Text -> a -> m () -enqueue b q m = - retrying retryPolicy retryPredicate (const enqueueAction) >>= either throwIO pure - where - retryPredicate _ res = pure (isLeft res) - retryPolicy = limitRetries 5 <> exponentialBackoff 50000 - enqueueAction = - liftIO $ - try @StomplException $ - stompTimeout "enqueue" 500000 $ - withConnection' b $ - \conn -> - withWriter - conn - (unpack q) - (unpack q) - [OWithReceipt, OWaitReceipt] - [] - oconv - $ \w -> - writeQ w jsonType [("persistent", "true")] m - --- Note [receipts] --- ~~~ --- When we acknowledge a message in 'listen', we don't need to wait for --- a receipt because nothing bad will happen if our ACK doesn't go --- through; handlers of events coming via queues are supposed to be --- idempotent. --- --- However, when we *send* a message, we definitely want a receipt (a --- confirmation that the broker received the message). This doesn't --- eliminate failure modes entirely – if we don't get a receipt we might --- think that a message has not been enqueued while it in fact has – but --- it's better than the opposite. - --- | Forever listen to messages from a STOMP queue and execute a callback --- for each incoming message. --- --- In case of connection failure or an exception, will retry indefinitely. --- --- When 'listen' catches any kind of exception, it will reestablish the --- connection and get a new message to process. Assuming that the broker is --- configured properly, after failing on the same message several times the --- message will go into the Dead Letter Queue where it can be analyzed --- manually. --- --- FUTUREWORK: This probably deserves a Polysemy action -listen :: - (FromJSON a, MonadLogger m, MonadMask m, MonadUnliftIO m) => - Broker -> - Text -> - (a -> m ()) -> - m () -listen b q callback = - recovering retryPolicy handlers (const listenAction) - where - retryPolicy = constantDelay 1000000 - listenAction = - withRunInIO $ \runInIO -> - withConnection' b $ \conn -> - withReader - conn - (unpack q) - (unpack q) - [OMode ClientIndi] - [] - (iconv q) - $ \r -> - forever $ do - -- NB: 'readQ' can't timeout because it's just reading from - -- a chan (no network queries are being made) - m <- readQ r - runInIO $ callback (msgContent m) - stompTimeout "listen/ack" 1000000 $ ack conn m - handlers = skipAsyncExceptions ++ [logError] - logError = const . Handler $ \(e :: SomeException) -> do - Log.err $ - msg (val "Exception when listening to a STOMP queue") - ~~ field "queue" (show q) - ~~ field "error" (displayException e) - pure True - --- Note [exception handling] --- ~~~ --- The callback might throw an exception, which will be caught by --- 'recovering'. This will kill and restart the connection, while we could --- in theory do better (just throw away the exception without killing --- the connection). However, this is supposed to be a very rare case --- and it would complicate the code so we don't care. - -------------------------------------------------------------------------------- --- Utilities - -iconv :: (FromJSON a) => Text -> InBound a -iconv queue _ _ _ bs = - case Aeson.eitherDecode (BL.fromStrict bs) of - Right x -> pure x - Left e -> - convertError $ - "Error when parsing message from STOMP queue " <> unpack queue <> ": " <> e - -oconv :: (ToJSON a) => OutBound a -oconv = pure . BL.toStrict . Aeson.encode - -jsonType :: MIME.Type -jsonType = MIME.Type (MIME.Application "json") [] - --- | Set up a STOMP connection. -withConnection' :: Broker -> (Con -> IO a) -> IO a -withConnection' b = - withConnection (unpack (host b)) (port b) config [] - where - config = - [OAuth (unpack (user cred)) (unpack (pass cred)) | Just cred <- [auth b]] - ++ [OTLS (tlsClientConfig (port b) (encodeUtf8 (host b))) | tls b] - ++ [OTmo 1000] - --- | Like 'timeout', but throws an 'AppException' instead of returning a --- 'Maybe'. Not very composable, but kinda convenient here. -stompTimeout :: String -> Int -> IO a -> IO a -stompTimeout location t act = - timeout t act >>= \case - Just x -> pure x - Nothing -> - throwIO $ - AppException $ - location <> ": STOMP request took more than " <> show t <> "mcs and has timed out" diff --git a/services/brig/src/Brig/Queue/Types.hs b/services/brig/src/Brig/Queue/Types.hs index e7784b8b8fe..7b05335c608 100644 --- a/services/brig/src/Brig/Queue/Types.hs +++ b/services/brig/src/Brig/Queue/Types.hs @@ -24,12 +24,11 @@ import Data.Aeson import Imports -- | Config file info for a remote queue that you can publish to and listen from. -data QueueOpts = StompQueueOpts Text | SqsQueueOpts Text +data QueueOpts = SqsQueueOpts Text deriving (Eq, Show) instance FromJSON QueueOpts where parseJSON = withObject "Queue" $ \o -> o .: "queueType" >>= \case - "stomp" -> StompQueueOpts <$> o .: "queueName" "sqs" -> SqsQueueOpts <$> o .: "queueName" other -> fail ("unknown 'queueType': " <> other) From 9b333b7b474834ef07c33bf352bd26048d799a20 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Mon, 6 Jul 2026 14:42:27 +0200 Subject: [PATCH 8/9] wire-subsystems: Remove unsused dependencies --- libs/wire-subsystems/default.nix | 99 ---------- libs/wire-subsystems/wire-subsystems.cabal | 208 ++++++++------------- 2 files changed, 74 insertions(+), 233 deletions(-) diff --git a/libs/wire-subsystems/default.nix b/libs/wire-subsystems/default.nix index 968ddff7faa..bfcf0e68b3e 100644 --- a/libs/wire-subsystems/default.nix +++ b/libs/wire-subsystems/default.nix @@ -14,7 +14,6 @@ , async , attoparsec , base -, base16-bytestring , base64-bytestring , bilge , bimap @@ -27,7 +26,6 @@ , conduit , constraints , containers -, contravariant , cookie , cql , crypton @@ -48,7 +46,6 @@ , file-embed , filepath , galley-types -, generics-sop , hashable , HaskellNet , HaskellNet-SSL @@ -76,12 +73,10 @@ , lens-aeson , lib , lrucaching -, mime , mime-mail , MonadRandom , mtl , network -, network-conduit-tls , network-uri , polysemy , polysemy-conc @@ -101,7 +96,6 @@ , resourcet , retry , saml2-web-sso -, schema-profunctor , scientific , servant , servant-client-core @@ -111,7 +105,6 @@ , sop-core , ssl-util , statistics -, stomp-queue , string-conversions , tagged , template @@ -136,7 +129,6 @@ , wai-utilities , wire-api , wire-api-federation -, wire-otel , witherable , zauth }: @@ -156,7 +148,6 @@ mkDerivation { async attoparsec base - base16-bytestring base64-bytestring bilge bimap @@ -169,7 +160,6 @@ mkDerivation { conduit constraints containers - contravariant cookie cql crypton @@ -188,7 +178,6 @@ mkDerivation { extra file-embed galley-types - generics-sop hashable HaskellNet HaskellNet-SSL @@ -200,7 +189,6 @@ mkDerivation { hex hscim HsOpenSSL - hspec html-entities http-api-data http-client @@ -214,12 +202,10 @@ mkDerivation { lens lens-aeson lrucaching - mime mime-mail MonadRandom mtl network - network-conduit-tls network-uri polysemy polysemy-conc @@ -237,7 +223,6 @@ mkDerivation { resourcet retry saml2-web-sso - schema-profunctor servant servant-client-core servant-server @@ -246,7 +231,6 @@ mkDerivation { sop-core ssl-util statistics - stomp-queue tagged template text @@ -270,139 +254,56 @@ mkDerivation { wai-utilities wire-api wire-api-federation - wire-otel witherable zauth ]; testHaskellDepends = [ aeson - aeson-pretty - amazonka - amazonka-core - amazonka-dynamodb - amazonka-ses - amazonka-sqs - amqp async - attoparsec base - base16-bytestring - base64-bytestring - bilge bloodhound bytestring - bytestring-conversion - case-insensitive - cassandra-util - comonad - conduit - constraints containers - contravariant - cookie - cql crypton - crypton-asn1-encoding - crypton-asn1-types - crypton-pem - crypton-x509 crypton-x509-store - currency-codes data-default - data-timeout - dns email-validate errors - exceptions extended extra - file-embed filepath - galley-types - generics-sop - hashable - HaskellNet - HaskellNet-SSL - hasql - hasql-migration - hasql-pool - hasql-th - hasql-transaction - hex hscim - HsOpenSSL hspec - html-entities - http-client - http-client-openssl - http-types - http2-manager imports iproute iso639 - kan-extensions lens - lens-aeson - lrucaching - mime mime-mail - MonadRandom - network - network-conduit-tls network-uri polysemy - polysemy-conc polysemy-plugin - polysemy-time polysemy-wire-zoo - profunctors - prometheus-client - proto-lens QuickCheck quickcheck-instances - ram random - raw-strings-qq - resource-pool - resourcet - retry saml2-web-sso - schema-profunctor scientific - servant servant-client-core - servant-server - singletons sodium-crypto-sign - sop-core - ssl-util - statistics - stomp-queue string-conversions tagged - template text - text-icu-translit time - time-out - time-units tinylog - token-bucket transformers types-common - types-common-journal - unliftio unordered-containers uri-bytestring utf8-string uuid vector - wai - wai-utilities wire-api wire-api-federation - wire-otel - witherable zauth ]; testToolDepends = [ hspec-discover ]; diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index b525a4027e2..d285da6c125 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -34,7 +34,7 @@ common common-all ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path - -Wredundant-constraints + -Wredundant-constraints -Wunused-packages default-extensions: AllowAmbiguousTypes @@ -82,130 +82,6 @@ common common-all UndecidableInstances ViewPatterns - build-depends: - , aeson - , aeson-pretty - , amazonka - , amazonka-core - , amazonka-dynamodb - , amazonka-ses - , amazonka-sqs - , amqp - , async - , attoparsec - , base - , base16-bytestring - , base64-bytestring - , bilge - , bloodhound - , bytestring - , bytestring-conversion - , case-insensitive - , cassandra-util - , comonad - , conduit - , constraints - , containers - , contravariant - , cookie - , cql - , crypton - , crypton-asn1-encoding - , crypton-asn1-types - , crypton-pem - , currency-codes - , data-default - , data-timeout - , dns - , email-validate - , errors - , exceptions - , extended - , extra - , file-embed - , galley-types - , generics-sop - , hashable - , HaskellNet - , HaskellNet-SSL - , hasql - , hasql-migration - , hasql-pool - , hasql-th - , hasql-transaction - , hex - , hscim - , HsOpenSSL - , hspec - , html-entities - , http-client - , http-client-openssl - , http-types - , http2-manager - , imports - , iproute - , iso639 - , kan-extensions - , lens - , lens-aeson - , lrucaching - , mime - , mime-mail - , MonadRandom - , network - , network-conduit-tls - , network-uri - , polysemy - , polysemy-conc - , polysemy-plugin - , polysemy-time - , polysemy-wire-zoo - , profunctors - , prometheus-client - , proto-lens - , QuickCheck - , ram - , raw-strings-qq - , resource-pool - , resourcet - , retry - , saml2-web-sso - , schema-profunctor - , servant - , servant-client-core - , servant-server - , singletons - , sodium-crypto-sign - , sop-core - , ssl-util - , statistics - , stomp-queue - , tagged - , template - , text - , text-icu-translit - , time - , time-out - , time-units - , tinylog - , token-bucket - , transformers - , types-common - , types-common-journal - , unliftio - , unordered-containers - , uri-bytestring - , utf8-string - , uuid - , vector - , wai - , wai-utilities - , wire-api - , wire-api-federation - , wire-otel - , witherable - , zauth - library import: common-all ghc-options: -fplugin=Polysemy.Plugin @@ -478,12 +354,13 @@ library , aeson-pretty , amazonka , amazonka-core + , amazonka-dynamodb , amazonka-ses + , amazonka-sqs , amqp , async , attoparsec , base - , base16-bytestring , base64-bytestring , bilge , bimap @@ -492,58 +369,82 @@ library , bytestring-conversion , case-insensitive , cassandra-util + , comonad , conduit + , constraints , containers + , cookie , cql , crypton + , crypton-asn1-encoding + , crypton-asn1-types + , crypton-pem , crypton-x509 , currency-codes , data-default , data-timeout + , dns , email-validate , errors , exceptions , extended , extra + , file-embed + , galley-types , hashable , HaskellNet , HaskellNet-SSL + , hasql + , hasql-migration + , hasql-pool + , hasql-th + , hasql-transaction , hex + , hscim , HsOpenSSL - , hspec , html-entities , http-api-data , http-client + , http-client-openssl , http-types , http2-manager , imports , iproute , iso639 + , kan-extensions , lens + , lens-aeson , lrucaching - , mime , mime-mail + , MonadRandom , mtl , network - , network-conduit-tls + , network-uri , polysemy + , polysemy-conc , polysemy-plugin , polysemy-time , polysemy-wire-zoo , postgresql-error-codes + , profunctors , prometheus-client + , proto-lens , QuickCheck , ram + , raw-strings-qq , resource-pool , resourcet , retry , saml2-web-sso - , schema-profunctor , servant , servant-client-core + , servant-server + , singletons , sodium-crypto-sign + , sop-core + , ssl-util , statistics - , stomp-queue + , tagged , template , text , text-icu-translit @@ -555,15 +456,17 @@ library , token-bucket , transformers , types-common + , types-common-journal , unliftio , unordered-containers , uri-bytestring + , utf8-string , uuid , vector + , wai , wai-utilities , wire-api , wire-api-federation - , wire-otel , witherable , zauth @@ -651,14 +554,51 @@ test-suite wire-subsystems-tests build-tool-depends: hspec-discover:hspec-discover build-depends: - , crypton-x509 + , aeson + , async + , base + , bloodhound + , bytestring + , containers + , crypton , crypton-x509-store + , data-default + , email-validate + , errors + , extended + , extra , filepath + , hscim , hspec + , imports + , iproute + , iso639 + , lens + , mime-mail + , network-uri + , polysemy + , polysemy-plugin + , polysemy-wire-zoo , QuickCheck , quickcheck-instances , random + , saml2-web-sso , scientific + , servant-client-core + , sodium-crypto-sign , string-conversions - , wai + , tagged + , text + , time + , tinylog + , transformers + , types-common + , unordered-containers + , uri-bytestring + , utf8-string + , uuid + , vector + , wire-api + , wire-api-federation , wire-subsystems + , zauth From deff2c008d1fc545129ad4c4905ce3a422ccd055 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Mon, 6 Jul 2026 16:58:41 +0200 Subject: [PATCH 9/9] WIP: Type tetris with moved options --- libs/wire-subsystems/src/Wire/Options.hs | 24 ++--- services/brig/src/Brig/API/Connection/Util.hs | 2 +- services/brig/src/Brig/App.hs | 89 +++++++++---------- .../brig/src/Brig/CanonicalInterpreter.hs | 19 +--- services/brig/src/Brig/Provider/Template.hs | 2 +- services/brig/src/Brig/Team/Template.hs | 2 +- services/brig/src/Brig/User/Template.hs | 3 +- 7 files changed, 63 insertions(+), 78 deletions(-) diff --git a/libs/wire-subsystems/src/Wire/Options.hs b/libs/wire-subsystems/src/Wire/Options.hs index d3229c393f4..971cb4992b0 100644 --- a/libs/wire-subsystems/src/Wire/Options.hs +++ b/libs/wire-subsystems/src/Wire/Options.hs @@ -4,6 +4,7 @@ module Wire.Options where import Amazonka (Region) import Amazonka.Types (S3AddressingStyle) +import Control.Lens (makePrisms) import Data.Aeson (FromJSON (..), Value (..), parseJSON, withObject, (.:), (.:?)) import Data.Aeson.TH (Options (..), defaultOptions, deriveFromJSON, deriveJSON) import Data.Aeson.Types qualified as A @@ -28,6 +29,7 @@ import Util.Options.Common (toOptionFieldName) import Util.Timeout (Timeout) import Wire.API.Allowlists (AllowlistEmailDomains (..)) import Wire.API.Routes.FederationDomainConfig (FederationDomainConfig (..), FederationRestriction (..), FederationStrategy) +import Wire.API.Routes.Version import Wire.API.Team.FeatureFlags (FeatureFlags) import Wire.API.User import Wire.AuthenticationSubsystem.Config (ZAuthSettings) @@ -35,6 +37,7 @@ import Wire.AuthenticationSubsystem.Cookie.Limit (CookieThrottle) import Wire.EmailSending.SMTP (SMTPConnType (..)) import Wire.EmailSubsystem.Template (TeamOpts) import Wire.PostgresMigrationOpts (PostgresMigrationOpts) +import Wire.RateLimit.Interpreter asciiOnly :: Text -> A.Parser ByteString asciiOnly t = @@ -187,7 +190,8 @@ data WireSettings = WireSettings assets :: AssetSettings, bots :: BotSettings, postgresMigration :: PostgresMigrationOpts, - logSettings :: LogSettings + logs :: LogSettings, + disabledAPIVersions :: !(Set VersionExp) } data SearchSettings = SearchSettings @@ -225,10 +229,9 @@ data UserSettings = UserSettings -- | Default locale to use when selecting templates use -- `defaultTemplateLocale` as the getter function which always provides a -- default value. TODO: Merge this and next. - defaultTemplateLocaleInternal :: !(Maybe Locale), + defaultTemplateLocale :: !(Maybe Locale), -- | Default locale to use for users - -- use `defaultUserLocale` as the getter function which always provides a default value - defaultUserLocaleInternal :: !(Maybe Locale), + defaultUserLocale :: !(Maybe Locale), propertyMaxKeyLen :: !(Maybe Int64), propertyMaxValueLen :: !(Maybe Int64), -- | How long, in milliseconds, to wait in between processing delete events @@ -245,13 +248,10 @@ data UserSettings = UserSettings sqsThrottleMillis :: !(Maybe Int), -- | Do not allow certain user creation flows. -- docs/reference/user/registration.md {#RefRestrictRegistration}. - restrictUserCreation :: !(Maybe Bool) + restrictUserCreation :: !(Maybe Bool), + domainsBlockedForRegistration :: !(HashSet Domain) } --- TODO: Make this the actual default when the YAML doesn't specify a value. -defaultTemplateLocale :: UserSettings -> Locale -defaultTemplateLocale = fromMaybe defaultLocale . defaultTemplateLocaleInternal - data TeamSettings = TeamSettings { -- \| Team invitation timeout, in seconds teamInvitationTimeout :: !Timeout, @@ -276,7 +276,9 @@ data AuthSettings = AuthSettings -- | Throttling tings (not to be confused with 'LoginRetryOpts') userCookieThrottle :: !CookieThrottle, -- | Block user from logging in for m minutes after n failed logins - limitFailedLogins :: !(Maybe LimitFailedLogins) + limitFailedLogins :: !(Maybe LimitFailedLogins), + -- | Rate limit on password hashing + passwordHashingRateLimit :: RateLimitConfig } data NotificationSettings = NotificationSettings {} @@ -627,3 +629,5 @@ defSrvDiscoveryIntervalSeconds = secondsToDiffTime 10 defSftListLength :: Range 1 100 Int defSftListLength = toRange (Proxy @5) + +makePrisms ''PrekeySelectionOpts diff --git a/services/brig/src/Brig/API/Connection/Util.hs b/services/brig/src/Brig/API/Connection/Util.hs index 38cce87aa36..0f79a8e102d 100644 --- a/services/brig/src/Brig/API/Connection/Util.hs +++ b/services/brig/src/Brig/API/Connection/Util.hs @@ -28,7 +28,6 @@ where import Brig.API.Types import Brig.App import Brig.Data.Connection qualified as Data -import Wire.Options (Settings (userMaxConnections)) import Control.Error (MaybeT, noteT) import Control.Monad.Trans.Except import Data.Id (UserId) @@ -39,6 +38,7 @@ import Polysemy import Wire.API.Connection (Relation (..)) import Wire.API.User import Wire.GalleyAPIAccess +import Wire.Options (Settings (userMaxConnections)) import Wire.UserStore import Wire.UserSubsystem diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index aad0ce2024c..b4ee1d56594 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -108,7 +108,6 @@ import Brig.AWS qualified as AWS import Brig.Calling qualified as Calling import Brig.DeleteQueue.Interpreter import Brig.Provider.Template -import Brig.Queue.Types import Brig.Schema.Run qualified as Migrations import Brig.Team.Template import Brig.Template (InvitationUrlTemplates (..), genTemplateBranding, genTemplateBrandingMap) @@ -165,7 +164,7 @@ import Wire.EmailSending.SMTP qualified as SMTP import Wire.EmailSubsystem.Template (Localised, TemplateBranding, forLocale) import Wire.EmailSubsystem.Templates.User import Wire.ExternalAccess.External -import Wire.Options (ElasticSearchOpts, Opts, Settings (..)) +import Wire.Options (ElasticSearchOpts, WireConfig, WireSettings) import Wire.Options qualified as Opt import Wire.PostgresMigrationOpts import Wire.RateLimit.Interpreter @@ -203,7 +202,7 @@ data Env = Env httpManager :: Manager, http2Manager :: Http2Manager, extGetManager :: (Manager, [Fingerprint Rsa] -> SSL.SSL -> IO ()), - settings :: Settings, + settings :: WireSettings, fsWatcher :: FS.WatchManager, turnEnv :: Calling.TurnEnv, sftEnv :: Maybe Calling.SFTEnv, @@ -224,7 +223,7 @@ data Env = Env makeLensesWith (lensRules & lensField .~ suffixNamer) ''Env -newEnv :: Opts -> IO Env +newEnv :: WireConfig -> IO Env newEnv opts = do Just md5 <- getDigestByName "MD5" Just sha256 <- getDigestByName "SHA256" @@ -237,58 +236,50 @@ newEnv opts = do utp <- loadUserTemplates opts ptp <- loadProviderTemplates opts ttp <- loadTeamTemplatesWithBrigOpts opts - let branding = genTemplateBranding . Opt.templateBranding . Opt.general . Opt.emailSMS $ opts - brandingAsMap = genTemplateBrandingMap . Opt.templateBranding . Opt.general . Opt.emailSMS $ opts - (emailAWSOpts, emailSMTP) <- emailConn lgr $ Opt.email (Opt.emailSMS opts) - aws <- AWS.mkEnv lgr (Opt.aws opts) emailAWSOpts mgr + let branding = genTemplateBranding opts.settings.email.general.templateBranding + brandingAsMap = genTemplateBrandingMap opts.settings.email.general.templateBranding + (emailAWSOpts, emailSMTP) <- emailConn lgr opts.externalServices.email + aws <- AWS.mkEnv lgr opts.externalServices.sqs (opts.externalServices.prekeySelection ^? Opt._DynamoDBPrekeySelection) emailAWSOpts mgr zau <- initZAuth opts clock <- mkAutoUpdate defaultUpdateSettings {updateAction = getCurrentTime} w <- FS.startManagerConf $ FS.defaultConfig {FS.confWatchMode = FS.WatchModeOS} - let turnOpts = Opt.turn opts + let turnOpts = opts.settings.calling.turn turnSecret <- Text.encodeUtf8 . Text.strip <$> Text.readFile (Opt.secret turnOpts) turn <- Calling.mkTurnEnv (Opt.serversSource turnOpts) (Opt.tokenTTL turnOpts) (Opt.configTTL turnOpts) turnSecret sha512 - eventsQueue :: QueueEnv <- case opts.internalEvents.internalEventsQueue of - StompQueueOpts q -> do - stomp :: Stomp.Env <- case (opts.stompOptions, opts.settings.stomp) of - (Just s, Just c) -> Stomp.mkEnv s <$> initCredentials c - (Just _, Nothing) -> error "STOMP is configured but 'setStomp' is not set" - (Nothing, Just _) -> error "'setStomp' is present but STOMP is not configured" - (Nothing, Nothing) -> error "stomp is selected for internal events, but not configured in 'setStomp', STOMP" - pure (StompQueueEnv (Stomp.broker stomp) q) - SqsQueueOpts q -> do - let throttleMillis = fromMaybe Opt.defSqsThrottleMillis opts.settings.sqsThrottleMillis - SqsQueueEnv aws throttleMillis <$> AWS.getQueueUrl (aws ^. AWS.amazonkaEnv) q - mSFTEnv <- mapM (Calling.mkSFTEnv sha512) $ Opt.sft opts - prekeyLocalLock <- case Opt.randomPrekeys opts of - Just True -> do + eventsQueue :: QueueEnv <- do + let throttleMillis = fromMaybe Opt.defSqsThrottleMillis opts.settings.users.sqsThrottleMillis + SqsQueueEnv aws throttleMillis <$> AWS.getQueueUrl (aws ^. AWS.amazonkaEnv) opts.externalServices.sqs.internalEventsQueue + mSFTEnv <- mapM (Calling.mkSFTEnv sha512) $ opts.settings.calling.sft + prekeyLocalLock <- case opts.externalServices.prekeySelection of + Opt.RandomPrekeySelection -> do Log.info lgr $ Log.msg (Log.val "randomPrekeys: active") Just <$> newMVar () _ -> do Log.info lgr $ Log.msg (Log.val "randomPrekeys: not active; using dynamoDB instead.") pure Nothing kpLock <- newMVar () - rabbitChan <- Q.mkRabbitMqChannelMVar lgr (Just "brig") opts.rabbitmq + rabbitChan <- Q.mkRabbitMqChannelMVar lgr (Just "brig") opts.externalServices.rabbitmq let allDisabledVersions = foldMap expandVersionExp opts.settings.disabledAPIVersions - idxEnv <- mkIndexEnv opts.elasticsearch lgr (Opt.galley opts) mgr - rateLimitEnv <- newRateLimitEnv opts.settings.passwordHashingRateLimit - hasqlPool <- initPostgresPool opts.postgresqlPool opts.postgresql opts.postgresqlPassword - amqpJobsPublisherChannel <- Q.mkRabbitMqChannelMVar lgr (Just "brig") opts.rabbitmq + idxEnv <- mkIndexEnv opts.externalServices.elasticsearch lgr opts.internalServices.galley mgr + rateLimitEnv <- newRateLimitEnv opts.settings.auth.passwordHashingRateLimit + hasqlPool <- initPostgresPool opts.externalServices.postgresqlPool opts.externalServices.postgresql opts.externalServices.postgresqlPassword + amqpJobsPublisherChannel <- Q.mkRabbitMqChannelMVar lgr (Just "brig") opts.externalServices.rabbitmq pure $! Env - { cargohold = mkEndpoint $ opts.cargohold, - galley = mkEndpoint $ opts.galley, - galleyEndpoint = opts.galley, - sparEndpoint = opts.spar, - gundeckEndpoint = opts.gundeck, - cargoholdEndpoint = opts.cargohold, - federator = opts.federatorInternal, - wireServerEnterpriseEndpoint = opts.wireServerEnterprise, + { cargohold = mkEndpoint $ opts.internalServices.cargohold, + galley = mkEndpoint $ opts.internalServices.galley, + galleyEndpoint = opts.internalServices.galley, + sparEndpoint = opts.internalServices.spar, + gundeckEndpoint = opts.internalServices.gundeck, + cargoholdEndpoint = opts.internalServices.cargohold, + federator = opts.internalServices.federatorInternal, + wireServerEnterpriseEndpoint = opts.internalServices.wireServerEnterprise, casClient = cas, hasqlPool = hasqlPool, smtpEnv = emailSMTP, - emailSender = opts.emailSMS.general.emailSender, + emailSender = opts.settings.email.general.emailSender, awsEnv = aws, -- used by `journalEvent` directly appLogger = lgr, internalEvents = (eventsQueue :: QueueEnv), @@ -314,10 +305,10 @@ newEnv opts = do keyPackageLocalLock = kpLock, rabbitmqChannel = rabbitChan, disabledVersions = allDisabledVersions, - enableSFTFederation = opts.multiSFT, + enableSFTFederation = opts.settings.calling.multiSFT, rateLimitEnv, amqpJobsPublisherChannel, - postgresMigration = opts.postgresMigration + postgresMigration = opts.settings.postgresMigration } where emailConn _ (Opt.EmailAWS aws) = pure (Just aws, Nothing) @@ -359,11 +350,11 @@ mkIndexEnv esOpts logger galleyEp rpcHttpManager = do idxCredentials = mEsCreds } -initZAuth :: Opts -> IO ZAuthEnv +initZAuth :: WireConfig -> IO ZAuthEnv initZAuth o = do - let zOpts = Opt.zauth o - privateKeys = Opt.privateKeys zOpts - publicKeys = Opt.publicKeys zOpts + let zOpts = o.settings.auth.zauth + privateKeys = zOpts.privateKeys + publicKeys = zOpts.publicKeys sk <- AuthenticationSubsystem.readKeys privateKeys pk <- AuthenticationSubsystem.readKeys publicKeys case (sk, pk) of @@ -428,16 +419,16 @@ initExtGetManager = do extEnv <- initExtEnv disableTlsV1 pure $ extEnv.extGetManager -initLogger :: Opts -> IO Logger +initLogger :: WireConfig -> IO Logger initLogger opts = - Log.mkLogger opts.logLevel opts.logNetStrings opts.logFormat + Log.mkLogger opts.settings.logs.logLevel Nothing (Last <$> opts.settings.logs.logFormat) -initCassandra :: Opts -> Logger -> IO Cas.ClientState +initCassandra :: WireConfig -> Logger -> IO Cas.ClientState initCassandra o g = initCassandraForService - (Opt.cassandra o) + o.externalServices.cassandraBrig "brig" - (Opt.discoUrl o) + Nothing (Just schemaVersion) g @@ -640,7 +631,7 @@ adhocSessionStoreInterpreter action = do -- Federation viewFederationDomain :: (MonadReader Env m) => m Domain -viewFederationDomain = asks (.settings.federationDomain) +viewFederationDomain = asks (.settings.federation.federationDomain) -- FUTUREWORK: rename to 'qualifyLocalMtl' qualifyLocal :: (MonadReader Env m) => a -> m (Local a) diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index 6b5cbc1fb3f..1987d4e004e 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -28,15 +28,12 @@ import Brig.Effects.SFT (SFT, interpretSFT) import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import Brig.Effects.UserPendingActivationStore.Cassandra (userPendingActivationStoreToCassandra) import Brig.IO.Intra (runEvents) -import Wire.Options (Settings (consumableNotifications), federationDomainConfigs, federationStrategy) -import Wire.Options qualified as Opt import Brig.Template (InvitationUrlTemplates) import Brig.User.Search.Index (IndexEnv (..)) import Cassandra qualified as Cas import Control.Exception (ErrorCall) -import Control.Lens (to, (^.), _Just) +import Control.Lens (to, (^.)) import Control.Monad.Catch (throwM) -import Data.Coerce (coerce) import Data.Qualified (Local, toLocalUnsafe) import Data.ZAuth.CryptoSign (CryptoSign, runCryptoSign) import Hasql.Pool (UsageError) @@ -115,6 +112,7 @@ import Wire.InvitationStore.Cassandra (interpretInvitationStoreToCassandra) import Wire.MigrationLock import Wire.NotificationSubsystem import Wire.NotificationSubsystem.Interpreter (defaultNotificationSubsystemConfig, runNotificationSubsystemGundeck) +import Wire.Options qualified as Opt import Wire.ParseException import Wire.PasswordResetCodeStore (PasswordResetCodeStore) import Wire.PasswordResetCodeStore.Cassandra (interpretClientToIO, passwordResetCodeStoreToCassandra) @@ -308,20 +306,11 @@ runRecursiveEffects = runClient . runApp . runUser . runAuth runBrigToIO :: App.Env -> AppT BrigCanonicalEffects a -> IO a runBrigToIO e (AppT ma) = do - let blockedDomains = - e - ^. ( App.settingsLens - . Opt.customerExtensionsLens - . _Just - . to - ( coerce {- safely drop newtype wrapper -} - Opt.domainsBlockedForRegistration - ) - ) + let blockedDomains = e.settings.users.domainsBlockedForRegistration userSubsystemConfig = UserSubsystemConfig { emailVisibilityConfig = e.settings.emailVisibility, - defaultLocale = Opt.defaultUserLocale e.settings, + defaultLocale = fromMaybe Opt.defaultLocale e.settings.users.defaultUserLocale, searchSameTeamOnly = fromMaybe False e.settings.searchSameTeamOnly, maxTeamSize = e.settings.maxTeamSize, activationCodeTimeout = e.settings.activationTimeout, diff --git a/services/brig/src/Brig/Provider/Template.hs b/services/brig/src/Brig/Provider/Template.hs index f4a3a8fff51..4d6956cb34c 100644 --- a/services/brig/src/Brig/Provider/Template.hs +++ b/services/brig/src/Brig/Provider/Template.hs @@ -106,7 +106,7 @@ loadProviderTemplates o = readLocalesDir defLocale (templateDir gOptions) "provi maybeUrl = fromByteString . encodeUtf8 $ pOptions.homeUrl gOptions = o.settings.email.general pOptions = o.settings.email.provider - defLocale = defaultTemplateLocale o.settings.users + defLocale = fromMaybe defaultLocale o.settings.users.defaultTemplateLocale readTemplate = readTemplateWithDefault gOptions.templateDir defLocale "provider" readText = readTextWithDefault gOptions.templateDir defLocale "provider" -- URL templates diff --git a/services/brig/src/Brig/Team/Template.hs b/services/brig/src/Brig/Team/Template.hs index 8459967600b..f8f41dd6695 100644 --- a/services/brig/src/Brig/Team/Template.hs +++ b/services/brig/src/Brig/Team/Template.hs @@ -35,5 +35,5 @@ loadTeamTemplatesWithBrigOpts o = loadTeamTemplates o.settings.email.team o.settings.email.general.templateDir - (defaultTemplateLocale o.settings.users) + (fromMaybe defaultLocale o.settings.users.defaultTemplateLocale) o.settings.email.general.emailSender diff --git a/services/brig/src/Brig/User/Template.hs b/services/brig/src/Brig/User/Template.hs index 02dde2ffd63..4f9ea6ce436 100644 --- a/services/brig/src/Brig/User/Template.hs +++ b/services/brig/src/Brig/User/Template.hs @@ -21,6 +21,7 @@ import Data.Text.Template import Imports import Wire.EmailSubsystem.Template hiding (readTemplate, readText) import Wire.EmailSubsystem.Templates.User +import Wire.Options () import Wire.Options qualified as Opt loadUserTemplates :: Opt.WireConfig -> IO (Localised UserTemplates) @@ -105,7 +106,7 @@ loadUserTemplates o = readLocalesDir defLocale templateDir "user" $ \fp -> teamActivationUrl = template tOptions.tActivationUrl passwordResetUrl = template uOptions.passwordResetUrl deletionUserUrl = template uOptions.deletionUrl - defLocale = Opt.defaultTemplateLocale o.settings.users + defLocale = fromMaybe Opt.defaultLocale o.settings.users.defaultTemplateLocale templateDir = gOptions.templateDir readTemplate = readTemplateWithDefault templateDir defLocale "user" readText = readTextWithDefault templateDir defLocale "user"