From cef209ee39179998b11cbeb889a874292cab3381 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 22 Jan 2025 09:10:51 +0100 Subject: [PATCH 01/12] Setup technitium --- charts/integration/templates/configmap.yaml | 5 ++ deploy/dockerephemeral/docker-compose.yaml | 81 ++++++++++++++------ hack/bin/integration-setup-federation.sh | 1 + hack/helm_vars/technitium/values.yaml.gotmpl | 36 +++++++++ hack/helmfile.yaml | 18 +++++ 5 files changed, 119 insertions(+), 22 deletions(-) create mode 100644 hack/helm_vars/technitium/values.yaml.gotmpl diff --git a/charts/integration/templates/configmap.yaml b/charts/integration/templates/configmap.yaml index 6dc88682c80..3535dbe6d4f 100644 --- a/charts/integration/templates/configmap.yaml +++ b/charts/integration/templates/configmap.yaml @@ -65,6 +65,11 @@ data: host: wireServerEnterprise.{{ .Release.Namespace }}.svc.cluster.local port: 8080 + dnsMockServer: + host: technitium-dnsserver + apiPort: 5380 + dohPort: 5381 + originDomain: federation-test-helper.{{ .Release.Namespace }}.svc.cluster.local rabbitmq: diff --git a/deploy/dockerephemeral/docker-compose.yaml b/deploy/dockerephemeral/docker-compose.yaml index 73c7324ae99..0d5bc6ce93b 100644 --- a/deploy/dockerephemeral/docker-compose.yaml +++ b/deploy/dockerephemeral/docker-compose.yaml @@ -20,7 +20,7 @@ networks: services: fake_dynamodb: container_name: demo_wire_dynamodb -# image: cnadiminti/dynamodb-local:2018-04-11 + # image: cnadiminti/dynamodb-local:2018-04-11 image: quay.io/wire/dynamodb_local:0.0.9 ulimits: nofile: @@ -44,7 +44,7 @@ services: fake_localstack: container_name: demo_wire_localstack -# image: localstack/localstack:0.8.0 # NB: this is younger than 0.8.6! + # image: localstack/localstack:0.8.0 # NB: this is younger than 0.8.6! image: quay.io/wire/localstack:0.0.9 ports: - 127.0.0.1:4569:4579 # ses # needed for local integration tests @@ -60,9 +60,9 @@ services: container_name: demo_wire_smtp image: inbucket/inbucket:latest ports: - - 127.0.0.1:2500:2500 - - 127.0.0.1:1100:1100 - - 127.0.0.1:9000:9000 + - 127.0.0.1:2500:2500 + - 127.0.0.1:1100:1100 + - 127.0.0.1:9000:9000 networks: - demo_wire @@ -70,7 +70,7 @@ services: container_name: demo_wire_s3 image: minio/minio:RELEASE.2023-07-07T07-13-57Z ports: - - "127.0.0.1:4570:9000" + - "127.0.0.1:4570:9000" environment: MINIO_ACCESS_KEY: dummykey MINIO_SECRET_KEY: dummysecret # minio requires a secret of at least 8 chars @@ -90,7 +90,7 @@ services: - demo_wire redis-cluster: - image: 'redis:6.0-alpine' + image: "redis:6.0-alpine" command: - redis-cli - --cluster @@ -122,10 +122,10 @@ services: - redis-node-5 - redis-node-6 redis-node-1: - image: 'redis:6.0-alpine' + image: "redis:6.0-alpine" command: redis-server /usr/local/etc/redis/redis.conf ports: - - '127.0.0.1:6373:6373' + - "127.0.0.1:6373:6373" volumes: - redis-node-1-data:/var/lib/redis - ./docker/redis-node-1.conf:/usr/local/etc/redis/redis.conf @@ -136,10 +136,10 @@ services: redis: ipv4_address: 172.20.0.31 redis-node-2: - image: 'redis:6.0-alpine' + image: "redis:6.0-alpine" command: redis-server /usr/local/etc/redis/redis.conf ports: - - '127.0.0.1:6374:6374' + - "127.0.0.1:6374:6374" volumes: - redis-node-2-data:/var/lib/redis - ./docker/redis-node-2.conf:/usr/local/etc/redis/redis.conf @@ -150,10 +150,10 @@ services: redis: ipv4_address: 172.20.0.32 redis-node-3: - image: 'redis:6.0-alpine' + image: "redis:6.0-alpine" command: redis-server /usr/local/etc/redis/redis.conf ports: - - '127.0.0.1:6375:6375' + - "127.0.0.1:6375:6375" volumes: - redis-node-3-data:/var/lib/redis - ./docker/redis-node-3.conf:/usr/local/etc/redis/redis.conf @@ -164,10 +164,10 @@ services: redis: ipv4_address: 172.20.0.33 redis-node-4: - image: 'redis:6.0-alpine' + image: "redis:6.0-alpine" command: redis-server /usr/local/etc/redis/redis.conf ports: - - '127.0.0.1:6376:6376' + - "127.0.0.1:6376:6376" volumes: - redis-node-4-data:/var/lib/redis - ./docker/redis-node-4.conf:/usr/local/etc/redis/redis.conf @@ -178,10 +178,10 @@ services: redis: ipv4_address: 172.20.0.34 redis-node-5: - image: 'redis:6.0-alpine' + image: "redis:6.0-alpine" command: redis-server /usr/local/etc/redis/redis.conf ports: - - '127.0.0.1:6377:6377' + - "127.0.0.1:6377:6377" volumes: - redis-node-5-data:/var/lib/redis - ./docker/redis-node-5.conf:/usr/local/etc/redis/redis.conf @@ -192,10 +192,10 @@ services: redis: ipv4_address: 172.20.0.35 redis-node-6: - image: 'redis:6.0-alpine' + image: "redis:6.0-alpine" command: redis-server /usr/local/etc/redis/redis.conf ports: - - '127.0.0.1:6378:6378' + - "127.0.0.1:6378:6378" volumes: - redis-node-6-data:/var/lib/redis - ./docker/redis-node-6.conf:/usr/local/etc/redis/redis.conf @@ -269,9 +269,9 @@ services: - RABBITMQ_USERNAME - RABBITMQ_PASSWORD ports: - - '127.0.0.1:5671:5671' - - '127.0.0.1:15671:15671' - - '127.0.0.1:15672:15672' + - "127.0.0.1:5671:5671" + - "127.0.0.1:15671:15671" + - "127.0.0.1:15672:15672" volumes: - ./rabbitmq-config/rabbitmq.conf:/etc/rabbitmq/conf.d/20-wire.conf - ./rabbitmq-config/certificates:/etc/rabbitmq/certificates @@ -312,6 +312,9 @@ services: networks: - demo_wire + # FUTUREWORK: Replace CoreDNS with Technitium (config below): The big benefit + # of the latter is that we can configure it at runtime; e.g. by creating + # new DNS records via a REST API. coredns: image: docker.io/coredns/coredns:1.8.4 volumes: @@ -326,6 +329,40 @@ services: networks: coredns: ipv4_address: 172.20.1.2 + dns-server: + # Heavily inspired by: + # https://github.com/TechnitiumSoftware/DnsServer/blob/fcd631b81ba366c7d3e443b8f8103f29a90ea3fe/docker-compose.yml + container_name: dns-server + hostname: dns-server + image: technitium/dns-server:latest + ports: + - "5380:5380/tcp" #DNS web console (HTTP) + # - "53443:53443/tcp" #DNS web console (HTTPS) + # - "53:53/udp" #DNS service + # - "53:53/tcp" #DNS service + # - "853:853/udp" #DNS-over-QUIC service + # - "853:853/tcp" #DNS-over-TLS service + # - "443:443/udp" #DNS-over-HTTPS service (HTTP/3) + - "443:443/tcp" #DNS-over-HTTPS service (HTTP/1.1, HTTP/2) + - "5381:80/tcp" #DNS-over-HTTP service (use with reverse proxy or certbot certificate renewal) + # - "8053:8053/tcp" #DNS-over-HTTP service (use with reverse proxy) + # - "67:67/udp" #DHCP service + environment: + - DNS_SERVER_DOMAIN=localhost #The primary domain name used by this DNS Server to identify itself. + - DNS_SERVER_ADMIN_PASSWORD=admin #DNS web console admin user password. + # - DNS_SERVER_ADMIN_PASSWORD_FILE=password.txt #The path to a file that contains a plain text password for the DNS web console admin user. + # - DNS_SERVER_PREFER_IPV6=false #DNS Server will use IPv6 for querying whenever possible with this option enabled. + # - DNS_SERVER_WEB_SERVICE_LOCAL_ADDRESSES=172.17.0.1,127.0.0.1 #Comma separated list of network interface IP addresses that you want the web service to listen on for requests. The "172.17.0.1" address is the built-in Docker bridge. The "[::]" is the default value if not specified. Note! This must be used only with "host" network mode. + # - DNS_SERVER_WEB_SERVICE_HTTP_PORT=5380 #The TCP port number for the DNS web console over HTTP protocol. + # - DNS_SERVER_WEB_SERVICE_HTTPS_PORT=53443 #The TCP port number for the DNS web console over HTTPS protocol. + # - DNS_SERVER_WEB_SERVICE_ENABLE_HTTPS=true #Enables HTTPS for the DNS web console. + # - DNS_SERVER_WEB_SERVICE_USE_SELF_SIGNED_CERT=true #Enables self signed TLS certificate for the DNS web console. + - DNS_SERVER_OPTIONAL_PROTOCOL_DNS_OVER_HTTP=true #Enables DNS server optional protocol DNS-over-HTTP on TCP port 8053 to be used with a TLS terminating reverse proxy like nginx. + # - DNS_SERVER_RECURSION=AllowOnlyForPrivateNetworks #Recursion options: Allow, Deny, AllowOnlyForPrivateNetworks, UseSpecifiedNetworkACL. + # - DNS_SERVER_RECURSION_NETWORK_ACL=192.168.10.0/24, !192.168.10.2 #Comma separated list of IP addresses or network addresses to allow access. Add ! character at the start to deny access, e.g. !192.168.10.0/24 will deny entire subnet. The ACL is processed in the same order its listed. If no networks match, the default policy is to deny all except loopback. Valid only for `UseSpecifiedNetworkACL` recursion option. + # - DNS_SERVER_RECURSION_DENIED_NETWORKS=1.1.1.0/24 #Comma separated list of IP addresses or network addresses to deny recursion. Valid only for `UseSpecifiedNetworkACL` recursion option. This option is obsolete and DNS_SERVER_RECURSION_NETWORK_ACL should be used instead. + # - DNS_SERVER_RECURSION_ALLOWED_NETWORKS=127.0.0.1, 192.168.1.0/24 #Comma separated list of IP addresses or network addresses to allow recursion. Valid only for `UseSpecifiedNetworkACL` recursion option. This option is obsolete and DNS_SERVER_RECURSION_NETWORK_ACL should be used instead. + # - DNS_SERVER_ENABLE_BLOCKING=false #Sets the DNS server to block domain names using Blocked Zone and Block List Zone. volumes: redis-node-1-data: diff --git a/hack/bin/integration-setup-federation.sh b/hack/bin/integration-setup-federation.sh index c5c9f8436a2..5feef59285b 100755 --- a/hack/bin/integration-setup-federation.sh +++ b/hack/bin/integration-setup-federation.sh @@ -53,6 +53,7 @@ echo "Installing charts..." set +e # This exists because we need to run `helmfile` with `--skip-deps`, without that it doesn't work. helm repo add bedag https://bedag.github.io/helm-charts/ +helm repo add obeone https://charts.obeone.cloud helmfile --environment "$HELMFILE_ENV" --file "${TOP_LEVEL}/hack/helmfile.yaml" sync --skip-deps --concurrency 0 EXIT_CODE=$? diff --git a/hack/helm_vars/technitium/values.yaml.gotmpl b/hack/helm_vars/technitium/values.yaml.gotmpl new file mode 100644 index 00000000000..e2a9d8c54e3 --- /dev/null +++ b/hack/helm_vars/technitium/values.yaml.gotmpl @@ -0,0 +1,36 @@ +env: + DNS_SERVER_DOMAIN: localhost #The primary domain name used by this DNS Server to identify itself. + DNS_SERVER_ADMIN_PASSWORD: admin #DNS web console admin user password. + DNS_SERVER_OPTIONAL_PROTOCOL_DNS_OVER_HTTP: "true" #Enables DNS server optional protocol DNS-over-HTTP on TCP port 80. + +service: + main: + annotations: {} + enabled: true + primary: true + type: ClusterIP + externalTrafficPolicy: null # non-sense for local types + ports: + doh-http: + enabled: true + port: 5381 + targetPort: 80 + protocol: TCP + admin-console: + enabled: true + port: 5380 + targetPort: 5380 + protocol: TCP + +# We don't want this to be reachable from outside. Things inside the cluster +# shall use the Service. +ingress: + # -- Enable and configure ingress settings for the chart under this key. + # @default -- See the [docs](https://github.com/k8s-at-home/library-charts/blob/main/charts/stable/common/README.md) + main: + enabled: false + +# We want to have a clean plate on every restart +persistence: + config: + enabled: false diff --git a/hack/helmfile.yaml b/hack/helmfile.yaml index 736f4577462..b4619c5c0a2 100644 --- a/hack/helmfile.yaml +++ b/hack/helmfile.yaml @@ -55,6 +55,9 @@ repositories: - name: bedag url: 'https://bedag.github.io/helm-charts/' + - name: obeone + url: 'https://charts.obeone.cloud' + releases: - name: 'fake-aws' namespace: '{{ .Values.namespace1 }}' @@ -251,10 +254,25 @@ releases: values: - secrets: configJson: {{ requiredEnv "ENTERPRISE_IMAGE_PULL_SECRET" }} + needs: + - technitium-dnsserver + set: + - name: config.dnsOverHttpsUrl + value: 'http://technitium-dnsserver:5381/dns-query' + # TODO: This should be removed later (fixes a deployment issue now) - name: wire-server-enterprise namespace: '{{ .Values.namespace2 }}' chart: '../.local/charts/wire-server-enterprise' values: - secrets: configJson: {{ requiredEnv "ENTERPRISE_IMAGE_PULL_SECRET" }} + needs: + - '{{ .Values.namespace1 }}/technitium-dnsserver' + + - name: technitium-dnsserver + namespace: '{{ .Values.namespace1 }}' + chart: obeone/technitium-dnsserver + values: + - './helm_vars/technitium/values.yaml.gotmpl' + From 3dc35ec69f66fb822a51bfdb8b761a10a28df04e Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 22 Jan 2025 09:56:57 +0100 Subject: [PATCH 02/12] Setup DoH and wire-server-enterprise --- .gitmodules | 3 ++- charts/brig/templates/configmap.yaml | 6 ++++++ charts/brig/values.yaml | 2 ++ charts/wire-server-enterprise/templates/configmap.yaml | 2 ++ charts/wire-server-enterprise/values.yaml | 1 + hack/helmfile.yaml | 5 +++++ 6 files changed, 18 insertions(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index de3af4ff464..30f51ea49ce 100644 --- a/.gitmodules +++ b/.gitmodules @@ -4,4 +4,5 @@ [submodule "services/wire-server-enterprise"] path = services/wire-server-enterprise url = https://github.com/wireapp/wire-server-enterprise - branch = main + # TODO: Change the `branch` back to `main` + branch = WPB-14307-domain-registration-endpoints diff --git a/charts/brig/templates/configmap.yaml b/charts/brig/templates/configmap.yaml index 4646242c3bd..12407a2fb9c 100644 --- a/charts/brig/templates/configmap.yaml +++ b/charts/brig/templates/configmap.yaml @@ -80,6 +80,12 @@ data: federatorInternal: host: federator port: 8080 + + {{- if and (.wireServerEnterprise) (default false .wireServerEnterprise.enabled) }} + wireServerEnterprise: + host: wire-server-enterprise + port: 8080 + {{- end }} {{- with .rabbitmq }} rabbitmq: diff --git a/charts/brig/values.yaml b/charts/brig/values.yaml index 517fc59decb..8d4d9a494a7 100644 --- a/charts/brig/values.yaml +++ b/charts/brig/values.yaml @@ -160,6 +160,8 @@ config: smtp: passwordFile: /etc/wire/brig/secrets/smtp-password.txt proxy: {} + wireServerEnterprise: + enabled: false turnStatic: v1: diff --git a/charts/wire-server-enterprise/templates/configmap.yaml b/charts/wire-server-enterprise/templates/configmap.yaml index bf901564405..1520be55f03 100644 --- a/charts/wire-server-enterprise/templates/configmap.yaml +++ b/charts/wire-server-enterprise/templates/configmap.yaml @@ -17,4 +17,6 @@ data: wireServerEnterprise: host: 0.0.0.0 port: 8080 + + dnsOverHttpsUrl: {{ required "config.dnsOverHttpsUrl: required to use DNS-over-HTTP(S)" .dnsOverHttpsUrl | }} {{- end }} diff --git a/charts/wire-server-enterprise/values.yaml b/charts/wire-server-enterprise/values.yaml index 7fba58e31ca..2a569c5d646 100644 --- a/charts/wire-server-enterprise/values.yaml +++ b/charts/wire-server-enterprise/values.yaml @@ -23,3 +23,4 @@ config: logLevel: Info logFormat: StructuredJSON logNetStrings: false + dnsOverHttpsUrl: https://dns.google/dns-query diff --git a/hack/helmfile.yaml b/hack/helmfile.yaml index b4619c5c0a2..00ba41b6af0 100644 --- a/hack/helmfile.yaml +++ b/hack/helmfile.yaml @@ -229,6 +229,8 @@ releases: value: {{ .Values.federationDomain1 }} - name: cargohold.config.settings.federationDomain value: {{ .Values.federationDomain1 }} + - name: brig.config.wireServerEnterprise.enabled + value: true needs: - 'databases-ephemeral' @@ -245,6 +247,9 @@ releases: value: {{ .Values.federationDomain2 }} - name: cargohold.config.settings.federationDomain value: {{ .Values.federationDomain2 }} + # TODO: This should be disabled later (fixes a deployment issue now) + - name: brig.config.wireServerEnterprise.enabled + value: true needs: - 'databases-ephemeral' From 7679686ab973312bf335d87044dabd48083b59e1 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 22 Jan 2025 10:00:39 +0100 Subject: [PATCH 03/12] Follow wire-server-enterprise --- libs/types-common/src/Data/Misc.hs | 48 ++++++++++++++++++- libs/wire-api/src/Wire/API/EnterpriseLogin.hs | 15 ++++++ .../Wire/API/Routes/Internal/Enterprise.hs | 17 +++++++ libs/wire-api/wire-api.cabal | 1 + services/wire-server-enterprise | 2 +- 5 files changed, 80 insertions(+), 3 deletions(-) diff --git a/libs/types-common/src/Data/Misc.hs b/libs/types-common/src/Data/Misc.hs index a72995b8667..e62754a6466 100644 --- a/libs/types-common/src/Data/Misc.hs +++ b/libs/types-common/src/Data/Misc.hs @@ -39,6 +39,13 @@ module Data.Misc HttpsUrl (..), mkHttpsUrl, ensureHttpsUrl, + httpsUrlToText, + httpsUrlFromText, + + -- * Url + Url (..), + urlToText, + urlFromText, -- * Fingerprint Fingerprint (..), @@ -224,6 +231,12 @@ mkHttpsUrl uri = ensureHttpsUrl :: URIRef Absolute -> HttpsUrl ensureHttpsUrl = HttpsUrl . (uriSchemeL . schemeBSL .~ "https") +httpsUrlToText :: HttpsUrl -> Text +httpsUrlToText = decodeUtf8 . toByteString' + +httpsUrlFromText :: Text -> Either String HttpsUrl +httpsUrlFromText = runParser parser . encodeUtf8 + instance Show HttpsUrl where showsPrec i = showsPrec i . httpsUrl @@ -235,8 +248,8 @@ instance FromByteString HttpsUrl where instance ToSchema HttpsUrl where schema = - (decodeUtf8 . toByteString') - .= parsedText "HttpsUrl" (runParser parser . encodeUtf8) + httpsUrlToText + .= parsedText "HttpsUrl" httpsUrlFromText & doc' . S.schema . S.example @@ -252,6 +265,37 @@ instance Cql HttpsUrl where instance Arbitrary HttpsUrl where arbitrary = pure $ HttpsUrl [URI.QQ.uri|https://example.com|] +-------------------------------------------------------------------------------- +-- Url + +-- | An absolute URL +newtype Url = Url + { unUrl :: URIRef Absolute + } + deriving stock (Eq, Ord, Generic) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema Url + +instance ToSchema Url where + schema = + urlToText + .= parsedText "Url" urlFromText + & doc' + . S.schema + . S.example + ?~ toJSON ("http://example.com" :: Text) + +urlToText :: Url -> Text +urlToText = decodeUtf8 . toByteString' + +urlFromText :: Text -> Either String Url +urlFromText = runParser parser . encodeUtf8 + +instance FromByteString Url where + parser = Url <$> uriParser strictURIParserOptions + +instance ToByteString Url where + builder = serializeURIRef . unUrl + -------------------------------------------------------------------------------- -- Fingerprint diff --git a/libs/wire-api/src/Wire/API/EnterpriseLogin.hs b/libs/wire-api/src/Wire/API/EnterpriseLogin.hs index a5411a552a9..cb37c43c7d7 100644 --- a/libs/wire-api/src/Wire/API/EnterpriseLogin.hs +++ b/libs/wire-api/src/Wire/API/EnterpriseLogin.hs @@ -7,13 +7,17 @@ import Control.Arrow import Control.Lens (makePrisms) import Data.Aeson (FromJSON, ToJSON) import Data.Aeson qualified as Aeson +import Data.ByteString.Builder +import Data.ByteString.Conversion import Data.Domain import Data.Id import Data.Misc import Data.OpenApi qualified as OpenApi +import Data.OpenApi qualified as S import Data.Schema import Data.Text.Ascii (Ascii, AsciiText (toText)) import Data.Text.Ascii qualified as Ascii +import Data.Text.Encoding qualified as Text import Imports import SAML2.WebSSO qualified as SAML import SAML2.WebSSO.Test.Arbitrary () @@ -207,6 +211,17 @@ instance ToSchema DomainRegistration where <*> (.teamInvite) .= teamInviteObjectSchema <*> (.dnsVerificationToken) .= optField "dns_verification_token" (maybeWithDefault Aeson.Null schema) +-- | The challenge to be presented in a TXT DNS record by the owner of the domain. +newtype DomainVerificationToken = DomainVerificationToken {unDomainVerificationToken :: Text} + deriving newtype (Eq, Ord, Show) + deriving (Aeson.FromJSON, Aeson.ToJSON, S.ToSchema) via (Schema DomainVerificationToken) + +instance ToSchema DomainVerificationToken where + schema = DomainVerificationToken <$> unDomainVerificationToken .= schema + +instance ToByteString DomainVerificationToken where + builder = byteString . Text.encodeUtf8 . unDomainVerificationToken + -------------------------------------------------------------------------------- -- CQL instances diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Enterprise.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Enterprise.hs index 364d055266a..50c101a511f 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Enterprise.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Enterprise.hs @@ -1,6 +1,9 @@ module Wire.API.Routes.Internal.Enterprise where +import Data.Domain +import Imports import Servant +import Wire.API.EnterpriseLogin import Wire.API.Routes.MultiVerb import Wire.API.Routes.Named @@ -11,3 +14,17 @@ type InternalAPIBase = "status" ( "status" :> MultiVerb 'GET '[JSON] '[RespondEmpty 200 "OK"] () ) + :<|> Named + "create-verification-token" + ( "create-verification-token" + :> Capture "domain" Domain + :> Capture "auth-token" Text + :> Post '[JSON] DomainVerificationToken + ) + :<|> Named + "verify-domain-token" + ( "verify-domain-token" + :> Capture "domain" Domain + :> Capture "auth-token" Text + :> Post '[JSON] Bool + ) diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index f8b6886e44f..b0e6b2ef05d 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -160,6 +160,7 @@ library Wire.API.Routes.Features Wire.API.Routes.FederationDomainConfig Wire.API.Routes.Internal.Brig + Wire.API.Routes.Internal.Enterprise Wire.API.Routes.Internal.Brig.Connection Wire.API.Routes.Internal.Brig.EJPD Wire.API.Routes.Internal.Brig.EnterpriseLogin diff --git a/services/wire-server-enterprise b/services/wire-server-enterprise index 126abff4608..ee02190ebb6 160000 --- a/services/wire-server-enterprise +++ b/services/wire-server-enterprise @@ -1 +1 @@ -Subproject commit 126abff46082573c958aed8e6a338a00c608c376 +Subproject commit ee02190ebb676e540db3ae2b2bcb75e3cc5d1455 From 7ce5cd25e58f215650a760473113c23c429ac297 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 22 Jan 2025 10:40:12 +0100 Subject: [PATCH 04/12] Implement domain verification endpoints --- charts/brig/templates/configmap.yaml | 4 + integration/default.nix | 2 + libs/wire-api/src/Wire/API/EnterpriseLogin.hs | 72 +++- libs/wire-api/src/Wire/API/Error/Brig.hs | 30 ++ .../src/Wire/API/Routes/Public/Brig.hs | 2 + .../Routes/Public/Brig/DomainVerification.hs | 178 +++++++++ .../Wire/API/Golden/Manual/EnterpriseLogin.hs | 2 +- ...testObject_DomainRegistrationUpdate_3.json | 2 +- .../testObject_DomainRegistration_3.json | 2 +- .../testObject_DomainRegistration_6.json | 2 +- libs/wire-api/wire-api.cabal | 2 +- libs/wire-subsystems/default.nix | 2 + .../src/Wire/DomainRegistrationStore.hs | 4 +- .../src/Wire/EnterpriseLoginSubsystem.hs | 26 +- .../Wire/EnterpriseLoginSubsystem/Error.hs | 22 +- .../EnterpriseLoginSubsystem/Interpreter.hs | 343 ++++++++++++++++-- libs/wire-subsystems/src/Wire/Rpc.hs | 2 +- .../wire-subsystems/src/Wire/SparAPIAccess.hs | 28 ++ .../src/Wire/SparAPIAccess/Rpc.hs | 80 ++++ .../InterpreterSpec.hs | 49 ++- .../EnterpriseLoginSubsystem.hs | 20 +- .../Wire/MockInterpreters/SparAPIAccess.hs | 10 + libs/wire-subsystems/wire-subsystems.cabal | 4 + services/brig/brig.integration.yaml | 4 + services/brig/src/Brig/API/Public.hs | 64 +++- services/brig/src/Brig/App.hs | 6 + .../brig/src/Brig/CanonicalInterpreter.hs | 29 +- services/brig/src/Brig/Options.hs | 6 + 28 files changed, 922 insertions(+), 75 deletions(-) create mode 100644 libs/wire-api/src/Wire/API/Routes/Public/Brig/DomainVerification.hs create mode 100644 libs/wire-subsystems/src/Wire/SparAPIAccess.hs create mode 100644 libs/wire-subsystems/src/Wire/SparAPIAccess/Rpc.hs create mode 100644 libs/wire-subsystems/test/unit/Wire/MockInterpreters/SparAPIAccess.hs diff --git a/charts/brig/templates/configmap.yaml b/charts/brig/templates/configmap.yaml index 12407a2fb9c..f8a78ba5985 100644 --- a/charts/brig/templates/configmap.yaml +++ b/charts/brig/templates/configmap.yaml @@ -64,6 +64,10 @@ data: host: galley port: 8080 + spar: + host: spar + port: 8080 + gundeck: host: gundeck port: 8080 diff --git a/integration/default.nix b/integration/default.nix index 3443839384f..321826afa83 100644 --- a/integration/default.nix +++ b/integration/default.nix @@ -31,6 +31,7 @@ , data-timeout , deriving-aeson , directory +, dns , errors , exceptions , extended @@ -134,6 +135,7 @@ mkDerivation { data-timeout deriving-aeson directory + dns errors exceptions extended diff --git a/libs/wire-api/src/Wire/API/EnterpriseLogin.hs b/libs/wire-api/src/Wire/API/EnterpriseLogin.hs index cb37c43c7d7..d8a1e5fc4e5 100644 --- a/libs/wire-api/src/Wire/API/EnterpriseLogin.hs +++ b/libs/wire-api/src/Wire/API/EnterpriseLogin.hs @@ -4,17 +4,21 @@ module Wire.API.EnterpriseLogin where import Cassandra qualified as C import Control.Arrow -import Control.Lens (makePrisms) +import Control.Lens (makePrisms, (?~)) import Data.Aeson (FromJSON, ToJSON) import Data.Aeson qualified as Aeson +import Data.ByteString qualified as BS +import Data.ByteString.Base64.URL qualified as B64U import Data.ByteString.Builder import Data.ByteString.Conversion +import Data.Default (Default, def) import Data.Domain import Data.Id import Data.Misc import Data.OpenApi qualified as OpenApi import Data.OpenApi qualified as S import Data.Schema +import Data.Text qualified as Text import Data.Text.Ascii (Ascii, AsciiText (toText)) import Data.Text.Ascii qualified as Ascii import Data.Text.Encoding qualified as Text @@ -22,6 +26,8 @@ import Imports import SAML2.WebSSO qualified as SAML import SAML2.WebSSO.Test.Arbitrary () import Test.QuickCheck (suchThat) +import Web.HttpApiData +import Wire.API.Routes.Bearer import Wire.Arbitrary data DomainRedirect @@ -34,6 +40,9 @@ data DomainRedirect deriving stock (Eq, Show, Generic) deriving (Arbitrary) via GenericUniform DomainRedirect +instance Default DomainRedirect where + def = None + makePrisms ''DomainRedirect data DomainRedirectTag @@ -46,6 +55,14 @@ data DomainRedirectTag deriving (Show, Ord, Eq, Enum, Bounded) deriving (ToJSON, FromJSON, OpenApi.ToSchema) via Schema DomainRedirectTag +domainRedirectTag :: DomainRedirect -> DomainRedirectTag +domainRedirectTag None = NoneTag +domainRedirectTag Locked = LockedTag +domainRedirectTag (SSO _) = SSOTag +domainRedirectTag (Backend _) = BackendTag +domainRedirectTag NoRegistration = NoRegistrationTag +domainRedirectTag PreAuthorized = PreAuthorizedTag + instance ToSchema DomainRedirectTag where schema = enum @Text "DomainRedirect Tag" $ @@ -64,19 +81,11 @@ domainRedirectTagSchema = field "domain_redirect" schema domainRedirectSchema :: ObjectSchema SwaggerDoc DomainRedirect domainRedirectSchema = snd - <$> (toTagged &&& id) + <$> (domainRedirectTag &&& id) .= bind (fst .= domainRedirectTagSchema) (snd .= dispatch domainRedirectObjectSchema) where - toTagged :: DomainRedirect -> DomainRedirectTag - toTagged None = NoneTag - toTagged Locked = LockedTag - toTagged (SSO _) = SSOTag - toTagged (Backend _) = BackendTag - toTagged NoRegistration = NoRegistrationTag - toTagged PreAuthorized = PreAuthorizedTag - domainRedirectObjectSchema :: DomainRedirectTag -> ObjectSchema SwaggerDoc DomainRedirect domainRedirectObjectSchema = \case NoneTag -> tag _None (pure ()) @@ -87,7 +96,7 @@ domainRedirectSchema = PreAuthorizedTag -> tag _PreAuthorized (pure ()) samlIdPIdObjectSchema :: ObjectSchema SwaggerDoc SAML.IdPId -samlIdPIdObjectSchema = SAML.IdPId <$> SAML.fromIdPId .= field "sso_idp_id" uuidSchema +samlIdPIdObjectSchema = SAML.IdPId <$> SAML.fromIdPId .= field "sso_code" uuidSchema backendUrlSchema :: ObjectSchema SwaggerDoc HttpsUrl backendUrlSchema = field "backend_url" schema @@ -108,6 +117,9 @@ data TeamInvite deriving stock (Eq, Show, Generic) deriving (Arbitrary) via GenericUniform TeamInvite +instance Default TeamInvite where + def = Allowed + makePrisms ''TeamInvite data TeamInviteTag @@ -211,6 +223,38 @@ instance ToSchema DomainRegistration where <*> (.teamInvite) .= teamInviteObjectSchema <*> (.dnsVerificationToken) .= optField "dns_verification_token" (maybeWithDefault Aeson.Null schema) +-- | Bearer authentication token for domain verification requests. +newtype DomainVerificationAuthToken = DomainVerificationAuthToken + { unDomainVerificationAuthToken :: ByteString + } + deriving stock (Eq, Ord, Show) + +parseDomainVerificationAuthToken :: Text -> Either String DomainVerificationAuthToken +parseDomainVerificationAuthToken txt = do + bytes <- B64U.decodeUnpadded (Text.encodeUtf8 txt) + unless (BS.length bytes == 32) $ Left "Invalid random auth token length" + pure (DomainVerificationAuthToken bytes) + +serializeDomainVerificationAuthToken :: DomainVerificationAuthToken -> Text +serializeDomainVerificationAuthToken = + Text.decodeUtf8 + . B64U.encodeUnpadded + . unDomainVerificationAuthToken + +instance ToSchema DomainVerificationAuthToken where + schema = + serializeDomainVerificationAuthToken + .= parsedText "DomainVerificationAuthToken" parseDomainVerificationAuthToken + +instance S.ToParamSchema (Bearer DomainVerificationAuthToken) where + toParamSchema _ = mempty & S.type_ ?~ S.OpenApiString + +instance FromHttpApiData DomainVerificationAuthToken where + parseUrlPiece = mapLeft Text.pack . parseDomainVerificationAuthToken + +instance ToByteString DomainVerificationAuthToken where + builder = builder . Text.encodeUtf8 . serializeDomainVerificationAuthToken + -- | The challenge to be presented in a TXT DNS record by the owner of the domain. newtype DomainVerificationToken = DomainVerificationToken {unDomainVerificationToken :: Text} deriving newtype (Eq, Ord, Show) @@ -264,3 +308,9 @@ instance C.Cql DnsVerificationToken where toCql = C.toCql . toText . unDnsVerificationToken fromCql (C.CqlAscii t) = DnsVerificationToken <$> Ascii.validate t fromCql _ = Left "DnsVerificationToken value: text expected" + +instance C.Cql DomainVerificationAuthToken where + ctype = C.Tagged C.AsciiColumn + toCql = C.toCql . serializeDomainVerificationAuthToken + fromCql (C.CqlAscii t) = parseDomainVerificationAuthToken t + fromCql _ = Left "DomainVerificationAuthToken value: text expected" diff --git a/libs/wire-api/src/Wire/API/Error/Brig.hs b/libs/wire-api/src/Wire/API/Error/Brig.hs index f5d2c28ad72..7367cd74d35 100644 --- a/libs/wire-api/src/Wire/API/Error/Brig.hs +++ b/libs/wire-api/src/Wire/API/Error/Brig.hs @@ -103,6 +103,16 @@ data BrigError | UserAlreadyInATeam | MLSServicesNotAllowed | NotificationQueueConnectionError + | DomainVerificationErrorNotFound + | DomainVerificationUnlockError + | DomainVerificationUnAuthorizeError + | DomainVerificationPreAuthorizeError + | DomainVerificationInvalidDomain + | DomainVerificationDomainVerificationFailed + | DomainVerificationOperationForbidden + | DomainVerificationInvalidAuthToken + | DomainVerificationAuthFailure + | DomainVerificationPaymentRequired instance (Typeable (MapError e), KnownError (MapError e)) => IsSwaggerError (e :: BrigError) where addToOpenApi = addStaticErrorToSwagger @(MapError e) @@ -307,3 +317,23 @@ type instance MapError 'UserAlreadyInATeam = 'StaticError 403 "user-already-in-a type instance MapError 'MLSServicesNotAllowed = 'StaticError 409 "mls-services-not-allowed" "Services not allowed in MLS" type instance MapError 'NotificationQueueConnectionError = 'StaticError 500 "internal-server-error" "Internal server error" + +type instance MapError 'DomainVerificationErrorNotFound = 'StaticError 404 "not-found" "Not Found" + +type instance MapError 'DomainVerificationUnlockError = 'StaticError 409 "unlock-error" "Domain can only be unlocked from a locked state" + +type instance MapError 'DomainVerificationUnAuthorizeError = 'StaticError 409 "unauthorize-error" "Domain redirect can not bet set to unauthorized when locked or SSO" + +type instance MapError 'DomainVerificationPreAuthorizeError = 'StaticError 409 "preauthorize-error" "Domain redirect must be 'none' to be pre-authorized" + +type instance MapError 'DomainVerificationInvalidDomain = 'StaticError 400 "invalid-domain" "Invalid domain" + +type instance MapError 'DomainVerificationDomainVerificationFailed = 'StaticError 403 "domain-verification-failed" "Domain verification failed" + +type instance MapError 'DomainVerificationOperationForbidden = 'StaticError 403 "operation-forbidden-for-domain-registration-state" "Invalid domain registration state update" + +type instance MapError 'DomainVerificationInvalidAuthToken = 'StaticError 403 "invalid-domain-verification-auth-token" "Invalid domain verification auth token" + +type instance MapError 'DomainVerificationAuthFailure = 'StaticError 401 "domain-registration-updated-auth-failure" "Domain registration updated auth failure" + +type instance MapError 'DomainVerificationPaymentRequired = 'StaticError 402 "domain-registration-updated-payment-required" "Domain registration updated payment required" diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index ca49bd99679..333da0d9605 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -58,6 +58,7 @@ import Wire.API.Routes.MultiVerb import Wire.API.Routes.Named import Wire.API.Routes.Public import Wire.API.Routes.Public.Brig.Bot (BotAPI) +import Wire.API.Routes.Public.Brig.DomainVerification (DomainVerificationAPI) import Wire.API.Routes.Public.Brig.OAuth (OAuthAPI) import Wire.API.Routes.Public.Brig.Provider (ProviderAPI) import Wire.API.Routes.Public.Brig.Services (ServicesAPI) @@ -100,6 +101,7 @@ type BrigAPI = :<|> BotAPI :<|> ServicesAPI :<|> ProviderAPI + :<|> DomainVerificationAPI data BrigAPITag diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig/DomainVerification.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig/DomainVerification.hs new file mode 100644 index 00000000000..a15b7ac549f --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig/DomainVerification.hs @@ -0,0 +1,178 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wire.API.Routes.Public.Brig.DomainVerification where + +import Control.Arrow +import Control.Lens (makePrisms) +import Data.Aeson.Types qualified as A +import Data.Domain +import Data.Id +import Data.Misc +import Data.OpenApi qualified as S +import Data.Schema +import Imports +import SAML2.WebSSO qualified as SAML +import Servant +import Wire.API.EnterpriseLogin +import Wire.API.Error +import Wire.API.Error.Brig +import Wire.API.Routes.Bearer +import Wire.API.Routes.MultiVerb +import Wire.API.Routes.Named +import Wire.API.Routes.Public (ZLocalUser) +import Wire.API.User.Identity (EmailAddress) + +data DomainRedirectConfig + = DomainRedirectConfigRemove + | DomainRedirectConfigBackend HttpsUrl + | DomainRedirectConfigNoRegistration + deriving stock (Eq, Show) + +makePrisms ''DomainRedirectConfig + +data DomainVerificationTokenResponse = DomainVerificationTokenResponse + { authToken :: Maybe DomainVerificationAuthToken, + dnsToken :: DomainVerificationToken + } + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema DomainVerificationTokenResponse) + +instance ToSchema DomainVerificationTokenResponse where + schema :: ValueSchema NamedSwaggerDoc DomainVerificationTokenResponse + schema = + object "DomainVerificationTokenResponse" $ + DomainVerificationTokenResponse + <$> (.authToken) .= maybe_ (optField "auth_token" schema) + <*> (.dnsToken) .= field "dns_verification_token" schema + +deriving via (Schema DomainRedirectConfig) instance A.ToJSON DomainRedirectConfig + +deriving via (Schema DomainRedirectConfig) instance A.FromJSON DomainRedirectConfig + +deriving via (Schema DomainRedirectConfig) instance S.ToSchema DomainRedirectConfig + +data DomainRedirectConfigTag + = DomainRedirectConfigRemoveTag + | DomainRedirectConfigBackendTag + | DomainRedirectConfigNoRegistrationTag + deriving (Show, Ord, Eq, Enum, Bounded) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema DomainRedirectConfigTag + +instance ToSchema DomainRedirectConfigTag where + schema = + enum @Text + "DomainRedirectConfigTag" + $ mconcat + [ element "remove" DomainRedirectConfigRemoveTag, + element "backend" DomainRedirectConfigBackendTag, + element "no-registration" DomainRedirectConfigNoRegistrationTag + ] + +domainRedirectConfigTagObjectSchema :: ObjectSchema SwaggerDoc DomainRedirectConfigTag +domainRedirectConfigTagObjectSchema = + field "domain_redirect" schema + +domainRedirectConfigToTag :: DomainRedirectConfig -> DomainRedirectConfigTag +domainRedirectConfigToTag = \case + DomainRedirectConfigRemove -> DomainRedirectConfigRemoveTag + DomainRedirectConfigBackend _ -> DomainRedirectConfigBackendTag + DomainRedirectConfigNoRegistration -> DomainRedirectConfigNoRegistrationTag + +domainRedirectConfigSchema :: ObjectSchema SwaggerDoc DomainRedirectConfig +domainRedirectConfigSchema = + snd + <$> (domainRedirectConfigToTag &&& id) + .= bind + (fst .= domainRedirectConfigTagObjectSchema) + (snd .= dispatch domainRedirectConfigObjectSchema) + where + domainRedirectConfigObjectSchema :: DomainRedirectConfigTag -> ObjectSchema SwaggerDoc DomainRedirectConfig + domainRedirectConfigObjectSchema = \case + DomainRedirectConfigBackendTag -> tag _DomainRedirectConfigBackend backendUrlSchema + DomainRedirectConfigNoRegistrationTag -> tag _DomainRedirectConfigNoRegistration (pure ()) + DomainRedirectConfigRemoveTag -> tag _DomainRedirectConfigRemove (pure ()) + +instance ToSchema DomainRedirectConfig where + schema = object "DomainRedirectConfig" domainRedirectConfigSchema + +newtype GetDomainRegistrationRequest = GetDomainRegistrationRequest {domainRegistrationRequestEmail :: EmailAddress} + deriving (A.FromJSON, A.ToJSON, S.ToSchema) via (Schema GetDomainRegistrationRequest) + +instance ToSchema GetDomainRegistrationRequest where + schema = + object "GetDomainRegistrationRequest" $ + GetDomainRegistrationRequest + <$> domainRegistrationRequestEmail + .= field "email" schema + +data TeamInviteConfig = TeamInviteConfig + { teamInvite :: TeamInvite, + code :: Maybe SAML.IdPId + } + deriving (Show, Eq) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema TeamInviteConfig) + +instance ToSchema TeamInviteConfig where + schema = + object "TeamInviteConfig" $ + TeamInviteConfig + <$> (.teamInvite) .= teamInviteObjectSchema + <*> code .= maybe_ (optField "sso" samlIdpIdSchema) + +samlIdpIdSchema :: ValueSchema NamedSwaggerDoc SAML.IdPId +samlIdpIdSchema = SAML.fromIdPId .= fmap SAML.IdPId uuidSchema + +type DomainVerificationAPI = + Named + "domain-verification-token" + ( Summary "Get a DNS verification token" + :> Header "Authorization" (Bearer DomainVerificationAuthToken) + :> "domain-verification" + :> Capture "domain" Domain + :> "token" + :> Post '[JSON] DomainVerificationTokenResponse + ) + :<|> Named + "domain-verification-token-team" + ( Summary "Get a DNS verification token" + :> CanThrow DomainVerificationAuthFailure + :> CanThrow DomainVerificationPaymentRequired + :> ZLocalUser + :> "domain-verification" + :> Capture "domain" Domain + :> "team-token" + :> Post '[JSON] DomainVerificationTokenResponse + ) + :<|> Named + "update-domain-redirect" + ( Summary "Verify DNS record and save domain redirect configuration" + :> CanThrow DomainVerificationOperationForbidden + :> CanThrow DomainVerificationDomainVerificationFailed + :> Header' '[Required, Strict] "Authorization" (Bearer DomainVerificationAuthToken) + :> "domain-verification" + :> Capture "domain" Domain + :> "backend" + :> ReqBody '[JSON] DomainRedirectConfig + :> MultiVerb1 'POST '[JSON] (RespondEmpty 200 "Updated") + ) + :<|> Named + "update-team-invite" + ( Summary "Verify DNS record and save team-invite configuration" + :> CanThrow DomainVerificationAuthFailure + :> CanThrow DomainVerificationPaymentRequired + :> CanThrow DomainVerificationOperationForbidden + :> CanThrow DomainVerificationDomainVerificationFailed + :> ZLocalUser + :> "domain-verification" + :> Capture "domain" Domain + :> "team" + :> ReqBody '[JSON] TeamInviteConfig + :> MultiVerb1 'POST '[JSON] (RespondEmpty 200 "Updated") + ) + :<|> Named + "get-domain-registration" + ( Summary "Get domain registration configuration by email" + :> CanThrow DomainVerificationInvalidDomain + :> "get-domain-registration" + :> ReqBody '[JSON] GetDomainRegistrationRequest + :> Post '[JSON] DomainRedirect + ) diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/EnterpriseLogin.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/EnterpriseLogin.hs index 93f12b4f078..b6a416e578d 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/EnterpriseLogin.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/EnterpriseLogin.hs @@ -77,7 +77,7 @@ testObject_DomainRegistration_6 = { domain = Domain "example.com", domainRedirect = PreAuthorized, teamInvite = Allowed, - dnsVerificationToken = Just $ DnsVerificationToken "wire-domain-::example.com" + dnsVerificationToken = Just $ DnsVerificationToken "wire-domain-Ym9vCg::example.com" } testObject_DomainRegistrationUpdate_1 :: DomainRegistrationUpdate diff --git a/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_3.json b/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_3.json index 3fd94eb5434..877c19486a4 100644 --- a/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_3.json +++ b/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_3.json @@ -1,5 +1,5 @@ { "domain_redirect": "sso", - "sso_idp_id": "abf7c0b2-f4e6-4588-8fbb-3b4bf2344284", + "sso_code": "abf7c0b2-f4e6-4588-8fbb-3b4bf2344284", "team_invite": "allowed" } diff --git a/libs/wire-api/test/golden/testObject_DomainRegistration_3.json b/libs/wire-api/test/golden/testObject_DomainRegistration_3.json index e584ad6cb6f..1e0c8c19f2e 100644 --- a/libs/wire-api/test/golden/testObject_DomainRegistration_3.json +++ b/libs/wire-api/test/golden/testObject_DomainRegistration_3.json @@ -2,7 +2,7 @@ "dns_verification_token": null, "domain": "example.com", "domain_redirect": "sso", - "sso_idp_id": "abf7c0b2-f4e6-4588-8fbb-3b4bf2344284", + "sso_code": "abf7c0b2-f4e6-4588-8fbb-3b4bf2344284", "team": "abf7c0b2-f4e6-4588-8fbb-3b4bf2344284", "team_invite": "team" } diff --git a/libs/wire-api/test/golden/testObject_DomainRegistration_6.json b/libs/wire-api/test/golden/testObject_DomainRegistration_6.json index b0e88693ad9..4c3b7580631 100644 --- a/libs/wire-api/test/golden/testObject_DomainRegistration_6.json +++ b/libs/wire-api/test/golden/testObject_DomainRegistration_6.json @@ -1,5 +1,5 @@ { - "dns_verification_token": "wire-domain-::example.com", + "dns_verification_token": "wire-domain-Ym9vCg::example.com", "domain": "example.com", "domain_redirect": "pre-authorized", "team_invite": "allowed" diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index b0e6b2ef05d..974dd9c4987 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -160,7 +160,6 @@ library Wire.API.Routes.Features Wire.API.Routes.FederationDomainConfig Wire.API.Routes.Internal.Brig - Wire.API.Routes.Internal.Enterprise Wire.API.Routes.Internal.Brig.Connection Wire.API.Routes.Internal.Brig.EJPD Wire.API.Routes.Internal.Brig.EnterpriseLogin @@ -183,6 +182,7 @@ library Wire.API.Routes.Public Wire.API.Routes.Public.Brig Wire.API.Routes.Public.Brig.Bot + Wire.API.Routes.Public.Brig.DomainVerification Wire.API.Routes.Public.Brig.OAuth Wire.API.Routes.Public.Brig.Provider Wire.API.Routes.Public.Brig.Services diff --git a/libs/wire-subsystems/default.nix b/libs/wire-subsystems/default.nix index 19d1ab39b2a..2a241143b73 100644 --- a/libs/wire-subsystems/default.nix +++ b/libs/wire-subsystems/default.nix @@ -13,6 +13,7 @@ , attoparsec , base , base16-bytestring +, base64-bytestring , bilge , bloodhound , bytestring @@ -105,6 +106,7 @@ mkDerivation { attoparsec base base16-bytestring + base64-bytestring bilge bloodhound bytestring diff --git a/libs/wire-subsystems/src/Wire/DomainRegistrationStore.hs b/libs/wire-subsystems/src/Wire/DomainRegistrationStore.hs index 2f46710f894..dffdd83700a 100644 --- a/libs/wire-subsystems/src/Wire/DomainRegistrationStore.hs +++ b/libs/wire-subsystems/src/Wire/DomainRegistrationStore.hs @@ -14,8 +14,8 @@ import Wire.API.EnterpriseLogin data StoredDomainRegistration = StoredDomainRegistration { domain :: Domain, - domainRedirect :: DomainRedirectTag, - teamInvite :: TeamInviteTag, + domainRedirect :: Maybe DomainRedirectTag, + teamInvite :: Maybe TeamInviteTag, idpId :: Maybe SAML.IdPId, backendUrl :: Maybe HttpsUrl, team :: Maybe TeamId, diff --git a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem.hs b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem.hs index 50901593ee8..d8885d21cab 100644 --- a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem.hs @@ -4,10 +4,12 @@ module Wire.EnterpriseLoginSubsystem where import Data.Domain import Data.Id +import Data.Qualified import Imports import Polysemy import Text.Email.Parser import Wire.API.EnterpriseLogin +import Wire.API.Routes.Public.Brig.DomainVerification import Wire.Arbitrary data InvitationFlow = ExistingUser | NewUser @@ -21,8 +23,30 @@ data EnterpriseLoginSubsystem m a where UnAuthorizeDomain :: Domain -> EnterpriseLoginSubsystem m () UpdateDomainRegistration :: Domain -> DomainRegistrationUpdate -> EnterpriseLoginSubsystem m () DeleteDomain :: Domain -> EnterpriseLoginSubsystem m () - GetDomainRegistration :: Domain -> EnterpriseLoginSubsystem m DomainRegistration GuardEmailDomainRegistrationTeamInvitation :: InvitationFlow -> TeamId -> EmailAddress -> EnterpriseLoginSubsystem m () GuardEmailDomainRegistrationRegister :: EmailAddress -> EnterpriseLoginSubsystem m () + GetDomainRegistration :: Domain -> EnterpriseLoginSubsystem m DomainRegistration -- TODO(leif): remove this + TryGetDomainRegistration :: Domain -> EnterpriseLoginSubsystem m (Maybe DomainRegistration) + RequestDomainVerificationToken :: + Maybe DomainVerificationAuthToken -> + Domain -> + EnterpriseLoginSubsystem m DomainVerificationTokenResponse + RequestDomainVerificationTeamToken :: + Local UserId -> + Domain -> + EnterpriseLoginSubsystem m DomainVerificationTokenResponse + UpdateDomainRedirect :: + DomainVerificationAuthToken -> + Domain -> + DomainRedirectConfig -> + EnterpriseLoginSubsystem m () + UpdateTeamInvite :: + Local UserId -> + Domain -> + TeamInviteConfig -> + EnterpriseLoginSubsystem m () + GetDomainRegistrationPublic :: + GetDomainRegistrationRequest -> + EnterpriseLoginSubsystem m DomainRedirect makeSem ''EnterpriseLoginSubsystem diff --git a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Error.hs b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Error.hs index 71b80923aa3..d4794080259 100644 --- a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Error.hs +++ b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Error.hs @@ -4,6 +4,8 @@ import Data.Text.Lazy qualified as LT import Imports import Network.HTTP.Types import Network.Wai.Utilities qualified as Wai +import Wire.API.Error +import Wire.API.Error.Brig import Wire.Arbitrary import Wire.Error @@ -15,6 +17,12 @@ data EnterpriseLoginSubsystemError | EnterpriseLoginSubsystemUnAuthorizeError | EnterpriseLoginSubsystemPreAuthorizeError | EnterpriseLoginSubsystemGuardFailed GuardFailure + | EnterpriseLoginSubsystemInvalidDomain + | EnterpriseLoginSubsystemDomainVerificationFailed + | EnterpriseLoginSubsystemOperationForbidden + | EnterpriseLoginSubsystemInvalidAuthToken + | EnterpriseLoginSubsystemAuthFailure + | EnterpriseLoginSubsystemPaymentRequired deriving (Show, Eq, Generic) deriving (Arbitrary) via (GenericUniform EnterpriseLoginSubsystemError) @@ -33,12 +41,9 @@ data GuardFailure enterpriseLoginSubsystemErrorToHttpError :: EnterpriseLoginSubsystemError -> HttpError enterpriseLoginSubsystemErrorToHttpError = StdError . \case - EnterpriseLoginSubsystemErrorNotFound -> Wai.mkError status404 "not-found" "Not Found" + EnterpriseLoginSubsystemErrorNotFound -> errorToWai @DomainVerificationErrorNotFound EnterpriseLoginSubsystemInternalError msg -> Wai.mkError status500 "internal-error" msg EnterpriseLoginSubsystemErrorUpdateFailure msg -> Wai.mkError status400 "update-failure" msg - EnterpriseLoginSubsystemUnlockError -> Wai.mkError status409 "unlock-error" "Domain can only be unlocked from a locked state" - EnterpriseLoginSubsystemUnAuthorizeError -> Wai.mkError status409 "unauthorize-error" "Domain redirect can not bet set to unauthorized when locked or SSO" - EnterpriseLoginSubsystemPreAuthorizeError -> Wai.mkError status409 "preauthorize-error" "Domain redirect must be 'none' to be pre-authorized" EnterpriseLoginSubsystemGuardFailed err -> let e403 msg = Wai.mkError status403 "condition-failed" msg e400 msg = Wai.mkError status400 "invalid-domain" (LT.pack msg) @@ -49,3 +54,12 @@ enterpriseLoginSubsystemErrorToHttpError = TeamInviteSetToNotAllowed -> e403 "`teamInvite` is set to `not-allowed`" TeamInviteRestrictedToOtherTeam -> e403 "`teamInvite` is restricted to another team." InvalidDomain msg -> e400 msg -- probably impossible. + EnterpriseLoginSubsystemUnlockError -> errorToWai @DomainVerificationUnlockError + EnterpriseLoginSubsystemUnAuthorizeError -> errorToWai @DomainVerificationUnAuthorizeError + EnterpriseLoginSubsystemPreAuthorizeError -> errorToWai @DomainVerificationPreAuthorizeError + EnterpriseLoginSubsystemInvalidDomain -> errorToWai @DomainVerificationInvalidDomain + EnterpriseLoginSubsystemDomainVerificationFailed -> errorToWai @DomainVerificationDomainVerificationFailed + EnterpriseLoginSubsystemOperationForbidden -> errorToWai @DomainVerificationOperationForbidden + EnterpriseLoginSubsystemInvalidAuthToken -> errorToWai @DomainVerificationInvalidAuthToken + EnterpriseLoginSubsystemAuthFailure -> errorToWai @DomainVerificationAuthFailure + EnterpriseLoginSubsystemPaymentRequired -> errorToWai @DomainVerificationPaymentRequired diff --git a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs index bcb09e0a7e6..1072ced192d 100644 --- a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs @@ -5,47 +5,79 @@ module Wire.EnterpriseLoginSubsystem.Interpreter ( runEnterpriseLoginSubsystem, EnterpriseLoginSubsystemConfig (..), + EnterpriseLoginSubsystemEmailConfig (..), ) where +import Bilge hiding (delete) +import Control.Lens ((^.), (^..), (^?)) import Data.Aeson qualified as Aeson import Data.Aeson.Encode.Pretty qualified as Aeson import Data.ByteString.Conversion (toByteString') -import Data.Domain (Domain, domainText, mkDomain) +import Data.ByteString.Lazy qualified as BL +import Data.Default +import Data.Domain import Data.Id import Data.Misc (HttpsUrl (..)) +import Data.Qualified import Data.Text.Encoding as T +import Data.Text.Encoding qualified as Text import Data.Text.Internal.Builder (fromLazyText, fromText, toLazyText) import Data.Text.Lazy.Builder (Builder) import Data.Text.Lazy.Encoding as LT import Imports hiding (lookup) +import Network.HTTP.Types.Method import Network.Mail.Mime (Address (Address), Mail (mailHeaders, mailParts, mailTo), emptyMail, plainPart) import Polysemy -import Polysemy.Error (Error, throw) -import Polysemy.Input (Input, input) +import Polysemy.Error +import Polysemy.Input import Polysemy.TinyLog (TinyLog) import Polysemy.TinyLog qualified as Log import SAML2.WebSSO qualified as SAML import System.Logger.Message qualified as Log import Text.Email.Parser qualified as Email +import Util.Options import Wire.API.EnterpriseLogin -import Wire.API.User.EmailAddress (EmailAddress, fromEmail) +import Wire.API.Routes.Public.Brig.DomainVerification +import Wire.API.Team.Feature +import Wire.API.Team.Member +import Wire.API.User hiding (NewUser) +import Wire.API.User.IdentityProvider (providers) import Wire.DomainRegistrationStore import Wire.EmailSending (EmailSending, sendMail) import Wire.EnterpriseLoginSubsystem -import Wire.EnterpriseLoginSubsystem.Error as Error +import Wire.EnterpriseLoginSubsystem.Error +import Wire.GalleyAPIAccess +import Wire.ParseException +import Wire.Rpc +import Wire.Sem.Random +import Wire.SparAPIAccess +import Wire.UserKeyStore +import Wire.UserSubsystem -data EnterpriseLoginSubsystemConfig = EnterpriseLoginSubsystemConfig +data EnterpriseLoginSubsystemEmailConfig = EnterpriseLoginSubsystemEmailConfig { auditEmailSender :: EmailAddress, auditEmailRecipient :: EmailAddress } +data EnterpriseLoginSubsystemConfig = EnterpriseLoginSubsystemConfig + { emailConfig :: Maybe EnterpriseLoginSubsystemEmailConfig, + wireServerEnterpriseEndpoint :: Endpoint + } + runEnterpriseLoginSubsystem :: ( Member DomainRegistrationStore r, Member (Error EnterpriseLoginSubsystemError) r, + Member (Error ParseException) r, + Member GalleyAPIAccess r, + Member SparAPIAccess r, Member TinyLog r, - Member (Input (Maybe EnterpriseLoginSubsystemConfig)) r, - Member EmailSending r + Member (Input EnterpriseLoginSubsystemConfig) r, + Member EmailSending r, + Member Random r, + Member Rpc r, + Member UserKeyStore r, + Member UserSubsystem r ) => Sem (EnterpriseLoginSubsystem ': r) a -> Sem r a @@ -60,12 +92,27 @@ runEnterpriseLoginSubsystem = interpret $ GetDomainRegistration domain -> getDomainRegistrationImpl domain GuardEmailDomainRegistrationTeamInvitation flow tid email -> guardEmailDomainRegistrationTeamInvitationImpl flow tid email GuardEmailDomainRegistrationRegister email -> guardEmailDomainRegistrationRegisterImpl email + TryGetDomainRegistration domain -> tryGetDomainRegistrationImpl domain + RequestDomainVerificationToken mAuthToken domain -> + runInputSem (wireServerEnterpriseEndpoint <$> input) $ + requestDomainVerificationTokenImpl mAuthToken domain + RequestDomainVerificationTeamToken lusr domain -> + runInputSem (wireServerEnterpriseEndpoint <$> input) $ + requestDomainVerificationTeamTokenImpl lusr domain + UpdateDomainRedirect mAuthToken domain config -> + runInputSem (wireServerEnterpriseEndpoint <$> input) $ + updateDomainRedirectImpl mAuthToken domain config + UpdateTeamInvite lusr domain config -> + runInputSem (wireServerEnterpriseEndpoint <$> input) $ + updateTeamInviteImpl lusr domain config + GetDomainRegistrationPublic req -> + getDomainRegistrationPublicImpl req deleteDomainImpl :: ( Member DomainRegistrationStore r, Member (Error EnterpriseLoginSubsystemError) r, Member TinyLog r, - Member (Input (Maybe EnterpriseLoginSubsystemConfig)) r, + Member (Input EnterpriseLoginSubsystemConfig) r, Member EmailSending r ) => Domain -> @@ -85,7 +132,7 @@ unauthorizeImpl :: ( Member DomainRegistrationStore r, Member (Error EnterpriseLoginSubsystemError) r, Member TinyLog r, - Member (Input (Maybe EnterpriseLoginSubsystemConfig)) r, + Member (Input EnterpriseLoginSubsystemConfig) r, Member EmailSending r ) => Domain -> @@ -115,7 +162,7 @@ updateDomainRegistrationImpl :: ( Member DomainRegistrationStore r, Member (Error EnterpriseLoginSubsystemError) r, Member TinyLog r, - Member (Input (Maybe EnterpriseLoginSubsystemConfig)) r, + Member (Input EnterpriseLoginSubsystemConfig) r, Member EmailSending r ) => Domain -> @@ -145,7 +192,7 @@ lockDomainImpl :: ( Member DomainRegistrationStore r, Member (Error EnterpriseLoginSubsystemError) r, Member TinyLog r, - Member (Input (Maybe EnterpriseLoginSubsystemConfig)) r, + Member (Input EnterpriseLoginSubsystemConfig) r, Member EmailSending r ) => Domain -> @@ -169,7 +216,7 @@ unlockDomainImpl :: ( Member DomainRegistrationStore r, Member (Error EnterpriseLoginSubsystemError) r, Member TinyLog r, - Member (Input (Maybe EnterpriseLoginSubsystemConfig)) r, + Member (Input EnterpriseLoginSubsystemConfig) r, Member EmailSending r ) => Domain -> @@ -195,7 +242,7 @@ preAuthorizeImpl :: ( Member DomainRegistrationStore r, Member (Error EnterpriseLoginSubsystemError) r, Member TinyLog r, - Member (Input (Maybe EnterpriseLoginSubsystemConfig)) r, + Member (Input EnterpriseLoginSubsystemConfig) r, Member EmailSending r ) => Domain -> @@ -254,6 +301,60 @@ tryGetDomainRegistrationImpl domain = do throw $ EnterpriseLoginSubsystemInternalError "The stored domain registration is invalid. Please update or delete and recreate it with a valid configuration." Just dr -> pure dr +getDomainVerificationToken :: + ( Member (Error ParseException) r, + Member (Input Endpoint) r, + Member Rpc r + ) => + Domain -> + Text -> + Sem r DomainVerificationToken +getDomainVerificationToken domain authToken = + decodeBodyOrThrow + =<< enterpriseRequest + ( method POST + . paths + [ "i", + "create-verification-token", + toByteString' domain, + toByteString' authToken + ] + . expect2xx + ) + +verifyDNSRecord :: + ( Member (Error ParseException) r, + Member (Error EnterpriseLoginSubsystemError) r, + Member (Input Endpoint) r, + Member Rpc r + ) => + Domain -> + Text -> + Sem r () +verifyDNSRecord domain authToken = do + verified <- + decodeBodyOrThrow + =<< enterpriseRequest + ( method POST + . paths + [ "i", + "verify-domain-token", + toByteString' domain, + toByteString' authToken + ] + . expect2xx + ) + unless verified $ + throw EnterpriseLoginSubsystemDomainVerificationFailed + +enterpriseRequest :: (Member Rpc r, Member (Input Endpoint) r) => (Request -> Request) -> Sem r (Response (Maybe LByteString)) +enterpriseRequest req = do + ep <- input + rpcWithRetries "wireServerEnterprise" ep req + +decodeBodyOrThrow :: forall a r. (Typeable a, Aeson.FromJSON a, Member (Error ParseException) r) => Response (Maybe BL.ByteString) -> Sem r a +decodeBodyOrThrow r = either (throw . ParseException "wireServerEnterprise") pure (responseJsonEither r) + fromStored :: StoredDomainRegistration -> Maybe DomainRegistration fromStored sdr = DomainRegistration sdr.domain @@ -264,27 +365,29 @@ fromStored sdr = getTeamInvite :: StoredDomainRegistration -> Maybe TeamInvite getTeamInvite = \case StoredDomainRegistration _ _ ti _ _ tid _ -> case (ti, tid) of - (AllowedTag, Nothing) -> Just Allowed - (NotAllowedTag, Nothing) -> Just NotAllowed - (TeamTag, Just teamId) -> Just $ Team teamId + (Just AllowedTag, Nothing) -> Just Allowed + (Just NotAllowedTag, Nothing) -> Just NotAllowed + (Just TeamTag, Just teamId) -> Just $ Team teamId + (Nothing, Nothing) -> Just Allowed _ -> Nothing getDomainRedirect :: StoredDomainRegistration -> Maybe DomainRedirect getDomainRedirect = \case StoredDomainRegistration _ dr _ ssoId url _ _ -> case (dr, ssoId, url) of - (NoneTag, Nothing, Nothing) -> Just None - (LockedTag, Nothing, Nothing) -> Just Locked - (PreAuthorizedTag, Nothing, Nothing) -> Just PreAuthorized - (SSOTag, Just idpId, Nothing) -> Just $ SSO idpId - (BackendTag, Nothing, Just beUrl) -> Just $ Backend beUrl - (NoRegistrationTag, Nothing, Nothing) -> Just NoRegistration + (Just NoneTag, Nothing, Nothing) -> Just None + (Just LockedTag, Nothing, Nothing) -> Just Locked + (Just PreAuthorizedTag, Nothing, Nothing) -> Just PreAuthorized + (Just SSOTag, Just idpId, Nothing) -> Just $ SSO idpId + (Just BackendTag, Nothing, Just beUrl) -> Just $ Backend beUrl + (Just NoRegistrationTag, Nothing, Nothing) -> Just NoRegistration + (Nothing, Nothing, Nothing) -> Just None _ -> Nothing toStored :: DomainRegistration -> StoredDomainRegistration toStored dr = let (domainRedirect, idpId, backendUrl) = fromDomainRedirect dr.domainRedirect (teamInvite, team) = fromTeamInvite dr.teamInvite - in StoredDomainRegistration dr.domain domainRedirect teamInvite idpId backendUrl team (dr.dnsVerificationToken) + in StoredDomainRegistration dr.domain (Just domainRedirect) (Just teamInvite) idpId backendUrl team dr.dnsVerificationToken where fromTeamInvite :: TeamInvite -> (TeamInviteTag, Maybe TeamId) fromTeamInvite Allowed = (AllowedTag, Nothing) @@ -307,18 +410,18 @@ validate dr = do _ -> pure () mkAuditMail :: EmailAddress -> EmailAddress -> Text -> LText -> Mail -mkAuditMail from to subject body = +mkAuditMail from to subject bdy = (emptyMail (Address Nothing (fromEmail from))) { mailTo = [Address Nothing (fromEmail to)], mailHeaders = [ ("Subject", subject), ("X-Zeta-Purpose", "audit") ], - mailParts = [[plainPart body]] + mailParts = [[plainPart bdy]] } sendAuditMail :: - ( Member (Input (Maybe EnterpriseLoginSubsystemConfig)) r, + ( Member (Input EnterpriseLoginSubsystemConfig) r, Member TinyLog r, Member EmailSending r ) => @@ -340,7 +443,7 @@ sendAuditMail url subject mBefore mAfter = do . Log.field "url" (LT.encodeUtf8 $ toLazyText url) . Log.field "old_value" (maybe "null" Aeson.encode mBefore) . Log.field "new_value" (maybe "null" Aeson.encode mAfter) - mConfig <- input + mConfig <- inputs emailConfig for_ mConfig $ \config -> do let mail = mkAuditMail (config.auditEmailSender) (config.auditEmailRecipient) subject auditLog sendMail mail @@ -419,3 +522,187 @@ guardEmailDomainRegistrationRegisterImpl email = do where ok = pure () nope = throw . EnterpriseLoginSubsystemGuardFailed + +requestDomainVerificationTokenImpl :: + ( Member Random r, + Member (Input Endpoint) r, + Member (Error ParseException) r, + Member Rpc r + ) => + Maybe DomainVerificationAuthToken -> + Domain -> + Sem r DomainVerificationTokenResponse +requestDomainVerificationTokenImpl mAuthToken domain = do + authToken <- maybe generateAuthToken pure mAuthToken + dnsToken <- getDomainVerificationToken domain (serializeDomainVerificationAuthToken authToken) + pure + DomainVerificationTokenResponse + { authToken = Just authToken, + dnsToken = dnsToken + } + +requestDomainVerificationTeamTokenImpl :: + forall r. + ( Member (Input Endpoint) r, + Member TinyLog r, + Member (Error EnterpriseLoginSubsystemError) r, + Member (Error ParseException) r, + Member UserSubsystem r, + Member GalleyAPIAccess r, + Member DomainRegistrationStore r, + Member Rpc r + ) => + Local UserId -> + Domain -> + Sem r DomainVerificationTokenResponse +requestDomainVerificationTeamTokenImpl lusr domain = do + (tid, _mDomReg) <- guardTeamAdminAccess lusr domain + let authToken = idToText tid + dnsToken <- getDomainVerificationToken domain authToken + pure + DomainVerificationTokenResponse + { authToken = Nothing, + dnsToken = dnsToken + } + +updateDomainRedirectImpl :: + ( Member (Error EnterpriseLoginSubsystemError) r, + Member (Error ParseException) r, + Member TinyLog r, + Member DomainRegistrationStore r, + Member (Input Endpoint) r, + Member (Input EnterpriseLoginSubsystemConfig) r, + Member EmailSending r, + Member Rpc r + ) => + DomainVerificationAuthToken -> + Domain -> + DomainRedirectConfig -> + Sem r () +updateDomainRedirectImpl authToken domain config = do + mbDomainReg <- tryGetDomainRegistrationImpl domain + update <- + maybe + (throw EnterpriseLoginSubsystemOperationForbidden) + pure + $ mbDomainReg >>= computeUpdate + verifyDNSRecord domain (serializeDomainVerificationAuthToken authToken) + updateDomainRegistrationImpl domain update + where + computeUpdate reg = case (config, reg.domainRedirect) of + (DomainRedirectConfigRemove, NoRegistration) -> + Just $ DomainRegistrationUpdate PreAuthorized reg.teamInvite + (DomainRedirectConfigRemove, Backend _) -> + Just $ DomainRegistrationUpdate PreAuthorized reg.teamInvite + (DomainRedirectConfigBackend url, PreAuthorized) -> + Just $ DomainRegistrationUpdate (Backend url) NotAllowed + (DomainRedirectConfigNoRegistration, PreAuthorized) -> + Just $ DomainRegistrationUpdate NoRegistration reg.teamInvite + _ -> Nothing + +updateTeamInviteImpl :: + forall r. + ( Member (Error EnterpriseLoginSubsystemError) r, + Member (Error ParseException) r, + Member (Input Endpoint) r, + Member (Input EnterpriseLoginSubsystemConfig) r, + Member DomainRegistrationStore r, + Member EmailSending r, + Member GalleyAPIAccess r, + Member SparAPIAccess r, + Member Rpc r, + Member TinyLog r, + Member UserSubsystem r + ) => + Local UserId -> + Domain -> + TeamInviteConfig -> + Sem r () +updateTeamInviteImpl luid domain config = do + (tid, mbDomainReg) <- guardTeamAdminAccess luid domain + verifyDNSRecord domain (idToText tid) + update <- validateUpdate tid mbDomainReg config + updateDomainRegistrationImpl domain update + where + validateUpdate :: TeamId -> Maybe DomainRegistration -> TeamInviteConfig -> Sem r DomainRegistrationUpdate + validateUpdate tid mDomReg conf = do + let domReg = fromMaybe defDomReg mDomReg + when (domReg.domainRedirect == Locked) $ + throw EnterpriseLoginSubsystemOperationForbidden + when (isJust $ domReg.domainRedirect ^? _Backend) $ + throw EnterpriseLoginSubsystemOperationForbidden + case conf.teamInvite of + Team tidConfig | tidConfig /= tid -> throw EnterpriseLoginSubsystemAuthFailure + validTeamInvite -> case conf.code of + Just idpId -> do + validateIdPId tid idpId + pure $ DomainRegistrationUpdate (SSO idpId) validTeamInvite + Nothing -> pure $ DomainRegistrationUpdate domReg.domainRedirect validTeamInvite + + validateIdPId :: + TeamId -> + SAML.IdPId -> + Sem r () + validateIdPId tid idp = do + idps <- getIdentityProviders tid + unless (idp `elem` idps.providers ^.. traverse . SAML.idpId) $ + throw EnterpriseLoginSubsystemOperationForbidden + + defDomReg :: DomainRegistration + defDomReg = DomainRegistration domain def def Nothing + +guardTeamAdminAccess :: + forall r. + ( Member TinyLog r, + Member (Error EnterpriseLoginSubsystemError) r, + Member UserSubsystem r, + Member GalleyAPIAccess r, + Member DomainRegistrationStore r + ) => + Local UserId -> + Domain -> + Sem r (TeamId, Maybe DomainRegistration) +guardTeamAdminAccess luid domain = do + profile <- getSelfProfile luid >>= note EnterpriseLoginSubsystemAuthFailure + tid <- note EnterpriseLoginSubsystemAuthFailure profile.selfUser.userTeam + teamMember <- + getTeamMember (tUnqualified luid) tid + >>= note EnterpriseLoginSubsystemAuthFailure + validatePaymentStatus tid + unless (isAdminOrOwner (teamMember ^. permissions)) $ + throw EnterpriseLoginSubsystemAuthFailure + mbDomainReg <- tryGetDomainRegistrationImpl domain + pure (tid, mbDomainReg) + where + validatePaymentStatus :: TeamId -> Sem r () + validatePaymentStatus tid = do + -- FUTUREWORK: we need a dedicated feature flag for domain registration that is managed by ibis + -- If the team is paying, conference calling will always be enabled + feature <- getFeatureConfigForTeam @_ @ConferenceCallingConfig tid + when (feature.status /= FeatureStatusEnabled) $ + throw EnterpriseLoginSubsystemPaymentRequired + +getDomainRegistrationPublicImpl :: + ( Member UserKeyStore r, + Member (Error EnterpriseLoginSubsystemError) r, + Member DomainRegistrationStore r, + Member TinyLog r + ) => + GetDomainRegistrationRequest -> + Sem r DomainRedirect +getDomainRegistrationPublicImpl (GetDomainRegistrationRequest email) = do + -- check if the email belongs to a registered user + mUser <- lookupKey (mkEmailKey email) + case mUser of + Nothing -> do + domain <- + either + (const (throw EnterpriseLoginSubsystemInvalidDomain)) + pure + $ mkDomain (Text.decodeUtf8 (domainPart email)) + mReg <- tryGetDomainRegistrationImpl domain + pure $ maybe None (.domainRedirect) mReg + Just _ -> pure None + +generateAuthToken :: (Member Random r) => Sem r DomainVerificationAuthToken +generateAuthToken = DomainVerificationAuthToken <$> Wire.Sem.Random.bytes 32 diff --git a/libs/wire-subsystems/src/Wire/Rpc.hs b/libs/wire-subsystems/src/Wire/Rpc.hs index 8a954eafddb..5fdbf9b87eb 100644 --- a/libs/wire-subsystems/src/Wire/Rpc.hs +++ b/libs/wire-subsystems/src/Wire/Rpc.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} module Wire.Rpc - ( Rpc, + ( Rpc (..), rpc, rpcWithRetries, runRpcWithHttp, diff --git a/libs/wire-subsystems/src/Wire/SparAPIAccess.hs b/libs/wire-subsystems/src/Wire/SparAPIAccess.hs new file mode 100644 index 00000000000..8fce888d2a3 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/SparAPIAccess.hs @@ -0,0 +1,28 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2025 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 . +{-# LANGUAGE TemplateHaskell #-} + +module Wire.SparAPIAccess where + +import Data.Id +import Polysemy +import Wire.API.User.IdentityProvider + +data SparAPIAccess m a where + GetIdentityProviders :: TeamId -> SparAPIAccess m IdPList + +makeSem ''SparAPIAccess diff --git a/libs/wire-subsystems/src/Wire/SparAPIAccess/Rpc.hs b/libs/wire-subsystems/src/Wire/SparAPIAccess/Rpc.hs new file mode 100644 index 00000000000..44fcdaa6790 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/SparAPIAccess/Rpc.hs @@ -0,0 +1,80 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2025 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Wire.SparAPIAccess.Rpc where + +import Bilge hiding (head, options, requestId) +import Data.Aeson hiding (json) +import Data.ByteString.Conversion +import Data.ByteString.Lazy qualified as BL +import Data.Id +import Imports +import Network.HTTP.Types.Method +import Polysemy +import Polysemy.Error +import Polysemy.Input +import Polysemy.TinyLog +import System.Logger.Message +import Util.Options +import Wire.API.User.IdentityProvider +import Wire.ParseException +import Wire.Rpc +import Wire.SparAPIAccess + +interpretSparAPIAccessToRpc :: + ( Member (Error ParseException) r, + Member Rpc r, + Member TinyLog r + ) => + Endpoint -> + Sem (SparAPIAccess ': r) a -> + Sem r a +interpretSparAPIAccessToRpc sparEndpoint = + interpret $ + runInputConst sparEndpoint . \case + GetIdentityProviders tid -> getIdentityProvidersImpl tid + +sparRequest :: + (Member Rpc r, Member (Input Endpoint) r) => + (Request -> Request) -> + Sem r (Response (Maybe LByteString)) +sparRequest req = do + ep <- input + rpcWithRetries "spar" ep req + +getIdentityProvidersImpl :: + ( Member TinyLog r, + Member (Error ParseException) r, + Member (Input Endpoint) r, + Member Rpc r + ) => + TeamId -> + Sem r IdPList +getIdentityProvidersImpl tid = do + debug $ + field "remote" ("spar" :: ByteString) + . msg (val "get identity providers") + . field "team" (toByteString tid) + decodeBodyOrThrow "spar" =<< sparRequest getReq + where + getReq = + method GET + . paths ["i", "identity-providers", toByteString' tid] + +-- FUTUREWORK: This is duplicated in Wire/GalleyAPIAccess/Rpc. Move to a common module. +decodeBodyOrThrow :: forall a r. (Typeable a, FromJSON a, Member (Error ParseException) r) => Text -> Response (Maybe BL.ByteString) -> Sem r a +decodeBodyOrThrow ctx r = either (throw . ParseException ctx) pure (responseJsonEither r) diff --git a/libs/wire-subsystems/test/unit/Wire/EnterpriseLoginSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/EnterpriseLoginSubsystem/InterpreterSpec.hs index 91d4d768b00..dc5f86be3cb 100644 --- a/libs/wire-subsystems/test/unit/Wire/EnterpriseLoginSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/EnterpriseLoginSubsystem/InterpreterSpec.hs @@ -1,5 +1,6 @@ module Wire.EnterpriseLoginSubsystem.InterpreterSpec where +import Data.Default import Data.Domain import Data.Id import Data.String.Conversions (cs) @@ -19,29 +20,63 @@ import Wire.EmailSending import Wire.EnterpriseLoginSubsystem import Wire.EnterpriseLoginSubsystem.Error import Wire.EnterpriseLoginSubsystem.Interpreter +import Wire.GalleyAPIAccess import Wire.MockInterpreters.DomainRegistrationStore import Wire.MockInterpreters.EmailSending +import Wire.MockInterpreters.Error +import Wire.MockInterpreters.GalleyAPIAccess +import Wire.MockInterpreters.Random +import Wire.MockInterpreters.SparAPIAccess +import Wire.MockInterpreters.UserKeyStore +import Wire.MockInterpreters.UserSubsystem +import Wire.ParseException +import Wire.Rpc import Wire.Sem.Logger.TinyLog +import Wire.Sem.Random +import Wire.SparAPIAccess +import Wire.UserKeyStore +import Wire.UserSubsystem runDependencies :: Sem '[ DomainRegistrationStore, - Error EnterpriseLoginSubsystemError, + (Error EnterpriseLoginSubsystemError), + (Error ParseException), + GalleyAPIAccess, + SparAPIAccess, TinyLog, - Input (Maybe EnterpriseLoginSubsystemConfig), - EmailSending + (Input EnterpriseLoginSubsystemConfig), + EmailSending, + Random, + Rpc, + UserKeyStore, + UserSubsystem ] a -> Either EnterpriseLoginSubsystemError a runDependencies = run + . userSubsystemTestInterpreter [] + . (evalState mempty . inMemoryUserKeyStoreInterpreter . raiseUnder) + . fakeRpc + . runRandomPure . noopEmailSendingInterpreter - . runInputConst Nothing + . runInputConst + ( EnterpriseLoginSubsystemConfig + Nothing + (error "undefined wire-server-enterprise endpoint") + ) . discardTinyLogs + . miniSparAPIAccess + . miniGalleyAPIAccess Nothing def + . runErrorUnsafe . runError - . evalState mempty - . inMemoryDomainRegistrationStoreInterpreter - . raiseUnder + . (evalState mempty . inMemoryDomainRegistrationStoreInterpreter . raiseUnder) + +fakeRpc :: InterpreterFor Rpc r +fakeRpc = interpret $ \case + Rpc {} -> error "Rpc not implemented" + RpcWithRetries {} -> error "RpcWithRetries not implemented" spec :: Spec spec = describe "EnterpriseLoginSubsystem" $ do diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EnterpriseLoginSubsystem.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EnterpriseLoginSubsystem.hs index bad8b31eed8..bf7919c1a3d 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EnterpriseLoginSubsystem.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EnterpriseLoginSubsystem.hs @@ -12,12 +12,18 @@ enterpriseLoginSubsystemTestInterpreter :: InterpreterFor EnterpriseLoginSubsystem r enterpriseLoginSubsystemTestInterpreter err = interpret \case - LockDomain _ -> undefined -- :: Domain -> EnterpriseLoginSubsystem m () - UnlockDomain _ -> undefined -- :: Domain -> EnterpriseLoginSubsystem m () - PreAuthorizeDomain _ -> undefined -- :: Domain -> EnterpriseLoginSubsystem m () - UnAuthorizeDomain _ -> undefined -- :: Domain -> EnterpriseLoginSubsystem m () - UpdateDomainRegistration _ _ -> undefined -- :: Domain -> DomainRegistrationUpdate -> EnterpriseLoginSubsystem m () - DeleteDomain _ -> undefined -- :: Domain -> EnterpriseLoginSubsystem m () - GetDomainRegistration _ -> undefined -- :: Domain -> EnterpriseLoginSubsystem m DomainRegistration + LockDomain _ -> undefined + UnlockDomain _ -> undefined + PreAuthorizeDomain _ -> undefined + UnAuthorizeDomain _ -> undefined + UpdateDomainRegistration _ _ -> undefined + DeleteDomain _ -> undefined + GetDomainRegistration _ -> undefined GuardEmailDomainRegistrationTeamInvitation {} -> throw err GuardEmailDomainRegistrationRegister _ -> throw err + TryGetDomainRegistration _ -> undefined + RequestDomainVerificationToken _ _ -> undefined + RequestDomainVerificationTeamToken _ _ -> undefined + UpdateDomainRedirect {} -> undefined + UpdateTeamInvite {} -> undefined + GetDomainRegistrationPublic _ -> undefined diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/SparAPIAccess.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/SparAPIAccess.hs new file mode 100644 index 00000000000..14501bb656c --- /dev/null +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/SparAPIAccess.hs @@ -0,0 +1,10 @@ +module Wire.MockInterpreters.SparAPIAccess where + +import Imports +import Polysemy +import Wire.SparAPIAccess + +-- | interprets galley by statically returning the values passed +miniSparAPIAccess :: InterpreterFor SparAPIAccess r +miniSparAPIAccess = interpret $ \case + GetIdentityProviders _ -> error "GetIdentityProviders not implemented in miniSparAPIAccess" diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index ad85491a049..e91266abbac 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -123,6 +123,8 @@ library Wire.Rpc Wire.SessionStore Wire.SessionStore.Cassandra + Wire.SparAPIAccess + Wire.SparAPIAccess.Rpc Wire.StoredUser Wire.TeamInvitationSubsystem Wire.TeamInvitationSubsystem.Error @@ -160,6 +162,7 @@ library , attoparsec , base , base16-bytestring + , base64-bytestring , bilge , bloodhound , bytestring @@ -264,6 +267,7 @@ test-suite wire-subsystems-tests Wire.MockInterpreters.PropertyStore Wire.MockInterpreters.Random Wire.MockInterpreters.SessionStore + Wire.MockInterpreters.SparAPIAccess Wire.MockInterpreters.UserKeyStore Wire.MockInterpreters.UserStore Wire.MockInterpreters.UserSubsystem diff --git a/services/brig/brig.integration.yaml b/services/brig/brig.integration.yaml index ad2c8da9560..476df0d6aa4 100644 --- a/services/brig/brig.integration.yaml +++ b/services/brig/brig.integration.yaml @@ -35,6 +35,10 @@ galley: host: 127.0.0.1 port: 8085 +spar: + host: 127.0.0.1 + port: 8088 + gundeck: host: 127.0.0.1 port: 8086 diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 7b256a5fc4f..9f76f9efd22 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -1,5 +1,7 @@ +{-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-partial-type-signatures #-} -- This file is part of the Wire Server implementation. -- @@ -99,6 +101,7 @@ import Servant.Swagger.UI import System.Logger.Class qualified as Log import Util.Logging (logFunction, logHandle, logTeam, logUser) import Wire.API.Connection qualified as Public +import Wire.API.EnterpriseLogin import Wire.API.Error import Wire.API.Error.Brig qualified as E import Wire.API.Federation.API.Brig qualified as BrigFederationAPI @@ -108,6 +111,7 @@ import Wire.API.Federation.Error import Wire.API.Federation.Version qualified as Fed import Wire.API.Properties qualified as Public import Wire.API.Routes.API +import Wire.API.Routes.Bearer import Wire.API.Routes.Internal.Brig qualified as BrigInternalAPI import Wire.API.Routes.Internal.Cannon qualified as CannonInternalAPI import Wire.API.Routes.Internal.Cargohold qualified as CargoholdInternalAPI @@ -117,6 +121,7 @@ import Wire.API.Routes.Internal.Spar qualified as SparInternalAPI import Wire.API.Routes.MultiTablePaging qualified as Public import Wire.API.Routes.Named (Named (Named)) import Wire.API.Routes.Public.Brig +import Wire.API.Routes.Public.Brig.DomainVerification import Wire.API.Routes.Public.Brig.OAuth import Wire.API.Routes.Public.Cannon import Wire.API.Routes.Public.Cargohold @@ -152,7 +157,8 @@ import Wire.DeleteQueue import Wire.EmailSending (EmailSending) import Wire.EmailSubsystem import Wire.EmailSubsystem.Template -import Wire.EnterpriseLoginSubsystem +import Wire.EnterpriseLoginSubsystem (EnterpriseLoginSubsystem) +import Wire.EnterpriseLoginSubsystem qualified as EnterpriseLogin import Wire.Error import Wire.Events (Events) import Wire.FederationConfigStore (FederationConfigStore) @@ -393,6 +399,7 @@ servantSitemap = :<|> botAPI :<|> servicesAPI :<|> providerAPI + :<|> domainVerificationAPI where userAPI :: ServerT UserAPI (Handler r) userAPI = @@ -543,6 +550,14 @@ servantSitemap = Named @"get-system-settings-unauthorized" getSystemSettings :<|> Named @"get-system-settings" getSystemSettingsInternal + domainVerificationAPI :: ServerT DomainVerificationAPI (Handler r) + domainVerificationAPI = + Named @"domain-verification-token" requestDomainVerificationToken + :<|> Named @"domain-verification-token-team" requestDomainVerificationTeamToken + :<|> Named @"update-domain-redirect" updateDomainRedirect + :<|> Named @"update-team-invite" updateTeamInvite + :<|> Named @"get-domain-registration" getDomainRegistration + -- Note [ephemeral user sideeffect] -- If the user is ephemeral and expired, it will be removed upon calling -- CheckUserExists[Un]Qualified, see 'Brig.API.User.userGC'. @@ -839,7 +854,8 @@ createUser (Public.NewUserPublic new) = lift . runExceptT $ do mapExceptT wrapHttp . checkAllowlistWithError RegisterErrorAllowlistError -- TODO: we need an integration test for this, but it'd be easier to write that in a -- different PR where we have https://github.com/wireapp/wire-server/pull/4389. - (lift . liftSem . guardEmailDomainRegistrationRegister) `mapM_` (emailIdentity =<< new.newUserIdentity) + (lift . liftSem . EnterpriseLogin.guardEmailDomainRegistrationRegister) + `mapM_` (emailIdentity =<< new.newUserIdentity) result <- API.createUser new let acc = createdAccount result @@ -1501,6 +1517,50 @@ getSystemSettingsInternal _ = do let iSettings = SystemSettingsInternal $ fromMaybe False optSettings.enableMLS pure $ SystemSettings pSettings iSettings +requestDomainVerificationToken :: + forall r. + (_) => + Maybe (Bearer DomainVerificationAuthToken) -> + Domain -> + Handler r DomainVerificationTokenResponse +requestDomainVerificationToken (fmap unBearer -> mAuthToken) domain = + lift . liftSem $ EnterpriseLogin.requestDomainVerificationToken mAuthToken domain + +requestDomainVerificationTeamToken :: + forall r. + (_) => + Local UserId -> + Domain -> + Handler r DomainVerificationTokenResponse +requestDomainVerificationTeamToken lusr domain = + lift . liftSem $ EnterpriseLogin.requestDomainVerificationTeamToken lusr domain + +updateDomainRedirect :: + (_) => + Bearer DomainVerificationAuthToken -> + Domain -> + DomainRedirectConfig -> + Handler r () +updateDomainRedirect (Bearer authToken) domain config = + lift . liftSem $ EnterpriseLogin.updateDomainRedirect authToken domain config + +updateTeamInvite :: + (_) => + Local UserId -> + Domain -> + TeamInviteConfig -> + Handler r () +updateTeamInvite lusr domain config = + lift . liftSem $ EnterpriseLogin.updateTeamInvite lusr domain config + +getDomainRegistration :: + (_) => + GetDomainRegistrationRequest -> + Handler r DomainRedirect +getDomainRegistration req = + lift . liftSem $ + EnterpriseLogin.getDomainRegistrationPublic req + -- Deprecated deprecatedOnboarding :: UserId -> JsonValue -> (Handler r) DeprecatedMatchingResult diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index eb7b06457e2..3dd13dd35b9 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -36,9 +36,11 @@ module Brig.App cargoholdLens, galleyLens, galleyEndpointLens, + sparEndpointLens, gundeckEndpointLens, cargoholdEndpointLens, federatorLens, + wireServerEnterpriseEndpointLens, casClientLens, smtpEnvLens, emailSenderLens, @@ -174,9 +176,11 @@ data Env = Env { cargohold :: RPC.Request, galley :: RPC.Request, galleyEndpoint :: Endpoint, + sparEndpoint :: Endpoint, gundeckEndpoint :: Endpoint, cargoholdEndpoint :: Endpoint, federator :: Maybe Endpoint, -- FUTUREWORK: should we use a better type here? E.g. to avoid fresh connections all the time? + wireServerEnterpriseEndpoint :: Endpoint, -- TODO: make this optional casClient :: Cas.ClientState, smtpEnv :: Maybe SMTP.SMTP, emailSender :: EmailAddress, @@ -269,9 +273,11 @@ newEnv opts = do { 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, casClient = cas, smtpEnv = emailSMTP, emailSender = opts.emailSMS.general.emailSender, diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index 71be677d8d1..67eec3f9bdb 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -90,6 +90,8 @@ import Wire.Sem.Random import Wire.Sem.Random.IO import Wire.SessionStore import Wire.SessionStore.Cassandra (interpretSessionStoreCassandra) +import Wire.SparAPIAccess (SparAPIAccess) +import Wire.SparAPIAccess.Rpc import Wire.TeamInvitationSubsystem import Wire.TeamInvitationSubsystem.Error import Wire.TeamInvitationSubsystem.Interpreter @@ -108,8 +110,8 @@ import Wire.VerificationCodeSubsystem.Interpreter type BrigCanonicalEffects = '[ AuthenticationSubsystem, TeamInvitationSubsystem, - UserSubsystem, - EnterpriseLoginSubsystem + EnterpriseLoginSubsystem, + UserSubsystem ] `Append` BrigLowerLevelEffects @@ -149,7 +151,7 @@ type BrigLowerLevelEffects = Input (Local ()), Input (Maybe AllowlistEmailDomains), Input TeamTemplates, - Input (Maybe EnterpriseLoginSubsystemConfig), + Input EnterpriseLoginSubsystemConfig, GundeckAPIAccess, FederationConfigStore, Jwk, @@ -162,6 +164,7 @@ type BrigLowerLevelEffects = Random, PasswordResetCodeStore, GalleyAPIAccess, + SparAPIAccess, EmailSending, Rpc, Metrics, @@ -247,6 +250,7 @@ runBrigToIO e (AppT ma) = do . runMetricsToIO . runRpcWithHttp e.httpManager e.requestId . emailSendingInterpreter e + . interpretSparAPIAccessToRpc e.sparEndpoint . interpretGalleyAPIAccessToRpc e.disabledVersions e.galleyEndpoint . passwordResetCodeStoreToCassandra @Cas.Client . randomToIO @@ -294,19 +298,30 @@ runBrigToIO e (AppT ma) = do . interpretPropertySubsystem propertySubsystemConfig . interpretVerificationCodeSubsystem . emailSubsystemInterpreter e.userTemplates e.teamTemplates e.templateBranding - . runEnterpriseLoginSubsystem . userSubsystemInterpreter + . runEnterpriseLoginSubsystem . runTeamInvitationSubsystem teamInvitationSubsystemConfig . authSubsystemInterpreter ) ) $ runReaderT ma e -mkEnterpriseLoginSubsystemConfig :: Env -> Maybe EnterpriseLoginSubsystemConfig -mkEnterpriseLoginSubsystemConfig env = do +mkEnterpriseLoginSubsystemEmailConfig :: Env -> Maybe EnterpriseLoginSubsystemEmailConfig +mkEnterpriseLoginSubsystemEmailConfig env = do recipient <- env.settings.auditLogEmailRecipient let sender = env.emailSender - pure $ EnterpriseLoginSubsystemConfig {auditEmailSender = sender, auditEmailRecipient = recipient} + pure + EnterpriseLoginSubsystemEmailConfig + { auditEmailSender = sender, + auditEmailRecipient = recipient + } + +mkEnterpriseLoginSubsystemConfig :: Env -> EnterpriseLoginSubsystemConfig +mkEnterpriseLoginSubsystemConfig env = + EnterpriseLoginSubsystemConfig + { emailConfig = mkEnterpriseLoginSubsystemEmailConfig env, + wireServerEnterpriseEndpoint = env.wireServerEnterpriseEndpoint + } rethrowHttpErrorIO :: (Member (Final IO) r) => InterpreterFor (Error HttpError) r rethrowHttpErrorIO act = do diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 1f44b17c0f6..1bfd116a577 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -376,10 +376,16 @@ data Opts = Opts cargohold :: !Endpoint, -- | Galley address galley :: !Endpoint, + -- | Spar address + spar :: !Endpoint, -- | Gundeck address gundeck :: !Endpoint, -- | Federator address federatorInternal :: !(Maybe Endpoint), + -- | Wire Server Enterprise address + -- TODO: This needs to be optional (`Maybe`): Not everbody with have the + -- enterprise service. + wireServerEnterprise :: !Endpoint, -- external -- | Cassandra settings From eb7b319b0d02e761ca91ab8273a7515057e92028 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 22 Jan 2025 10:47:25 +0100 Subject: [PATCH 05/12] Domain verification integration tests --- integration/integration.cabal | 3 + integration/test/API/Brig.hs | 37 ++ integration/test/Test/DNSMock.hs | 95 ++++ integration/test/Test/DomainVerification.hs | 488 ++++++++++++++++++++ integration/test/Test/EnterpriseLogin.hs | 9 +- integration/test/Testlib/Env.hs | 6 +- integration/test/Testlib/HTTP.hs | 4 + integration/test/Testlib/Types.hs | 19 +- services/integration.yaml | 5 + 9 files changed, 657 insertions(+), 9 deletions(-) create mode 100644 integration/test/Test/DNSMock.hs create mode 100644 integration/test/Test/DomainVerification.hs diff --git a/integration/integration.cabal b/integration/integration.cabal index c484885d4de..c477a8bd688 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -120,6 +120,8 @@ library Test.Connection Test.Conversation Test.Demo + Test.DNSMock + Test.DomainVerification Test.EJPD Test.EnterpriseLogin Test.Errors @@ -230,6 +232,7 @@ library , data-timeout , deriving-aeson , directory + , dns , errors , exceptions , extended diff --git a/integration/test/API/Brig.hs b/integration/test/API/Brig.hs index fad55b67595..93644cd3e0e 100644 --- a/integration/test/API/Brig.hs +++ b/integration/test/API/Brig.hs @@ -890,3 +890,40 @@ postServiceWhitelist user tid update = do "whitelist" ] submit "POST" (addJSON updateJson req) + +domainVerificationToken :: (HasCallStack, MakesValue domain) => domain -> String -> Maybe String -> App Response +domainVerificationToken domain registrationDomain mAuthToken = do + req <- baseRequest domain Brig Versioned $ joinHttpPath ["domain-verification", registrationDomain, "token"] + let req' = case mAuthToken of + Just authToken -> addHeader "Authorization" ("Bearer " <> authToken) req + Nothing -> req + submit "POST" req' + +domainVerificationTeamToken :: (HasCallStack, MakesValue user) => user -> String -> App Response +domainVerificationTeamToken user registrationDomain = do + req <- baseRequest user Brig Versioned $ joinHttpPath ["domain-verification", registrationDomain, "team-token"] + submit "POST" req + +-- brig expects an auth-token for this request. @mAuthToken@ is only `Maybe` for testing error cases! +updateDomainRedirect :: (HasCallStack, MakesValue domain) => domain -> String -> Maybe String -> Value -> App Response +updateDomainRedirect domain registrationDomain mAuthToken config = do + req <- + baseRequest domain Brig Versioned $ + joinHttpPath ["domain-verification", registrationDomain, "backend"] + let req' = case mAuthToken of + Just authToken -> addHeader "Authorization" ("Bearer " <> authToken) req + Nothing -> req + submit "POST" $ req' & addJSON config + +updateTeamInvite :: (HasCallStack, MakesValue user, MakesValue payload) => user -> String -> payload -> App Response +updateTeamInvite user registrationDomain payload = do + req <- + baseRequest user Brig Versioned $ + joinHttpPath ["domain-verification", registrationDomain, "team"] + p <- make payload + submit "POST" $ req & addJSON p + +getDomainRegistrationFromEmail :: (HasCallStack, MakesValue domain) => domain -> String -> App Response +getDomainRegistrationFromEmail domain email = do + req <- baseRequest domain Brig Versioned $ joinHttpPath ["get-domain-registration"] + submit "POST" $ req & addJSONObject ["email" .= email] diff --git a/integration/test/Test/DNSMock.hs b/integration/test/Test/DNSMock.hs new file mode 100644 index 00000000000..640183de250 --- /dev/null +++ b/integration/test/Test/DNSMock.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- TODO: merge with DomainVerification, EnterpriseLogin? +module Test.DNSMock where + +import Control.Lens +import Control.Monad.Reader.Class +import qualified Data.ByteString.Lazy as LBS +import Network.DNS +import Network.DNS.Decode as Dec +import qualified Network.HTTP.Client as HTTP +import Testlib.Prelude + +type LByteString = LBS.ByteString + +-- | Test that we can provide and lookup a TXT record in +-- Technitium (dns-server for tests) +testNewTXTRecord :: (HasCallStack) => App () +testNewTXTRecord = do + tok <- getTechnitiumApiKey + setTechnitiumReverseProxyACL tok "0.0.0.0/0" + registerTechnitiumZone tok "example.com" + registerTechnitiumRecord tok "example.com" "example.com" "TXT" "we own this domain and we're the good guys, trust us!" + + dohUrl <- technitiumDohUrl + let question = HTTP.RequestBodyBS $ encodeQuestion 0 (Question "example.com" TXT) mempty + req <- externalRequest dohUrl <&> addBody question "application/dns-message" . addHeader "Accept" "application/dns-message" + bindResponse (submit "POST" req) $ \resp -> do + let received :: Either DNSError DNSMessage = Dec.decode (resp.body :: ByteString) + expected :: Either DNSError DNSMessage = Right (DNSMessage {header = DNSHeader {identifier = 0, flags = DNSFlags {qOrR = QR_Response, opcode = OP_STD, authAnswer = True, trunCation = False, recDesired = True, recAvailable = True, rcode = NoErr, authenData = False, chkDisable = False}}, ednsHeader = EDNSheader (EDNS {ednsVersion = 0, ednsUdpSize = 1232, ednsDnssecOk = False, ednsOptions = []}), question = [Question {qname = "example.com.", qtype = TXT}], answer = [ResourceRecord {rrname = "example.com.", rrtype = TXT, rrclass = 1, rrttl = 3600, rdata = RD_TXT "we own this domain and we're the good guys, trrrrust us!"}], authority = [], additional = []}) + -- if we had aeson instances for DNSError and DNSMessage, we could get nicer error messages here, but meh. + show received `shouldMatch` show expected + +technitiumDohUrl :: App String +technitiumDohUrl = do + env <- ask + pure $ "http://" <> env.dnsMockServerConfig.host <> ":" <> show env.dnsMockServerConfig.dohPort <> "/dns-query" + +technitiumApiUrl :: App String +technitiumApiUrl = do + env <- ask + pure $ "http://" <> env.dnsMockServerConfig.host <> ":" <> show env.dnsMockServerConfig.apiPort <> "/api" + +getTechnitiumApiKey :: (HasCallStack) => App String +getTechnitiumApiKey = do + tok <- requestTechnitiumApiKey + setTechnitiumReverseProxyACL tok "0.0.0.0/0" + pure tok + +requestTechnitiumApiKey :: (HasCallStack) => App String +requestTechnitiumApiKey = do + url <- technitiumApiUrl <&> (<> "/user/createToken") + req <- externalRequest url <&> addQueryParams [("user", "admin"), ("pass", "admin"), ("tokenName", "someToken")] + bindResponse (submit "POST" req) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.jsonBody %. "status" `shouldMatch` ("ok" :: String) + asString $ resp.jsonBody %. "token" + +setTechnitiumReverseProxyACL :: (HasCallStack) => String -> String -> App () +setTechnitiumReverseProxyACL tok acl = do + url <- technitiumApiUrl <&> (<> "/settings/set") + req <- externalRequest url <&> addQueryParams [("token", tok), ("reverseProxyNetworkACL", acl)] + submit "POST" req >>= assertStatus 200 + +registerTechnitiumZone :: (HasCallStack) => String -> String -> App () +registerTechnitiumZone tok zone = do + url <- technitiumApiUrl <&> (<> "/zones/create") + req <- externalRequest url <&> addQueryParams [("token", tok), ("zone", zone), ("type", "primary")] + submit "POST" req >>= assertStatus 200 + +registerTechnitiumRecord :: (HasCallStack) => String -> String -> String -> String -> String -> App () +registerTechnitiumRecord tok zone domain typ text = do + url <- technitiumApiUrl <&> (<> "/zones/records/add") + let params = + [ ("token", tok), + ("zone", zone), + ("domain", domain), + ("type", typ), + ("text", text) + ] + req <- externalRequest url <&> addQueryParams params + submit "POST" req >>= assertStatus 200 + +deleteTechnitiumRecord :: (HasCallStack) => String -> String -> String -> String -> String -> App () +deleteTechnitiumRecord tok zone domain typ text = do + url <- technitiumApiUrl <&> (<> "/zones/records/delete") + let params = + [ ("token", tok), + ("zone", zone), + ("domain", domain), + ("type", typ), + ("text", text) + ] + req <- externalRequest url <&> addQueryParams params + submit "POST" req >>= assertStatus 200 diff --git a/integration/test/Test/DomainVerification.hs b/integration/test/Test/DomainVerification.hs new file mode 100644 index 00000000000..4f3f9fc20e4 --- /dev/null +++ b/integration/test/Test/DomainVerification.hs @@ -0,0 +1,488 @@ +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} + +-- | See also: "Test.EnterpriseLogin" +module Test.DomainVerification where + +import API.Brig +import API.BrigInternal +import API.Common +import API.GalleyInternal (setTeamFeatureLockStatus, setTeamFeatureStatus) +import SetupHelpers +import Test.DNSMock +import Testlib.Prelude + +mkDomainRedirectBackend :: String -> Value +mkDomainRedirectBackend url = object ["domain_redirect" .= "backend", "backend_url" .= url] + +testDomainVerificationOnPremFlow :: (HasCallStack) => App () +testDomainVerificationOnPremFlow = do + domain <- randomDomain + + -- [customer admin] fetch tokens + (authToken, dnsToken) <- + bindResponse (domainVerificationToken OwnDomain domain Nothing) $ \resp -> do + resp.status `shouldMatchInt` 200 + authToken <- resp.json %. "auth_token" & asString + dnsToken <- resp.json %. "dns_verification_token" & asString + pure (authToken, dnsToken) + + -- cannot set config for non-preauthorized domain + bindResponse + ( updateDomainRedirect + OwnDomain + domain + (Just authToken) + (mkDomainRedirectBackend "https://wire.example.com") + ) + $ \resp -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "operation-forbidden-for-domain-registration-state" + + -- [backoffice] preauth + domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204 + + -- [customer admin] post config without auth token (this is not allowed) + updateDomainRedirect + OwnDomain + domain + Nothing + (mkDomainRedirectBackend "https://wire.example.com") + >>= assertStatus 400 + + -- [customer admin] post config with auth token, but without creating the TXT DNS record + bindResponse + ( updateDomainRedirect + OwnDomain + domain + (Just authToken) + (mkDomainRedirectBackend "https://wire.example.com") + ) + $ \resp -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "domain-verification-failed" + + -- [customer admin] register TXT DNS record + tok <- getTechnitiumApiKey + registerTechnitiumZone tok domain + registerTechnitiumRecord tok domain ("wire-domain." <> domain) "TXT" "WRONG-DNS-TOKEN" + + -- [customer admin] post config with auth token, but with invalid TXT DNS record + bindResponse + ( updateDomainRedirect + OwnDomain + domain + (Just authToken) + (mkDomainRedirectBackend "https://wire.example.com") + ) + $ \resp -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "domain-verification-failed" + + registerTechnitiumRecord tok domain ("wire-domain." <> domain) "TXT" dnsToken + + -- [customer admin] post config (happy flow) + updateDomainRedirect + OwnDomain + domain + (Just authToken) + (mkDomainRedirectBackend "https://wire.example.com") + >>= assertStatus 200 + + void $ randomUser OwnDomain def {email = Just ("paolo@" <> domain)} + + -- [customer user] pull the redirect config based on email + bindResponse (getDomainRegistrationFromEmail OwnDomain ("sven@" ++ domain)) \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain_redirect" `shouldMatch` "backend" + resp.json %. "backend_url" `shouldMatch` "https://wire.example.com" + + -- [customer user] using a registered emails should return `none` + bindResponse (getDomainRegistrationFromEmail OwnDomain ("paolo@" ++ domain)) \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain_redirect" `shouldMatch` "none" + +testDomainVerificationWrongAuth :: (HasCallStack) => App () +testDomainVerificationWrongAuth = do + domain <- randomDomain + + -- [backoffice] preauth + domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204 + + -- [customer admin] fetch tokens + void $ domainVerificationToken OwnDomain domain Nothing >>= getJSON 200 + wrongToken <- generateWrongToken + + -- [customer admin] post config with wrong token + bindResponse + ( updateDomainRedirect + OwnDomain + domain + (Just wrongToken) + (mkDomainRedirectBackend "https://wire.example.com") + ) + $ \resp -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "domain-verification-failed" + where + generateWrongToken :: App String + generateWrongToken = do + domain <- randomDomain + tokens <- domainVerificationToken OwnDomain domain Nothing >>= getJSON 200 + tokens %. "auth_token" & asString + +testDomainVerificationOnPremFlowNoRegistration :: (HasCallStack) => App () +testDomainVerificationOnPremFlowNoRegistration = do + domain <- randomDomain + + -- [backoffice] preauth + domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204 + + -- [customer admin] fetch tokens + tokens <- domainVerificationToken OwnDomain domain Nothing >>= getJSON 200 + authToken <- tokens %. "auth_token" & asString + dnsToken <- tokens %. "dns_verification_token" & asString + + -- [customer admin] register TXT DNS record + tok <- getTechnitiumApiKey + registerTechnitiumZone tok domain + registerTechnitiumRecord tok domain ("wire-domain." <> domain) "TXT" dnsToken + + -- [customer admin] post no-registration config + updateDomainRedirect + OwnDomain + domain + (Just authToken) + (object ["domain_redirect" .= "no-registration"]) + >>= assertStatus 200 + + bindResponse (getDomainRegistrationFromEmail OwnDomain ("paolo@" ++ domain)) \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain_redirect" `shouldMatch` "no-registration" + +testDomainVerificationTokenIsVerifiedEverytime :: (HasCallStack) => App () +testDomainVerificationTokenIsVerifiedEverytime = do + domain <- randomDomain + + -- [backoffice] preauth + domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204 + + -- [customer admin] fetch tokens + tokens <- domainVerificationToken OwnDomain domain Nothing >>= getJSON 200 + authToken <- tokens %. "auth_token" & asString + dnsToken <- tokens %. "dns_verification_token" & asString + + -- [customer admin] register TXT DNS record + tok <- getTechnitiumApiKey + registerTechnitiumZone tok domain + registerTechnitiumRecord tok domain ("wire-domain." <> domain) "TXT" dnsToken + + -- [customer admin] post no-registration config + updateDomainRedirect + OwnDomain + domain + (Just authToken) + (object ["domain_redirect" .= "no-registration"]) + >>= assertStatus 200 + + bindResponse (getDomainRegistrationFromEmail OwnDomain ("paolo@" ++ domain)) \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain_redirect" `shouldMatch` "no-registration" + + deleteTechnitiumRecord tok domain ("wire-domain." <> domain) "TXT" dnsToken + registerTechnitiumRecord tok domain ("wire-domain." <> domain) "TXT" "WRONG-TOKEN" + + -- [customer admin] post no-registration config - should fail + bindResponse + ( updateDomainRedirect + OwnDomain + domain + (Just authToken) + (object ["domain_redirect" .= "remove"]) + ) + \resp -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "domain-verification-failed" + +testDomainVerificationRemoveFailure :: (HasCallStack) => App () +testDomainVerificationRemoveFailure = do + domain <- randomDomain + + -- [backoffice] preauth + domainRegistrationPreAuthorize OwnDomain domain >>= assertStatus 204 + + -- [customer admin] fetch tokens + tokens <- domainVerificationToken OwnDomain domain Nothing >>= getJSON 200 + authToken <- tokens %. "auth_token" & asString + dnsToken <- tokens %. "dns_verification_token" & asString + + -- [customer admin] register TXT DNS record + tok <- getTechnitiumApiKey + registerTechnitiumZone tok domain + registerTechnitiumRecord tok domain ("wire-domain." <> domain) "TXT" dnsToken + + bindResponse (getDomainRegistrationFromEmail OwnDomain ("paolo@" ++ domain)) \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain_redirect" `shouldMatch` "pre-authorized" + + -- [customer admin] try to remove entry + bindResponse + ( updateDomainRedirect + OwnDomain + domain + (Just authToken) + (object ["domain_redirect" .= "remove"]) + ) + $ \resp -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "operation-forbidden-for-domain-registration-state" + + -- check that it's still set to preauthorized + bindResponse (getDomainRegistrationFromEmail OwnDomain ("paolo@" ++ domain)) \resp -> do + resp.status `shouldMatchInt` 200 + + -- [customer admin] set it to no-registration, then remove + updateDomainRedirect + OwnDomain + domain + (Just authToken) + (object ["domain_redirect" .= "no-registration"]) + >>= assertStatus 200 + updateDomainRedirect + OwnDomain + domain + (Just authToken) + (object ["domain_redirect" .= "remove"]) + >>= assertStatus 200 + + -- removing again should fail + bindResponse + ( updateDomainRedirect + OwnDomain + domain + (Just authToken) + (object ["domain_redirect" .= "remove"]) + ) + $ \resp -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "operation-forbidden-for-domain-registration-state" + +testDomainVerificationLockedState :: (HasCallStack) => App () +testDomainVerificationLockedState = do + domain <- randomDomain + + -- [backoffice] lock the domain (public email provider) + domainRegistrationLock OwnDomain domain >>= assertStatus 204 + + -- tokens can still be fetched + tokens <- domainVerificationToken OwnDomain domain Nothing >>= getJSON 200 + authToken <- tokens %. "auth_token" & asString + dnsToken <- tokens %. "dns_verification_token" & asString + + -- register DNS record + tok <- getTechnitiumApiKey + registerTechnitiumZone tok domain + registerTechnitiumRecord tok domain ("wire-domain." <> domain) "TXT" dnsToken + + -- domain redirect cannot be updated + bindResponse + ( updateDomainRedirect + OwnDomain + domain + (Just authToken) + (object ["domain_redirect" .= "no-registration"]) + ) + $ \resp -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "operation-forbidden-for-domain-registration-state" + +testDomainVerificationLockedStateTeam :: (HasCallStack) => App () +testDomainVerificationLockedStateTeam = do + domain <- randomDomain + (owner, tid, _m : _) <- createTeam OwnDomain 2 + + -- set conference calling (paying team) + assertSuccess =<< do + setTeamFeatureLockStatus owner tid "conferenceCalling" "unlocked" + setTeamFeatureStatus owner tid "conferenceCalling" "enabled" + + -- [backoffice] lock the domain (public email provider) + domainRegistrationLock OwnDomain domain >>= assertStatus 204 + + -- tokens can still be fetched + tokens <- domainVerificationTeamToken owner domain >>= getJSON 200 + dnsToken <- tokens %. "dns_verification_token" & asString + + -- register DNS record + tok <- getTechnitiumApiKey + registerTechnitiumZone tok domain + registerTechnitiumRecord tok domain ("wire-domain." <> domain) "TXT" dnsToken + + -- team invite cannot be updated + bindResponse + ( updateTeamInvite + owner + domain + (object ["team_invite" .= "not-allowed"]) + ) + $ \resp -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "operation-forbidden-for-domain-registration-state" + +testUpdateTeamInvite :: (HasCallStack) => App () +testUpdateTeamInvite = do + (owner, tid, mem : _) <- createTeam OwnDomain 2 + + domain <- randomDomain + + bindResponse (domainVerificationTeamToken owner domain) $ \resp -> do + resp.status `shouldMatchInt` 402 + resp.json %. "label" `shouldMatch` "domain-registration-updated-payment-required" + + -- set conference calling (paying team) + assertSuccess =<< do + setTeamFeatureLockStatus owner tid "conferenceCalling" "unlocked" + setTeamFeatureStatus owner tid "conferenceCalling" "enabled" + + bindResponse (domainVerificationTeamToken mem domain) $ \resp -> do + resp.status `shouldMatchInt` 401 + resp.json %. "label" `shouldMatch` "domain-registration-updated-auth-failure" + + -- [customer admin] fetch tokens + tokens <- domainVerificationTeamToken owner domain >>= getJSON 200 + dnsToken <- tokens %. "dns_verification_token" & asString + + -- [customer admin] register TXT DNS record + tok <- getTechnitiumApiKey + registerTechnitiumZone tok domain + registerTechnitiumRecord tok domain ("wire-domain." <> domain) "TXT" dnsToken + + -- setting team invite to the wrong team should fail + fakeTeamId <- randomId + updateTeamInvite owner domain (object ["team_invite" .= "team", "team" .= fakeTeamId]) + >>= assertStatus 401 + + -- non-admin should not be able to set team-invite + bindResponse + ( updateTeamInvite mem domain (object ["team_invite" .= "team", "team" .= tid]) + ) + $ \resp -> do + resp.status `shouldMatchInt` 401 + resp.json %. "label" `shouldMatch` "domain-registration-updated-auth-failure" + + -- [customer admin] set team-invite to team + updateTeamInvite owner domain (object ["team_invite" .= "team", "team" .= tid]) + >>= assertStatus 200 + + bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain" `shouldMatch` domain + resp.json %. "domain_redirect" `shouldMatch` "none" + resp.json %. "team_invite" `shouldMatch` "team" + resp.json %. "team" `shouldMatch` tid + + bindResponse (getDomainRegistrationFromEmail OwnDomain ("paolo@" ++ domain)) \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain_redirect" `shouldMatch` "none" + + -- [customer admin] set team-invite to not-allowed + updateTeamInvite owner domain (object ["team_invite" .= "not-allowed"]) + >>= assertStatus 200 + + bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain" `shouldMatch` domain + resp.json %. "domain_redirect" `shouldMatch` "none" + resp.json %. "team_invite" `shouldMatch` "not-allowed" + + bindResponse (getDomainRegistrationFromEmail OwnDomain ("paolo@" ++ domain)) \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain_redirect" `shouldMatch` "none" + +testUpdateTeamInviteSSO :: (HasCallStack) => App () +testUpdateTeamInviteSSO = do + (owner, tid, _m : _) <- createTeam OwnDomain 2 + + -- set conference calling (paying team) + assertSuccess =<< do + setTeamFeatureLockStatus owner tid "conferenceCalling" "unlocked" + setTeamFeatureStatus owner tid "conferenceCalling" "enabled" + + domain <- randomDomain + + -- [customer admin] fetch tokens + tokens <- domainVerificationTeamToken owner domain >>= getJSON 200 + dnsToken <- tokens %. "dns_verification_token" & asString + + -- [customer admin] register TXT DNS record + tok <- getTechnitiumApiKey + registerTechnitiumZone tok domain + registerTechnitiumRecord tok domain ("wire-domain." <> domain) "TXT" dnsToken + + -- [customer admin] post team-invite config with an invalid idp + fakeIdP <- randomId + updateTeamInvite owner domain (object ["team_invite" .= "allowed", "sso" .= fakeIdP]) + >>= assertStatus 403 + + -- [customer admin] register a new idp and use it to set a team-invite config + void $ setTeamFeatureStatus owner tid "sso" "enabled" + idp <- bindResponse (registerTestIdPWithMeta owner) $ \resp -> do + resp.status `shouldMatchInt` 201 + resp.json %. "id" + updateTeamInvite owner domain (object ["team_invite" .= "allowed", "sso" .= idp]) + >>= assertStatus 200 + + bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain" `shouldMatch` domain + resp.json %. "domain_redirect" `shouldMatch` "sso" + resp.json %. "team_invite" `shouldMatch` "allowed" + resp.json %. "sso_code" `shouldMatch` idp + + bindResponse (getDomainRegistrationFromEmail OwnDomain ("paolo@" ++ domain)) \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain_redirect" `shouldMatch` "sso" + resp.json %. "sso_code" `shouldMatch` idp + +testUpdateTeamInviteLocked :: (HasCallStack) => App () +testUpdateTeamInviteLocked = do + (owner, tid, _m : _) <- createTeam OwnDomain 2 + + -- set conference calling (paying team) + assertSuccess =<< do + setTeamFeatureLockStatus owner tid "conferenceCalling" "unlocked" + setTeamFeatureStatus owner tid "conferenceCalling" "enabled" + + domain <- randomDomain + + -- [customer admin] fetch tokens + tokens <- domainVerificationTeamToken owner domain >>= getJSON 200 + dnsToken <- tokens %. "dns_verification_token" & asString + + -- [customer admin] register TXT DNS record + tok <- getTechnitiumApiKey + registerTechnitiumZone tok domain + registerTechnitiumRecord tok domain ("wire-domain." <> domain) "TXT" dnsToken + + -- set domain-redirect to locked + domainRegistrationLock OwnDomain domain >>= assertStatus 204 + + -- setting team-invite to not-allowed should fail for locked domains + bindResponse (updateTeamInvite owner domain (object ["team_invite" .= "not-allowed"])) $ \resp -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "operation-forbidden-for-domain-registration-state" + + updateDomainRegistration + OwnDomain + domain + ( object + [ "domain_redirect" .= "backend", + "team_invite" .= "not-allowed", + "backend_url" .= "https://wire.example.com" + ] + ) + >>= assertStatus 204 + + -- setting team-invite to allowed should fail for on-prem domains + bindResponse (updateTeamInvite owner domain (object ["team_invite" .= "allowed"])) $ \resp -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "operation-forbidden-for-domain-registration-state" diff --git a/integration/test/Test/EnterpriseLogin.hs b/integration/test/Test/EnterpriseLogin.hs index 342ef04cd38..9654a50463c 100644 --- a/integration/test/Test/EnterpriseLogin.hs +++ b/integration/test/Test/EnterpriseLogin.hs @@ -1,3 +1,4 @@ +-- | See also: "Test.DomainVerification" module Test.EnterpriseLogin where import API.BrigInternal @@ -144,7 +145,7 @@ testDomainRegistrationUpdate = do updateDomain domain $ object [ "domain_redirect" .= "sso", - "sso_idp_id" .= "f82bad56-df61-49c0-bc9a-dc45c8ee1000", + "sso_code" .= "f82bad56-df61-49c0-bc9a-dc45c8ee1000", "team_invite" .= "allowed" ] updateDomain domain @@ -167,7 +168,7 @@ testDomainRegistrationUpdate = do resp.json %. "domain_redirect" `shouldMatch` (update %. "domain_redirect") resp.json %. "team_invite" `shouldMatch` (update %. "team_invite") lookupField resp.json "backend_url" `shouldMatch` lookupField update "backend_url" - lookupField resp.json "sso_idp_id" `shouldMatch` lookupField update "sso_idp_id" + lookupField resp.json "sso_code" `shouldMatch` lookupField update "sso_code" lookupField resp.json "team" `shouldMatch` lookupField update "team" testDomainRegistrationUpdateInvalidCases :: App () @@ -258,7 +259,7 @@ testDomainRegistrationUnAuthorizeFailureWhenSso = do let update = object [ "domain_redirect" .= "sso", - "sso_idp_id" .= "f82bad56-df61-49c0-bc9a-dc45c8ee1000", + "sso_code" .= "f82bad56-df61-49c0-bc9a-dc45c8ee1000", "team_invite" .= "team", "team" .= "3bc23f21-dc03-4922-9563-c3beedf895db" ] @@ -276,7 +277,7 @@ testDomainRegistrationDelete = do let update = object [ "domain_redirect" .= "sso", - "sso_idp_id" .= "f82bad56-df61-49c0-bc9a-dc45c8ee1000", + "sso_code" .= "f82bad56-df61-49c0-bc9a-dc45c8ee1000", "team_invite" .= "team", "team" .= "3bc23f21-dc03-4922-9563-c3beedf895db" ] diff --git a/integration/test/Testlib/Env.hs b/integration/test/Testlib/Env.hs index d14cb630a17..d0b8d745efd 100644 --- a/integration/test/Testlib/Env.hs +++ b/integration/test/Testlib/Env.hs @@ -112,7 +112,8 @@ mkGlobalEnv cfgFile = do gRabbitMQConfigV0 = intConfig.rabbitmqV0, gRabbitMQConfigV1 = intConfig.rabbitmqV1, gTempDir = tempDir, - gTimeOutSeconds = timeOutSeconds + gTimeOutSeconds = timeOutSeconds, + gDNSMockServerConfig = intConfig.dnsMockServer } where createSSLContext :: Maybe FilePath -> IO (Maybe OpenSSL.SSLContext) @@ -162,7 +163,8 @@ mkEnv currentTestName ge = do resourcePool = ge.gBackendResourcePool, rabbitMQConfig = ge.gRabbitMQConfig, timeOutSeconds = ge.gTimeOutSeconds, - currentTestName + currentTestName, + dnsMockServerConfig = ge.gDNSMockServerConfig } allCiphersuites :: [Ciphersuite] diff --git a/integration/test/Testlib/HTTP.hs b/integration/test/Testlib/HTTP.hs index 0b919db3c7c..5b883d4873a 100644 --- a/integration/test/Testlib/HTTP.hs +++ b/integration/test/Testlib/HTTP.hs @@ -165,6 +165,10 @@ rawBaseRequest domain service versioned path = do let HostPort h p = serviceHostPort serviceMap service in "http://" <> h <> ":" <> show p <> ("/" <> joinHttpPath (pathSegsPrefix <> splitHttpPath path)) +-- | The bare minimum to ge a `HTTP.Request` given a URL +externalRequest :: String -> App HTTP.Request +externalRequest = liftIO . HTTP.parseRequest + getAPIVersionFor :: (MakesValue domain) => domain -> App Int getAPIVersionFor domain = do d <- asString domain diff --git a/integration/test/Testlib/Types.hs b/integration/test/Testlib/Types.hs index aa3a1639aa6..16cd6457b9f 100644 --- a/integration/test/Testlib/Types.hs +++ b/integration/test/Testlib/Types.hs @@ -105,6 +105,15 @@ instance FromJSON RabbitMQConfig where <*> ob .: fromString "tls" <*> ob .: fromString "vHost" +data DNSMockServerConfig = DNSMockServerConfig + { host :: !String, + apiPort :: !Word16, + dohPort :: !Word16 + } + deriving (Show, Generic) + +instance FromJSON DNSMockServerConfig + -- | Initialised once per testsuite. data GlobalEnv = GlobalEnv { gServiceMap :: Map String ServiceMap, @@ -122,7 +131,8 @@ data GlobalEnv = GlobalEnv gRabbitMQConfigV0 :: RabbitMQConfig, gRabbitMQConfigV1 :: RabbitMQConfig, gTempDir :: FilePath, - gTimeOutSeconds :: Int + gTimeOutSeconds :: Int, + gDNSMockServerConfig :: DNSMockServerConfig } data IntegrationConfig = IntegrationConfig @@ -135,7 +145,8 @@ data IntegrationConfig = IntegrationConfig rabbitmq :: RabbitMQConfig, rabbitmqV0 :: RabbitMQConfig, rabbitmqV1 :: RabbitMQConfig, - cassandra :: CassandraConfig + cassandra :: CassandraConfig, + dnsMockServer :: DNSMockServerConfig } deriving (Show, Generic) @@ -153,6 +164,7 @@ instance FromJSON IntegrationConfig where <*> o .: fromString "rabbitmq-v0" <*> o .: fromString "rabbitmq-v1" <*> o .: fromString "cassandra" + <*> o .: fromString "dnsMockServer" data ServiceMap = ServiceMap { brig :: HostPort, @@ -229,7 +241,8 @@ data Env = Env resourcePool :: ResourcePool BackendResource, rabbitMQConfig :: RabbitMQConfig, timeOutSeconds :: Int, - currentTestName :: Maybe String + currentTestName :: Maybe String, + dnsMockServerConfig :: DNSMockServerConfig } data Response = Response diff --git a/services/integration.yaml b/services/integration.yaml index ffcff1f945a..fb44243945f 100644 --- a/services/integration.yaml +++ b/services/integration.yaml @@ -183,6 +183,11 @@ cassandra: host: 127.0.0.1 port: 9042 +dnsMockServer: + host: localhost + apiPort: 5380 + dohPort: 5381 + federation-v0: originDomain: federation-v0.example.com brig: From ca4e56f85623e640badebec39aa103b427161724 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 21 Jan 2025 16:07:05 +0100 Subject: [PATCH 06/12] Add domain verification endpoints to nginx conf --- charts/nginz/values.yaml | 11 +++++++++++ .../nginz/integration-test/conf/nginz/nginx.conf | 15 +++++++++++++++ 2 files changed, 26 insertions(+) diff --git a/charts/nginz/values.yaml b/charts/nginz/values.yaml index 6614cae2a0c..948758d6efc 100644 --- a/charts/nginz/values.yaml +++ b/charts/nginz/values.yaml @@ -471,6 +471,17 @@ nginx_conf: - path: /upgrade-personal-to-team$ envs: - all + - path: /domain-verification/([^/]*)/team(-token)?$ + envs: + - all + - path: /domain-verification/ + envs: + - all + disable_zauth: true + - path: /get-domain-registration$ + envs: + - all + disable_zauth: true galley: - path: /conversations/code-check disable_zauth: true diff --git a/services/nginz/integration-test/conf/nginz/nginx.conf b/services/nginz/integration-test/conf/nginz/nginx.conf index f674540cd5d..208f5a53a27 100644 --- a/services/nginz/integration-test/conf/nginz/nginx.conf +++ b/services/nginz/integration-test/conf/nginz/nginx.conf @@ -349,6 +349,21 @@ http { proxy_pass http://brig; } + location ~* ^(/v[0-9]+)?/domain-verification/(.*)/team(-token)?$ { + include common_response_with_zauth.conf; + proxy_pass http://brig; + } + + location ~* ^(/v[0-9]+)?/domain-verification/ { + include common_response_no_zauth.conf; + proxy_pass http://brig; + } + + location ~* ^(/v[0-9]+)?/get-domain-registration$ { + include common_response_no_zauth.conf; + proxy_pass http://brig; + } + # Cargohold Endpoints location ~* ^(/v[0-9]+)?/assets { From ac2d09c70df0d99913e855eed52065527ef90964 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 22 Jan 2025 13:49:13 +0100 Subject: [PATCH 07/12] Add CHANGELOG entry --- changelog.d/1-api-changes/WPB-14307 | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 changelog.d/1-api-changes/WPB-14307 diff --git a/changelog.d/1-api-changes/WPB-14307 b/changelog.d/1-api-changes/WPB-14307 new file mode 100644 index 00000000000..67bc88681c2 --- /dev/null +++ b/changelog.d/1-api-changes/WPB-14307 @@ -0,0 +1,6 @@ +New endpoints for domain registration and verification: +- POST /domain-verification/:domain/token +- POST /domain-verification/:domain/backend +- POST /domain-verification/:domain/team-token +- POST /domain-verification/:domain/team +- POST /get-domain-registration From 1d87ea25f7d5651bf726922e5dbd1daf1373146c Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 23 Jan 2025 08:55:10 +0100 Subject: [PATCH 08/12] Fix DNS test and prevent UTF8 crash --- integration/test/Test/DNSMock.hs | 2 +- integration/test/Testlib/Assertions.hs | 7 ++++--- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/integration/test/Test/DNSMock.hs b/integration/test/Test/DNSMock.hs index 640183de250..5a4e8808885 100644 --- a/integration/test/Test/DNSMock.hs +++ b/integration/test/Test/DNSMock.hs @@ -27,7 +27,7 @@ testNewTXTRecord = do req <- externalRequest dohUrl <&> addBody question "application/dns-message" . addHeader "Accept" "application/dns-message" bindResponse (submit "POST" req) $ \resp -> do let received :: Either DNSError DNSMessage = Dec.decode (resp.body :: ByteString) - expected :: Either DNSError DNSMessage = Right (DNSMessage {header = DNSHeader {identifier = 0, flags = DNSFlags {qOrR = QR_Response, opcode = OP_STD, authAnswer = True, trunCation = False, recDesired = True, recAvailable = True, rcode = NoErr, authenData = False, chkDisable = False}}, ednsHeader = EDNSheader (EDNS {ednsVersion = 0, ednsUdpSize = 1232, ednsDnssecOk = False, ednsOptions = []}), question = [Question {qname = "example.com.", qtype = TXT}], answer = [ResourceRecord {rrname = "example.com.", rrtype = TXT, rrclass = 1, rrttl = 3600, rdata = RD_TXT "we own this domain and we're the good guys, trrrrust us!"}], authority = [], additional = []}) + expected :: Either DNSError DNSMessage = Right (DNSMessage {header = DNSHeader {identifier = 0, flags = DNSFlags {qOrR = QR_Response, opcode = OP_STD, authAnswer = True, trunCation = False, recDesired = True, recAvailable = True, rcode = NoErr, authenData = False, chkDisable = False}}, ednsHeader = EDNSheader (EDNS {ednsVersion = 0, ednsUdpSize = 1232, ednsDnssecOk = False, ednsOptions = []}), question = [Question {qname = "example.com.", qtype = TXT}], answer = [ResourceRecord {rrname = "example.com.", rrtype = TXT, rrclass = 1, rrttl = 3600, rdata = RD_TXT "we own this domain and we're the good guys, trust us!"}], authority = [], additional = []}) -- if we had aeson instances for DNSError and DNSMessage, we could get nicer error messages here, but meh. show received `shouldMatch` show expected diff --git a/integration/test/Testlib/Assertions.hs b/integration/test/Testlib/Assertions.hs index f31e8b7814c..3c0a87ecd11 100644 --- a/integration/test/Testlib/Assertions.hs +++ b/integration/test/Testlib/Assertions.hs @@ -26,6 +26,7 @@ import qualified Data.Map as Map import Data.Maybe (isJust, mapMaybe) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text +import qualified Data.Text.Encoding.Error as Text import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL import GHC.Stack as Stack @@ -158,7 +159,7 @@ shouldMatchBase64 :: b -> App () a `shouldMatchBase64` b = do - xa <- Text.decodeUtf8 . B64.decodeLenient . Text.encodeUtf8 . Text.pack <$> asString a + xa <- Text.decodeUtf8With Text.lenientDecode . B64.decodeLenient . Text.encodeUtf8 . Text.pack <$> asString a xa `shouldMatch` b shouldNotMatch :: @@ -394,14 +395,14 @@ prettyResponse r = Nothing -> [] Just b -> [ colored yellow "request body:", - Text.unpack . Text.decodeUtf8 $ case Aeson.decode (BS.fromStrict b) of + Text.unpack . Text.decodeUtf8With Text.lenientDecode $ case Aeson.decode (BS.fromStrict b) of Just v -> BS.toStrict (Aeson.encodePretty (v :: Aeson.Value)) Nothing -> hex b ], pure $ colored blue "response status: " <> show r.status, pure $ colored blue "response body:", pure $ - ( TL.unpack . TL.decodeUtf8 $ + ( TL.unpack . TL.decodeUtf8With Text.lenientDecode $ case r.jsonBody of Just b -> (Aeson.encodePretty b) Nothing -> BS.fromStrict r.body From 1143dc9606200701973ba562796f8136b14376e6 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 23 Jan 2025 09:27:14 +0100 Subject: [PATCH 09/12] fixup! Setup DoH and wire-server-enterprise --- .gitmodules | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 30f51ea49ce..de3af4ff464 100644 --- a/.gitmodules +++ b/.gitmodules @@ -4,5 +4,4 @@ [submodule "services/wire-server-enterprise"] path = services/wire-server-enterprise url = https://github.com/wireapp/wire-server-enterprise - # TODO: Change the `branch` back to `main` - branch = WPB-14307-domain-registration-endpoints + branch = main From 7ad961aee132dd48b03a49eade9aa101767139aa Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 23 Jan 2025 09:59:01 +0100 Subject: [PATCH 10/12] Make enterprise service endpoint optional in brig --- libs/wire-api/src/Wire/API/Error/Brig.hs | 3 +++ .../Wire/EnterpriseLoginSubsystem/Error.hs | 2 ++ .../EnterpriseLoginSubsystem/Interpreter.hs | 24 ++++++++++++++++++- .../src/Wire/EnterpriseLoginSubsystem/Null.hs | 13 ++++++++++ libs/wire-subsystems/wire-subsystems.cabal | 1 + services/brig/src/Brig/App.hs | 2 +- .../brig/src/Brig/CanonicalInterpreter.hs | 22 ++++++++++------- services/brig/src/Brig/Options.hs | 4 +--- 8 files changed, 57 insertions(+), 14 deletions(-) create mode 100644 libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Null.hs diff --git a/libs/wire-api/src/Wire/API/Error/Brig.hs b/libs/wire-api/src/Wire/API/Error/Brig.hs index 7367cd74d35..81ae8550ae7 100644 --- a/libs/wire-api/src/Wire/API/Error/Brig.hs +++ b/libs/wire-api/src/Wire/API/Error/Brig.hs @@ -113,6 +113,7 @@ data BrigError | DomainVerificationInvalidAuthToken | DomainVerificationAuthFailure | DomainVerificationPaymentRequired + | DomainVerificationNotEnabled instance (Typeable (MapError e), KnownError (MapError e)) => IsSwaggerError (e :: BrigError) where addToOpenApi = addStaticErrorToSwagger @(MapError e) @@ -337,3 +338,5 @@ type instance MapError 'DomainVerificationInvalidAuthToken = 'StaticError 403 "i type instance MapError 'DomainVerificationAuthFailure = 'StaticError 401 "domain-registration-updated-auth-failure" "Domain registration updated auth failure" type instance MapError 'DomainVerificationPaymentRequired = 'StaticError 402 "domain-registration-updated-payment-required" "Domain registration updated payment required" + +type instance MapError 'DomainVerificationNotEnabled = 'StaticError 503 "enterprise-service-not-enabled" "Enterprise service not enabled" diff --git a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Error.hs b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Error.hs index d4794080259..e598a6452d7 100644 --- a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Error.hs +++ b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Error.hs @@ -23,6 +23,7 @@ data EnterpriseLoginSubsystemError | EnterpriseLoginSubsystemInvalidAuthToken | EnterpriseLoginSubsystemAuthFailure | EnterpriseLoginSubsystemPaymentRequired + | EnterpriseLoginSubsystemNotEnabled deriving (Show, Eq, Generic) deriving (Arbitrary) via (GenericUniform EnterpriseLoginSubsystemError) @@ -63,3 +64,4 @@ enterpriseLoginSubsystemErrorToHttpError = EnterpriseLoginSubsystemInvalidAuthToken -> errorToWai @DomainVerificationInvalidAuthToken EnterpriseLoginSubsystemAuthFailure -> errorToWai @DomainVerificationAuthFailure EnterpriseLoginSubsystemPaymentRequired -> errorToWai @DomainVerificationPaymentRequired + EnterpriseLoginSubsystemNotEnabled -> errorToWai @DomainVerificationNotEnabled diff --git a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs index 1072ced192d..8bc6a7ff215 100644 --- a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs @@ -3,7 +3,8 @@ {-# OPTIONS_GHC -Wno-ambiguous-fields #-} module Wire.EnterpriseLoginSubsystem.Interpreter - ( runEnterpriseLoginSubsystem, + ( runEnterpriseLoginSubsystemWithConfig, + runEnterpriseLoginSubsystem, EnterpriseLoginSubsystemConfig (..), EnterpriseLoginSubsystemEmailConfig (..), ) @@ -65,6 +66,27 @@ data EnterpriseLoginSubsystemConfig = EnterpriseLoginSubsystemConfig wireServerEnterpriseEndpoint :: Endpoint } +runEnterpriseLoginSubsystemWithConfig :: + ( Member DomainRegistrationStore r, + Member (Error EnterpriseLoginSubsystemError) r, + Member (Error ParseException) r, + Member GalleyAPIAccess r, + Member SparAPIAccess r, + Member TinyLog r, + Member EmailSending r, + Member Random r, + Member Rpc r, + Member UserKeyStore r, + Member UserSubsystem r + ) => + EnterpriseLoginSubsystemConfig -> + Sem (EnterpriseLoginSubsystem ': r) a -> + Sem r a +runEnterpriseLoginSubsystemWithConfig config = + runInputConst config + . runEnterpriseLoginSubsystem + . raiseUnder + runEnterpriseLoginSubsystem :: ( Member DomainRegistrationStore r, Member (Error EnterpriseLoginSubsystemError) r, diff --git a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Null.hs b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Null.hs new file mode 100644 index 00000000000..160ff9c1fc1 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Null.hs @@ -0,0 +1,13 @@ +module Wire.EnterpriseLoginSubsystem.Null (runEnterpriseLoginSubsystemNoConfig) where + +import Imports +import Polysemy +import Polysemy.Error +import Wire.EnterpriseLoginSubsystem +import Wire.EnterpriseLoginSubsystem.Error + +runEnterpriseLoginSubsystemNoConfig :: + (Member (Error EnterpriseLoginSubsystemError) r) => + InterpreterFor EnterpriseLoginSubsystem r +runEnterpriseLoginSubsystemNoConfig = interpret $ \_ -> + throw EnterpriseLoginSubsystemNotEnabled diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index e91266abbac..b71fa3a4f0e 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -90,6 +90,7 @@ library Wire.EnterpriseLoginSubsystem Wire.EnterpriseLoginSubsystem.Error Wire.EnterpriseLoginSubsystem.Interpreter + Wire.EnterpriseLoginSubsystem.Null Wire.Error Wire.Events Wire.FederationAPIAccess diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index 3dd13dd35b9..a846735489e 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -180,7 +180,7 @@ data Env = Env gundeckEndpoint :: Endpoint, cargoholdEndpoint :: Endpoint, federator :: Maybe Endpoint, -- FUTUREWORK: should we use a better type here? E.g. to avoid fresh connections all the time? - wireServerEnterpriseEndpoint :: Endpoint, -- TODO: make this optional + wireServerEnterpriseEndpoint :: Maybe Endpoint, casClient :: Cas.ClientState, smtpEnv :: Maybe SMTP.SMTP, emailSender :: EmailAddress, diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index 67eec3f9bdb..db662f0cb2a 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -50,6 +50,7 @@ import Wire.EmailSubsystem.Interpreter import Wire.EnterpriseLoginSubsystem import Wire.EnterpriseLoginSubsystem.Error (EnterpriseLoginSubsystemError, enterpriseLoginSubsystemErrorToHttpError) import Wire.EnterpriseLoginSubsystem.Interpreter +import Wire.EnterpriseLoginSubsystem.Null import Wire.Error import Wire.Events import Wire.FederationAPIAccess qualified @@ -151,7 +152,6 @@ type BrigLowerLevelEffects = Input (Local ()), Input (Maybe AllowlistEmailDomains), Input TeamTemplates, - Input EnterpriseLoginSubsystemConfig, GundeckAPIAccess, FederationConfigStore, Jwk, @@ -263,7 +263,6 @@ runBrigToIO e (AppT ma) = do . interpretJwk . interpretFederationDomainConfig e.casClient e.settings.federationStrategy (foldMap (remotesMapFromCfgFile . fmap (.federationDomainConfig)) e.settings.federationDomainConfigs) . runGundeckAPIAccess e.gundeckEndpoint - . runInputConst (mkEnterpriseLoginSubsystemConfig e) . runInputConst (teamTemplatesNoLocale e) . runInputConst e.settings.allowlistEmailDomains . runInputConst (toLocalUnsafe e.settings.federationDomain ()) @@ -299,7 +298,10 @@ runBrigToIO e (AppT ma) = do . interpretVerificationCodeSubsystem . emailSubsystemInterpreter e.userTemplates e.teamTemplates e.templateBranding . userSubsystemInterpreter - . runEnterpriseLoginSubsystem + . maybe + runEnterpriseLoginSubsystemNoConfig + runEnterpriseLoginSubsystemWithConfig + (mkEnterpriseLoginSubsystemConfig e) . runTeamInvitationSubsystem teamInvitationSubsystemConfig . authSubsystemInterpreter ) @@ -316,12 +318,14 @@ mkEnterpriseLoginSubsystemEmailConfig env = do auditEmailRecipient = recipient } -mkEnterpriseLoginSubsystemConfig :: Env -> EnterpriseLoginSubsystemConfig -mkEnterpriseLoginSubsystemConfig env = - EnterpriseLoginSubsystemConfig - { emailConfig = mkEnterpriseLoginSubsystemEmailConfig env, - wireServerEnterpriseEndpoint = env.wireServerEnterpriseEndpoint - } +mkEnterpriseLoginSubsystemConfig :: Env -> Maybe EnterpriseLoginSubsystemConfig +mkEnterpriseLoginSubsystemConfig env = do + endpoint <- env.wireServerEnterpriseEndpoint + pure + EnterpriseLoginSubsystemConfig + { emailConfig = mkEnterpriseLoginSubsystemEmailConfig env, + wireServerEnterpriseEndpoint = endpoint + } rethrowHttpErrorIO :: (Member (Final IO) r) => InterpreterFor (Error HttpError) r rethrowHttpErrorIO act = do diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 1bfd116a577..5bc7b0c4210 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -383,9 +383,7 @@ data Opts = Opts -- | Federator address federatorInternal :: !(Maybe Endpoint), -- | Wire Server Enterprise address - -- TODO: This needs to be optional (`Maybe`): Not everbody with have the - -- enterprise service. - wireServerEnterprise :: !Endpoint, + wireServerEnterprise :: !(Maybe Endpoint), -- external -- | Cassandra settings From c36e2f58d1f87b03647ac39462e255d5817f4d23 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 23 Jan 2025 10:25:47 +0100 Subject: [PATCH 11/12] Disable enterprise service on the second backend --- hack/helmfile.yaml | 13 ------------- integration/test/Test/DomainVerification.hs | 5 +++++ integration/test/Testlib/ModService.hs | 7 ++++++- integration/test/Testlib/ResourcePool.hs | 5 +++++ integration/test/Testlib/Types.hs | 2 ++ 5 files changed, 18 insertions(+), 14 deletions(-) diff --git a/hack/helmfile.yaml b/hack/helmfile.yaml index 00ba41b6af0..a2018cdd712 100644 --- a/hack/helmfile.yaml +++ b/hack/helmfile.yaml @@ -247,9 +247,6 @@ releases: value: {{ .Values.federationDomain2 }} - name: cargohold.config.settings.federationDomain value: {{ .Values.federationDomain2 }} - # TODO: This should be disabled later (fixes a deployment issue now) - - name: brig.config.wireServerEnterprise.enabled - value: true needs: - 'databases-ephemeral' @@ -265,16 +262,6 @@ releases: - name: config.dnsOverHttpsUrl value: 'http://technitium-dnsserver:5381/dns-query' - # TODO: This should be removed later (fixes a deployment issue now) - - name: wire-server-enterprise - namespace: '{{ .Values.namespace2 }}' - chart: '../.local/charts/wire-server-enterprise' - values: - - secrets: - configJson: {{ requiredEnv "ENTERPRISE_IMAGE_PULL_SECRET" }} - needs: - - '{{ .Values.namespace1 }}/technitium-dnsserver' - - name: technitium-dnsserver namespace: '{{ .Values.namespace1 }}' chart: obeone/technitium-dnsserver diff --git a/integration/test/Test/DomainVerification.hs b/integration/test/Test/DomainVerification.hs index 4f3f9fc20e4..cb714e404ab 100644 --- a/integration/test/Test/DomainVerification.hs +++ b/integration/test/Test/DomainVerification.hs @@ -486,3 +486,8 @@ testUpdateTeamInviteLocked = do bindResponse (updateTeamInvite owner domain (object ["team_invite" .= "allowed"])) $ \resp -> do resp.status `shouldMatchInt` 403 resp.json %. "label" `shouldMatch` "operation-forbidden-for-domain-registration-state" + +testDisabledEnterpriseService :: (HasCallStack) => App () +testDisabledEnterpriseService = do + domain <- randomDomain + domainVerificationToken OtherDomain domain Nothing >>= assertStatus 503 diff --git a/integration/test/Testlib/ModService.hs b/integration/test/Testlib/ModService.hs index 98178e152e1..35d9a7298f3 100644 --- a/integration/test/Testlib/ModService.hs +++ b/integration/test/Testlib/ModService.hs @@ -267,7 +267,12 @@ updateServiceMapInConfig resource forSrv config = _ -> pure overridden ) config - [(srv, berInternalServicePorts resource srv :: Int) | srv <- allServices] + [ (srv, berInternalServicePorts resource srv :: Int) + | srv <- allServices, + -- if a service is not enabled, do not set its endpoint configuration, + -- unless we are starting the service itself + berEnableService resource srv || srv == forSrv + ] startBackend :: (HasCallStack) => diff --git a/integration/test/Testlib/ResourcePool.hs b/integration/test/Testlib/ResourcePool.hs index 8a262cfccf1..6aef77c18fc 100644 --- a/integration/test/Testlib/ResourcePool.hs +++ b/integration/test/Testlib/ResourcePool.hs @@ -126,6 +126,7 @@ backendResources dynConfs = berNginzSslPort = Ports.portForDyn Ports.NginzSSL i, berNginzHttp2Port = Ports.portForDyn Ports.NginzHttp2 i, berInternalServicePorts = Ports.internalServicePorts name, + berEnableService = const True, berMlsPrivateKeyPaths = dynConf.mlsPrivateKeyPaths } ) @@ -156,6 +157,7 @@ backendA = berVHost = "backendA", berNginzSslPort = Ports.port Ports.NginzSSL BackendA, berInternalServicePorts = Ports.internalServicePorts BackendA, + berEnableService = const True, berNginzHttp2Port = Ports.port Ports.NginzHttp2 BackendA, berMlsPrivateKeyPaths = object @@ -195,6 +197,9 @@ backendB = berVHost = "backendB", berNginzSslPort = Ports.port Ports.NginzSSL BackendB, berInternalServicePorts = Ports.internalServicePorts BackendB, + berEnableService = \case + WireServerEnterprise -> False + _ -> True, berNginzHttp2Port = Ports.port Ports.NginzHttp2 BackendB, berMlsPrivateKeyPaths = object diff --git a/integration/test/Testlib/Types.hs b/integration/test/Testlib/Types.hs index 16cd6457b9f..b4407c6d72d 100644 --- a/integration/test/Testlib/Types.hs +++ b/integration/test/Testlib/Types.hs @@ -70,6 +70,8 @@ data BackendResource = BackendResource berNginzSslPort :: Word16, berNginzHttp2Port :: Word16, berInternalServicePorts :: forall a. (Num a) => Service -> a, + -- | A disabled service is started anyway, but not configured in the other services. + berEnableService :: Service -> Bool, berMlsPrivateKeyPaths :: Value } From 575998cf1c1c7cc324f3f08f36541217830318a4 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 23 Jan 2025 10:28:59 +0100 Subject: [PATCH 12/12] Remove TODOs --- integration/test/Test/DNSMock.hs | 1 - libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem.hs | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/integration/test/Test/DNSMock.hs b/integration/test/Test/DNSMock.hs index 5a4e8808885..3dd0d836124 100644 --- a/integration/test/Test/DNSMock.hs +++ b/integration/test/Test/DNSMock.hs @@ -1,6 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} --- TODO: merge with DomainVerification, EnterpriseLogin? module Test.DNSMock where import Control.Lens diff --git a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem.hs b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem.hs index d8885d21cab..15a6939de13 100644 --- a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem.hs @@ -25,7 +25,7 @@ data EnterpriseLoginSubsystem m a where DeleteDomain :: Domain -> EnterpriseLoginSubsystem m () GuardEmailDomainRegistrationTeamInvitation :: InvitationFlow -> TeamId -> EmailAddress -> EnterpriseLoginSubsystem m () GuardEmailDomainRegistrationRegister :: EmailAddress -> EnterpriseLoginSubsystem m () - GetDomainRegistration :: Domain -> EnterpriseLoginSubsystem m DomainRegistration -- TODO(leif): remove this + GetDomainRegistration :: Domain -> EnterpriseLoginSubsystem m DomainRegistration TryGetDomainRegistration :: Domain -> EnterpriseLoginSubsystem m (Maybe DomainRegistration) RequestDomainVerificationToken :: Maybe DomainVerificationAuthToken ->