diff --git a/.envrc b/.envrc index b7b3f2c35fd..6fd34b70988 100644 --- a/.envrc +++ b/.envrc @@ -49,6 +49,11 @@ export LANG=en_US.UTF-8 export RABBITMQ_USERNAME=guest export RABBITMQ_PASSWORD=alpaca-grapefruit +# Redis + +export REDIS_PASSWORD=very-secure-redis-cluster-password +export REDIS_ADDITIONAL_WRITE_PASSWORD=very-secure-redis-master-password + # Integration tests export INTEGRATION_DYNAMIC_BACKENDS_POOLSIZE=3 @@ -58,7 +63,7 @@ export AWS_REGION="eu-west-1" export AWS_ACCESS_KEY_ID="dummykey" export AWS_SECRET_ACCESS_KEY="dummysecret" -# integration test suite timeout +# integration test suite timeout export TEST_TIMEOUT_SECONDS=2 # allow local .envrc overrides diff --git a/.hlint.yaml b/.hlint.yaml index 66e3cff5d97..b5b237ee5fa 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -11,6 +11,7 @@ - ignore: { name: Avoid lambda using `infix` } - ignore: { name: Eta reduce } - ignore: { name: Use section } +- ignore: { name: "Use :" } - ignore: { name: Use underscore } # custom rules: diff --git a/CHANGELOG.md b/CHANGELOG.md index c58915993f9..a1ff6491b11 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,241 @@ +# [2024-04-25] (Chart Release 4.42.0) + +## Release notes + + +* There is a new optional Boolean in Brig's Helm chart, `config.multiSFT.enabled`, + signalling whether calls between federated SFT servers are allowed. + + IMPORTANT: The value of this new option needs be set to the value of + `multiSFT.enabled` in SFT's Helm chart. Otherwise federated SFT servers won't + work. + + If provided, the field `is_federating` in the response of `/calls/config/v2` + will reflect `multiSFT.enabled`'s value. + + Example: + + ``` + # [brig/values.yaml] + multiSFT: + enabled: true + ``` + + Also, the optional object `sftToken` with its fields `ttl` and `secret` define + whether an SFT credential would be rendered in the response of + `/calls/config/v2`. The field `ttl` determines the seconds for the credential to + be valid and `secret` is the path to the secret shared with SFT to create + credentials. + + Example: + + ``` + # [brig.yaml] + sft: + sftBaseDomain: sft.wire.example.com + sftSRVServiceName: sft + sftDiscoveryIntervalSeconds: 10 + sftListLength: 20 + sftToken: + ttl: 120 + secret: /path/to/secret + ``` (#3915) + +* The "addClient" internal endpoint of galley has been changed. This can cause temporary failures during upgrades if brig attempts to use this endpoint on a different version of galley. (#3904) + +* Removed the deprecated and unused field `geoDb` from Brig's config. (#3975) + +* Added support for 3 more MLS ciphersuites. To enable MLS, all supported signature schemes (ed25519 and the three ecdsa variants) now need to have private keys specified in galley's configuration file. (#3964) + + +## API changes + + +* Create version 6 of client-related endpoints, fixing an oddity in the serialisation of capabilities. (#3904) + +* Add gzip request support to spar and proxy (#4013) + + +## Features + + +* Backend validates display name during DPoP challenge (#3890) + +* Add Helm chart `smallstep-accomp` that provides a CRL endpoint proxy for federated E2EI (#3896) + +* Support for Elasticsearch password authentication (#6717, #7283) + +* Support unblocking a user in an MLS 1-to-1 conversation (#3940) + +* Add E2EI configuration setup to smallstep-accomp chart (#3944) + +* Remove Helm migrated charts webapp, team-settings, account-pages, sftd (#3927) + +* charts/nginz: Rate limiting claiming MLS key-pacakges by requesting and target user (#3918) + +* Support connecting to Elasticsearch over TLS + + It can be enabled by setting these options on the wire-server helm chart: + + ```yaml + brig: + config: + elasticsearch: + scheme: https + + # When custom CAs are required, one of these must be set: + tlsCa: + tlsCaSecretRef: + name: + key: + + # When TLS needs to be used without verification: + insecureSkipVerifyTls: true + + elasticsearch-index: + elasticsearch: + scheme: https + + # When custom CAs are required, one of these must be set: + tlsCa: + tlsCaSecretRef: + name: + key: + + # When TLS needs to be used without verification: + insecureSkipVerifyTls: true + ``` (#3989) + +* Make gundeck's notificationTTL configurable. The value defines how long + notifications are (at most) stored in the database. Decreasing this value e.g. + helps to safe database space on test environments. (#3960) + +* charts/nginz: Allow 3000 reqs/min on /conversations/one2one/:user_domain/:user (#3918) + +* Support authenticating to redis (#3971) + + +## Bug fixes and other updates + + +* Send connection cancelled event to local pending connection when user gets deleted (#3861) + +* Optional `apiProxy` attribute added to `deeplink.json` in nginz chart (#3933) + +* coturn cert-reloader sidecar config: process name should not contain the path (helm chart) (#3916) + +* Prevent conflict on subsequent tries to provision a SCIM user (#3914) + +* Avoid IO Exception when querying + + GET /converations/{cnv_domain}/{cnv}/groupinfo + + with public group state not set in galley.converation. (#3939) + +* Return an actual list of other users in a remote MLS 1-to-1 conversation (#3998) + +* charts/background-worker: Fix name of the service monitor (#3913) + +* Fix crash when enqueing an empty list of notifications and federation is disabled (#PR_NOT_FOUND) + +* Add the request ID to the request's execution environment in gundeck, such that it can be logged. (#3903) + +* The AWS SNS ARN was parsed by accumulating the environment name up to the first + dash ('-') such that parts of this name spilled over into the app name. Now, we + accumulate up to the last dash. (#3894) + +* Fix bug where welcome notifications were generated for each client instead of for each user (#3907) + +* Do not deliver MLS one-to-one conversation messages to a user that blocked the sender (#3889, #3906) + +* Optimize getting all feature configs (#4002) + + +## Documentation + + +* adds new coding-conventions.md and talks about the decision we made for `cs` (#4006) + +* Distinguish UTCTime and UTCTimeMillis in swagger (#3899) + +* Patch hole in scim docs regarding wire team role manipulation. (#3897) + + +## Internal changes + + +* Create a new script (`Sbom.hs`) to generate the wire-server sbom (bill of material) file. (#3942) + +* port flaking LH tests to new integration and improve the ergonomics of our testing library (#3876) + +* some small refactorings to make it more clear in code what is happening when registering a scim token and an IdP (#3966) + +* In order for the CRL-proxy to function correctly, it needs to have CORS headers set. + We are now setting the CORS headers on the ingress level. (#3956) + +* drop cs in all production code and from Imports (#4001) + +* Galley's internal `DELETE /i/client/:clientID` now early-exits before visiting all conversations if the client is already gone. + Galley now reports debug logs for every call to Cassandra. (#3985) + +* move formatting and linting of haskell files to treefmt, remove some of the now unneeded rules (#4000) + +* Integration test cases for strangely behaving feature config settings. (#4007) + +* Add ldap-scim-bridge chart to the wire-server release (#3999) + +* Disable `integration` subchart of `wire-server` by default (#3682) + +* Provide password as value in `elasticsearch-ephemeral`. This way we can use + different passwords on our test systems. Ensuring that the password is really + configurable (and not accidentally hardcoded somewhere.) (#3994) + +* Upgraded fluent-bit chart to version 0.46.2 + Added example values for fluent-bit helm chart for output to syslog server (#4012) + +* Ported 2FA tests to the new integration test suite (#3986) + +* To ensure certificate revocations get active in a short time frame, disable + caching of proxy results on client side by setting respective HTTP headers. (#3952) + +* Ensure that targets of the smallstep nginx proxy are resolved at runtime via the + configured DNS server. This has two benefits: The target gets adjusted when it's + changed at the DNS server. And, nginx doesn't fail to start when the target + doesn't exist yet. (#3947) + +* Use schema-profunctor for user event serialisation and introduce golden tests (#3912) + +* Setup federation-v0 environment for use in integration tests: + - add federation-v0 domain to test environment + - provision integration certificates with cert-manager (#3849, #3898) + +* Add assets to output of ejpd-info end-point in stern; also: + + - [brig] now talks to carghold for profile picture extraction; + - [integration] migrate ejpd tests; + - [integration] enhanced `shouldMatch` shows a diff on failure now; + - [integration] added `shouldMatchLeniently` for rule-based canonicalization of arguments (#3875) + +* Bump hsaml2, saml2-web-sso dependencies. (#3995) + +* Remove support for push token transport types APNSVoIP, APNSVoIPSandbox from gundeck. (#3967) + +* Include remote domain in federator error logs (#3919) + +* Remove remaining splinters of wai-routing, wai-predicate from brig. (#3996) + + +## Federation changes + + +* The on-conversation-updated notification is now queued instead of being sent directly. A new version of the notification has been introduced with a different JSON format for the body, mostly for testing purposes of the versioning system. + + Since the notification is now sent asynchronously, some error conditions in case of unreachable backends cannot be triggered anymore. (#3831) + +* Versioning of backend to backend notifications. Notifications are now stored in "bundles" containing a serialised payload for each supported version. The background worker then dynamically selects the best version to use and sends only the notification corresponding to that version. + (#3831) + + # [2024-02-13] (Chart Release 4.41.0) # [2024-02-12] (Chart Release 4.40.0) diff --git a/Makefile b/Makefile index 9656c7e9d17..3d83ba04244 100644 --- a/Makefile +++ b/Makefile @@ -7,7 +7,7 @@ DOCKER_TAG ?= $(USER) # default helm chart version must be 0.0.42 for local development (because 42 is the answer to the universe and everything) HELM_SEMVER ?= 0.0.42 # The list of helm charts needed on internal kubernetes testing environments -CHARTS_INTEGRATION := wire-server databases-ephemeral redis-cluster rabbitmq fake-aws ingress-nginx-controller nginx-ingress-controller nginx-ingress-services fluent-bit kibana sftd restund coturn k8ssandra-test-cluster +CHARTS_INTEGRATION := wire-server databases-ephemeral redis-cluster rabbitmq fake-aws ingress-nginx-controller nginx-ingress-controller nginx-ingress-services fluent-bit kibana restund coturn k8ssandra-test-cluster # The list of helm charts to publish on S3 # FUTUREWORK: after we "inline local subcharts", # (e.g. move charts/brig to charts/wire-server/brig) @@ -17,8 +17,8 @@ CHARTS_RELEASE := wire-server redis-ephemeral redis-cluster rabbitmq rabbitmq-ex fake-aws fake-aws-s3 fake-aws-sqs aws-ingress fluent-bit kibana backoffice \ calling-test demo-smtp elasticsearch-curator elasticsearch-external \ elasticsearch-ephemeral minio-external cassandra-external \ -nginx-ingress-controller ingress-nginx-controller nginx-ingress-services reaper sftd restund coturn \ -inbucket k8ssandra-test-cluster postgresql +nginx-ingress-controller ingress-nginx-controller nginx-ingress-services reaper restund coturn \ +inbucket k8ssandra-test-cluster postgresql ldap-scim-bridge smallstep-accomp KIND_CLUSTER_NAME := wire-server HELM_PARALLELISM ?= 1 # 1 for sequential tests; 6 for all-parallel tests @@ -129,9 +129,8 @@ devtest: .PHONY: sanitize-pr sanitize-pr: ./hack/bin/generate-local-nix-packages.sh - make formatf make hlint-inplace-pr - make hlint-check-pr # sometimes inplace has been observed not to do its job very well. + make format make git-add-cassandra-schema @git diff-files --quiet -- || ( echo "There are unstaged changes, please take a look, consider committing them, and try again."; exit 1 ) @git diff-index --quiet --cached HEAD -- || ( echo "There are staged changes, please take a look, consider committing them, and try again."; exit 1 ) @@ -155,28 +154,16 @@ ghcid: # Used by CI .PHONY: lint-all -lint-all: formatc hlint-check-all check-local-nix-derivations treefmt-check - -.PHONY: hlint-check-all -hlint-check-all: - ./tools/hlint.sh -f all -m check +lint-all: treefmt-check check-local-nix-derivations .PHONY: hlint-inplace-all hlint-inplace-all: ./tools/hlint.sh -f all -m inplace -.PHONY: hlint-check-pr -hlint-check-pr: - ./tools/hlint.sh -f pr -m check - .PHONY: hlint-inplace-pr hlint-inplace-pr: ./tools/hlint.sh -f pr -m inplace -.PHONY: hlint-check -hlint-check: - ./tools/hlint.sh -f changeset -m check - .PHONY: hlint-inplace hlint-inplace: ./tools/hlint.sh -f changeset -m inplace @@ -192,35 +179,27 @@ check-local-nix-derivations: regen-local-nix-derivations services: init install $(MAKE) -C services/nginz -# formats all Haskell files (which don't contain CPP) +# formats everything according to treefmt rules +# this may take a while (5 minutes) on first run but should be instant on +# any subsequent run except after you have changed files. .PHONY: format format: - ./tools/ormolu.sh - -# formats all Haskell files changed in this PR, even if local changes are not committed to git -.PHONY: formatf -formatf: - ./tools/ormolu.sh -f pr - -# formats all Haskell files even if local changes are not committed to git -.PHONY: formatf-all -formatf-all: - ./tools/ormolu.sh -f all + treefmt -# checks that all Haskell files are formatted; fail if a `make format` run is needed. +# checks the format .PHONY: formatc -formatc: - ./tools/ormolu.sh -c +formatc: + treefmt-check # For any Haskell or Rust file, update or add a license header if necessary. # Headers should be added according to Ormolu's formatting rules, but please check just in case. .PHONY: add-license add-license: - # Check headroom is installed. If not, please run 'stack install headroom' + # Check headroom is installed. command -v headroom headroom run @echo "" - @echo "you might want to run 'make formatf' now to make sure ormolu is happy" + @echo "you might want to run 'make format' now to make sure ormolu is happy" .PHONY: treefmt treefmt: @@ -294,9 +273,17 @@ db-reset: c ./dist/gundeck-schema --keyspace gundeck_test2 --replication-factor 1 --reset ./dist/spar-schema --keyspace spar_test2 --replication-factor 1 --reset ./integration/scripts/integration-dynamic-backends-db-schemas.sh --replication-factor 1 --reset - ./dist/brig-index reset --elasticsearch-index-prefix directory --elasticsearch-server http://localhost:9200 > /dev/null - ./dist/brig-index reset --elasticsearch-index-prefix directory2 --elasticsearch-server http://localhost:9200 > /dev/null - ./integration/scripts/integration-dynamic-backends-brig-index.sh --elasticsearch-server http://localhost:9200 > /dev/null + ./dist/brig-index reset \ + --elasticsearch-index-prefix directory \ + --elasticsearch-server https://localhost:9200 \ + --elasticsearch-credentials ./services/brig/test/resources/elasticsearch-credentials.yaml > /dev/null + ./dist/brig-index reset \ + --elasticsearch-index-prefix directory2 \ + --elasticsearch-server https://localhost:9200 \ + --elasticsearch-credentials ./services/brig/test/resources/elasticsearch-credentials.yaml > /dev/null + ./integration/scripts/integration-dynamic-backends-brig-index.sh \ + --elasticsearch-server https://localhost:9200 \ + --elasticsearch-credentials ./services/brig/test/resources/elasticsearch-credentials.yaml > /dev/null @@ -312,9 +299,20 @@ db-migrate: c ./dist/gundeck-schema --keyspace gundeck_test2 --replication-factor 1 > /dev/null ./dist/spar-schema --keyspace spar_test2 --replication-factor 1 > /dev/null ./integration/scripts/integration-dynamic-backends-db-schemas.sh --replication-factor 1 > /dev/null - ./dist/brig-index reset --elasticsearch-index-prefix directory --elasticsearch-server http://localhost:9200 > /dev/null - ./dist/brig-index reset --elasticsearch-index-prefix directory2 --elasticsearch-server http://localhost:9200 > /dev/null - ./integration/scripts/integration-dynamic-backends-brig-index.sh --elasticsearch-server http://localhost:9200 > /dev/null + ./dist/brig-index reset \ + --elasticsearch-index-prefix directory \ + --elasticsearch-server https://localhost:9200 \ + --elasticsearch-ca-cert ./services/brig/test/resources/elasticsearch-ca.pem \ + --elasticsearch-credentials ./services/brig/test/resources/elasticsearch-credentials.yaml > /dev/null + ./dist/brig-index reset \ + --elasticsearch-index-prefix directory2 \ + --elasticsearch-server https://localhost:9200 \ + --elasticsearch-ca-cert ./services/brig/test/resources/elasticsearch-ca.pem \ + --elasticsearch-credentials ./services/brig/test/resources/elasticsearch-credentials.yaml > /dev/null + ./integration/scripts/integration-dynamic-backends-brig-index.sh \ + --elasticsearch-server https://localhost:9200 \ + --elasticsearch-ca-cert ./services/brig/test/resources/elasticsearch-ca.pem \ + --elasticsearch-credentials ./services/brig/test/resources/elasticsearch-credentials.yaml > /dev/null ################################# ## dependencies @@ -512,6 +510,7 @@ guard-inotify: .PHONY: kind-integration-setup kind-integration-setup: guard-inotify .local/kind-kubeconfig + KUBECONFIG=$(CURDIR)/.local/kind-kubeconfig helmfile sync -f $(CURDIR)/hack/helmfile-federation-v0.yaml HELMFILE_ENV="kind" KUBECONFIG=$(CURDIR)/.local/kind-kubeconfig make kube-integration-setup .PHONY: kind-integration-test @@ -545,11 +544,12 @@ helm-template-%: clean-charts charts-integration ./hack/bin/helm-template.sh $(*) # Ask the security team for the `DEPENDENCY_TRACK_API_KEY` (if you need it) +# changing the directory is necessary because of some quirkiness of how +# runhaskell / ghci behaves (it doesn't find modules that aren't in the same +# directory as the script that is being executed) .PHONY: upload-bombon upload-bombon: - nix build -f nix wireServer.allLocalPackagesBom -o "bill-of-materials.$(HELM_SEMVER).json" - ./hack/bin/bombon.hs -- \ - --bom-filepath "./bill-of-materials.$(HELM_SEMVER).json" \ + cd ./hack/bin && ./bombon.hs -- \ --project-version $(HELM_SEMVER) \ --api-key $(DEPENDENCY_TRACK_API_KEY) \ --auto-create diff --git a/cabal.project b/cabal.project index 471d12e874a..932f0f55399 100644 --- a/cabal.project +++ b/cabal.project @@ -103,6 +103,8 @@ package hscim ghc-options: -Werror package http2-manager ghc-options: -Werror +package inconsistencies + ghc-options: -Werror package integration ghc-options: -Werror package imports diff --git a/cassandra-schema.cql b/cassandra-schema.cql index efcf3424035..a35870fedfd 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -2165,6 +2165,7 @@ CREATE TABLE spar_test.scim_user_times ( CREATE TABLE spar_test.scim_external ( team uuid, external_id text, + creation_status int, user uuid, PRIMARY KEY (team, external_id) ) WITH CLUSTERING ORDER BY (external_id ASC) diff --git a/charts/account-pages/.helmignore b/charts/account-pages/.helmignore deleted file mode 100644 index f0c13194444..00000000000 --- a/charts/account-pages/.helmignore +++ /dev/null @@ -1,21 +0,0 @@ -# Patterns to ignore when building packages. -# This supports shell glob matching, relative path matching, and -# negation (prefixed with !). Only one pattern per line. -.DS_Store -# Common VCS dirs -.git/ -.gitignore -.bzr/ -.bzrignore -.hg/ -.hgignore -.svn/ -# Common backup files -*.swp -*.bak -*.tmp -*~ -# Various IDEs -.project -.idea/ -*.tmproj diff --git a/charts/account-pages/Chart.yaml b/charts/account-pages/Chart.yaml deleted file mode 100644 index 7fb4845a803..00000000000 --- a/charts/account-pages/Chart.yaml +++ /dev/null @@ -1,4 +0,0 @@ -apiVersion: v1 -description: A Helm chart for the Wire account pages in Kubernetes -name: account-pages -version: 0.0.42 diff --git a/charts/account-pages/README.md b/charts/account-pages/README.md deleted file mode 100644 index f2c38b5f642..00000000000 --- a/charts/account-pages/README.md +++ /dev/null @@ -1 +0,0 @@ -Basic web application that provides a frontend with functionality for account activation and password reset diff --git a/charts/account-pages/templates/_helpers.tpl b/charts/account-pages/templates/_helpers.tpl deleted file mode 100644 index af896de0f49..00000000000 --- a/charts/account-pages/templates/_helpers.tpl +++ /dev/null @@ -1,25 +0,0 @@ -{{/* vim: set filetype=mustache: */}} -{{/* -Expand the name of the chart. -*/}} -{{- define "account-pages.name" -}} -{{- default .Chart.Name .Values.nameOverride | trunc 63 | trimSuffix "-" -}} -{{- end -}} - -{{/* -Create a default fully qualified app name. -We truncate at 63 chars because some Kubernetes name fields are limited to this (by the DNS naming spec). -*/}} -{{- define "account-pages.fullname" -}} -{{- $name := default .Chart.Name .Values.nameOverride -}} -{{- printf "%s-%s" .Release.Name $name | trunc 63 | trimSuffix "-" -}} -{{- end -}} - -{{/* Allow KubeVersion to be overridden. */}} -{{- define "kubeVersion" -}} - {{- default .Capabilities.KubeVersion.Version .Values.kubeVersionOverride -}} -{{- end -}} - -{{- define "includeSecurityContext" -}} - {{- (semverCompare ">= 1.24-0" (include "kubeVersion" .)) -}} -{{- end -}} diff --git a/charts/account-pages/templates/deployment.yaml b/charts/account-pages/templates/deployment.yaml deleted file mode 100644 index 0c6bdf00baa..00000000000 --- a/charts/account-pages/templates/deployment.yaml +++ /dev/null @@ -1,64 +0,0 @@ -apiVersion: apps/v1 -kind: Deployment -metadata: - name: account-pages - labels: - app: account-pages - chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} - release: {{ .Release.Name }} - heritage: {{ .Release.Service }} -spec: - replicas: {{ .Values.replicaCount }} - strategy: - type: RollingUpdate - rollingUpdate: - maxUnavailable: 0 - maxSurge: {{ .Values.replicaCount | mul 2 }} - selector: - matchLabels: - app: account-pages - template: - metadata: - labels: - app: account-pages - release: {{ .Release.Name }} - spec: - containers: - - name: account-pages - {{- if .Values.image.digest }} - image: "{{ .Values.image.repository }}@{{ .Values.image.digest }}" - {{- else }} - image: "{{ .Values.image.repository }}:{{ .Values.image.tag }}" - {{- end }} - {{- if eq (include "includeSecurityContext" .) "true" }} - securityContext: - {{- toYaml .Values.podSecurityContext | nindent 10 }} - {{- end }} - env: - - name: BACKEND_REST - value: https://{{ .Values.config.externalUrls.backendRest }} - - name: APP_BASE - value: https://{{ .Values.config.externalUrls.appHost }} - {{- range $key, $val := .Values.envVars }} - - name: {{ $key }} - value: {{ $val | quote }} - {{- end }} - ports: - - name: http - containerPort: {{ .Values.service.http.internalPort }} - readinessProbe: - httpGet: - path: /_health/ - port: {{ .Values.service.http.internalPort }} - scheme: HTTP - livenessProbe: - initialDelaySeconds: 30 - timeoutSeconds: 3 - httpGet: - path: /_health/ - port: {{ .Values.service.http.internalPort }} - scheme: HTTP - resources: -{{ toYaml .Values.resources | indent 12 }} - dnsPolicy: ClusterFirst - restartPolicy: Always diff --git a/charts/account-pages/values.yaml b/charts/account-pages/values.yaml deleted file mode 100644 index 4148cfd8dc8..00000000000 --- a/charts/account-pages/values.yaml +++ /dev/null @@ -1,61 +0,0 @@ -# Default values for the account-pages. -replicaCount: 1 -resources: - requests: - memory: "128Mi" - cpu: "100m" - limits: - memory: "512Mi" - cpu: "1" -image: - repository: quay.io/wire/account - tag: "2.2.1-v0.28.21-0-6bfd7c5" -service: - https: - externalPort: 443 - http: - internalPort: 8080 - -## The following has to be provided to deploy this chart - -#config: -# externalUrls: -# backendRest: nginz-https.wire.example -# backendWebsocket: nginz-ssl.wire.example -# appHost: account.wire.example - -# Some relevant environment options. For a comprehensive -# list of available variables, please refer to: -# https://github.com/wireapp/wire-web-config-wire/blob/master/wire-account/.env.defaults -# -# NOTE: Without an empty dictionary, you will see warnings -# when overriding envVars -envVars: {} -# E.g. -# envVars: -# FEATURE_ENABLE_DEBUG: "true" -# You are likely to need at least following CSP headers -# due to the fact that you are likely to do cross sub-domain requests -# i.e., from account.wire.example to nginz-https.wire.example -# CSP_EXTRA_CONNECT_SRC: "https://*.wire.example, wss://*.wire.example" -# CSP_EXTRA_IMG_SRC: "https://*.wire.example" -# CSP_EXTRA_SCRIPT_SRC: "https://*.wire.example" -# CSP_EXTRA_DEFAULT_SRC: "https://*.wire.example" -# CSP_EXTRA_FONT_SRC: "https://*.wire.example" -# CSP_EXTRA_FRAME_SRC: "https://*.wire.example" -# CSP_EXTRA_MANIFEST_SRC: "https://*.wire.example" -# CSP_EXTRA_OBJECT_SRC: "https://*.wire.example" -# CSP_EXTRA_MEDIA_SRC: "https://*.wire.example" -# CSP_EXTRA_PREFETCH_SRC: "https://*.wire.example" -# CSP_EXTRA_STYLE_SRC: "https://*.wire.example" -# CSP_EXTRA_WORKER_SRC: "https://*.wire.example" - -podSecurityContext: - allowPrivilegeEscalation: false - capabilities: - drop: - - ALL - runAsUser: 1000 - runAsGroup: 1000 - seccompProfile: - type: RuntimeDefault diff --git a/charts/background-worker/templates/servicemonitor.yaml b/charts/background-worker/templates/servicemonitor.yaml index dc9e0636107..14dd65b488e 100644 --- a/charts/background-worker/templates/servicemonitor.yaml +++ b/charts/background-worker/templates/servicemonitor.yaml @@ -2,9 +2,9 @@ apiVersion: monitoring.coreos.com/v1 kind: ServiceMonitor metadata: - name: brig + name: background-worker labels: - app: brig + app: background-worker chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} release: {{ .Release.Name }} heritage: {{ .Release.Service }} diff --git a/charts/brig/templates/_helpers.tpl b/charts/brig/templates/_helpers.tpl index 857c0203de8..2c3b801d674 100644 --- a/charts/brig/templates/_helpers.tpl +++ b/charts/brig/templates/_helpers.tpl @@ -23,3 +23,44 @@ created one (in case the CA is provided as PEM string.) {{- dict "name" "brig-cassandra" "key" "ca.pem" | toYaml -}} {{- end -}} {{- end -}} + + +{{- define "configureElasticSearchCa" -}} +{{ or (hasKey .elasticsearch "tlsCa") (hasKey .elasticsearch "tlsCaSecretRef") }} +{{- end -}} + +{{- define "elasticsearchTlsSecretName" -}} +{{- if .elasticsearch.tlsCaSecretRef -}} +{{ .elasticsearch.tlsCaSecretRef.name }} +{{- else }} +{{- print "brig-elasticsearch-ca" -}} +{{- end -}} +{{- end -}} + +{{- define "elasticsearchTlsSecretKey" -}} +{{- if .elasticsearch.tlsCaSecretRef -}} +{{ .elasticsearch.tlsCaSecretRef.key }} +{{- else }} +{{- print "ca.pem" -}} +{{- end -}} +{{- end -}} + +{{- define "configureAdditionalElasticSearchCa" -}} +{{ or (hasKey .elasticsearch "additionalTlsCa") (hasKey .elasticsearch "additionalTlsCaSecretRef") }} +{{- end -}} + +{{- define "additionalElasticsearchTlsSecretName" -}} +{{- if .elasticsearch.additionalTlsCaSecretRef -}} +{{ .elasticsearch.additionalTlsCaSecretRef.name }} +{{- else }} +{{- print "brig-additional-elasticsearch-ca" -}} +{{- end -}} +{{- end -}} + +{{- define "additionalElasticsearchTlsSecretKey" -}} +{{- if .elasticsearch.additionalTlsCaSecretRef -}} +{{ .elasticsearch.additionalTlsCaSecretRef.key }} +{{- else }} +{{- print "ca.pem" -}} +{{- end -}} +{{- end -}} diff --git a/charts/brig/templates/configmap.yaml b/charts/brig/templates/configmap.yaml index e128169dbe4..7bcc86a1901 100644 --- a/charts/brig/templates/configmap.yaml +++ b/charts/brig/templates/configmap.yaml @@ -33,11 +33,28 @@ data: {{- end }} elasticsearch: - url: http://{{ .elasticsearch.host }}:{{ .elasticsearch.port }} + url: {{ .elasticsearch.scheme }}://{{ .elasticsearch.host }}:{{ .elasticsearch.port }} index: {{ .elasticsearch.index }} + {{- if .elasticsearch.additionalWriteHost }} + additionalWriteIndexUrl: {{ .elasticsearch.additionalWriteScheme }}://{{ .elasticsearch.additionalWriteHost }}:{{ .elasticsearch.additionalWritePort }} + {{- end }} {{- if .elasticsearch.additionalWriteIndex }} additionalWriteIndex: {{ .elasticsearch.additionalWriteIndex }} {{- end }} + {{- if $.Values.secrets.elasticsearch }} + credentials: /etc/wire/brig/secrets/elasticsearch-credentials.yaml + {{- end }} + {{- if (include "configureElasticSearchCa" .) }} + caCert: /etc/wire/brig/elasticsearch-ca/{{ include "elasticsearchTlsSecretKey" .}} + {{- end }} + {{- if (include "configureAdditionalElasticSearchCa" .) }} + additionalCaCert: /etc/wire/brig/additional-elasticsearch-ca/{{ include "additionalElasticsearchTlsSecretKey" .}} + {{- end }} + {{- if $.Values.secrets.elasticsearchAdditional }} + additionalCredentials: /etc/wire/brig/secrets/elasticsearch-additional-credentials.yaml + {{- end }} + insecureSkipVerifyTls: {{ .elasticsearch.insecureSkipVerifyTls }} + additionalInsecureSkipVerifyTls: {{ .elasticsearch.additionalInsecureSkipVerifyTls }} cargohold: host: cargohold @@ -51,6 +68,9 @@ data: host: gundeck port: 8080 + {{- if .multiSFT }} + multiSFT: {{ .multiSFT.enabled }} + {{- end }} {{- if .enableFederation }} # TODO remove this federator: @@ -203,6 +223,13 @@ data: {{- if .sftDiscoveryIntervalSeconds }} sftDiscoveryIntervalSeconds: {{ .sftDiscoveryIntervalSeconds }} {{- end }} + {{- if .sftToken }} + sftToken: + {{- with .sftToken }} + ttl: {{ .ttl }} + secret: {{ .secret }} + {{- end }} + {{- end }} {{- end }} {{- end }} diff --git a/charts/brig/templates/deployment.yaml b/charts/brig/templates/deployment.yaml index e37c4142af6..dea3c0dacba 100644 --- a/charts/brig/templates/deployment.yaml +++ b/charts/brig/templates/deployment.yaml @@ -34,19 +34,30 @@ spec: - name: "brig-config" configMap: name: "brig" + - name: "brig-secrets" + secret: + secretName: "brig" {{- if eq $.Values.turn.serversSource "files" }} - name: "turn-servers" configMap: name: "turn" {{- end }} - - name: "brig-secrets" - secret: - secretName: "brig" {{- if eq (include "useCassandraTLS" .Values.config) "true" }} - name: "brig-cassandra" secret: secretName: {{ (include "tlsSecretRef" .Values.config | fromYaml).name }} {{- end}} + {{- if eq (include "configureElasticSearchCa" .Values.config) "true" }} + - name: "elasticsearch-ca" + secret: + secretName: {{ include "elasticsearchTlsSecretName" .Values.config }} + {{- end }} + {{- if eq (include "configureAdditionalElasticSearchCa" .Values.config) "true" }} + - name: "additional-elasticsearch-ca" + secret: + secretName: {{ include "additionalElasticsearchTlsSecretName" .Values.config }} + {{- end }} + containers: - name: brig image: "{{ .Values.image.repository }}:{{ .Values.image.tag }}" @@ -68,6 +79,14 @@ spec: - name: "brig-cassandra" mountPath: "/etc/wire/brig/cassandra" {{- end }} + {{- if eq (include "configureElasticSearchCa" .Values.config) "true" }} + - name: "elasticsearch-ca" + mountPath: "/etc/wire/brig/elasticsearch-ca/" + {{- end }} + {{- if eq (include "configureAdditionalElasticSearchCa" .Values.config) "true" }} + - name: "additional-elasticsearch-ca" + mountPath: "/etc/wire/brig/additional-elasticsearch-ca/" + {{- end }} env: - name: LOG_LEVEL value: {{ .Values.config.logLevel }} diff --git a/charts/brig/templates/elasticsearch-ca-secret.yaml b/charts/brig/templates/elasticsearch-ca-secret.yaml new file mode 100644 index 00000000000..3c64b0e92d8 --- /dev/null +++ b/charts/brig/templates/elasticsearch-ca-secret.yaml @@ -0,0 +1,30 @@ +--- +{{- if not (empty .Values.config.elasticsearch.tlsCa) }} +apiVersion: v1 +kind: Secret +metadata: + name: "brig-elasticsearch-ca" + labels: + app: brig + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: "{{ .Release.Name }}" + heritage: "{{ .Release.Service }}" +type: Opaque +data: + ca.pem: {{ .Values.elasticsearch.tlsCa | b64enc | quote }} +{{- end }} +--- +{{- if not (empty .Values.config.elasticsearch.additionalTlsCa) }} +apiVersion: v1 +kind: Secret +metadata: + name: "brig-additional-elasticsearch-ca" + labels: + app: brig + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: "{{ .Release.Name }}" + heritage: "{{ .Release.Service }}" +type: Opaque +data: + ca.pem: {{ .Values.elasticsearch.additionalTlsCa | b64enc | quote }} +{{- end }} diff --git a/charts/brig/templates/secret.yaml b/charts/brig/templates/secret.yaml index a4e51228b60..c2359979f57 100644 --- a/charts/brig/templates/secret.yaml +++ b/charts/brig/templates/secret.yaml @@ -35,4 +35,10 @@ data: rabbitmqUsername: {{ .rabbitmq.username | b64enc | quote }} rabbitmqPassword: {{ .rabbitmq.password | b64enc | quote }} {{- end }} + {{- if .elasticsearch }} + elasticsearch-credentials.yaml: {{ .elasticsearch | toYaml | b64enc }} + {{- end }} + {{- if .elasticsearchAdditional }} + elasticsearch-additional-credentials.yaml: {{ .elasticsearchAdditional | toYaml | b64enc }} + {{- end }} {{- end }} diff --git a/charts/brig/templates/tests/brig-integration.yaml b/charts/brig/templates/tests/brig-integration.yaml index aff0f6d525a..62bea731895 100644 --- a/charts/brig/templates/tests/brig-integration.yaml +++ b/charts/brig/templates/tests/brig-integration.yaml @@ -44,6 +44,11 @@ spec: - name: "brig-integration-secrets" secret: secretName: "brig-integration" + {{- if eq (include "configureElasticSearchCa" .Values.config) "true" }} + - name: elasticsearch-ca + secret: + secretName: {{ include "elasticsearchTlsSecretName" .Values.config }} + {{- end}} {{- if eq (include "useCassandraTLS" .Values.config) "true" }} - name: "brig-cassandra" secret: @@ -106,6 +111,10 @@ spec: # non-default locations # (see corresp. TODO in galley.) mountPath: "/etc/wire/integration-secrets" + {{- if eq (include "configureElasticSearchCa" .Values.config) "true" }} + - name: elasticsearch-ca + mountPath: "/etc/wire/brig/elasticsearch-ca" + {{- end}} {{- if eq (include "useCassandraTLS" .Values.config) "true" }} - name: "brig-cassandra" mountPath: "/etc/wire/brig/cassandra" diff --git a/charts/brig/templates/tests/configmap.yaml b/charts/brig/templates/tests/configmap.yaml index 56667e55ed3..f4f2ce08fe9 100644 --- a/charts/brig/templates/tests/configmap.yaml +++ b/charts/brig/templates/tests/configmap.yaml @@ -33,6 +33,8 @@ data: host: spar port: 8080 + multiSFT: false + # TODO remove this federator: host: federator diff --git a/charts/brig/values.yaml b/charts/brig/values.yaml index 6afcd1a853d..e11aa931a5a 100644 --- a/charts/brig/values.yaml +++ b/charts/brig/values.yaml @@ -29,9 +29,30 @@ config: # key: elasticsearch: + scheme: http host: elasticsearch-client port: 9200 index: directory + insecureSkipVerifyTls: false +# To configure custom TLS CA, please provide one of these: +# tlsCa: +# +# Or refer to an existing secret (containing the CA): +# tlsCaSecretRef: +# name: +# key: + additionalWriteScheme: http + # additionalWriteHost: + additionalWritePort: 9200 + # additionalWriteIndex: + additionalInsecureSkipVerifyTls: false +# To configure custom TLS CA, please provide one of these: +# additionalTlsCa: +# +# Or refer to an existing secret (containing the CA): +# additionalTlsCaSecretRef: +# name: +# key: aws: region: "eu-west-1" sesEndpoint: https://email.eu-west-1.amazonaws.com @@ -40,6 +61,8 @@ config: # -- If set to false, 'dynamoDBEndpoint' _must_ be set. randomPrekeys: true useSES: true + multiSFT: + enabled: false # keep multiSFT default in sync with sft chart's multiSFT.enabled enableFederation: false # keep enableFederation default in sync with galley and cargohold chart's config.enableFederation as well as wire-server chart's tags.federation # Not used if enableFederation is false rabbitmq: diff --git a/charts/coturn/templates/configmap-coturn-conf-template.yaml b/charts/coturn/templates/configmap-coturn-conf-template.yaml index cc458f7db61..b020ee5080d 100644 --- a/charts/coturn/templates/configmap-coturn-conf-template.yaml +++ b/charts/coturn/templates/configmap-coturn-conf-template.yaml @@ -27,7 +27,7 @@ data: no-cli ## turn, stun. - listening-ip=__COTURN_EXT_IP__ + listening-ip={{ default "__COTURN_EXT_IP__" .Values.coturnTurnListenIP }} listening-port={{ .Values.coturnTurnListenPort }} relay-ip=__COTURN_EXT_IP__ realm=dummy.io diff --git a/charts/coturn/templates/statefulset.yaml b/charts/coturn/templates/statefulset.yaml index 8fa0d5f0ede..d2b9c7ef9b7 100644 --- a/charts/coturn/templates/statefulset.yaml +++ b/charts/coturn/templates/statefulset.yaml @@ -186,7 +186,7 @@ spec: - name: CONFIG_DIR value: /secrets-tls - name: PROCESS_NAME - value: /usr/bin/turnserver + value: turnserver - name: RELOAD_SIGNAL value: SIGUSR2 volumeMounts: diff --git a/charts/coturn/values.yaml b/charts/coturn/values.yaml index 84934676739..10279a6aa3e 100644 --- a/charts/coturn/values.yaml +++ b/charts/coturn/values.yaml @@ -26,6 +26,10 @@ coturnTurnListenPort: 3478 coturnMetricsListenPort: 9641 coturnTurnTlsListenPort: 5349 +# If you need to specify which IP Coturn should bind to. +# This will typically be the IP of the kubenode. +# coturnTurnListenIP: "182.168.22.133" + tls: enabled: false # compliant with BSI TR-02102-2 @@ -108,3 +112,4 @@ livenessProbe: readinessProbe: timeoutSeconds: 5 failureThreshold: 5 + diff --git a/charts/elasticsearch-ephemeral/templates/_helpers.tpl b/charts/elasticsearch-ephemeral/templates/_helpers.tpl index 2aa4295dc81..6ecbd30d5a9 100644 --- a/charts/elasticsearch-ephemeral/templates/_helpers.tpl +++ b/charts/elasticsearch-ephemeral/templates/_helpers.tpl @@ -14,4 +14,3 @@ We truncate at 53 chars (63 - len("-discovery")) because some Kubernetes name fi {{- $name := default .Chart.Name .Values.nameOverride -}} {{- printf "%s" $name | trunc 53 | trimSuffix "-" -}} {{- end -}} - diff --git a/charts/elasticsearch-ephemeral/templates/cert.yaml b/charts/elasticsearch-ephemeral/templates/cert.yaml new file mode 100644 index 00000000000..bae69529d25 --- /dev/null +++ b/charts/elasticsearch-ephemeral/templates/cert.yaml @@ -0,0 +1,30 @@ + +{{- if .Values.tls.enabled -}} +apiVersion: cert-manager.io/v1 +kind: Certificate +metadata: + name: {{ template "fullname" . }} + namespace: {{ .Release.Namespace }} + labels: + chart: "{{ .Chart.Name }}-{{ .Chart.Version }}" + release: "{{ .Release.Name }}" + heritage: "{{ .Release.Service }}" +spec: + issuerRef: {{ required "Please specify .Values.tls.issuerRef when .Values.tls.enabled is true" .Values.tls.issuerRef | toJson }} + usages: + - server auth + duration: 2160h # 90d + renewBefore: 360h # 15d + isCA: false + secretName: {{ template "fullname" . }}-certificate + + privateKey: + algorithm: ECDSA + size: 384 + encoding: PKCS1 + rotationPolicy: Always + + dnsNames: + - {{ template "fullname" . }} + - {{ template "fullname" . }}.{{ .Release.Namespace }}.svc.cluster.local +{{- end -}} diff --git a/charts/elasticsearch-ephemeral/templates/es.yaml b/charts/elasticsearch-ephemeral/templates/es.yaml index 79526560ad1..81832c6783b 100644 --- a/charts/elasticsearch-ephemeral/templates/es.yaml +++ b/charts/elasticsearch-ephemeral/templates/es.yaml @@ -32,6 +32,18 @@ spec: value: "single-node" - name: "action.auto_create_index" value: ".watches,.triggered_watches,.watcher-history-*,pod-*,node-*" + - name: "xpack.security.enabled" + value: "true" + - name: "ELASTIC_PASSWORD" + value: {{ .Values.secrets.password }} + {{- if .Values.tls.enabled }} + - name: "xpack.security.http.ssl.enabled" + value: "true" + - name: "xpack.security.http.ssl.certificate" + value: "certs/tls.crt" + - name: "xpack.security.http.ssl.key" + value: "certs/tls.key" + {{- end }} ports: - containerPort: 9200 name: http @@ -42,9 +54,18 @@ spec: volumeMounts: - name: storage mountPath: /data + {{- if .Values.tls.enabled }} + - name: certificate + mountPath: /usr/share/elasticsearch/config/certs + {{- end }} resources: {{ toYaml .Values.resources | indent 12 }} volumes: - emptyDir: medium: "" name: "storage" + {{- if .Values.tls.enabled }} + - name: certificate + secret: + secretName: {{ template "fullname" . }}-certificate + {{- end }} diff --git a/charts/elasticsearch-ephemeral/values.yaml b/charts/elasticsearch-ephemeral/values.yaml index 9d0c5cae8ab..1543bd897fa 100644 --- a/charts/elasticsearch-ephemeral/values.yaml +++ b/charts/elasticsearch-ephemeral/values.yaml @@ -14,3 +14,10 @@ resources: requests: cpu: "250m" memory: "500Mi" + +tls: + enabled: false + # issuerRef: .. + +secrets: + password: "changeme" diff --git a/charts/elasticsearch-index/templates/_helpers.tpl b/charts/elasticsearch-index/templates/_helpers.tpl index 47bf703112c..a3581b09d50 100644 --- a/charts/elasticsearch-index/templates/_helpers.tpl +++ b/charts/elasticsearch-index/templates/_helpers.tpl @@ -16,10 +16,39 @@ This is used to switch between provided secret (e.g. by cert-manager) and created one (in case the CA is provided as PEM string.) */}} -{{- define "tlsSecretRef" -}} + +{{- define "cassandraTlsSecretName" -}} +{{- if .cassandra.tlsCaSecretRef -}} +{{ .cassandra.tlsCaSecretRef.name }} +{{- else }} +{{- print "elasticsearch-index-migrate-cassandra-client-ca" -}} +{{- end -}} +{{- end -}} + +{{- define "cassandraTlsSecretKey" -}} {{- if .cassandra.tlsCaSecretRef -}} -{{ .cassandra.tlsCaSecretRef | toYaml }} +{{ .cassandra.tlsCaSecretRef.key }} +{{- else }} +{{- print "ca.pem" -}} +{{- end -}} +{{- end -}} + +{{- define "configureElasticsearchCa" -}} +{{ or (hasKey .elasticsearch "tlsCa") (hasKey .elasticsearch "tlsCaSecretRef") }} +{{- end -}} + +{{- define "elasticsearchTlsSecretName" -}} +{{- if .elasticsearch.tlsCaSecretRef -}} +{{ .elasticsearch.tlsCaSecretRef.name }} +{{- else }} +{{- printf "%s-ca" (include "fullname" .) -}} +{{- end -}} +{{- end -}} + +{{- define "elasticsearchTlsSecretKey" -}} +{{- if .elasticsearch.tlsCaSecretRef -}} +{{ .elasticsearch.tlsCaSecretRef.key }} {{- else }} -{{- dict "name" "elasticsearch-index-migrate-cassandra-client-ca" "key" "ca.pem" | toYaml -}} +{{- print "ca.pem" -}} {{- end -}} {{- end -}} diff --git a/charts/elasticsearch-index/templates/create-index.yaml b/charts/elasticsearch-index/templates/create-index.yaml index 9e2c5fda798..225ecf82c9b 100644 --- a/charts/elasticsearch-index/templates/create-index.yaml +++ b/charts/elasticsearch-index/templates/create-index.yaml @@ -21,20 +21,48 @@ spec: chart: "{{.Chart.Name}}-{{.Chart.Version}}" spec: restartPolicy: OnFailure + {{- if or (eq (include "configureElasticsearchCa" .Values) "true") (hasKey .Values.secrets "elasticsearch") }} + volumes: + {{- if hasKey .Values.secrets "elasticsearch" }} + - name: elasticsearch-index-secrets + secret: + secretName: elasticsearch-index + {{- end }} + {{- if eq (include "configureElasticsearchCa" .Values) "true" }} + - name: elasticsearch-ca + secret: + secretName: {{ include "elasticsearchTlsSecretName" .Values }} + {{- end }} + {{- end }} initContainers: # Creates index in elasticsearch only when it doesn't exist. # Does nothing if the index exists. - name: brig-index-create image: "{{ .Values.image.repository }}:{{ .Values.image.tag }}" - imagePullPolicy: {{ default "" .Values.imagePullPolicy | quote }} - {{- if eq (include "includeSecurityContext" .) "true" }} + {{- if or (eq (include "configureElasticsearchCa" .Values) "true") (hasKey .Values.secrets "elasticsearch") }} + volumeMounts: + {{- if hasKey .Values.secrets "elasticsearch" }} + - name: "elasticsearch-index-secrets" + mountPath: "/etc/wire/elasticsearch-index/secrets" + {{- end }} + + {{- if eq (include "configureElasticsearchCa" .Values) "true" }} + - name: elasticsearch-ca + mountPath: "/certs/elasticsearch" + {{- end }} + {{- end }} + {{- if eq (include "includeSecurityContext" .) "true" }} securityContext: {{- toYaml .Values.podSecurityContext | nindent 12 }} - {{- end }} + {{- end }} args: - create - --elasticsearch-server - - "http://{{ required "missing elasticsearch-index.elasticsearch.host!" .Values.elasticsearch.host }}:{{ .Values.elasticsearch.port }}" + - "{{ .Values.elasticsearch.scheme }}://{{ required "missing elasticsearch-index.elasticsearch.host!" .Values.elasticsearch.host }}:{{ .Values.elasticsearch.port }}" + {{- if hasKey .Values.secrets "elasticsearch" }} + - --elasticsearch-credentials + - "/etc/wire/elasticsearch-index/secrets/elasticsearch-credentials.yaml" + {{- end }} - --elasticsearch-index - "{{ or (.Values.elasticsearch.additionalWriteIndex) (.Values.elasticsearch.index) }}" - --elasticsearch-shards=5 @@ -43,18 +71,48 @@ spec: {{- if .Values.elasticsearch.delete_template }} - --delete-template - "{{ .Values.elasticsearch.delete_template }}" - {{- end}} + {{- end }} + {{- if eq (include "configureElasticsearchCa" .Values) "true" }} + - --elasticsearch-ca-cert + - /certs/elasticsearch/{{- include "elasticsearchTlsSecretKey" .Values}} + {{- end }} + {{- if .Values.elasticsearch.insecureSkipTlsVerify }} + - --elasticsearch-insecure-skip-tls-verify + {{- end }} containers: - name: brig-index-update-mapping image: "{{ .Values.image.repository }}:{{ .Values.image.tag }}" imagePullPolicy: {{ default "" .Values.imagePullPolicy | quote }} - {{- if eq (include "includeSecurityContext" .) "true" }} + {{- if or (eq (include "configureElasticsearchCa" .Values) "true") (hasKey .Values.secrets "elasticsearch") }} + volumeMounts: + {{- if hasKey .Values.secrets "elasticsearch" }} + - name: "elasticsearch-index-secrets" + mountPath: "/etc/wire/elasticsearch-index/secrets" + {{- end }} + + {{- if eq (include "configureElasticsearchCa" .Values) "true" }} + - name: elasticsearch-ca + mountPath: "/certs/elasticsearch" + {{- end }} + {{- end }} + {{- if eq (include "includeSecurityContext" .) "true" }} securityContext: {{- toYaml .Values.podSecurityContext | nindent 12 }} - {{- end }} + {{- end }} args: - update-mapping - --elasticsearch-server - - "http://{{ required "missing elasticsearch-index.elasticsearch.host!" .Values.elasticsearch.host }}:{{ .Values.elasticsearch.port }}" + - "{{ .Values.elasticsearch.scheme }}://{{ required "missing elasticsearch-index.elasticsearch.host!" .Values.elasticsearch.host }}:{{ .Values.elasticsearch.port }}" + {{- if hasKey .Values.secrets "elasticsearch" }} + - --elasticsearch-credentials + - "/etc/wire/elasticsearch-index/secrets/elasticsearch-credentials.yaml" + {{- end }} - --elasticsearch-index - "{{ or (.Values.elasticsearch.additionalWriteIndex) (.Values.elasticsearch.index) }}" + {{- if eq (include "configureElasticsearchCa" .Values) "true" }} + - --elasticsearch-ca-cert + - /certs/elasticsearch/{{- include "elasticsearchTlsSecretKey" .Values}} + {{- end }} + {{- if .Values.elasticsearch.insecureSkipTlsVerify }} + - --elasticsearch-insecure-skip-tls-verify + {{- end }} diff --git a/charts/elasticsearch-index/templates/elasticsearch-ca-secret.yaml b/charts/elasticsearch-index/templates/elasticsearch-ca-secret.yaml new file mode 100644 index 00000000000..060d84e56a1 --- /dev/null +++ b/charts/elasticsearch-index/templates/elasticsearch-ca-secret.yaml @@ -0,0 +1,14 @@ +{{- if not (empty .Values.elasticsearch.tlsCa) }} +apiVersion: v1 +kind: Secret +metadata: + name: "{{ include "fullname" .}}-ca" + labels: + app: elasticsearch-index + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: "{{ .Release.Name }}" + heritage: "{{ .Release.Service }}" +type: Opaque +data: + ca.pem: {{ .Values.elasticsearch.tlsCa | b64enc | quote }} +{{- end }} diff --git a/charts/elasticsearch-index/templates/migrate-data.yaml b/charts/elasticsearch-index/templates/migrate-data.yaml index 3d54e1f51b8..3bf41e02a61 100644 --- a/charts/elasticsearch-index/templates/migrate-data.yaml +++ b/charts/elasticsearch-index/templates/migrate-data.yaml @@ -22,15 +22,18 @@ spec: spec: restartPolicy: OnFailure containers: - # Creates index in elasticsearch only when it doesn't exist. - # Does nothing if the index exists. + # Reindexes all users when a new migration is detected. - name: brig-index image: "{{ .Values.image.repository }}:{{ .Values.image.tag }}" imagePullPolicy: {{ default "" .Values.imagePullPolicy | quote }} args: - migrate-data - --elasticsearch-server - - "http://{{ required "missing elasticsearch-index.elasticsearch.host!" .Values.elasticsearch.host }}:{{ .Values.elasticsearch.port }}" + - "{{ .Values.elasticsearch.scheme }}://{{ required "missing elasticsearch-index.elasticsearch.host!" .Values.elasticsearch.host }}:{{ .Values.elasticsearch.port }}" + {{- if hasKey .Values.secrets "elasticsearch" }} + - --elasticsearch-credentials + - "/etc/wire/elasticsearch-index/secrets/elasticsearch-credentials.yaml" + {{- end }} - --elasticsearch-index - "{{ or (.Values.elasticsearch.additionalWriteIndex) (.Values.elasticsearch.index) }}" - --cassandra-host @@ -44,17 +47,42 @@ spec: - --galley-port - "{{ required "missing elasticsearch-index.galley.port!" .Values.galley.port }}" {{- if eq (include "useCassandraTLS" .Values) "true" }} - - --tls-ca-certificate-file - - /certs/{{- (include "tlsSecretRef" .Values | fromYaml).key }} + - --cassandra-ca-cert + - /certs/cassandra/{{- include "cassandraTlsSecretKey" .Values }} + {{- end }} + {{- if eq (include "configureElasticsearchCa" .Values) "true" }} + - --elasticsearch-ca-cert + - /certs/elasticsearch/{{- include "elasticsearchTlsSecretKey" .Values}} + {{- end }} + {{- if .Values.elasticsearch.insecureSkipTlsVerify }} + - --elasticsearch-insecure-skip-tls-verify {{- end }} - {{- if eq (include "useCassandraTLS" .Values) "true" }} volumeMounts: + {{- if hasKey .Values.secrets "elasticsearch" }} + - name: "elasticsearch-index-secrets" + mountPath: "/etc/wire/elasticsearch-index/secrets" + {{- end }} + {{- if eq (include "useCassandraTLS" .Values) "true" }} - name: elasticsearch-index-migrate-cassandra-client-ca - mountPath: "/certs" + mountPath: "/certs/cassandra" + {{- end }} + {{- if eq (include "configureElasticsearchCa" .Values) "true" }} + - name: elasticsearch-ca + mountPath: "/certs/elasticsearch" {{- end }} - {{- if eq (include "useCassandraTLS" .Values) "true" }} volumes: + {{- if hasKey .Values.secrets "elasticsearch" }} + - name: elasticsearch-index-secrets + secret: + secretName: elasticsearch-index + {{- end }} + {{- if eq (include "useCassandraTLS" .Values) "true" }} - name: elasticsearch-index-migrate-cassandra-client-ca secret: - secretName: {{ (include "tlsSecretRef" .Values | fromYaml).name }} - {{- end}} + secretName: {{ include "cassandraTlsSecretName" .Values }} + {{- end }} + {{- if eq (include "configureElasticsearchCa" .Values) "true" }} + - name: elasticsearch-ca + secret: + secretName: {{ include "elasticsearchTlsSecretName" .Values }} + {{- end }} diff --git a/charts/elasticsearch-index/templates/secret.yaml b/charts/elasticsearch-index/templates/secret.yaml new file mode 100644 index 00000000000..cda93a046bc --- /dev/null +++ b/charts/elasticsearch-index/templates/secret.yaml @@ -0,0 +1,20 @@ +{{- if hasKey .Values.secrets "elasticsearch" }} +apiVersion: v1 +kind: Secret +metadata: + name: elasticsearch-index + labels: + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: "{{ .Release.Name }}" + heritage: "{{ .Release.Service }}" + annotations: + "helm.sh/hook": pre-install,pre-upgrade + "helm.sh/hook-delete-policy": "before-hook-creation" +type: Opaque +data: + {{- with .Values.secrets }} + {{- if .elasticsearch }} + elasticsearch-credentials.yaml: {{ .elasticsearch | toYaml | b64enc }} + {{- end }} + {{- end }} +{{- end }} diff --git a/charts/elasticsearch-index/values.yaml b/charts/elasticsearch-index/values.yaml index 93e8a97ef6f..a7c136f233f 100644 --- a/charts/elasticsearch-index/values.yaml +++ b/charts/elasticsearch-index/values.yaml @@ -1,9 +1,18 @@ # Default values for elasticsearch-index elasticsearch: + scheme: http #host: # elasticsearch-client|elasticsearch-ephemeral port: 9200 index: directory delete_template: directory +# To enable TLS verification with a custom CA: +# tlsCa: +# +# Or refer to an existing secret (containing the CA): +# tlsCaSecretRef: +# name: +# key: + insecureSkipTlsVerify: false cassandra: # host: port: 9042 @@ -30,3 +39,5 @@ podSecurityContext: runAsNonRoot: true seccompProfile: type: RuntimeDefault + +secrets: {} diff --git a/charts/federator/templates/tests/federator-integration.yaml b/charts/federator/templates/tests/federator-integration.yaml index f30d7873798..e0d9673cd3e 100644 --- a/charts/federator/templates/tests/federator-integration.yaml +++ b/charts/federator/templates/tests/federator-integration.yaml @@ -16,7 +16,7 @@ spec: # integration tests need access to the client certificate private key - name: "federator-secrets" secret: - secretName: "federator-secret" + secretName: {{ if .Values.tls.useCertManager }} "federator-certificate-secret" {{ else }} "federator-secret" {{ end }} # integration tests need access to the CA - name: "federator-ca" configMap: diff --git a/charts/fluent-bit/requirements.yaml b/charts/fluent-bit/requirements.yaml index 096b844d3d8..bd546eee438 100644 --- a/charts/fluent-bit/requirements.yaml +++ b/charts/fluent-bit/requirements.yaml @@ -1,4 +1,4 @@ dependencies: - name: fluent-bit - version: 0.19.6 + version: 0.46.2 repository: https://fluent.github.io/helm-charts diff --git a/charts/fluent-bit/values.yaml b/charts/fluent-bit/values.yaml index b73a28e190d..26fe5d5dd02 100644 --- a/charts/fluent-bit/values.yaml +++ b/charts/fluent-bit/values.yaml @@ -22,6 +22,24 @@ fluent-bit: Retry_Limit False Trace_Error On Replace_Dots On + # syslog output reference - https://docs.fluentbit.io/manual/pipeline/outputs/syslog + # Uncomment this section to enable syslog output + # [OUTPUT] + # name syslog + # match * + # host syslog.yourserver.com + # port 514 + # mode udp + # syslog_format rfc5424 + # syslog_maxsize 2048 + # syslog_message_key message + # syslog_hostname_key hostname + # syslog_appname_key appname + # # syslog_severity_key severity + # # syslog_facility_key facility + # # syslog_procid_key procid + # # syslog_msgid_key msgid + # # syslog_sd_key sd ## https://docs.fluentbit.io/manual/pipeline/parsers customParsers: | [PARSER] diff --git a/charts/galley/templates/configmap.yaml b/charts/galley/templates/configmap.yaml index 1ff99379292..1043cc17416 100644 --- a/charts/galley/templates/configmap.yaml +++ b/charts/galley/templates/configmap.yaml @@ -75,10 +75,11 @@ data: federationDomain: {{ .settings.federationDomain }} {{- if $.Values.secrets.mlsPrivateKeys }} mlsPrivateKeyPaths: - {{- if $.Values.secrets.mlsPrivateKeys.removal.ed25519 }} removal: ed25519: "/etc/wire/galley/secrets/removal_ed25519.pem" - {{- end }} + ecdsa_secp256r1_sha256: "/etc/wire/galley/secrets/removal_ecdsa_secp256r1_sha256.pem" + ecdsa_secp384r1_sha384: "/etc/wire/galley/secrets/removal_ecdsa_secp384r1_sha384.pem" + ecdsa_secp521r1_sha512: "/etc/wire/galley/secrets/removal_ecdsa_secp521r1_sha512.pem" {{- end }} disabledAPIVersions: {{ toJson .settings.disabledAPIVersions }} {{- if .settings.featureFlags }} diff --git a/charts/galley/templates/secret.yaml b/charts/galley/templates/secret.yaml index 9cc45c39d1e..84995f51bc5 100644 --- a/charts/galley/templates/secret.yaml +++ b/charts/galley/templates/secret.yaml @@ -13,6 +13,15 @@ data: {{- if .Values.secrets.mlsPrivateKeys.removal.ed25519 }} removal_ed25519.pem: {{ .Values.secrets.mlsPrivateKeys.removal.ed25519 | b64enc | quote }} {{- end -}} + {{- if .Values.secrets.mlsPrivateKeys.removal.ecdsa_secp256r1_sha256 }} + removal_ecdsa_secp256r1_sha256.pem: {{ .Values.secrets.mlsPrivateKeys.removal.ecdsa_secp256r1_sha256 | b64enc | quote }} + {{- end -}} + {{- if .Values.secrets.mlsPrivateKeys.removal.ecdsa_secp384r1_sha384 }} + removal_ecdsa_secp384r1_sha384.pem: {{ .Values.secrets.mlsPrivateKeys.removal.ecdsa_secp384r1_sha384 | b64enc | quote }} + {{- end -}} + {{- if .Values.secrets.mlsPrivateKeys.removal.ecdsa_secp521r1_sha512 }} + removal_ecdsa_secp521r1_sha512.pem: {{ .Values.secrets.mlsPrivateKeys.removal.ecdsa_secp521r1_sha512 | b64enc | quote }} + {{- end -}} {{- end -}} {{- if $.Values.config.enableFederation }} diff --git a/charts/gundeck/templates/configmap.yaml b/charts/gundeck/templates/configmap.yaml index cac6782ab9a..bd49b906760 100644 --- a/charts/gundeck/templates/configmap.yaml +++ b/charts/gundeck/templates/configmap.yaml @@ -55,7 +55,7 @@ data: settings: httpPoolSize: 1024 - notificationTTL: 2419200 + notificationTTL: {{ required "config.notificationTTL" .notificationTTL }} bulkPush: {{ .bulkPush }} {{- if hasKey . "perNativePushConcurrency" }} perNativePushConcurrency: {{ .perNativePushConcurrency }} diff --git a/charts/gundeck/templates/deployment.yaml b/charts/gundeck/templates/deployment.yaml index 20ca7988245..ec1e064ccc2 100644 --- a/charts/gundeck/templates/deployment.yaml +++ b/charts/gundeck/templates/deployment.yaml @@ -65,6 +65,34 @@ spec: name: gundeck key: awsSecretKey {{- end }} + {{- if hasKey .Values.secrets "redisUsername" }} + - name: REDIS_USERNAME + valueFrom: + secretKeyRef: + name: gundeck + key: redisUsername + {{- end }} + {{- if hasKey .Values.secrets "redisPassword" }} + - name: REDIS_PASSWORD + valueFrom: + secretKeyRef: + name: gundeck + key: redisPassword + {{- end }} + {{- if hasKey .Values.secrets "redisAdditionalWriteUsername" }} + - name: REDIS_ADDITIONAL_WRITE_USERNAME + valueFrom: + secretKeyRef: + name: gundeck + key: redisAdditionalWriteUsername + {{- end }} + {{- if hasKey .Values.secrets "redisAdditionalWritePassword" }} + - name: REDIS_ADDITIONAL_WRITE_PASSWORD + valueFrom: + secretKeyRef: + name: gundeck + key: redisAdditionalWritePassword + {{- end }} - name: AWS_REGION value: "{{ .Values.config.aws.region }}" {{- with .Values.config.proxy }} diff --git a/charts/gundeck/templates/secret.yaml b/charts/gundeck/templates/secret.yaml index 459ab0f24f4..eae9c4ab33d 100644 --- a/charts/gundeck/templates/secret.yaml +++ b/charts/gundeck/templates/secret.yaml @@ -1,4 +1,4 @@ -{{- if hasKey .Values.secrets "awsKeyId" }} +{{- if not (empty .Values.secrets) }} apiVersion: v1 kind: Secret metadata: @@ -11,7 +11,23 @@ metadata: type: Opaque data: {{- with .Values.secrets }} + {{- if hasKey . "awsKeyId" }} awsKeyId: {{ .awsKeyId | b64enc | quote }} + {{- end }} + {{- if hasKey . "awsSecretKey" }} awsSecretKey: {{ .awsSecretKey | b64enc | quote }} {{- end }} + {{- if hasKey . "redisUsername" }} + redisUsername: {{ .redisUsername | b64enc | quote }} + {{- end }} + {{- if hasKey . "redisPassword" }} + redisPassword: {{ .redisPassword | b64enc | quote }} + {{- end }} + {{- if hasKey . "redisAdditionalWriteUsername" }} + redisAdditionalWriteUsername: {{ .redisAdditionalWriteUsername | b64enc | quote }} + {{- end }} + {{- if hasKey . "redisAdditionalWritePassword" }} + redisAdditionalWritePassword: {{ .redisAdditionalWritePassword | b64enc | quote }} + {{- end }} + {{- end }} {{- end }} diff --git a/charts/gundeck/templates/tests/configmap.yaml b/charts/gundeck/templates/tests/configmap.yaml index e2051925c11..b3e1423acf6 100644 --- a/charts/gundeck/templates/tests/configmap.yaml +++ b/charts/gundeck/templates/tests/configmap.yaml @@ -41,6 +41,6 @@ data: # a "redis migration" test in gundeck makes use of a second (distinct) redis redis2: - host: redis-ephemeral-master + host: redis-ephemeral-2-master port: 6379 connectionMode: master diff --git a/charts/gundeck/templates/tests/gundeck-integration.yaml b/charts/gundeck/templates/tests/gundeck-integration.yaml index 8b00f2c9865..088ed679bdb 100644 --- a/charts/gundeck/templates/tests/gundeck-integration.yaml +++ b/charts/gundeck/templates/tests/gundeck-integration.yaml @@ -73,6 +73,34 @@ spec: value: "eu-west-1" - name: TEST_XML value: /tmp/result.xml + {{- if hasKey .Values.secrets "redisUsername" }} + - name: REDIS_USERNAME + valueFrom: + secretKeyRef: + name: gundeck + key: redisUsername + {{- end }} + {{- if hasKey .Values.secrets "redisPassword" }} + - name: REDIS_PASSWORD + valueFrom: + secretKeyRef: + name: gundeck + key: redisPassword + {{- end }} + {{- if and (hasKey .Values.tests "secrets") (hasKey .Values.tests.secrets "redisAdditionalWriteUsername") }} + - name: REDIS_ADDITIONAL_WRITE_USERNAME + valueFrom: + secretKeyRef: + name: gundeck-integration + key: redisAdditionalWriteUsername + {{- end }} + {{- if and (hasKey .Values.tests "secrets") (hasKey .Values.tests.secrets "redisAdditionalWritePassword") }} + - name: REDIS_ADDITIONAL_WRITE_PASSWORD + valueFrom: + secretKeyRef: + name: gundeck-integration + key: redisAdditionalWritePassword + {{- end }} {{- if .Values.tests.config.uploadXml }} - name: UPLOAD_XML_S3_BASE_URL value: {{ .Values.tests.config.uploadXml.baseUrl }} diff --git a/charts/gundeck/templates/tests/secret.yaml b/charts/gundeck/templates/tests/secret.yaml index 1af8959e4c3..ff5712545c8 100644 --- a/charts/gundeck/templates/tests/secret.yaml +++ b/charts/gundeck/templates/tests/secret.yaml @@ -1,3 +1,4 @@ +{{- if not (empty .Values.tests.secrets) }} apiVersion: v1 kind: Secret metadata: @@ -10,7 +11,17 @@ metadata: type: Opaque data: {{- with .Values.tests.secrets }} + {{- if hasKey . "uploadXmlAwsAccessKeyId" }} uploadXmlAwsAccessKeyId: {{ .uploadXmlAwsAccessKeyId | b64enc | quote }} + {{- end }} + {{- if hasKey . "uploadXmlAwsSecretAccessKey" }} uploadXmlAwsSecretAccessKey: {{ .uploadXmlAwsSecretAccessKey | b64enc | quote }} {{- end }} - + {{- if hasKey . "redisAdditionalWriteUsername" }} + redisAdditionalWriteUsername: {{ .redisAdditionalWriteUsername | b64enc | quote }} + {{- end }} + {{- if hasKey . "redisAdditionalWritePassword" }} + redisAdditionalWritePassword: {{ .redisAdditionalWritePassword | b64enc | quote }} + {{- end }} + {{- end }} +{{- end }} diff --git a/charts/gundeck/values.yaml b/charts/gundeck/values.yaml index 75f3ce54ef7..80816a0eaad 100644 --- a/charts/gundeck/values.yaml +++ b/charts/gundeck/values.yaml @@ -57,6 +57,11 @@ config: # the database if notifications have inlined payloads. internalPageSize: 100 + # TTL of stored notifications in Seconds. After this period, notifications + # will be deleted and thus not delivered. + # The default is 28 days. + notificationTTL: 2419200 + serviceAccount: # When setting this to 'false', either make sure that a service account named # 'gundeck' exists or change the 'name' field to 'default' diff --git a/charts/integration/templates/_helpers.tpl b/charts/integration/templates/_helpers.tpl index e278f287d1f..68e9c251380 100644 --- a/charts/integration/templates/_helpers.tpl +++ b/charts/integration/templates/_helpers.tpl @@ -42,14 +42,18 @@ {{ or (hasKey .cassandra "tlsCa") (hasKey .cassandra "tlsCaSecretRef") }} {{- end -}} -{{/* Return a Dict of TLS CA secret name and key -This is used to switch between provided secret (e.g. by cert-manager) and -created one (in case the CA is provided as PEM string.) -*/}} -{{- define "tlsSecretRef" -}} +{{- define "cassandraTlsSecretName" -}} {{- if .cassandra.tlsCaSecretRef -}} -{{ .cassandra.tlsCaSecretRef | toYaml }} +{{ .cassandra.tlsCaSecretRef.name }} {{- else }} -{{- dict "name" "integration-cassandra" "key" "ca.pem" | toYaml -}} +{{- print "integration-cassandra" -}} +{{- end -}} +{{- end -}} + +{{- define "cassandraTlsSecretKey" -}} +{{- if .cassandra.tlsCaSecretRef -}} +{{ .cassandra.tlsCaSecretRef.key }} +{{- else }} +{{- print "ca.pem" -}} {{- end -}} {{- end -}} diff --git a/charts/integration/templates/configmap.yaml b/charts/integration/templates/configmap.yaml index e18128cbf58..2c2178dc14f 100644 --- a/charts/integration/templates/configmap.yaml +++ b/charts/integration/templates/configmap.yaml @@ -125,3 +125,43 @@ data: {{- if eq (include "useCassandraTLS" .Values.config) "true" }} tlsCa: /etc/wire/galley/cassandra/{{- (include "tlsSecretRef" .Values.config | fromYaml).key }} {{- end }} + + federation-v0: + originDomain: federation-test-helper.wire-federation-v0.svc.cluster.local + brig: + host: brig.wire-federation-v0.svc.cluster.local + port: 8080 + cannon: + host: cannon.wire-federation-v0.svc.cluster.local + port: 8080 + cargohold: + host: cargohold.wire-federation-v0.svc.cluster.local + port: 8080 + federatorInternal: + host: federator.wire-federation-v0.svc.cluster.local + port: 8080 + federatorExternal: + host: federator.wire-federation-v0.svc.cluster.local + port: 8081 + galley: + host: galley.wire-federation-v0.svc.cluster.local + port: 8080 + gundeck: + host: gundeck.wire-federation-v0.svc.cluster.local + port: 8080 + nginz: + host: nginz-integration-http.wire-federation-v0.svc.cluster.local + port: 8080 + spar: + host: spar.wire-federation-v0.svc.cluster.local + port: 8080 + proxy: + host: proxy.wire-federation-v0.svc.cluster.local + port: 8080 + backgroundWorker: + host: backgroundWorker.wire-federation-v0.svc.cluster.local + port: 8080 + stern: + host: stern.wire-federation-v0.svc.cluster.local + port: 8080 + integrationTestHostName: integration-headless.{{ .Release.Namespace }}.svc.cluster.local diff --git a/charts/integration/templates/ingress.yaml b/charts/integration/templates/ingress.yaml index 8ae7a87b23a..7d2748022f0 100644 --- a/charts/integration/templates/ingress.yaml +++ b/charts/integration/templates/ingress.yaml @@ -17,7 +17,7 @@ metadata: nginx.ingress.kubernetes.io/backend-protocol: "HTTP" nginx.ingress.kubernetes.io/auth-tls-verify-client: "on" nginx.ingress.kubernetes.io/auth-tls-verify-depth: "{{ $.Values.tls.verify_depth }}" - nginx.ingress.kubernetes.io/auth-tls-secret: "{{ $.Release.Namespace }}/federator-ca-secret" + nginx.ingress.kubernetes.io/auth-tls-secret: "{{ or $.Values.tls.caNamespace $.Release.Namespace }}/federator-ca-secret" nginx.ingress.kubernetes.io/configuration-snippet: | proxy_set_header "X-SSL-Certificate" $ssl_client_escaped_cert; spec: diff --git a/charts/integration/templates/integration-integration.yaml b/charts/integration/templates/integration-integration.yaml index 5199c03def4..fa5e32bb604 100644 --- a/charts/integration/templates/integration-integration.yaml +++ b/charts/integration/templates/integration-integration.yaml @@ -75,10 +75,15 @@ spec: - name: "nginz-secrets" secret: secretName: "nginz" + + - name: elasticsearch-ca + secret: + secretName: {{ .Values.config.elasticsearch.tlsCaSecretRef.name }} + {{- if eq (include "useCassandraTLS" .Values.config) "true" }} - name: integration-cassandra secret: - secretName: {{ (include "tlsSecretRef" .Values.config | fromYaml).name }} + secretName: {{ include "cassandraTlsSecretName" .Values.config }} {{- end }} restartPolicy: Never @@ -90,9 +95,11 @@ spec: {{- toYaml .Values.podSecurityContext | nindent 6 }} {{- end }} volumeMounts: + - name: elasticsearch-ca + mountPath: "/certs/elasticsearch" {{- if eq (include "useCassandraTLS" .Values.config) "true" }} - name: "integration-cassandra" - mountPath: "/certs" + mountPath: "/certs/cassandra" {{- end }} env: - name: INTEGRATION_DYNAMIC_BACKENDS_POOLSIZE @@ -124,10 +131,12 @@ spec: --port {{ .Values.config.cassandra.port }} \ --replication-factor {{ .Values.config.cassandra.replicationFactor }} \ {{- if eq (include "useCassandraTLS" .Values.config) "true" }} - --tls-ca-certificate-file /certs/{{- (include "tlsSecretRef" .Values.config | fromYaml).key }} + --tls-ca-certificate-file /certs/cassandra/{{- include "cassandraTlsSecretKey" .Values.config }} {{ end }} - integration-dynamic-backends-brig-index.sh --elasticsearch-server http://{{ .Values.config.elasticsearch.host }}:9200 + integration-dynamic-backends-brig-index.sh \ + --elasticsearch-server https://elastic:changeme@{{ .Values.config.elasticsearch.host }}:9200 \ + --elasticsearch-ca-cert /certs/elasticsearch/{{ .Values.config.elasticsearch.tlsCaSecretRef.key }} integration-dynamic-backends-ses.sh {{ .Values.config.sesEndpointUrl }} integration-dynamic-backends-s3.sh {{ .Values.config.s3EndpointUrl }} {{- range $name, $dynamicBackend := .Values.config.dynamicBackends }} @@ -227,6 +236,9 @@ spec: - name: nginz-secrets mountPath: /etc/wire/nginz/secrets + - name: elasticsearch-ca + mountPath: /etc/wire/brig/elasticsearch-ca + {{- if eq (include "useCassandraTLS" .Values.config) "true" }} - name: "integration-cassandra" mountPath: "/certs" @@ -262,6 +274,20 @@ spec: secretKeyRef: name: brig key: rabbitmqPassword + {{- if hasKey .Values.secrets "redisUsername" }} + - name: REDIS_USERNAME + valueFrom: + secretKeyRef: + name: integration + key: redisUsername + {{- end }} + {{- if hasKey .Values.secrets "redisPassword" }} + - name: REDIS_PASSWORD + valueFrom: + secretKeyRef: + name: integration + key: redisPassword + {{- end }} - name: TEST_XML value: /tmp/result.xml {{- if .Values.config.uploadXml }} diff --git a/charts/integration/templates/secret.yaml b/charts/integration/templates/secret.yaml index 52c3199b5f0..32f6085176e 100644 --- a/charts/integration/templates/secret.yaml +++ b/charts/integration/templates/secret.yaml @@ -10,6 +10,16 @@ metadata: type: Opaque data: {{- with .Values.secrets }} + {{- if hasKey . "uploadXmlAwsAccessKeyId" }} uploadXmlAwsAccessKeyId: {{ .uploadXmlAwsAccessKeyId | b64enc | quote }} + {{- end }} + {{- if hasKey . "uploadXmlAwsSecretAccessKey" }} uploadXmlAwsSecretAccessKey: {{ .uploadXmlAwsSecretAccessKey | b64enc | quote }} {{- end }} + {{- if hasKey . "redisUsername" }} + redisUsername: {{ .redisUsername | b64enc | quote }} + {{- end }} + {{- if hasKey . "redisPassword" }} + redisPassword: {{ .redisPassword | b64enc | quote }} + {{- end }} + {{- end }} diff --git a/charts/integration/templates/service.yaml b/charts/integration/templates/service.yaml index d445160ad4e..350b33f11f7 100644 --- a/charts/integration/templates/service.yaml +++ b/charts/integration/templates/service.yaml @@ -1,4 +1,15 @@ {{- $newLabels := eq (include "integrationTestHelperNewLabels" .) "true" -}} +--- +apiVersion: v1 +kind: Service +metadata: + name: integration-headless +spec: + selector: + app: integration-integration + type: ClusterIP + clusterIP: None + --- apiVersion: v1 kind: Service diff --git a/charts/integration/values.yaml b/charts/integration/values.yaml index 25de2d456e7..f1310f8fa4e 100644 --- a/charts/integration/values.yaml +++ b/charts/integration/values.yaml @@ -39,6 +39,9 @@ config: tls: verify_depth: 1 + # Namespace from which to obtain the secret containing the CA trusted by + # federator. + # caNamespace: wire-federation-v0 ingress: class: nginx diff --git a/charts/nginx-ingress-services/templates/certificate_federator.yaml b/charts/nginx-ingress-services/templates/certificate_federator.yaml index 3437ab5aad5..0ac26b6b2f1 100644 --- a/charts/nginx-ingress-services/templates/certificate_federator.yaml +++ b/charts/nginx-ingress-services/templates/certificate_federator.yaml @@ -31,5 +31,5 @@ spec: encoding: PKCS1 rotationPolicy: Always dnsNames: - - {{ .Values.config.dns.federator }} + - "{{ or .Values.config.dns.certificateDomain .Values.config.dns.federator }}" {{- end -}} diff --git a/charts/nginx-ingress-services/templates/ingress_federator.yaml b/charts/nginx-ingress-services/templates/ingress_federator.yaml index e9fa137ebca..fa76aae8d95 100644 --- a/charts/nginx-ingress-services/templates/ingress_federator.yaml +++ b/charts/nginx-ingress-services/templates/ingress_federator.yaml @@ -19,7 +19,7 @@ metadata: nginx.ingress.kubernetes.io/backend-protocol: "HTTP" nginx.ingress.kubernetes.io/auth-tls-verify-client: "on" nginx.ingress.kubernetes.io/auth-tls-verify-depth: "{{ .Values.tls.verify_depth }}" - nginx.ingress.kubernetes.io/auth-tls-secret: "{{ .Release.Namespace }}/federator-ca-secret" + nginx.ingress.kubernetes.io/auth-tls-secret: "{{ or $.Values.tls.caNamespace $.Release.Namespace }}/federator-ca-secret" nginx.ingress.kubernetes.io/configuration-snippet: | proxy_set_header "X-SSL-Certificate" $ssl_client_escaped_cert; spec: diff --git a/charts/nginx-ingress-services/values.yaml b/charts/nginx-ingress-services/values.yaml index bbdb5928bc8..73d7ee2ee6f 100644 --- a/charts/nginx-ingress-services/values.yaml +++ b/charts/nginx-ingress-services/values.yaml @@ -45,6 +45,9 @@ tls: # leak a hint about a common origin. name: letsencrypt-http01 kind: Issuer # Issuer | ClusterIssuer + # Namespace from which to obtain the secret containing the CA trusted by + # federator. + # caNamespace: wire-federation-v0 # Name of the ingress. # @@ -118,6 +121,8 @@ config: # ^ fakeS3 is ignored if fakeS3.enabled == false # federator: federator. # ^ federator is ignored unless federator.enabled == true +# certificateDomain: federator. +# ^ domain to use in the CSR when using cert-manager # teamSettings: teams. # ^ teamSettings is ignored unless teamSettings.enabled == true # accountPages: account. diff --git a/charts/nginz/templates/conf/_deeplink.json.tpl b/charts/nginz/templates/conf/_deeplink.json.tpl index da5ddb19a6d..5a11f07b1a6 100644 --- a/charts/nginz/templates/conf/_deeplink.json.tpl +++ b/charts/nginz/templates/conf/_deeplink.json.tpl @@ -15,6 +15,15 @@ "websiteURL": {{ .websiteURL | quote }} {{- end }} }, + {{- if hasKey . "apiProxy" }} + {{- with .apiProxy }} + "apiProxy" : { + "host" : {{ .host | quote }}, + "port" : {{ .port }}, + "needsAuthentication" : {{ .needsAuthentication }} + }, + {{- end }} + {{- end }} "title" : {{ .title | quote }} } {{- end }} diff --git a/charts/nginz/templates/conf/_nginx.conf.tpl b/charts/nginz/templates/conf/_nginx.conf.tpl index d2c92d579b2..e50fadfa021 100644 --- a/charts/nginz/templates/conf/_nginx.conf.tpl +++ b/charts/nginz/templates/conf/_nginx.conf.tpl @@ -125,6 +125,11 @@ http { 0 ""; } + map $rate_limit $rate_limited_by_zuser_path { + 1 "$zauth_user$uri"; + 0 ""; + } + map $http_origin $cors_header { default ""; {{ range $origin := .Values.nginx_conf.allowlisted_origins }} @@ -275,6 +280,10 @@ http { limit_req zone={{ $location.specific_user_rate_limit }}{{ if hasKey $location "specific_user_rate_limit_burst" }} burst={{ $location.specific_user_rate_limit_burst }}{{ end }} nodelay; {{- end }} + {{- range $specific_limit := $location.specific_rate_limits }} + limit_req zone={{ $specific_limit.zone }}{{ if hasKey $specific_limit "burst" }} burst={{ $specific_limit.burst }}{{ end }} nodelay; + {{- end }} + if ($request_method = 'OPTIONS') { add_header 'Access-Control-Allow-Methods' "GET, POST, PUT, DELETE, OPTIONS"; add_header 'Access-Control-Allow-Headers' "$http_access_control_request_headers, DNT,X-Mx-ReqToken,Keep-Alive,User-Agent,X-Requested-With,If-Modified-Since,Cache-Control,Content-Type"; diff --git a/charts/nginz/values.yaml b/charts/nginz/values.yaml index c9d6594f942..2bfa5ae21d9 100644 --- a/charts/nginz/values.yaml +++ b/charts/nginz/values.yaml @@ -67,6 +67,9 @@ nginx_conf: user_rate_limit_request_zones: - limit_req_zone $rate_limited_by_addr zone=reqs_per_addr_sso:12m rate=50r/s; - limit_req_zone $rate_limited_by_zuser zone=reqs_per_user_signatures:12m rate=10r/m; + - limit_req_zone $rate_limited_by_zuser zone=key_package_claims_per_user:12m rate=3000r/m; + - limit_req_zone $rate_limited_by_zuser_path zone=key_package_claims_per_user_per_target:12m rate=100r/m; + - limit_req_zone $rate_limited_by_zuser zone=one2one_conv:12m rate=3000r/m; # The origins from which we allow CORS requests. These are combined with # 'external_env_domain' and 'additional_external_env_domains' to form a full @@ -209,6 +212,20 @@ nginx_conf: - path: /clients envs: - all + - path: /mls/key-packages/claim + envs: + - all + specific_rate_limits: + # This endpoint gets called for every user that will get added to a + # conversation. A lot of these are expected during conversation + # creation. + - zone: key_package_claims_per_user + burst: 600 + - zone: key_package_claims_per_user_per_target + burst: 100 + # The name is a little misleading, this just disables default rate + # limiting in favour of the specific one defined above. + unlimited_requests_endpoint: true - path: /mls/key-packages envs: - all @@ -440,6 +457,15 @@ nginx_conf: - all max_body_size: 40m body_buffer_size: 256k + - path: /conversations/one2one/ + envs: + - all + # During MLS migration, this endpoint gets called _a lot_. + specific_user_rate_limit: one2one_conv + specific_user_rate_limit_burst: 1000 + # The name is a little misleading, this just disables default rate + # limiting in favour of the specific one defined above. + unlimited_requests_endpoint: true - path: /conversations/([^/]*)/([^/]*)/protocol envs: - all diff --git a/charts/sftd/Chart.yaml b/charts/sftd/Chart.yaml deleted file mode 100644 index 3ebbb82a5ca..00000000000 --- a/charts/sftd/Chart.yaml +++ /dev/null @@ -1,14 +0,0 @@ -apiVersion: v2 -name: sftd -description: SFTD is a component for engaging in conference calls -type: application - -# This is the chart version. This version number should be incremented each time you make changes -# to the chart and its templates, including the app version. -# Versions are expected to follow Semantic Versioning (https://semver.org/) -version: 0.0.42 - -# This is the version number of the application being deployed. This version number should be -# incremented each time you make changes to the application. Versions are not expected to -# follow Semantic Versioning. They should reflect the version the application is using. -appVersion: 4.0.10 diff --git a/charts/sftd/README.md b/charts/sftd/README.md deleted file mode 100644 index 2cdb05de31c..00000000000 --- a/charts/sftd/README.md +++ /dev/null @@ -1,259 +0,0 @@ -# SFTD Chart - -In theory the `sftd` chart can be installed on its own, but it's usually -installed as part of the `wire-server` umbrella chart. - -## Parameters - -### Required -| Parameter | Description | -|-----------------|---------------------------------------------------------------------------------------------| -| `host` | The domain name on which the SFT will be reachable. Should point to your ingress controller | -| `allowOrigin` | Allows CORS requests on this domain. Set this to the domain of your wire webapp. | - - -### Bring your own certificate -| Parameter | Description | -|-----------------|---------------------------------------------------------------------------------------------| -| `tls.key` | Private key of the TLS certificate for `host` | -| `tls.crt` | TLS certificate for `host` | - -### Cert-manager certificate - -| Parameter | Description | -|-----------------|----------------------------------------------------------------------------------------------------------------------------------------------------| -| `tls.issuerRef` | describes what [Issuer](https://cert-manager.io/docs/reference/api-docs/#meta.cert-manager.io/v1.ObjectReference) to use to request a certificate | - - -### Other (optional) parameters - -| Parameter | Default | Description | -|---------------------------------|---------|---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------| -| `terminationGracePeriodSeconds` | `10` | The time to wait after terminating an sft node before shutting it down. Useful to wait for a pod to have less calls before shutting down. Pod won't take new calls whilst terminating | -| `replicaCount` | `1` | Amount of SFT servers to run. Only one SFT server can run per node. So `replicaCount <= nodeCount` | -| `nodeSelector`, `affinity` | `{}` | Used to constraint SFT servers to only run on specific nodes | - -Please see [values.yaml](./values.yaml) for an overview of other parameters that can be configured. - -## Deploy - - -#### As part of `wire-server` umbrella chart - -The `sftd` can be deployed as part of the `wire-server` umbrella chart. You can -edit the `values.yaml` of your `wire-server` chart to configure sftd. - -```yaml -tags: - sftd: true - -sftd: - host: sftd.wire.example - allowOrigin: https://webapp.wire.example - tls: - # The https://cert-manager.io issuer to use to retrieve a certificate - issuerRef: - kind: ClusterIssuer - name: letsencrypt-prod -``` - -#### Standalone - -You can also install `sftd` as stand-alone. This is useful if you want to be -more careful with releases and want to decouple the release lifecycle of `sftd` -and `wire-server`. For example, if you set `terminationGracePeriodSeconds` to -allow calls to drain to a large number (say a few hours), this would make the -deployment of the `wire-server` umbrella-chart that usually is snappy to run -very slow. - - -``` -helm install sftd wire/sftd \ - --set host=sftd.wire.example \ - --set allowOrigin=https://webapp.wire.example \ - --set-file tls.crt=/path/to/tls.crt \ - --set-file tls.key=/path/to/tls.key -``` - - -the `host` option will be used to set up an `Ingress` object. - -The domain in `host` must point to the public IP you have deployed to handle -incoming traffic to your cluster. This is environment-specific. - -You can switch between `cert-manager` and own-provided certificates at any -time. Helm will delete the `sftd` secret automatically and then cert-manager -will create it instead. - - -`allowOrigin` MUST be in sync the domain where the web app is hosted -as configured in the `wire-server` chart or the webapp will not be able to contact the SFT -server. - -You MUST configure `brig` to hand out the SFT server to clients, in order for clients to be -able to use the new conference calling features: - -```yaml -brig: - # ... - optSettings: - # ... - setSftStaticUrl: https://sftd.wire.example:443 -``` - -## Routability - -We currently require network connectivity between clients and the SFT server -and between the SFT server and the restund servers. In other words; the SFT -server needs to be directly reachable on its public IP to clients and should be -able to reach the restund servers on their public IPs. - -More exotic setups _are_ possible but are currently *not* officially supported. Please -contact us if you have different constraints. - -### No public IP on default interface - -Often on-prem or at certain cloud providers your nodes will not have directly routable public IP addresses -but are deployed in 1:1 NAT. This chart is able to auto-detect this scenario if your cloud providers adds -an `ExternalIP` field to your kubernetes node objects. - -On on-prem you should set an `wire.com/external-ip` annotation on your kubernetes nodes so that sftd is aware -of its external IP when it gets scheduled on a node. - -If you use our kubespray playbooks to bootstrap kubernetes, you simply have to -set the `external_ip` field in your `group_vars` -```yaml -# inventory/group_vars/k8s-cluster -node_annotations: - wire.com/external-ip: {{ external_ip }} -``` -And the `external_ip` is set in the inventory per node: -``` -node0 ansible_host=.... ip=... external_ip=aaa.xxx.yyy.zzz -``` - -If you are hosting Kubernetes through other means you can annotate your nodes manually: -``` -$ kubectl annotate node $HOSTNAME wire.com/external-ip=$EXTERNAL_IP -``` - -## Rollout - -Kubernetes will shut down pods and start new ones when rolling out a release. Any calls -that were in progress on said pod will be terminated and will cause the call to drop. - -Kubernetes can be configured to wait for a certain amount of seconds before -stopping the pod. During this timeframe new calls wil not be initiated on the -pod, but existing calls will also not be disrupted. If you want to roll out a -release with minimal impact you can set the -[`terminationGracePeriodSeconds`](./values.yaml#L18) option to the maximum -length you want to wait before cutting off calls. - -For example to cordon SFTs for one hour before dropping calls: -``` -helm upgrade sftd wire/sftd --set terminationGracePeriodSeconds=3600 -``` - -Currently due to the fact we're using a `StatefulSet` to orchestrate update -rollouts, and `StatefulSet`s will not replace all pods at once but instead -one-for-one (aka. *rolling update*), a rollout of a release will take `oldReplicas * terminationGracePeriodSeconds` -to complete. - - -## Scaling up or down - -You can scale up and down by specifying `replicas`: - -```yaml -sftd: - replicaCount: 3 -``` - -By default we provision *1* replica. - -Note that due to the usage of `hostNetwork` there can only be _one_ instance of -`sftd` per Kubernetes node. You will need as many nodes available as you have -replicas. - -As a rule of thumb we support *50* concurrent connections per *1 vCPU*. These -numbers might improve as we work on optimizing the SFTD code. You should adjust -the amount of replicas based on your expected usage patterns and Kubernetes -node specifications. - -If you're using a Kubernetes cloud offering, we recommend setting up cluster -auto-scaling so that you automatically provision new Kubernetes nodes when the -amount of replicas increases above the amount of nodes available. - - -## Multiple sftd deployments in a single cluster -Because sftd uses the `hostNetwork` and binds to the public IP of the node, -there can only be one `sftd` pod running per node in the cluster. Within a -single `StatefulSet` kubernetes will make sure no two pods are scheduled on the -same machine automatically. However, if you have multiple `sftd` deployments under -different releases names or in a different namespace more care has to be taken. - -You can set the `nodeSelector` option; to make sure your sftd releases run on disjoint sets of nodes. - -For example, consider the following inventory of nodes, where there are two groups -annotated with - -``` -[sftd-prod:vars] -node_labels="wire.com/role=sftd-prod" -[sftd-staging:vars] -node_labels="wire.com/role=sftd-staging" - -[sftd-prod] -node0 -node1 -node3 - -[sftd-staging] -node4 -``` - -Then we can make two `sftd` deployments and make sure Kubernetes schedules them on distinct set of nodes: - -``` -helm install wire-prod charts/wire-server --set 'nodeSelector.wire\.com/role=sftd-prod' ...other-flags -helm install wire-staging charts/wire-server --set 'nodeSelector.wire\.com/role=sftd-staging' ...other-flags -``` - - -## Port conflicts and `hostNetwork` - -Kubernetes by default allocates node ports in the `30000-32768` range. This can -be adjusted with the `--service-nodeport-range` flag. -https://kubernetes.io/docs/concepts/services-networking/service/ SFTD asks the -kernel for free ports, which by default are in the `32768-61000` range -(https://ma.ttias.be/linux-increase-ip_local_port_range-tcp-port-range/). - -On a default installation these ranges do not overlap and sftd should never have -conflicts with kubernetes components. You should however check that on your OS -these ranges aren't configured differently. - - - -# Future work - -We're (ab-)using a `StatefulSet` to give each pod a stable DNS name and use -that to route call join requests to the right calling service. - -Downside of `StatefulSet` is that rollouts are slow -- propoerionally to how -high you set `terminationGracePeriodSeconds`. - -However, it seems that `coredns` supports to be configured to have the same DNS -behaviour for any pods, not just pods in `StatefulSet`s. -(https://github.com/kubernetes/kubernetes/issues/47992#issuecomment-499580692) - -This requires a deployer of wire to edit their cluster's CoreDNS config to set -the -[`endpoint_pod_names`](https://github.com/coredns/coredns/tree/master/plugin/kubernetes) -option which they might not have the ability to do. - -If you are able to set this setting, you could use a `Deployment` instead of a -`StatefulSet`. The benefit of a `Deployment` is that it replaces all pods at -once; such that you do not have to wait `replicaCount * -terminationGracePeriodSeconds` for a rollout to finish but just -`terminationGracePeriodSeconds`. This drastically improves operations. We -should expose this as an option for a future release. diff --git a/charts/sftd/templates/_helpers.tpl b/charts/sftd/templates/_helpers.tpl deleted file mode 100644 index 05918c69f6e..00000000000 --- a/charts/sftd/templates/_helpers.tpl +++ /dev/null @@ -1,91 +0,0 @@ -{{/* -Expand the name of the chart. -*/}} -{{- define "sftd.name" -}} -{{- default .Chart.Name .Values.nameOverride | trunc 63 | trimSuffix "-" }} -{{- end }} - -{{/* -Create a default fully qualified app name. -We truncate at 63 chars because some Kubernetes name fields are limited to this (by the DNS naming spec). -If release name contains chart name it will be used as a full name. -*/}} -{{- define "sftd.fullname" -}} -{{- if .Values.fullnameOverride }} -{{- .Values.fullnameOverride | trunc 63 | trimSuffix "-" }} -{{- else }} -{{- $name := default .Chart.Name .Values.nameOverride }} -{{- if contains $name .Release.Name }} -{{- .Release.Name | trunc 63 | trimSuffix "-" }} -{{- else }} -{{- printf "%s-%s" .Release.Name $name | trunc 63 | trimSuffix "-" }} -{{- end }} -{{- end }} -{{- end }} - -{{/* -Create chart name and version as used by the chart label. -*/}} -{{- define "sftd.chart" -}} -{{- printf "%s-%s" .Chart.Name .Chart.Version | replace "+" "_" | trunc 63 | trimSuffix "-" }} -{{- end }} - -{{/* -Common labels -*/}} -{{- define "sftd.labels" -}} -helm.sh/chart: {{ include "sftd.chart" . }} -{{ include "sftd.selectorLabels" . }} -{{- if .Chart.AppVersion }} -app.kubernetes.io/version: {{ .Chart.AppVersion | quote }} -{{- end }} -app.kubernetes.io/managed-by: {{ .Release.Service }} -{{- end }} -{{- define "sftd.join-call.labels" -}} -helm.sh/chart: {{ include "sftd.chart" . }} -{{ include "sftd.join-call.selectorLabels" . }} -app.kubernetes.io/managed-by: {{ .Release.Service }} -{{- end }} - -{{/* -Selector labels -*/}} -{{- define "sftd.selectorLabels" -}} -app.kubernetes.io/name: {{ include "sftd.name" . }} -app.kubernetes.io/instance: {{ .Release.Name }} -{{- end }} -{{- define "sftd.join-call.selectorLabels" -}} -app.kubernetes.io/name: join-call -app.kubernetes.io/instance: {{ .Release.Name }} -{{- end }} - -{{/* Allow KubeVersion to be overridden. */}} -{{- define "kubeVersion" -}} - {{- default .Capabilities.KubeVersion.Version .Values.kubeVersionOverride -}} -{{- end -}} - -{{/* Get Ingress API Version */}} -{{- define "ingress.apiVersion" -}} - {{- if and (.Capabilities.APIVersions.Has "networking.k8s.io/v1") (semverCompare ">= 1.19-0" (include "kubeVersion" .)) -}} - {{- print "networking.k8s.io/v1" -}} - {{- else if .Capabilities.APIVersions.Has "networking.k8s.io/v1beta1" -}} - {{- print "networking.k8s.io/v1beta1" -}} - {{- else -}} - {{- print "extensions/v1beta1" -}} - {{- end -}} -{{- end -}} - -{{/* Check Ingress stability */}} -{{- define "ingress.isStable" -}} - {{- eq (include "ingress.apiVersion" .) "networking.k8s.io/v1" -}} -{{- end -}} - -{{/* Check Ingress supports pathType */}} -{{/* pathType was added to networking.k8s.io/v1beta1 in Kubernetes 1.18 */}} -{{- define "ingress.supportsPathType" -}} - {{- or (eq (include "ingress.isStable" .) "true") (and (eq (include "ingress.apiVersion" .) "networking.k8s.io/v1beta1") (semverCompare ">= 1.18-0" (include "kubeVersion" .))) -}} -{{- end -}} - -{{- define "ingress.FieldNotAnnotation" -}} - {{- (semverCompare ">= 1.27-0" (include "kubeVersion" .)) -}} -{{- end -}} diff --git a/charts/sftd/templates/configmap-join-call.yaml b/charts/sftd/templates/configmap-join-call.yaml deleted file mode 100644 index 523d741a2b5..00000000000 --- a/charts/sftd/templates/configmap-join-call.yaml +++ /dev/null @@ -1,24 +0,0 @@ -apiVersion: v1 -kind: ConfigMap -metadata: - name: {{ include "sftd.fullname" . }}-join-call - labels: - {{- include "sftd.join-call.labels" . | nindent 4 }} - -data: - default.conf.template: | - server { - listen 8080; - resolver ${NAMESERVER}; - - location /healthz { return 204; } - - location ~ ^/sfts/([a-z0-9\-]+)/(.*) { - proxy_pass http://$1.{{ include "sftd.fullname" . }}.${POD_NAMESPACE}.svc.cluster.local:8585/$2; - } - - location ~ ^/sft_servers_all.json$ { - root /etc/wire/sftd-disco/; - } - - } diff --git a/charts/sftd/templates/deployment-join-call.yaml b/charts/sftd/templates/deployment-join-call.yaml deleted file mode 100644 index 3574bf04815..00000000000 --- a/charts/sftd/templates/deployment-join-call.yaml +++ /dev/null @@ -1,80 +0,0 @@ -apiVersion: apps/v1 -kind: Deployment -metadata: - name: {{ include "sftd.fullname" . }}-join-call - labels: - {{- include "sftd.join-call.labels" . | nindent 4 }} -spec: - replicas: {{ .Values.joinCall.replicaCount }} - selector: - matchLabels: - {{- include "sftd.join-call.selectorLabels" . | nindent 6 }} - template: - metadata: - labels: - {{- include "sftd.join-call.selectorLabels" . | nindent 8 }} - annotations: - checksum/configmap: {{ include (print .Template.BasePath "/configmap-join-call.yaml") . | sha256sum }} - spec: - {{- with .Values.imagePullSecrets }} - imagePullSecrets: - {{- toYaml . | nindent 8 }} - {{- end }} - securityContext: - {{- toYaml .Values.podSecurityContext | nindent 8 }} - volumes: - - name: nginx-config - configMap: - name: {{ include "sftd.fullname" . }}-join-call - - name: sftd-disco - emptyDir: {} - containers: - - name: sftd-disco - image: quay.io/wire/sftd_disco:wip-2 # TODO configure + version - volumeMounts: - - name: sftd-disco - mountPath: /etc/wire/sftd-disco - readOnly: false - command: - - "/bin/sh" - - "-c" - - | - /usr/bin/sftd_disco.sh _sft._tcp.{{ include "sftd.fullname" . }}.{{ .Release.Namespace }}.svc.cluster.local - - name: nginx - securityContext: - {{- toYaml .Values.securityContext | nindent 12 }} - image: "{{ .Values.joinCall.image.repository }}:{{ .Values.joinCall.image.tag }}" - imagePullPolicy: {{ .Values.image.pullPolicy }} - ports: - - name: http - containerPort: 8080 - protocol: TCP - livenessProbe: - httpGet: - path: /healthz - port: http - readinessProbe: - httpGet: - path: /healthz - port: http - resources: - {{- toYaml .Values.resources | nindent 12 }} - volumeMounts: - - mountPath: /etc/nginx/conf.d/default.conf.template - name: nginx-config - subPath: default.conf.template - - name: sftd-disco - mountPath: /etc/wire/sftd-disco - readOnly: true - env: - - name: POD_NAMESPACE - valueFrom: - fieldRef: - fieldPath: metadata.namespace - command: - - "/bin/sh" - - "-c" - - | - export NAMESERVER=`cat /etc/resolv.conf | grep "nameserver" | awk '{print $2}' | tr '\n' ' '` - envsubst '$NAMESERVER $POD_NAMESPACE' < /etc/nginx/conf.d/default.conf.template > /etc/nginx/conf.d/default.conf - exec nginx -g 'daemon off;' diff --git a/charts/sftd/templates/ingress.yaml b/charts/sftd/templates/ingress.yaml deleted file mode 100644 index 0c82a936f40..00000000000 --- a/charts/sftd/templates/ingress.yaml +++ /dev/null @@ -1,69 +0,0 @@ -{{- $apiIsStable := eq (include "ingress.isStable" .) "true" -}} -{{- $ingressFieldNotAnnotation := eq (include "ingress.FieldNotAnnotation" .) "true" -}} -{{- $ingressSupportsPathType := eq (include "ingress.supportsPathType" .) "true" -}} -apiVersion: {{ include "ingress.apiVersion" . }} -kind: Ingress -metadata: - name: "{{ include "sftd.fullname" . }}" - labels: - {{- include "sftd.labels" . | nindent 4 }} - annotations: - {{- if not $ingressFieldNotAnnotation }} - kubernetes.io/ingress.class: "{{ .Values.config.ingressClass }}" - {{- end }} - nginx.ingress.kubernetes.io/enable-cors: "true" - nginx.ingress.kubernetes.io/cors-allow-origin: "{{ required "Must specify allowOrigin" .Values.allowOrigin }}" -spec: - {{- if $ingressFieldNotAnnotation }} - ingressClassName: "{{ .Values.config.ingressClass }}" - {{- end }} - tls: - - hosts: - - "{{ required "Must specify host" .Values.host }}" - secretName: "{{ include "sftd.fullname" . }}" - rules: - - host: "{{ .Values.host }}" - http: - paths: - - path: /sft/ - {{- if $ingressSupportsPathType }} - pathType: Prefix - {{- end }} - backend: - {{- if $apiIsStable }} - service: - name: {{ include "sftd.fullname" . }} - port: - name: sft - {{- else }} - serviceName: "{{ include "sftd.fullname" . }}" - servicePort: sft - {{- end }} - - path: /sfts/ - {{- if $ingressSupportsPathType }} - pathType: Prefix - {{- end }} - backend: - {{- if $apiIsStable }} - service: - name: "{{ include "sftd.fullname" . }}-join-call" - port: - name: http - {{- else }} - serviceName: "{{ include "sftd.fullname" . }}-join-call" - servicePort: http - {{- end }} - - path: /sft_servers_all.json - {{- if $ingressSupportsPathType }} - pathType: Exact - {{- end }} - backend: - {{- if $apiIsStable }} - service: - name: "{{ include "sftd.fullname" . }}-join-call" - port: - name: http - {{- else }} - serviceName: "{{ include "sftd.fullname" . }}-join-call" - servicePort: http - {{- end }} diff --git a/charts/sftd/templates/secret-or-certificate.yaml b/charts/sftd/templates/secret-or-certificate.yaml deleted file mode 100644 index 44eb6c65260..00000000000 --- a/charts/sftd/templates/secret-or-certificate.yaml +++ /dev/null @@ -1,34 +0,0 @@ -{{- if .Values.tls.issuerRef -}} -{{- if or .Values.tls.key .Values.tls.crt }} -{{- fail "ingress.issuer and ingress.{crt,key} are mutually exclusive" -}} -{{- end -}} -apiVersion: cert-manager.io/v1 -kind: Certificate -metadata: - name: "{{ include "sftd.fullname" . }}" - labels: - {{- include "sftd.labels" . | nindent 4 }} -spec: - dnsNames: - - {{ .Values.host }} - secretName: "{{ include "sftd.fullname" . }}" - issuerRef: - {{- toYaml .Values.tls.issuerRef | nindent 4 }} - privateKey: - rotationPolicy: Always - algorithm: ECDSA - size: 384 -{{- else if and .Values.tls.key .Values.tls.crt -}} -apiVersion: v1 -kind: Secret -metadata: - name: "{{ include "sftd.fullname" . }}" - labels: - {{- include "sftd.labels" . | nindent 4 }} -type: kubernetes.io/tls -data: - tls.key: {{ required "tls.key is required" .Values.tls.key | b64enc }} - tls.crt: {{ required "tls.crt is required" .Values.tls.crt | b64enc }} -{{- else -}} -{{- fail "must specify tls.key and tls.crt , or tls.issuerRef" -}} -{{- end -}} diff --git a/charts/sftd/templates/secret.yaml b/charts/sftd/templates/secret.yaml deleted file mode 100644 index 1ad51ec77f6..00000000000 --- a/charts/sftd/templates/secret.yaml +++ /dev/null @@ -1,11 +0,0 @@ -{{- if and .Values.multiSFT.enabled (not .Values.multiSFT.discoveryRequired) }} -apiVersion: v1 -kind: Secret -metadata: - name: {{ include "sftd.fullname" . }}-secret - labels: - {{- include "sftd.labels" . | nindent 4 }} -type: Opaque -data: - zrest_secret.txt: {{ required "must specify authentication secret" .Values.multiSFT.secret | b64enc | quote }} -{{- end }} diff --git a/charts/sftd/templates/service-account.yaml b/charts/sftd/templates/service-account.yaml deleted file mode 100644 index 347a4e66e4a..00000000000 --- a/charts/sftd/templates/service-account.yaml +++ /dev/null @@ -1,33 +0,0 @@ ---- -apiVersion: v1 -kind: ServiceAccount -metadata: - name: {{ include "sftd.fullname" . }} - labels: - {{- include "sftd.labels" . | nindent 4 }} ---- -apiVersion: rbac.authorization.k8s.io/v1 -kind: ClusterRole -metadata: - name: {{ include "sftd.fullname" . }} - labels: - {{- include "sftd.labels" . | nindent 4 }} -rules: - - apiGroups: [""] - resources: [nodes] - verbs: [get] ---- -apiVersion: rbac.authorization.k8s.io/v1 -kind: ClusterRoleBinding -metadata: - name: {{ include "sftd.fullname" . }} - labels: - {{- include "sftd.labels" . | nindent 4 }} -roleRef: - kind: ClusterRole - apiGroup: rbac.authorization.k8s.io - name: {{ include "sftd.fullname" . }} -subjects: - - kind: ServiceAccount - name: {{ include "sftd.fullname" . }} - namespace: {{ .Release.Namespace }} diff --git a/charts/sftd/templates/service-join-call.yaml b/charts/sftd/templates/service-join-call.yaml deleted file mode 100644 index 6663681e8ac..00000000000 --- a/charts/sftd/templates/service-join-call.yaml +++ /dev/null @@ -1,13 +0,0 @@ -apiVersion: v1 -kind: Service -metadata: - name: {{ include "sftd.fullname" . }}-join-call - labels: - {{- include "sftd.join-call.labels" . | nindent 4 }} -spec: - ports: - - port: 80 - targetPort: http - name: http - selector: - {{- include "sftd.join-call.selectorLabels" . | nindent 4 }} diff --git a/charts/sftd/templates/service.yaml b/charts/sftd/templates/service.yaml deleted file mode 100644 index fe7b69643a0..00000000000 --- a/charts/sftd/templates/service.yaml +++ /dev/null @@ -1,20 +0,0 @@ ---- -apiVersion: v1 -kind: Service -metadata: - name: {{ include "sftd.fullname" . }} - labels: - {{- include "sftd.labels" . | nindent 4 }} -spec: - # Needs to be headless - # See: https://kubernetes.io/docs/concepts/workloads/controllers/statefulset/ - clusterIP: None - ports: - - port: 8585 - targetPort: sft - name: sft - - port: 49090 - targetPort: metrics - name: metrics - selector: - {{- include "sftd.selectorLabels" . | nindent 4 }} diff --git a/charts/sftd/templates/servicemonitor.yaml b/charts/sftd/templates/servicemonitor.yaml deleted file mode 100644 index 6a2b2fc34a3..00000000000 --- a/charts/sftd/templates/servicemonitor.yaml +++ /dev/null @@ -1,15 +0,0 @@ -{{- if .Values.metrics.serviceMonitor.enabled }} -apiVersion: monitoring.coreos.com/v1 -kind: ServiceMonitor -metadata: - name: {{ include "sftd.fullname" . }} - labels: - {{- include "sftd.labels" . | nindent 4 }} -spec: - endpoints: - - port: metrics - path: /metrics - selector: - matchLabels: - {{- include "sftd.selectorLabels" . | nindent 6 }} -{{- end }} diff --git a/charts/sftd/templates/statefulset.yaml b/charts/sftd/templates/statefulset.yaml deleted file mode 100644 index 8559acf7654..00000000000 --- a/charts/sftd/templates/statefulset.yaml +++ /dev/null @@ -1,209 +0,0 @@ -apiVersion: apps/v1 -kind: StatefulSet -metadata: - name: {{ include "sftd.fullname" . }} - labels: - {{- include "sftd.labels" . | nindent 4 }} -spec: - replicas: {{ .Values.replicaCount }} - # Allows sfts to start up and shut down in parallel when scaling up and down. - # However this does not affect upgrades. - podManagementPolicy: Parallel - serviceName: {{ include "sftd.fullname" . }} - selector: - matchLabels: - {{- include "sftd.selectorLabels" . | nindent 6 }} - template: - metadata: - {{- with .Values.podAnnotations }} - annotations: - {{- toYaml . | nindent 8 }} - {{- end }} - labels: - {{- include "sftd.selectorLabels" . | nindent 8 }} - spec: - {{- with .Values.imagePullSecrets }} - imagePullSecrets: - {{- toYaml . | nindent 8 }} - {{- end }} - securityContext: - {{- toYaml .Values.podSecurityContext | nindent 8 }} - terminationGracePeriodSeconds: {{ .Values.terminationGracePeriodSeconds }} - hostNetwork: true - dnsPolicy: ClusterFirstWithHostNet - serviceAccountName: {{ include "sftd.fullname" . }} - volumes: - - name: external-ip - emptyDir: {} - {{- if .Values.multiSFT.enabled }} - {{- if .Values.multiSFT.discoveryRequired }} - - name: multi-sft-config - emptyDir: {} - {{- else }} - - name: sft-secret - secret: - secretName: {{ include "sftd.fullname" . }}-secret - {{- end }} - {{- end }} - initContainers: - - name: get-external-ip - image: bitnami/kubectl:1.24.12 - volumeMounts: - - name: external-ip - mountPath: /external-ip - env: - - name: NODE_NAME - valueFrom: - fieldRef: - fieldPath: spec.nodeName - command: - - /bin/sh - - -c - - | - set -e - - # In the cloud, this setting is available to indicate the true IP address - addr=$(kubectl get node $NODE_NAME -ojsonpath='{.status.addresses[?(@.type=="ExternalIP")].address}') - - # On on-prem we allow people to set "wire.com/external-ip" to override this - if [ -z "$addr" ]; then - addr=$(kubectl get node $NODE_NAME -ojsonpath='{.metadata.annotations.wire\.com/external-ip}') - fi - echo -n "$addr" | tee /dev/stderr > /external-ip/ip - - {{- if and .Values.multiSFT.enabled .Values.multiSFT.discoveryRequired }} - - name: get-multi-sft-config - image: "{{ .Values.image.repository }}:{{ .Values.image.tag | default .Chart.AppVersion }}" - - volumeMounts: - - name: multi-sft-config - mountPath: /multi-sft-config - - command: - - /bin/sh - - -c - - | - set -e - - - response=$(curl "{{ .Values.multiSFT.turnDiscoveryURL }}") - if [ -z "$response" ]; then - echo "No response from restund server." - exit 1 - fi - - echo "$response" | jq -r '.username' > /multi-sft-config/username - if [ ! -s /multi-sft-config/username ]; then - echo "Response does not contain a username" - exit 1 - fi - - echo "$response" | jq -r '.password' > /multi-sft-config/password - if [ ! -s /multi-sft-config/password ]; then - echo "Response does not contain a password" - exit 1 - fi - - echo "$response" | jq -r '.uris[0]' > /multi-sft-config/turn_server - if [ ! -s /multi-sft-config/turn_server ]; then - echo "Response does not contain a turn server" - exit 1 - fi - {{- end }} - - containers: - - name: {{ .Chart.Name }} - securityContext: - {{- toYaml .Values.securityContext | nindent 12 }} - image: "{{ .Values.image.repository }}:{{ .Values.image.tag | default .Chart.AppVersion }}" - imagePullPolicy: {{ .Values.image.pullPolicy }} - env: - - name: POD_IP - valueFrom: - fieldRef: - fieldPath: status.podIP - - name: POD_NAME - valueFrom: - fieldRef: - fieldPath: metadata.name - volumeMounts: - - name: external-ip - mountPath: /external-ip - {{- if .Values.multiSFT.enabled }} - {{- if .Values.multiSFT.discoveryRequired }} - - name: multi-sft-config - mountPath: /multi-sft-config - {{- else }} - - name: sft-secret - mountPath: /secrets - {{- end }} - {{- end }} - command: - - /bin/sh - - -c - - | - set -e - EXTERNAL_IP=$(cat /external-ip/ip) - if [ -z "${EXTERNAL_IP}" ]; then - ACCESS_ARGS= - else - ACCESS_ARGS="-A ${EXTERNAL_IP}" - fi - - MULTI_SFT_ARGS="" - - {{- if .Values.multiSFT.enabled }} - {{- if .Values.multiSFT.discoveryRequired }} - MULTI_SFT_ARGS="-t $(cat /multi-sft-config/turn_server) \ - -x $(cat /multi-sft-config/username) \ - -c $(cat /multi-sft-config/password)" - {{- else }} - MULTI_SFT_ARGS="-t {{ required "must specify TURN server URI" .Values.multiSFT.turnServerURI }} \ - -s /secrets/zrest_secret.txt" - {{- end }} - {{- end }} - - exec sftd \ - -I "${POD_IP}" \ - -M "${POD_IP}" \ - ${ACCESS_ARGS} \ - ${MULTI_SFT_ARGS} \ - {{ if .Values.turnDiscoveryEnabled }}-T{{ end }} \ - -u "https://{{ required "must specify host" .Values.host }}/sfts/${POD_NAME}" - ports: - - name: sft - containerPort: 8585 - protocol: TCP - - name: metrics - containerPort: 49090 - protocol: TCP - livenessProbe: - httpGet: - path: /metrics - port: metrics - readinessProbe: - httpGet: - path: /metrics - port: metrics - lifecycle: - preStop: - exec: - # TODO: Workaround because sftd does not support graceful draining natively. - # tracked in https://github.com/zinfra/backend-issues/issues/1451 - command: - - /bin/sleep - - "{{ .Values.terminationGracePeriodSeconds }}" - resources: - {{- toYaml .Values.resources | nindent 12 }} - {{- with .Values.nodeSelector }} - nodeSelector: - {{- toYaml . | nindent 8 }} - {{- end }} - {{- with .Values.affinity }} - affinity: - {{- toYaml . | nindent 8 }} - {{- end }} - {{- with .Values.tolerations }} - tolerations: - {{- toYaml . | nindent 8 }} - {{- end }} diff --git a/charts/sftd/values.yaml b/charts/sftd/values.yaml deleted file mode 100644 index c9e23fa2990..00000000000 --- a/charts/sftd/values.yaml +++ /dev/null @@ -1,110 +0,0 @@ -# Default values for sftd. -# This is a YAML-formatted file. -# Declare variables to be passed into your templates. - -# The amount of SFT instances to run. NOTE: Only one SFT can run per node due -# to `hostNetwork`. If this number is higher than the amount of nodes that can -# be used for scheduling (Also see `nodeSelector`) pods will remain in a -# pending state untill you add more capacit. -replicaCount: 1 - -image: - repository: quay.io/wire/sftd - pullPolicy: IfNotPresent - # Overrides the image tag whose default is the chart appVersion. - tag: "" - -config: - ingressClass: "nginx" - -imagePullSecrets: [] -nameOverride: "" -fullnameOverride: "" - -metrics: - serviceMonitor: - enabled: false - -# The time to wait after terminating an sft node before shutting it down. No -# new calls will be initiated whilst a pod is being terminated. -terminationGracePeriodSeconds: 10 - -podAnnotations: {} - -podSecurityContext: - fsGroup: 31337 - -securityContext: - # Pick a high number that is unlikely to conflict with the host - # https://kubesec.io/basics/containers-securitycontext-runasuser/ - runAsUser: 31337 - # capabilities: - # drop: - # - ALL - # readOnlyRootFilesystem: true - # runAsNonRoot: true - -resources: {} - # We usually recommend not to specify default resources and to leave this as a conscious - # choice for the user. This also increases chances charts run on environments with little - # resources, such as Minikube. If you do want to specify resources, uncomment the following - # lines, adjust them as necessary, and remove the curly braces after 'resources:'. - # limits: - # cpu: 100m - # memory: 128Mi - # requests: - # cpu: 100m - # memory: 128Mi - -# If you have multiple deployments of sftd running in one cluster, it is -# important that they run on disjoint sets of nodes, you can use nodeSelector to enforce this -nodeSelector: {} - -tolerations: [] - -affinity: {} - -# allowOrigin: https://webapp.wire.example -# host: -tls: {} - # {key,crt} and issuerRef are mutally exclusive - # key: - # crt: - # issuerRef: - # The name of the issuer (e.g. letsencrypr-prod) - # name: ca-issuer - # We can reference ClusterIssuers by changing the kind here. - # The default value is Issuer (i.e. a locally namespaced Issuer) - # kind: Issuer - # This is optional since cert-manager will default to this value however - # if you are using an external issuer, change this to that issuer group. - # group: cert-manager.io - -joinCall: - replicaCount: 3 - image: - repository: nginxinc/nginx-unprivileged - pullPolicy: IfNotPresent - # Overrides the image tag whose default is the chart appVersion. - tag: "1.25.3" - -# Allow SFT instances to choose/consider using a TURN server for themselves as a proxy when -# trying to establish a connection to clients -# DOCS: https://docs.wire.com/understand/sft.html#prerequisites -turnDiscoveryEnabled: false - -# Allow establishing calls involving remote SFT servers (e.g. for Federation) -# Requires appVersion 3.0.9 or later -multiSFT: - enabled: false - # For sftd versions up to 3.1.3, sftd uses the TURN servers advertised at a - # discovery URL. - turnDiscoveryURL: "" - # For sftd versions 3.1.10 and later, this discovery process is no longer - # required or supported, and must be disabled. sftd must instead be directly - # configured with the authentication secret used by the TURN server and the - # URI for the TURN server. - discoveryRequired: true - secret: - turnServerURI: - diff --git a/charts/smallstep-accomp/Chart.yaml b/charts/smallstep-accomp/Chart.yaml new file mode 100644 index 00000000000..6dad899102f --- /dev/null +++ b/charts/smallstep-accomp/Chart.yaml @@ -0,0 +1,4 @@ +apiVersion: v1 +description: Accompanying chart for Smallstep E2EI support +name: smallstep-accomp +version: 1.0.4 diff --git a/charts/smallstep-accomp/README.md b/charts/smallstep-accomp/README.md new file mode 100644 index 00000000000..ad57924296c --- /dev/null +++ b/charts/smallstep-accomp/README.md @@ -0,0 +1,113 @@ +# smallstep-acomp - Helm chart accompanying smallstep + +This Helm chart is meant to be installed alongside the [step-certificates Helm +chart](https://smallstep.github.io/helm-charts) in the same namespace. It has been tested with Helm +chart version `1.25.0` and image + +``` +image: + repository: cr.step.sm/smallstep/step-ca + tag: "0.25.3-rc7" +``` + +This Helm chart provides: + +- A reverse-proxy for Certificate Revocation List (CR) distribution endpoints to federating smallstep + servers +- Smallstep server configuration for the End-to-End Identity setup + + +## Reverse-proxy for CRL distribution points + +This Helm chart installs a reverse proxy that proxies the Certificate Revocation List (CRL) +Distribution Point of the Smallstep servers CRL Certificate Authority (CA) from federating domains +and the own domain. This reverse proxy is required for a working End-to-End Identity setup. + +The Helm chart deploys a nginx server that reverse-proxies +`https:///proxyCrl/` to `https://{other_acme_domain}/crl` +as well as an ingress for the `/proxyCrl` endpoint. For example if `upstreams.proxiedHosts` is set +to `[acme.alpha.example.com, acme.beta.example.com]` and the host for the Smallstep server on the +own domain is `acme.alpha.example.com` this helm chart will forward requests + +- `https://acme.alpha.example.com/proxyCrl/acme.alpha.example.com` to `https://acme.alpha.example.com/crl` +- `https://acme.alpha.example.com/proxyCrl/acme.beta.example.com` to `https://acme.beta.example.com/crl` + +| Name | Description | +| -------------------------- | --------------------------------------------------------------------------------------------------------- | +| `upstreams.enable` | Set to `false` in case you want to write custom nginx server block for the upstream rules | +| `upstreams.dnsResolver` | DNS server that nginx uses to resolve the proxied hostnames | +| `upstreams.proxiedHosts` | List of remote (federated) step-ca hostnames to proxy. Also include the own step-ca host here. | +| `nginx.ingress.enable` | Set to `false` if you need to define a custom ingress for the /proxyCrl endpoint. Make sure CORS is set. | +| `nginx.ingress.hostname` | Hostname of the step-ca server | +| `nginx.ingress.extraTls` | The TLS configuration | +| `nginx.ingress.annotations`| CORS config for the ingress, set the hostname of the step-ca server here | + +For more details on `nginx.*` parameters see README.md documentation in the `nginx` dependency chart. + +## Smallstep server configuration for the End-to-End Identity setup + +This Helm chart helps to create configuration file for step-ca. If `stepConfig.enabled` is `true` a +configmap that contains a `ca.json` will be created. The name of that configmap is compatible with the +step-certificates Helm chart, so that it can be directly used. However since step-ca is deployed +from a seperate Helm release updating and deploying a configuration won't cause an automatic reload +of the step-ca server. It is therefore recommended to manually restart step-ca after configuartion +changes if this Helm chart is used for these purposes. + +For references see: + +- [[1] Configuring `step-ca`](https://smallstep.com/docs/step-ca/configuration/) +- [[2] Configuring `step-ca` Provisioners - ACME for Wire messenger clients ](https://smallstep.com/docs/step-ca/provisioners/#acme-for-wire-messenger-clients) + +| Parameter | Description | +|------------------------------------------------------|-----------------------------------------------------------------------------------------------------------------------------------| +| `stepConfig.enabled` | Create a configmap with configuration file for `step-certificates` Helm chart. | +| | If `true` then almost all `stepConfig.*` parameters are required. | +| `stepConfig.configTemplate` | Template for the configuration file. Overwrite this if the default value is not generic enough for your use case. | +| `stepConfig.address` | See [1] | +| `stepConfig.dnsName` | Used in `dnsNames` config entry (See [1]) and to define the CRL URL. | +| `stepConfig.additionalDNSNames` | Optional. Additional entries to `dnsNames` configuration field | +| `stepConfig.root` | See [1]. Public key of the Root CA | +| `stepConfig.crt` | See [1]. Public key of the Intermediate CA | +| `stepConfig.key` | See [1]. Private key of the Intermediate CA | +| `stepConfig.federatedRoots` | See [1]. Add all cross-signed Intermediate CA certs from federating domains here. | +| `stepConfig.db` | See [1] | +| `stepConfig.tls` | See [1] | +| `stepConfig.logger` | See [1] | +| `stepConfig.authority.claims` | See [1] | +| `stepConfig.authority.jwk` | JSON string of the JWK provisioner to use. A JWK provisioner can be created | +| | by running `step ca init` then copying it out of the generated `ca.json`, discarding the `ca.json`. | +| `stepConfig.authority.acme.name` | Name of the ACME provisioner. Default: `"keycloakteams"` | +| `stepConfig.authority.acme.claims` | See [1] | +| `stepConfig.authority.acme.dpop.key` | See [2]. Public half of the DPoP signature key bundle configured of the Wire deployment. | +| | Use the same value as `brig.secrets.dpopSigKeyBundle` value of the `wire-server` Helm chart. | +| | Base64 encoded string of the PEM encoded public key. | +| `stepConfig.authority.acme.dpop.wireDomain` | Set this to the federation domain of the backend | +| `stepConfig.authority.acme.oidc.clientId` | Name of the OIDC client. Default: "wireapp". | +| `stepConfig.authority.acme.oidc.discoveryBaseUrl` | OpenID Connect Discovery endpoint. The OIDC provider must respond with its configuration when `/.well-known/openid-configuration` | +| | is appended to the URL. For Keycloak this URL is of format `https:///auth/realms/`. | +| `stepConfig.authority.acme.oidc.issuerUrl` | For Keycloak this must be of the format `https:///auth/realms/?client_id=wireapp` | +| `stepConfig.authority.acme.oidc.signatureAlgorithms` | See [2] | +| `stepConfig.authority.acme.oidc.transform` | See [2]. Has sensible default. There shouldn't be any need to customize this setting. | +| `stepConfig.authority.acme.x509.organization` | Set this to the federation domain of the backend | +| `stepConfig.authority.acme.x509.template` | See [2]. Go template for a client certificate which is evaluated by step-ca. | +| | This string is evaluated as template of the Helm chart first. | +| | Has a sensible default. There shouldn't be a need to customize this setting. | + +| Parameter | Description | +|-----------------------|-------------------------------------------------------------------------------------------------------| +| `caPassword.enabled` | If `true` generate Secret with a name that the `step-certificates` Helm chart will automatically use. | +| | The Helm chart will mount this at `/home/step/secrets/passwords/password`. | +| `caPassword.password` | Password that decrypts the intermediate CA private key | + +| Parameter | Description | +|---------------------------|-------------------------------------------------------------------------------------------------------| +| `existingSecrets.enabled` | If `true` generate Secret with a name that the `step-certificates` Helm chart will automatically use. | +| `existingSecrets.data` | Map from filename to content. Each entry will be mounted as file `/home/step/secrets/` | +| | Add the private key of the Intermediate CA here. | + +| Parameter | Description | +|-------------------------|-----------------------------------------------------------------------------------------------------| +| `existingCerts.enabled` | If `true` generate ConfigMap with a name that the Helm chart will automatically use. | +| `existingCerts.data` | Map from filename to content. Each entry will be mounted as file `/home/step/certs/` | +| `existingCerts.data` | Use it to make public keys of the Root, intermediate CA as well as the cross-signed certs available | +| | to step-ca. Each entry will be mounted as file `/home/step/certs/` | diff --git a/charts/smallstep-accomp/requirements.yaml b/charts/smallstep-accomp/requirements.yaml new file mode 100644 index 00000000000..e9d0780c6e9 --- /dev/null +++ b/charts/smallstep-accomp/requirements.yaml @@ -0,0 +1,4 @@ +dependencies: +- name: nginx + version: 15.10.4 + repository: https://charts.bitnami.com/bitnami diff --git a/charts/smallstep-accomp/templates/_helpers.tpl b/charts/smallstep-accomp/templates/_helpers.tpl new file mode 100644 index 00000000000..fb5cb93c9ce --- /dev/null +++ b/charts/smallstep-accomp/templates/_helpers.tpl @@ -0,0 +1,3 @@ +{{- define "fullname" -}} +smallstep-step-certificates +{{- end -}} diff --git a/charts/smallstep-accomp/templates/ca-password.yaml b/charts/smallstep-accomp/templates/ca-password.yaml new file mode 100644 index 00000000000..cd1bdc962a9 --- /dev/null +++ b/charts/smallstep-accomp/templates/ca-password.yaml @@ -0,0 +1,12 @@ +{{- if .Values.caPassword.enabled }} +apiVersion: v1 +kind: Secret +metadata: + name: smallstep-step-certificates-ca-password + labels: + chart: "{{ .Chart.Name }}-{{ .Chart.Version }}" + release: "{{ .Release.Name }}" +type: Opaque +data: + password: {{ .Values.caPassword.password | b64enc | quote }} +{{- end }} diff --git a/charts/smallstep-accomp/templates/certs.yaml b/charts/smallstep-accomp/templates/certs.yaml new file mode 100644 index 00000000000..c9ef0ce45a9 --- /dev/null +++ b/charts/smallstep-accomp/templates/certs.yaml @@ -0,0 +1,13 @@ +{{- if .Values.existingCerts.enabled }} +apiVersion: v1 +kind: ConfigMap +metadata: + name: smallstep-step-certificates-certs + labels: + chart: "{{ .Chart.Name }}-{{ .Chart.Version }}" + release: "{{ .Release.Name }}" +data: + {{- range $key, $value := .Values.existingCerts.data }} + {{ $key }}: {{ $value | quote }} + {{- end }} +{{- end }} diff --git a/charts/smallstep-accomp/templates/secrets.yaml b/charts/smallstep-accomp/templates/secrets.yaml new file mode 100644 index 00000000000..8448fbc7f8f --- /dev/null +++ b/charts/smallstep-accomp/templates/secrets.yaml @@ -0,0 +1,14 @@ +{{- if .Values.existingSecrets.enabled }} +apiVersion: v1 +kind: Secret +metadata: + name: smallstep-step-certificates-secrets + labels: + chart: "{{ .Chart.Name }}-{{ .Chart.Version }}" + release: "{{ .Release.Name }}" +type: Opaque +data: + {{- range $key, $value := .Values.existingSecrets.data }} + {{ $key }}: {{ $value | b64enc | quote }} + {{- end }} +{{- end }} diff --git a/charts/smallstep-accomp/templates/server-block-configmap.yaml b/charts/smallstep-accomp/templates/server-block-configmap.yaml new file mode 100644 index 00000000000..59c423d3345 --- /dev/null +++ b/charts/smallstep-accomp/templates/server-block-configmap.yaml @@ -0,0 +1,39 @@ +{{- if and .Values.upstreams.enabled .Values.nginx.existingServerBlockConfigmap }} +apiVersion: v1 +kind: ConfigMap +metadata: + name: {{ .Values.nginx.existingServerBlockConfigmap }} + labels: + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} +data: + server.conf: | + resolver {{ .Values.upstreams.dnsResolver }}; + + server { + listen 0.0.0.0:8080; + + {{- range .Values.upstreams.proxiedHosts }} + + location /proxyCrl/{{ . }} { + # This indirection is required to make the resolver check the domain. + # Otherwise, broken upstreams lead to broken deployments. + set $backend "{{ . }}"; + + proxy_redirect off; + proxy_set_header X-Forwarded-Host $http_host; + proxy_set_header Host $backend; + proxy_hide_header Content-Type; + add_header Content-Type application/pkix-crl; + # Prevent caching on client side + add_header Cache-Control 'no-cache, no-store, must-revalidate'; + add_header Pragma 'no-cache'; + add_header Expires '0'; + + proxy_pass "https://$backend/crl"; + } + + {{- end }} + } +{{- end }} diff --git a/charts/smallstep-accomp/templates/step-config.yaml b/charts/smallstep-accomp/templates/step-config.yaml new file mode 100644 index 00000000000..0cb957fa88c --- /dev/null +++ b/charts/smallstep-accomp/templates/step-config.yaml @@ -0,0 +1,9 @@ +{{- if .Values.stepConfig.enabled }} +apiVersion: v1 +kind: ConfigMap +metadata: + name: smallstep-step-certificates-config +data: + ca.json: |- + {{(tpl .Values.stepConfig.configTemplate .) | fromYaml | toJson }} +{{- end }} diff --git a/charts/smallstep-accomp/values.yaml b/charts/smallstep-accomp/values.yaml new file mode 100644 index 00000000000..e4e3ad18437 --- /dev/null +++ b/charts/smallstep-accomp/values.yaml @@ -0,0 +1,212 @@ +nginx: + existingServerBlockConfigmap: "smallstep-accomp-server-block" + + service: + type: ClusterIP + + ingress: + enabled: true + # ingressClassName: "nginx" + + # hostname: "acme.alpha.example.com" + path: "/proxyCrl" + pathType: "Prefix" + + # extraTls: + # - + # hosts: [ "acme.alpha.example.com" ] + # secretName: "smallstep-step-certificates-ingress-cert" + + # annotations: + # nginx.ingress.kubernetes.io/cors-allow-origin: https://webapp.acme.alpha.example.com + # nginx.ingress.kubernetes.io/cors-expose-headers: Replay-Nonce, Location + # nginx.ingress.kubernetes.io/enable-cors: 'true' + +upstreams: + enabled: true + # dnsResolver: 9.9.9.9 + + # Note: include the smallstep host of the own domain here as well + proxiedHosts: [] + # proxiedHosts: + # - acme.alpha.example.com + # - acme.beta.example.com + # - acme.gamma.example.com + + +caPassword: + enabled: true + password: "...." + +existingSecrets: + enabled: false + # data: + # ca.key: foobar + +existingCerts: + enabled: false + # data: + # ca.crt: "-----BEGIN CERTIFICATE-----...." + # root_ca.crt: "-----BEGIN CERTIFICATE-----...." + # ca-other2-cross-signed.crt: "-----BEGIN CERTIFICATE-----...." + # ca-other3-cross-signed.crt: "-----BEGIN CERTIFICATE-----...." + +stepConfig: + enabled: true + + address: "0.0.0.0:9000" + + # dnsName: acme.alpha.example.com + + # additionalDNSNames: + # - localhost + + root: /home/step/certs/root_ca.crt + crt: /home/step/certs/ca.crt + key: /home/step/secrets/ca.key + + federatedRoots: + - /home/step/certs/ca.crt + + # federatedRoots: + # - /home/step/certs/ca.crt + # - /home/step/certs/acme.beta.example.com-xsigned-by-acme.alpha.example.com + + db: + badgerFileLoadingMode: "" + dataSource: /home/step/db + type: badgerv2 + + tls: + cipherSuites: + - TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 + maxVersion: 1.3 + minVersion: 1.2 + renegotiation: false + + logger: + format: text + + authority: + claims: + maxTLSCertDuration: 87701h + + # jwk: |- + # { + # "type": "JWK", + # "name": "..example.com", + # "key": { ... }, + # "encryptedKey": "e..." + # } + + acme: + name: keycloakteams + + claims: + allowRenewalAfterExpiry: false + defaultTLSCertDuration: 2160h + disableRenewal: false + maxTLSCertDuration: 2160h + minTLSCertDuration: 60s + + dpop: + # key: + wireDomain: alpha.example.com + + oidc: + clientId: wireapp + # discoveryBaseUrl: https://keycloak.example.com/auth/realms/master + # issuerUrl: https://keycloak.example.com/auth/realms/master?client_id=wireapp + signatureAlgorithms: + - RS256 + - ES256 + - ES384 + - EdDSA + transform: | + { + "name": "{{ .name }}", + "preferred_username": "wireapp://%40{{ .preferred_username }}" + } + + x509: + # organization: alpha.example.com + template: | + { + "subject": { + "organization": {{ required "stepConfig.authority.acme.x509.organization is missing" .Values.stepConfig.authority.acme.x509.organization | toJson }}, + "commonName": {{ "{{" }} toJson .Oidc.name {{ "}}" }} + }, + "uris": [{{ "{{" }} toJson .Oidc.preferred_username {{ "}}" }}, {{ "{{" }} toJson .Dpop.sub {{ "}}" }}], + "keyUsage": ["digitalSignature"], + "extKeyUsage": ["clientAuth"], + "crlDistributionPoints": {{ tpl "[ https://{{ required \"stepConfig.dnsName is missing\" .Values.stepConfig.dnsName }}/crl ]" . | fromYamlArray | toJson }} + } + + configTemplate: |- + address: {{ required "stepConfig.address is missing" .Values.stepConfig.address }} + + dnsNames: + - {{ required "stepConfig.dnsName is missing" .Values.stepConfig.dnsName }} + {{- if .Values.stepConfig.additionalDNSNames }} + {{- .Values.stepConfig.additionalDNSNames | toYaml | nindent 2 }} + {{- end }} + + crt: {{ required "stepConfig.crt is missing" .Values.stepConfig.crt }} + key: {{ required "stepConfig.key is missing" .Values.stepConfig.key }} + root: {{ required "stepConfig.root is missing" .Values.stepConfig.root }} + + federatedRoots: + {{- required "stepConfig.federatedRoots is missing" .Values.stepConfig.federatedRoots | toYaml | nindent 2 }} + + crl: + enabled: true + generateOnRevoke: true + idpURL: https://{{ required "stepConfig.dnsName is missing" .Values.stepConfig.dnsName }}/crl + + db: + {{ required "stepConfig.db is missing" .Values.stepConfig.db | toYaml | nindent 2 }} + + tls: + {{ required "stepConfig.tls is missing" .Values.stepConfig.tls | toYaml | nindent 2 }} + + logger: + {{ required "stepConfig.logger is missing" .Values.stepConfig.logger | toYaml | nindent 2 }} + + authority: + claims: + {{ required "stepConfig.authority.claims is missing" .Values.stepConfig.authority.claims | toYaml | nindent 4 }} + provisioners: + - {{ required "stepConfig.authority.jwk is missing" .Values.stepConfig.authority.jwk | fromJson | toYaml | nindent 6 }} + - name: {{ required "stepConfig.authority.acme.name is missing" .Values.stepConfig.authority.acme.name }} + type: ACME + forceCN: true + challenges: + - wire-oidc-01 + - wire-dpop-01 + claims: + {{ required "stepConfig.authority.acme.claims is missing" .Values.stepConfig.authority.acme.claims | toYaml | nindent 8 }} + options: + wire: + dpop: + key: {{ required "stepConfig.authority.acme.dpop.key is missing" .Values.stepConfig.authority.acme.dpop.key }} + target: https://{{ required "stepConfig.authority.acme.dpop.wireDomain" .Values.stepConfig.authority.acme.dpop.wireDomain }}/clients/{{ "{{" }}.DeviceID{{ "}}" }}/access-token + oidc: + config: + clientId: {{ required "stepConfig.authority.acme.oidc.clientId is missing" .Values.stepConfig.authority.acme.oidc.clientId }} + signatureAlgorithms: + {{ required "stepConfig.authority.acme.oidc.signatureAlgorithms is missing" .Values.stepConfig.authority.acme.oidc.signatureAlgorithms | toYaml | nindent 14 }} + provider: + discoveryBaseUrl: {{ required "stepConfig.authority.acme.oidc.discoveryBaseUrl is missing" .Values.stepConfig.authority.acme.oidc.discoveryBaseUrl }} + id_token_signing_alg_values_supported: + {{ required "stepConfig.authority.acme.oidc.signatureAlgorithms is missing" .Values.stepConfig.authority.acme.oidc.signatureAlgorithms | toYaml | nindent 14 }} + issuerUrl: {{ required "stepConfig.authority.acme.oidc.issuerUrl is missing" .Values.stepConfig.authority.acme.oidc.issuerUrl }} + transform: {{ required "stepConfig.authority.acme.oidc.transform is missing" .Values.stepConfig.authority.acme.oidc.transform | toJson }} + x509: + template: {{ (tpl .Values.stepConfig.authority.acme.x509.template .) | toJson }} + + {{- if .Values.stepConfig.extraConfig }} + {{ .Values.stepConfig.extraconfig | toYaml }} + {{- end }} + + + diff --git a/charts/team-settings/.helmignore b/charts/team-settings/.helmignore deleted file mode 100644 index f0c13194444..00000000000 --- a/charts/team-settings/.helmignore +++ /dev/null @@ -1,21 +0,0 @@ -# Patterns to ignore when building packages. -# This supports shell glob matching, relative path matching, and -# negation (prefixed with !). Only one pattern per line. -.DS_Store -# Common VCS dirs -.git/ -.gitignore -.bzr/ -.bzrignore -.hg/ -.hgignore -.svn/ -# Common backup files -*.swp -*.bak -*.tmp -*~ -# Various IDEs -.project -.idea/ -*.tmproj diff --git a/charts/team-settings/Chart.yaml b/charts/team-settings/Chart.yaml deleted file mode 100644 index efc59bdbf7d..00000000000 --- a/charts/team-settings/Chart.yaml +++ /dev/null @@ -1,4 +0,0 @@ -apiVersion: v1 -description: A Helm chart for the Wire team-settings in Kubernetes -name: team-settings -version: 0.0.42 diff --git a/charts/team-settings/README.md b/charts/team-settings/README.md deleted file mode 100644 index 5a8e758e948..00000000000 --- a/charts/team-settings/README.md +++ /dev/null @@ -1,5 +0,0 @@ -Team settings are part of a private repo. As such, this chart expects a secret named `wire-teamsettings-readonly-pull-secret` to be made available as a secret. Check the [values file](values.yaml) for more info. - -kubectl create -f wire-teamsettings-readonly-pull-secret.yml --namespace= - -If you want to get access to it, get in [touch with us](https://wire.com/pricing/). diff --git a/charts/team-settings/templates/_helpers.tpl b/charts/team-settings/templates/_helpers.tpl deleted file mode 100644 index 12c09876c39..00000000000 --- a/charts/team-settings/templates/_helpers.tpl +++ /dev/null @@ -1,25 +0,0 @@ -{{/* vim: set filetype=mustache: */}} -{{/* -Expand the name of the chart. -*/}} -{{- define "team-settings.name" -}} -{{- default .Chart.Name .Values.nameOverride | trunc 63 | trimSuffix "-" -}} -{{- end -}} - -{{/* -Create a default fully qualified app name. -We truncate at 63 chars because some Kubernetes name fields are limited to this (by the DNS naming spec). -*/}} -{{- define "team-settings.fullname" -}} -{{- $name := default .Chart.Name .Values.nameOverride -}} -{{- printf "%s-%s" .Release.Name $name | trunc 63 | trimSuffix "-" -}} -{{- end -}} - -{{/* Allow KubeVersion to be overridden. */}} -{{- define "kubeVersion" -}} - {{- default .Capabilities.KubeVersion.Version .Values.kubeVersionOverride -}} -{{- end -}} - -{{- define "includeSecurityContext" -}} - {{- (semverCompare ">= 1.24-0" (include "kubeVersion" .)) -}} -{{- end -}} diff --git a/charts/team-settings/templates/deployment.yaml b/charts/team-settings/templates/deployment.yaml deleted file mode 100644 index ddd916c15e6..00000000000 --- a/charts/team-settings/templates/deployment.yaml +++ /dev/null @@ -1,74 +0,0 @@ -apiVersion: apps/v1 -kind: Deployment -metadata: - name: team-settings - labels: - app: team-settings - chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} - release: {{ .Release.Name }} - heritage: {{ .Release.Service }} -spec: - replicas: {{ .Values.replicaCount }} - strategy: - type: RollingUpdate - rollingUpdate: - maxUnavailable: 0 - maxSurge: {{ .Values.replicaCount | mul 2 }} - selector: - matchLabels: - app: team-settings - template: - metadata: - labels: - app: team-settings - release: {{ .Release.Name }} - spec: - # Check the README to find out more about this secret - imagePullSecrets: - - name: wire-teamsettings-readonly-pull-secret - containers: - - name: team-settings - image: "{{ .Values.image.repository }}:{{ .Values.image.tag }}" - {{- if eq (include "includeSecurityContext" .) "true" }} - securityContext: - {{- toYaml .Values.podSecurityContext | nindent 10 }} - {{- end }} - env: - - name: NODE_PORT - value: "{{ .Values.service.http.internalPort }}" - - name: APP_BASE - value: https://{{ .Values.config.externalUrls.appHost }}/ - - name: BACKEND_REST - value: https://{{ .Values.config.externalUrls.backendRest }} - - name: BACKEND_WS - value: wss://{{ .Values.config.externalUrls.backendWebsocket }} - - {{- if not (hasKey .Values.envVars "FEATURE_ENABLE_PAYMENT") }} - # NOTE defaults to 'true', but since we assume on-prem here, we default to 'false' - # SRC https://github.com/wireapp/wire-web-config-default/blob/master/wire-team-settings/.env.defaults#L48 - - name: FEATURE_ENABLE_PAYMENT - value: {{ .Values.config.enablePayment | default false | quote }} - {{- end }} - {{- range $key, $val := .Values.envVars }} - - name: {{ $key }} - value: {{ $val | quote }} - {{- end }} - ports: - - name: http - containerPort: {{ .Values.service.http.internalPort }} - readinessProbe: - httpGet: - path: /_health/ - port: {{ .Values.service.http.internalPort }} - scheme: HTTP - livenessProbe: - initialDelaySeconds: 30 - timeoutSeconds: 3 - httpGet: - path: /_health/ - port: {{ .Values.service.http.internalPort }} - scheme: HTTP - resources: -{{ toYaml .Values.resources | indent 12 }} - dnsPolicy: ClusterFirst - restartPolicy: Always diff --git a/charts/team-settings/templates/secret.yaml b/charts/team-settings/templates/secret.yaml deleted file mode 100644 index 64710da6f48..00000000000 --- a/charts/team-settings/templates/secret.yaml +++ /dev/null @@ -1,16 +0,0 @@ -apiVersion: v1 -kind: Secret -metadata: - name: wire-teamsettings-readonly-pull-secret - labels: - chart: "{{ .Chart.Name }}-{{ .Chart.Version }}" - release: "{{ .Release.Name }}" - heritage: "{{ .Release.Service }}" -type: kubernetes.io/dockerconfigjson -data: - {{/* for_helm_linting is necessary only since the 'with' block below does not throw an error upon an empty .Values.secrets */}} - for_helm_linting: {{ required "No .secrets found in configuration. Did you forget to helm -f path/to/secrets.yaml ?" .Values.secrets | quote | b64enc | quote }} - - {{- with .Values.secrets }} - .dockerconfigjson: {{ .configJson }} - {{- end }} diff --git a/charts/team-settings/values.yaml b/charts/team-settings/values.yaml deleted file mode 100644 index a8c8dc82281..00000000000 --- a/charts/team-settings/values.yaml +++ /dev/null @@ -1,65 +0,0 @@ -# Default values for the team-settings. -replicaCount: 1 -resources: - requests: - memory: "128Mi" - cpu: "100m" - limits: - memory: "512Mi" - cpu: "1" -image: - repository: quay.io/wire/team-settings - tag: "4.15.1-v0.31.19-0-ee1dbce" -service: - https: - externalPort: 443 - http: - internalPort: 8080 - -## The following has to be provided to deploy this chart - -#config: -# externalUrls: -# backendRest: nginz-https.wire.example -# backendWebsocket: nginz-ssl.wire.example -# backendDomain: wire.example -# appHost: teams.wire.example - -#secrets: -# configJson: - -# Some relevant environment options. For a comprehensive -# list of available variables, please refer to: -# https://github.com/wireapp/wire-web-config-wire/blob/master/wire-team-settings/.env.defaults -# -# NOTE: Without an empty dictionary, you will see warnings -# when overriding envVars -envVars: {} -# E.g. -# envVars: -# FEATURE_ENABLE_DEBUG: "true" -# You are likely to need at least following CSP headers -# due to the fact that you are likely to do cross sub-domain requests -# i.e., from teams.wire.example to nginz-https.wire.example -# CSP_EXTRA_CONNECT_SRC: "https://*.wire.example, wss://*.wire.example" -# CSP_EXTRA_IMG_SRC: "https://*.wire.example" -# CSP_EXTRA_SCRIPT_SRC: "https://*.wire.example" -# CSP_EXTRA_DEFAULT_SRC: "https://*.wire.example" -# CSP_EXTRA_FONT_SRC: "https://*.wire.example" -# CSP_EXTRA_FRAME_SRC: "https://*.wire.example" -# CSP_EXTRA_MANIFEST_SRC: "https://*.wire.example" -# CSP_EXTRA_OBJECT_SRC: "https://*.wire.example" -# CSP_EXTRA_MEDIA_SRC: "https://*.wire.example" -# CSP_EXTRA_PREFETCH_SRC: "https://*.wire.example" -# CSP_EXTRA_STYLE_SRC: "https://*.wire.example" -# CSP_EXTRA_WORKER_SRC: "https://*.wire.example" - -podSecurityContext: - allowPrivilegeEscalation: false - capabilities: - drop: - - ALL - runAsUser: 1000 - runAsGroup: 1000 - seccompProfile: - type: RuntimeDefault diff --git a/charts/webapp/.helmignore b/charts/webapp/.helmignore deleted file mode 100644 index f0c13194444..00000000000 --- a/charts/webapp/.helmignore +++ /dev/null @@ -1,21 +0,0 @@ -# Patterns to ignore when building packages. -# This supports shell glob matching, relative path matching, and -# negation (prefixed with !). Only one pattern per line. -.DS_Store -# Common VCS dirs -.git/ -.gitignore -.bzr/ -.bzrignore -.hg/ -.hgignore -.svn/ -# Common backup files -*.swp -*.bak -*.tmp -*~ -# Various IDEs -.project -.idea/ -*.tmproj diff --git a/charts/webapp/Chart.yaml b/charts/webapp/Chart.yaml deleted file mode 100644 index 1f94da93f39..00000000000 --- a/charts/webapp/Chart.yaml +++ /dev/null @@ -1,4 +0,0 @@ -apiVersion: v1 -description: A Helm chart for the Wire webapp in Kubernetes -name: webapp -version: 0.0.42 diff --git a/charts/webapp/templates/_helpers.tpl b/charts/webapp/templates/_helpers.tpl deleted file mode 100644 index 2a098feb857..00000000000 --- a/charts/webapp/templates/_helpers.tpl +++ /dev/null @@ -1,25 +0,0 @@ -{{/* vim: set filetype=mustache: */}} -{{/* -Expand the name of the chart. -*/}} -{{- define "webapp.name" -}} -{{- default .Chart.Name .Values.nameOverride | trunc 63 | trimSuffix "-" -}} -{{- end -}} - -{{/* -Create a default fully qualified app name. -We truncate at 63 chars because some Kubernetes name fields are limited to this (by the DNS naming spec). -*/}} -{{- define "webapp.fullname" -}} -{{- $name := default .Chart.Name .Values.nameOverride -}} -{{- printf "%s-%s" .Release.Name $name | trunc 63 | trimSuffix "-" -}} -{{- end -}} - -{{/* Allow KubeVersion to be overridden. */}} -{{- define "kubeVersion" -}} - {{- default .Capabilities.KubeVersion.Version .Values.kubeVersionOverride -}} -{{- end -}} - -{{- define "includeSecurityContext" -}} - {{- (semverCompare ">= 1.24-0" (include "kubeVersion" .)) -}} -{{- end -}} diff --git a/charts/webapp/templates/deployment.yaml b/charts/webapp/templates/deployment.yaml deleted file mode 100644 index c17491f2fd8..00000000000 --- a/charts/webapp/templates/deployment.yaml +++ /dev/null @@ -1,71 +0,0 @@ -apiVersion: apps/v1 -kind: Deployment -metadata: - name: webapp - labels: - app: webapp - chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} - release: {{ .Release.Name }} - heritage: {{ .Release.Service }} -spec: - replicas: {{ .Values.replicaCount }} - strategy: - type: RollingUpdate - rollingUpdate: - maxUnavailable: 0 - maxSurge: {{ .Values.replicaCount | mul 2 }} - selector: - matchLabels: - app: webapp - template: - metadata: - labels: - app: webapp - release: {{ .Release.Name }} - spec: - containers: - - name: webapp - {{- if .Values.image.digest }} - image: "{{ .Values.image.repository }}@{{ .Values.image.digest }}" - {{- else }} - image: "{{ .Values.image.repository }}:{{ .Values.image.tag }}" - {{- end }} - {{- if eq (include "includeSecurityContext" .) "true" }} - securityContext: - {{- toYaml .Values.podSecurityContext | nindent 10 }} - {{- end }} - # Check variables here: https://github.com/wireapp/wire-webapp/wiki/Self-hosting - env: - # it is vital that you don't add trailing '/' in this section! - - name: NODE_PORT - value: "{{ .Values.service.http.internalPort }}" - - name: APP_BASE - value: "https://{{ .Values.config.externalUrls.appHost }}" - - name: BACKEND_REST - value: "https://{{ .Values.config.externalUrls.backendRest }}" - - name: BACKEND_WS - value: "wss://{{ .Values.config.externalUrls.backendWebsocket }}" - {{- range $key, $val := .Values.envVars }} - - name: {{ $key }} - value: {{ $val | quote }} - {{- end }} - ports: - - name: http - containerPort: {{ .Values.service.http.internalPort }} - # NOTE: /test/ returns an HTML document a 200 response code - readinessProbe: - httpGet: - path: /_health/ - port: {{ .Values.service.http.internalPort }} - scheme: HTTP - livenessProbe: - initialDelaySeconds: 30 - timeoutSeconds: 3 - httpGet: - path: /_health/ - port: {{ .Values.service.http.internalPort }} - scheme: HTTP - resources: -{{ toYaml .Values.resources | indent 12 }} - dnsPolicy: ClusterFirst - restartPolicy: Always diff --git a/charts/webapp/values.yaml b/charts/webapp/values.yaml deleted file mode 100644 index 6ce8a3146f1..00000000000 --- a/charts/webapp/values.yaml +++ /dev/null @@ -1,62 +0,0 @@ -# Default values for the webapp. -replicaCount: 1 -resources: - requests: - memory: "128Mi" - cpu: "100m" - limits: - memory: "512Mi" - cpu: "1" -image: - repository: quay.io/wire/webapp - tag: "2024-01-22-production.1-v0.31.17-0-7f83dbe" -service: - https: - externalPort: 443 - http: - internalPort: 8080 - -## The following has to be provided to deploy this chart - -#config: -# externalUrls: -# backendRest: nginz-https.wire.example -# backendWebsocket: nginz-ssl.wire.example -# backendDomain: wire.example -# appHost: webapp.wire.example - -# Some relevant environment options. For a comprehensive -# list of available variables, please refer to: -# https://github.com/wireapp/wire-web-config-wire/blob/master/wire-webapp/.env.defaults -# -# NOTE: Without an empty dictionary, you will see warnings -# when overriding envVars -envVars: {} -# E.g. -# envVars: -# FEATURE_ENABLE_DEBUG: "true" -# You are likely to need at least following CSP headers -# due to the fact that you are likely to do cross sub-domain requests -# i.e., from webapp.wire.example to nginz-https.wire.example -# CSP_EXTRA_CONNECT_SRC: "https://*.wire.example, wss://*.wire.example" -# CSP_EXTRA_IMG_SRC: "https://*.wire.example" -# CSP_EXTRA_SCRIPT_SRC: "https://*.wire.example" -# CSP_EXTRA_DEFAULT_SRC: "https://*.wire.example" -# CSP_EXTRA_FONT_SRC: "https://*.wire.example" -# CSP_EXTRA_FRAME_SRC: "https://*.wire.example" -# CSP_EXTRA_MANIFEST_SRC: "https://*.wire.example" -# CSP_EXTRA_OBJECT_SRC: "https://*.wire.example" -# CSP_EXTRA_MEDIA_SRC: "https://*.wire.example" -# CSP_EXTRA_PREFETCH_SRC: "https://*.wire.example" -# CSP_EXTRA_STYLE_SRC: "https://*.wire.example" -# CSP_EXTRA_WORKER_SRC: "https://*.wire.example" - -podSecurityContext: - allowPrivilegeEscalation: false - capabilities: - drop: - - ALL - runAsUser: 1000 - runAsGroup: 1000 - seccompProfile: - type: RuntimeDefault diff --git a/charts/wire-server/requirements.yaml b/charts/wire-server/requirements.yaml index b5350be6c80..2d1fafb9674 100644 --- a/charts/wire-server/requirements.yaml +++ b/charts/wire-server/requirements.yaml @@ -77,26 +77,6 @@ dependencies: tags: - nginz - services -- name: webapp - version: "0.0.42" - repository: "file://../webapp" - tags: - - web - - webapp -- name: team-settings - version: "0.0.42" - repository: "file://../team-settings" - tags: - - web - - team-settings - - private -- name: account-pages - version: "0.0.42" - repository: "file://../account-pages" - tags: - - web - - account-pages - - private - name: legalhold version: "0.0.42" repository: "file://../legalhold" @@ -119,11 +99,6 @@ dependencies: - federation - haskellServices - services -- name: sftd - version: "0.0.42" - repository: "file://../sftd" - tags: - - sftd - name: integration version: "0.0.42" repository: "file://../integration" diff --git a/charts/wire-server/values.yaml b/charts/wire-server/values.yaml index 3a0a3f1f525..7e41eca7838 100644 --- a/charts/wire-server/values.yaml +++ b/charts/wire-server/values.yaml @@ -13,3 +13,4 @@ tags: sftd: false backoffice: false mlsstats: false + integration: false diff --git a/deploy/dockerephemeral/coredns-config/db.example.com b/deploy/dockerephemeral/coredns-config/db.example.com index 1c33e941fb1..a458686bca7 100644 --- a/deploy/dockerephemeral/coredns-config/db.example.com +++ b/deploy/dockerephemeral/coredns-config/db.example.com @@ -17,4 +17,4 @@ _wire-server-federator._tcp.b IN SRV 0 0 9443 localhost. _wire-server-federator._tcp.d1 IN SRV 0 0 10443 localhost. _wire-server-federator._tcp.d2 IN SRV 0 0 11443 localhost. _wire-server-federator._tcp.d3 IN SRV 0 0 12443 localhost. -_wire-server-federator._tcp.v0 IN SRV 0 0 21443 localhost. +_wire-server-federator._tcp.federation-v0 IN SRV 0 0 21443 localhost. diff --git a/deploy/dockerephemeral/docker-compose.yaml b/deploy/dockerephemeral/docker-compose.yaml index 2ac1a1843e8..b44ad1932d0 100644 --- a/deploy/dockerephemeral/docker-compose.yaml +++ b/deploy/dockerephemeral/docker-compose.yaml @@ -77,9 +77,20 @@ services: networks: - demo_wire + redis-master: + container_name: demo_wire_redis + image: redis:6.0-alpine + command: redis-server /usr/local/etc/redis/redis.conf + ports: + - "127.0.0.1:6379:6379" + volumes: + - ./docker/redis-master-mode.conf:/usr/local/etc/redis/redis.conf + networks: + - demo_wire + redis-cluster: image: 'redis:6.0-alpine' - command: redis-cli --cluster create 172.20.0.31:6373 172.20.0.32:6374 172.20.0.33:6375 172.20.0.34:6376 172.20.0.35:6377 172.20.0.36:6378 --cluster-replicas 1 --cluster-yes + command: redis-cli --cluster create 172.20.0.31:6373 172.20.0.32:6374 172.20.0.33:6375 172.20.0.34:6376 172.20.0.35:6377 172.20.0.36:6378 --cluster-replicas 1 --cluster-yes -a very-secure-redis-cluster-password networks: redis: ipv4_address: 172.20.0.30 @@ -159,10 +170,13 @@ services: elasticsearch: container_name: demo_wire_elasticsearch - #image: elasticsearch:5.6 - image: julialongtin/elasticsearch:0.0.9-amd64 - # https://hub.docker.com/_/elastic is deprecated, but 6.2.4 did not work without further changes. - # image: docker.elastic.co/elasticsearch/elasticsearch:6.2.4 + build: + context: . + dockerfile_inline: | + FROM julialongtin/elasticsearch:0.0.9-amd64 + RUN /usr/share/elasticsearch/bin/elasticsearch-plugin install x-pack -b + # this seems to be necessary to run X-Pack on Alpine (https://discuss.elastic.co/t/elasticsearch-failing-to-start-due-to-x-pack/85125/7) + RUN rm -rf /usr/share/elasticsearch/plugins/x-pack/platform/linux-x86_64 ulimits: nofile: soft: 65536 @@ -171,12 +185,17 @@ services: - "127.0.0.1:9200:9200" - "127.0.0.1:9300:9300" environment: + - "xpack.ml.enabled=false" + - "xpack.security.enabled=true" + - "xpack.security.http.ssl.enabled=true" + - "xpack.ssl.certificate=certs/elasticsearch-cert.pem" + - "xpack.ssl.key=certs/elasticsearch-key.pem" - "bootstrap.system_call_filter=false" -# ES_JVM_OPTIONS is reserved, so... -# what's present in the jvm.options file by default. -# - "JVM_OPTIONS_ES=-Xmx2g -Xms2g" - "JVM_OPTIONS_ES=-Xmx512m -Xms512m" - "discovery.type=single-node" + volumes: + - ./docker/elasticsearch-cert.pem:/usr/share/elasticsearch/config/certs/elasticsearch-cert.pem + - ./docker/elasticsearch-key.pem:/usr/share/elasticsearch/config/certs/elasticsearch-key.pem networks: - demo_wire diff --git a/deploy/dockerephemeral/docker/elasticsearch-ca.pem b/deploy/dockerephemeral/docker/elasticsearch-ca.pem new file mode 100644 index 00000000000..d4ef94d4d2a --- /dev/null +++ b/deploy/dockerephemeral/docker/elasticsearch-ca.pem @@ -0,0 +1,19 @@ +-----BEGIN CERTIFICATE----- +MIIDHjCCAgagAwIBAgIUXd/KjPrGXSmRyZ4Q/9O3LPGB70owDQYJKoZIhvcNAQEL +BQAwJzElMCMGA1UEAxMcZWxhc3RpY3NlYXJjaC5jYS5leGFtcGxlLmNvbTAeFw0y +NDA0MjIxMjA0MDBaFw0yOTA0MjExMjA0MDBaMCcxJTAjBgNVBAMTHGVsYXN0aWNz +ZWFyY2guY2EuZXhhbXBsZS5jb20wggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEK +AoIBAQC0R+Ptk46Hd8SrR+S/dM7nGvhYA2ErWUFhpyUDWi7VpUpTgtlyTzmNgxAl +h9QWn8GuqvwqCFBnbiLL+OV6EsT1/fKt/3iYVv+myg5gBTPHt/QNaHZ5E7wMdwDR +HRuAKQI9kCdZZZ7/prVPTQDx0E12yxMWbE+NgvYfNmkJXSG3Y5S5ihE8RO+JZYec +AWfc3iwEZeD7d9WnVsb0sM+iJwMOOTlxKSI8Cw+ukcXdTh9pmxyQNZVd1tSGX/NH +281EKroIPLqIAxgy1d2cUqiCKIf4pGEbijb8m/OkoFez+7vjmD57A8uSuwyXz7+x +E2uRJFAisug5zdb8KWAJBlEkggWbAgMBAAGjQjBAMA4GA1UdDwEB/wQEAwIBBjAP +BgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBQ1/LWQ/Ckxpc7HdBp6mNBfZNQssDAN +BgkqhkiG9w0BAQsFAAOCAQEAfGo1ONgSfTwRtT/ZsZgAnseqZSQCuvUQ4nrg2dDe +cFZtC05EczfmPx7G7Q2VeF9ZU56m/Ep57gE4W2wwVIwoG3Zam0kG4HirkgLNPagf +j3RkDrCvrjeESYFj7qwdnmgFNxotlC0KjHkGrfdT7gTDSWoNE3tobxyFaT1YQyBB +L6oRVlKa6O0ivgADUw/VMIARqFgCni/PhaHd4UlR9bgLVQ4MEVb463MMpGAdK4ZZ +l1bYVRf0pTeYnEiUG2HXt/1JFzSowFoZD8wVOXa0kcxy9SK/UCX8PVzMx06G4Ion +NNkzz9uSme9hAQlVsW6gxzl0NhwOtClpPIlvEqHwgF54KQ== +-----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/elasticsearch-cert.pem b/deploy/dockerephemeral/docker/elasticsearch-cert.pem new file mode 100755 index 00000000000..5de2ffadd23 --- /dev/null +++ b/deploy/dockerephemeral/docker/elasticsearch-cert.pem @@ -0,0 +1,20 @@ +-----BEGIN CERTIFICATE----- +MIIDTzCCAjegAwIBAgIUZg82eQUqHA61XD0suiu4Gp5C0rswDQYJKoZIhvcNAQEL +BQAwJzElMCMGA1UEAxMcZWxhc3RpY3NlYXJjaC5jYS5leGFtcGxlLmNvbTAeFw0y +NDA0MjIxMjA0MDBaFw0yNTA0MjIxMjA0MDBaMAAwggEiMA0GCSqGSIb3DQEBAQUA +A4IBDwAwggEKAoIBAQC4I8zWkyQGetTaVB7GuDi8dDqEabCHis6TVaA8hORbCSs/ +swlPM5e8gJuyuQIOiyC07Ai4sl/C5lyjbMK4eaBz+jB3tGA1YEgZzruZiKJV0JlN +kzTWFly5960quj7XuD2vlJ+0+ozT3GDsykh675mBx6LRF+/eWd9VFcexxqXvj0GC +M+01ffT8Ue0CvhxtGhg89m1NY4Lo3n/22PCPHnSqMJGbTx7gVpUs1eDQ6rgMIoES +kstFLgq5JiTr4ojLq1q2iGjAbxR+DCle/6abUMCcegBHBN6n5hAPO4X++T/moOta +3FIjwJN68SGRG3V4BNOE1x1nunKxQjKzsOqU0SvbAgMBAAGjgZkwgZYwDgYDVR0P +AQH/BAQDAgWgMB0GA1UdJQQWMBQGCCsGAQUFBwMBBggrBgEFBQcDAjAMBgNVHRMB +Af8EAjAAMB0GA1UdDgQWBBTsbRvngQ1YdeLmiHuDEHTWlTufXjAfBgNVHSMEGDAW +gBQ1/LWQ/Ckxpc7HdBp6mNBfZNQssDAXBgNVHREBAf8EDTALgglsb2NhbGhvc3Qw +DQYJKoZIhvcNAQELBQADggEBAElA1AylS20xyMtFlFda/f3neLapwRf9beVLbzR3 +4N+VaN6ZeUeO62E5t1nFWayguapPkAPW5YkQtW72KlthcIKKwu+WOMUxUJmiVfJJ +hNtBSx5RpEoiJ7qi0gQCUshYoU/B5tlRTgy+vstXCbP9ME/B2Oqn2RN5PsrRmiYU +/hJ6WqQiRaX7ysrn1cCyDMjCpBv2s4QZVBD/08l8sZfeOpxxgWj6cy4ucHn3Vbvi +4MQvwWPuAGpJy7w77v1na8DRjEnMlYoMyoDVjKAFBwwTo+8rWfLsnDSWtAHDQJsI +eluO9vR0JNNEp3f/mV4lqeFwdgN6cJzYDfePdWpqGrTSL4U= +-----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/docker/elasticsearch-key.pem b/deploy/dockerephemeral/docker/elasticsearch-key.pem new file mode 100755 index 00000000000..ee573176b4d --- /dev/null +++ b/deploy/dockerephemeral/docker/elasticsearch-key.pem @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEpAIBAAKCAQEAuCPM1pMkBnrU2lQexrg4vHQ6hGmwh4rOk1WgPITkWwkrP7MJ +TzOXvICbsrkCDosgtOwIuLJfwuZco2zCuHmgc/owd7RgNWBIGc67mYiiVdCZTZM0 +1hZcufetKro+17g9r5SftPqM09xg7MpIeu+Zgcei0Rfv3lnfVRXHscal749BgjPt +NX30/FHtAr4cbRoYPPZtTWOC6N5/9tjwjx50qjCRm08e4FaVLNXg0Oq4DCKBEpLL +RS4KuSYk6+KIy6tatohowG8UfgwpXv+mm1DAnHoARwTep+YQDzuF/vk/5qDrWtxS +I8CTevEhkRt1eATThNcdZ7pysUIys7DqlNEr2wIDAQABAoIBABR7lvt/XpCB9U9b +8Bh2wYjk/OVhxEsve48UBUD2H1ipCnCJf82ZlZVYUPlubvYjL74wS0AQR2qsqT1c +icRvcxOzjtSh8dm+HgcQ4flQI46cJ5FjgIsX7bSaAl8wXHEug14WkDVXcXbXmsh8 +L9fM8yxmgovzt7DqGleilpYF3Mtq2bNYMm7q74SKSaiz/FplgYpFJJ+jWG4ExELN +mzmMFjQQ77n0ORsnyXAzIHy4XE5loj2oHlLene5XUbNv02Bi4kY5GRADVaxEphKK +YD6m2ktLHJXzfqpsdmzup3nKi7j+m0sOcMr3SC+JBqjwwG6cyhENmPxi6fKK4XhS +bPo2JyECgYEA3ovs9f5jUMV0uZ/4jGI9rNGXgQo1DPpY2zz8UvYBN/erk8+PLxK1 +mNns5Lt5UFeduRwwbNSIUR817dLLeRnNClxOjS3aaT6jCciHVGiXkWFzCbnaV9Xl +Ozv4V+s9Duwu7sqAnZrW47ykjU9G9UrsmlidoLDKXHwAshwDXkN7wiMCgYEA09Hm +ZyC4ypR94yUMmgCKq57T5mfYJEXZoe6KlQ8zTJCOjOZesl767vrjV4hijML9I25U +dqLCxf+7ifJWhgfBJNbXfHAVEPWVkazJ1ZF/6UXvKIUoHfcL9/aNQv2uX1kto7sR +wUSSxIDxaNqtnRB3gYS67PKju0ZvFU3d0qtDPukCgYAeLK7Gc+WXcA5xlMUok7F1 +Gz4FmxKyXcdqgoxb20szAXvcIMpzQYAp53J9WQYL5LVYAgB24SJSjX7MbkZ0dxEc +FIP6FHuGxZ1pmCzxPvU+Gw50BSUbv77DF1CG6zhuK4v5iK+Drxjv7AYLuvIOFEic +bOOChDYL8CxP+ghi4ZeILQKBgQCfeFt6MMxu17SfGfmOx/Gem4j04iF7zYq3uxti +dXstnXd05MtOhutsmD4oXGm1h+eEkT/NwWPaJVpP1L8HUTc8QPMioE974Sil7+xU +eaJPQXN4kidNx/yexmQ7lzl8V2tg5SnM04+bmWgmhNxIb2lJfWAtm89g4vomk+T5 +Ai8yYQKBgQDAEtH13565FJnd0qxYI+o1ooNbAhVQx/bR6tWaMF3/h4fQi5vTn1/6 +Z6f9Y8koJSoxNxkN1hpg0h2SqzAFtvUfpSyRMaYunm4VXNRsGOJALzgOwGlZ/3C9 +v6tnxXBASSfwOeFr3ToYlTTJg6b612cTHb6w4VyDA+Sy96YLbnd9Cg== +-----END RSA PRIVATE KEY----- diff --git a/deploy/dockerephemeral/docker/redis-master-mode.conf b/deploy/dockerephemeral/docker/redis-master-mode.conf new file mode 100644 index 00000000000..d71dbc51c97 --- /dev/null +++ b/deploy/dockerephemeral/docker/redis-master-mode.conf @@ -0,0 +1 @@ +requirepass very-secure-redis-master-password \ No newline at end of file diff --git a/deploy/dockerephemeral/docker/redis-node-1.conf b/deploy/dockerephemeral/docker/redis-node-1.conf index 3f7f7d69ff4..011df166cda 100644 --- a/deploy/dockerephemeral/docker/redis-node-1.conf +++ b/deploy/dockerephemeral/docker/redis-node-1.conf @@ -3,3 +3,5 @@ cluster-enabled yes cluster-config-file nodes.conf cluster-node-timeout 5000 appendonly yes +requirepass very-secure-redis-cluster-password +masterauth very-secure-redis-cluster-password \ No newline at end of file diff --git a/deploy/dockerephemeral/docker/redis-node-2.conf b/deploy/dockerephemeral/docker/redis-node-2.conf index c81ccd43ffa..fa2850e9234 100644 --- a/deploy/dockerephemeral/docker/redis-node-2.conf +++ b/deploy/dockerephemeral/docker/redis-node-2.conf @@ -3,3 +3,5 @@ cluster-enabled yes cluster-config-file nodes.conf cluster-node-timeout 5000 appendonly yes +requirepass very-secure-redis-cluster-password +masterauth very-secure-redis-cluster-password \ No newline at end of file diff --git a/deploy/dockerephemeral/docker/redis-node-3.conf b/deploy/dockerephemeral/docker/redis-node-3.conf index 6ae5804185a..81d01b5421f 100644 --- a/deploy/dockerephemeral/docker/redis-node-3.conf +++ b/deploy/dockerephemeral/docker/redis-node-3.conf @@ -3,3 +3,5 @@ cluster-enabled yes cluster-config-file nodes.conf cluster-node-timeout 5000 appendonly yes +requirepass very-secure-redis-cluster-password +masterauth very-secure-redis-cluster-password diff --git a/deploy/dockerephemeral/docker/redis-node-4.conf b/deploy/dockerephemeral/docker/redis-node-4.conf index 1c3464629ef..50361d22810 100644 --- a/deploy/dockerephemeral/docker/redis-node-4.conf +++ b/deploy/dockerephemeral/docker/redis-node-4.conf @@ -3,3 +3,5 @@ cluster-enabled yes cluster-config-file nodes.conf cluster-node-timeout 5000 appendonly yes +requirepass very-secure-redis-cluster-password +masterauth very-secure-redis-cluster-password diff --git a/deploy/dockerephemeral/docker/redis-node-5.conf b/deploy/dockerephemeral/docker/redis-node-5.conf index e28f7909b5a..68885b25b43 100644 --- a/deploy/dockerephemeral/docker/redis-node-5.conf +++ b/deploy/dockerephemeral/docker/redis-node-5.conf @@ -3,3 +3,5 @@ cluster-enabled yes cluster-config-file nodes.conf cluster-node-timeout 5000 appendonly yes +requirepass very-secure-redis-cluster-password +masterauth very-secure-redis-cluster-password diff --git a/deploy/dockerephemeral/docker/redis-node-6.conf b/deploy/dockerephemeral/docker/redis-node-6.conf index b77c8e19c91..07da6325790 100644 --- a/deploy/dockerephemeral/docker/redis-node-6.conf +++ b/deploy/dockerephemeral/docker/redis-node-6.conf @@ -3,3 +3,5 @@ cluster-enabled yes cluster-config-file nodes.conf cluster-node-timeout 5000 appendonly yes +requirepass very-secure-redis-cluster-password +masterauth very-secure-redis-cluster-password diff --git a/deploy/dockerephemeral/federation-v0.yaml b/deploy/dockerephemeral/federation-v0.yaml index 1342056cac5..8ed1179b048 100644 --- a/deploy/dockerephemeral/federation-v0.yaml +++ b/deploy/dockerephemeral/federation-v0.yaml @@ -182,6 +182,8 @@ services: networks: - demo_wire - coredns + extra_hosts: + - "host.docker.internal.:host-gateway" ports: - '127.0.0.1:21097:8080' - '127.0.0.1:21098:8081' diff --git a/deploy/dockerephemeral/federation-v0/brig.yaml b/deploy/dockerephemeral/federation-v0/brig.yaml index 06dfefe80e3..6c2216b3c1a 100644 --- a/deploy/dockerephemeral/federation-v0/brig.yaml +++ b/deploy/dockerephemeral/federation-v0/brig.yaml @@ -10,7 +10,8 @@ cassandra: # filterNodesByDatacentre: datacenter1 elasticsearch: - url: http://demo_wire_elasticsearch:9200 + # FUTUREWORK: use separate ES v0 instance + url: http://elastic:changeme@demo_wire_elasticsearch:9200 index: directory_test rabbitmq: diff --git a/deploy/dockerephemeral/federation-v0/integration-ca.pem b/deploy/dockerephemeral/federation-v0/integration-ca.pem index 2315c7c7404..10a906c111b 100644 --- a/deploy/dockerephemeral/federation-v0/integration-ca.pem +++ b/deploy/dockerephemeral/federation-v0/integration-ca.pem @@ -1,19 +1,19 @@ -----BEGIN CERTIFICATE----- -MIIDAjCCAeqgAwIBAgIULBRPt7tLLvsw7kciIdjbXB8tddQwDQYJKoZIhvcNAQEL -BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjMxMTIxMTM1ODAwWhcN -MjgxMTE5MTM1ODAwWjAZMRcwFQYDVQQDEw5jYS5leGFtcGxlLmNvbTCCASIwDQYJ -KoZIhvcNAQEBBQADggEPADCCAQoCggEBAMcUoMS1MjHMEB4RN84hGz4J/pvS/BJF -7HL7FgOjGuJ+aMCtpmO2ht59mUWJVvt1TAYtEraz4fpZl2Vs4MsPm8R5GjWBU6Su -9MVBk8d5R38ruhKSgTtBJdUjRMZ68fDjVGy8mPy8J45QuXVjgfZeDzcpVH+A1K+3 -gJRazCD9r9vxVlc/W335uX1q8uH1u4kXCxkESjWK7/we/fHVcRI/caIdjoluqfP7 -bhDQ+jTJCYhrLR0yWLZocJhe+FgMaOxEBw+ojYKa+Xq6wEMK2YXkhmDZW49O/JQP -ZqROwXD8BHQ2IJyOES25adL3F7yN7sODXuPhDAg8SYV1/kr2nALQTzECAwEAAaNC -MEAwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFJO6 -JJpzdazNjXtum3zX8UYWaQIJMA0GCSqGSIb3DQEBCwUAA4IBAQCoV7sw9CgICo9O -JacaB+P0Uk0dnISjsrKpcAKnuVdh1rN94+beXyttSBgQtDgVBehlESN+/B9fefLb -lhVxgCYq8inx4wZs22h8ZkjpJiOmBDjvHwgkCQOoh/Kog9gkmDr4qbFahU5GpaTp -x1rlNF3qaNRvZSVoxIVwYYiexKS5/KYMedII2EoBMHcFj0qKMhdDIT1Uw2PJZwiA -qjGDsSnLS+VeA8Zluc3m/os0ynjR6BEFQF1sn/OGO0eFaSMxXz0+Z4vT3J+c08Be -z2uZWQBgCiV/bL8F5xgokbHx+Vl0lz+1PEoFre8IJihmcnT8ZPWv/8eWPAr0gavH -+R0lNAyw +MIIDAjCCAeqgAwIBAgIUdsGG4S0KMPKYzS6UNoDuNpvkRFcwDQYJKoZIhvcNAQEL +BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjQwNDIyMTIwNDAwWhcN +MjkwNDIxMTIwNDAwWjAZMRcwFQYDVQQDEw5jYS5leGFtcGxlLmNvbTCCASIwDQYJ +KoZIhvcNAQEBBQADggEPADCCAQoCggEBAJatmwqb8Fabb7JQ916v7QI5ufMEBxhK +VUsnn5frxkAA99LpFRYqs4ycPWQk20tbaNpO2E7pGm0ALuKR5YR5OP69iR6+6JZl +H+c48iryVAXpBZe/PGV1vZRDsOce5YAS0mCNtLEh21FV+6QtnQdgEGbdebBhdQ5l +VN/f8hdkSCPdm56j2K/LUuwOibJYRy5zwJwjmhwuFSurTFN2Y4f6f7AYCgam2q1w +D5dk3JF8RRByvJdJQ8lNmuZbStGLgMTr+Il8Cu+huFUCcGxdDQjM4wKLwS3DgOwV +UXfMsFYxac0I4Z/oMsgE3WVDpTqTFyBGux5nOUzAeCo4iWMKHIypeukCAwEAAaNC +MEAwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFDnH +CL3yIYkqK51ynDHRQcc6Xc/rMA0GCSqGSIb3DQEBCwUAA4IBAQCUzI4edToGsBTp +qnV2MtXwhoBFnmAa4O8RMsbRZqE+DCzBhPSIl9UMaeIEMoIvXL2KOO+rEw2M1uQc +D4r+dAdUhLbIFEyMNIA5EZfJfimEE0qaLGJqI5X1FFVeCvlvI1UDoSj0KQD9GEsg +VidDnhzg712cGdBY2K4U/BmpLMn8+WZ7+TSVIX8fGylzDCRtCQ36vrD5pkQzblqU +sjO8Apwej/t+BI/Y+T1MFvZhstbJ3mSQpHhnmARXLOrwjcOmLzWVlQa1IJxtxaf9 +gRxVchzH7fQxNlR6/zWtd2av07pFR9k2o9WUn/A5lpoUcVrokvCsOooqqG3UwALU +fZm6IO1I -----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/federation-v0/integration-leaf-key.pem b/deploy/dockerephemeral/federation-v0/integration-leaf-key.pem index 8ed90523cd3..1a45ba1ea46 100644 --- a/deploy/dockerephemeral/federation-v0/integration-leaf-key.pem +++ b/deploy/dockerephemeral/federation-v0/integration-leaf-key.pem @@ -1,27 +1,27 @@ -----BEGIN RSA PRIVATE KEY----- -MIIEpAIBAAKCAQEA1ueRV5jCjz+AWOmFzKkkjqPrCj1GGz8VDm5HLm4e7EO/LGXk -+RAYeKupGF9eqGBkiYfw9eZrjbf+uf5mpe7qKGrP67iCEzyjkbMMB8I89dcLwp7Y -uXYWfHw4NdFkSZoE0gmZ6Jh7EK+G2n+PZUaS9T43QoqMv0pFQ1roZpVMKkjnkW5J -4cU3JfXQQzdNCMiXlpGAIL0cKee6cwkPpGC1X3/6XQDyW7Q9nOjSw0mPmiZuK4iR -qwdy4edjKhcvJxuxHw215hVi0QVqbUcNzffS0mO+VIXz2IEbdzUwhSZJISsHQEOa -27UrBdRSg+Wb3FDQ+J8IeS6PR5JwjBcwt+DAjQIDAQABAoIBAHXZSS/TOqZZeWXI -sbH4824xX7weu+pHHqHqQaiphNWllRmgyv72H6VU5YbTDdKiAaAV50LB2CtAQjT2 -2I2YRdpiMKEgblxkPYKxwCAlGU7rXayddVXG9y/O4vhIWomuJ4SS9U7DB4Gv7/C0 -UQuFtyM7ugwIdISWEwOLv7Q5nSn2DYYXapNSmCUYv2FJEd57MJFtZ+CTHPu+ALxY -/qCGga8WBQ9Io/4A6UWN76m5IREeGh/pBwwhestpvUB9hXXe037Z11G3j/mNjqmz -SoUdEXnXpqJMA4c73hrryZR7TRPjRQx2P7YTyMwwOaJenhCS2F7ohJrwXNEtfbXt -Tb4mAQECgYEA8Qc4YqbF+xDmav1Mw7tpQ34EW7U1BF6RW+zpaRVVYXc+hZq8Rscl -yhzvYI2F4b9qOXw73Vdj3Hbd3f3BRC2ayMUk82pmbFEhZjQR9cGaLH1JfNXBdgz+ -wenmdczUAhmDiIseXTYdXL0FFgc9F/UFzmAYmD/kkMHTO2wnfeAci00CgYEA5EDv -UJzW/hWUtawWfg0Bw+H5RR2W/28dGG+680zazZwVHtDF7sEiThmR8AlLu74tWUMg -PBREdxOui5qRhmZO3y3JLJ8mjmEUQqC4x1NWReZCAcWGTNXn/PHsWPlK82qp/Q98 -lYJLShtbOOgo1hUPYeQ3hFnDi8HM3QssEeYB6kECgYA0kdSUf7dyuQ7oivKxRjEB -TXz5254Co/WkTRnjl4mVxoJWdZdXAJyXZpQ3RObMhAlRHG2aKzNWpH5jqrL6gc/e -tlEG3lAUk+Vq+zRnm6Baz8C1f5HAg7kU5kUjsFcVVidAIseuoNzqmzd+xHlovkJT -7tWub1EU2ZGOxloetEDFiQKBgQCfPrp4OGQ6cp4EvaIXoUV4/0Aku0cswL3A3brF -ofoJdvq5PBjLwQ0JBgfuOt4OhtkmrJFhuRYnKaEeHuGmrdwbEtuG+SYyMYKsFWu1 -DOxk6gdlKwTOuHIY5EPrs0laWDFur45Q1M1oT3uuUTKkYZ8QweMFwIaQC8687N17 -Q0hUwQKBgQDu55deAXAAS9FCqT4qidyxmvjdpkn8BKZhetss+t0m7Rum9OJCiMI5 -90exbnlRtUP4soNOccS3w3ie2HPspdlIsllYnd4/KaHQbdEoGtvrF5rM77X+81N1 -xPgNsMJM167VEWWJJCE+rkeWiF+irrjiHj7QlLmKkK4bmEzp5XuLyg== +MIIEowIBAAKCAQEAukRPdjUjKs7P2TgP4VDpb77Rb7KjMMBtcRP525qEnUQzFHPk +Va4cqh6xacgh2NJCyFyDEWDI9pQ03i0HISIldoBngDVvM6kwvbs+kjZ+/t/Jx3aH +zC9dmsLqmCqU+OmofpD1pt8hZWwOtYj58pfqdhrP+M6qQ92/tgmkk9njLFwsAjxY +gMXZCo0IiSIE9BE9NGvR9bp6hvEekCqREPdHi44iFca/5V4A8fSZwBlTHod5Z83r +MpHLnR1ReVVOQgzbIBGcLdmtH8IA9ZgUHy1/HOmf9e0MYOYOKbKvH3cry7WSscPL +47x+JQyFLimidfsJQCY+022rdPg9CdrCWFGxgQIDAQABAoIBAGjeBqK1fewe7XQN +FRu0cwh/tOge+bN70uHj7jrN/rWP7PYp3TbDxM2eZCH7E9s/XWvycbQ5+kqg3Dbt +wOLNl6vk1OCgtM+wBIn9PlgRKGSUV8Tdncy+KgP0kyFCcAbHfh5rvHHLk8DHGmzo +BlinYNBHfilFKST2VnXFbgvzkuuorS1BRAzlVpyJnaen04emBJ+KPIwNyguPQrlv +5duBIO1bzlEjFVufrLkI0IumWqBAPOvHcRy1geSz/MG7LssB9r25k5LA5OEDxqwx +ykSzuniaLL6BGMSCAMpTM3/hF1ijrkTd74cI4cp7k2ufcYT74ZU2lyDKEjBukG/p +H0/1Q8ECgYEAwL7VWIpySGtrJEPZH1FxtpJYg8SE0F4lUxIbIQcc6rzLJfLOLQO5 +ruTVONPTlue6PHrRO8pQTbW9AnjZvHMIiwxidY/RwUVKFuxzfrYZ9ZbKXyVOh48a +WXe5OnpuVodPEHQrKzkl93YWMgMCXNPri1h0jr0fMGXy9jZzoKK5f1kCgYEA92Uw +P4WyBL2hm/5BNUoxCiLyd1dDdQt1h6VByxYM7OXDhXq1iHnhX+NbjMT0QfOFyXBP +uQQCB9IQElmMmWsoEv6uEQCeuCvOxq+Evoz+3fP2te89HjZ1C5SXUMfG7qKfFzbt +WP6e/CqAeQPnnqI89ghw/IerQkeVMoVvHbSXZmkCgYBZPgJ6JGAVt+a7u85j+cm0 +xr3FBNCZyX1uoQt+l1SEOzW0NF/R58+pcrpmvW1SiahpKFSIYnwb/vGsm1f1MS3b +c7iCxjxQSEytoH05Rgdu9ops01Ew4slIc26H7Pf5iFzLOX5jXOp/UWWlck89u8Fr +m2EcVeSC/DEqXrvavH02wQKBgBzVKDhfBo5S44DgswzY5ro9tHCANRZxDXOPqQlY +Oo1pgc4OrRWIzuF0B/lyAt2k2hTOCBySAQKUUtcwpJhEytjb4cGNhvID+Qdi8V+b +4yBPDJPLnB3nTuDYooIBpoetYEk+V48lrbXJ5ks0T0xHsD8kYLatwSHqYdMPhhG6 +OGLxAoGBALZQSuO4fHew4ksMcBy891ZSOFUV9xAtR490EdEQdOiPrQj5vmnSpxEx +QsSVbn+49OYwzjBP+sHtpiTMF4ZlafHvjcNZ5dFIImqyuEugEdnD5UnFd92AQ9Gv +ufa7BMs99BRdkkolCXBZC+Dq4t4Z/+MDSMtjO5mh9V0boDakdJPb -----END RSA PRIVATE KEY----- diff --git a/deploy/dockerephemeral/federation-v0/integration-leaf.pem b/deploy/dockerephemeral/federation-v0/integration-leaf.pem index d8e7ee0955c..2247758aafd 100644 --- a/deploy/dockerephemeral/federation-v0/integration-leaf.pem +++ b/deploy/dockerephemeral/federation-v0/integration-leaf.pem @@ -1,21 +1,21 @@ -----BEGIN CERTIFICATE----- -MIIDcjCCAlqgAwIBAgIUXlJ06fjgHbzEvIRscFvEwxpsioMwDQYJKoZIhvcNAQEL -BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjMxMTIxMTM1ODAwWhcN -MjQxMTIwMTM1ODAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA -1ueRV5jCjz+AWOmFzKkkjqPrCj1GGz8VDm5HLm4e7EO/LGXk+RAYeKupGF9eqGBk -iYfw9eZrjbf+uf5mpe7qKGrP67iCEzyjkbMMB8I89dcLwp7YuXYWfHw4NdFkSZoE -0gmZ6Jh7EK+G2n+PZUaS9T43QoqMv0pFQ1roZpVMKkjnkW5J4cU3JfXQQzdNCMiX -lpGAIL0cKee6cwkPpGC1X3/6XQDyW7Q9nOjSw0mPmiZuK4iRqwdy4edjKhcvJxux -Hw215hVi0QVqbUcNzffS0mO+VIXz2IEbdzUwhSZJISsHQEOa27UrBdRSg+Wb3FDQ -+J8IeS6PR5JwjBcwt+DAjQIDAQABo4HKMIHHMA4GA1UdDwEB/wQEAwIFoDAdBgNV +MIIDcjCCAlqgAwIBAgIUK9Dix5VZpBYOby63cdmjtfg6RpwwDQYJKoZIhvcNAQEL +BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjQwNDIyMTIwNDAwWhcN +MjUwNDIyMTIwNDAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA +ukRPdjUjKs7P2TgP4VDpb77Rb7KjMMBtcRP525qEnUQzFHPkVa4cqh6xacgh2NJC +yFyDEWDI9pQ03i0HISIldoBngDVvM6kwvbs+kjZ+/t/Jx3aHzC9dmsLqmCqU+Omo +fpD1pt8hZWwOtYj58pfqdhrP+M6qQ92/tgmkk9njLFwsAjxYgMXZCo0IiSIE9BE9 +NGvR9bp6hvEekCqREPdHi44iFca/5V4A8fSZwBlTHod5Z83rMpHLnR1ReVVOQgzb +IBGcLdmtH8IA9ZgUHy1/HOmf9e0MYOYOKbKvH3cry7WSscPL47x+JQyFLimidfsJ +QCY+022rdPg9CdrCWFGxgQIDAQABo4HKMIHHMA4GA1UdDwEB/wQEAwIFoDAdBgNV HSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAdBgNVHQ4E -FgQUWm43ORCCQGlDu3JaPIm15lsr5swwHwYDVR0jBBgwFoAUk7okmnN1rM2Ne26b -fNfxRhZpAgkwSAYDVR0RAQH/BD4wPIIZKi5pbnRlZ3JhdGlvbi5leGFtcGxlLmNv +FgQUaJdzHC5JsdIEKTYxqAWoSHvFCNgwHwYDVR0jBBgwFoAUOccIvfIhiSornXKc +MdFBxzpdz+swSAYDVR0RAQH/BD4wPIIZKi5pbnRlZ3JhdGlvbi5leGFtcGxlLmNv bYIUaG9zdC5kb2NrZXIuaW50ZXJuYWyCCWxvY2FsaG9zdDANBgkqhkiG9w0BAQsF -AAOCAQEAfrlC1maUJMg5n61YEpBwIS9O0LLhNidZ6dBEPwDiBwskzkTKoWksSR+n -7OytNFQvrdclejxIyvoOvBhLqNY4pFYdNRUu42GESUpCA6cQlW3a9QchTEuNASWR -AdrmGmjXYwPFGjnVUVPR+Abs9lG7/8eDYoq1B1AdBkW1EJ7+0/DrLOLDtloxYmBF -bydmLcesdPvgBLkHfBlOG54jH/ILXHAHxskWmGqixY6L1svhrcnwsindxRcfT4QB -fAtNDfAfiftUdb96QJfpwN1/N1oEHFl2D0ynE8sFOuVFm0gQ6mblH+Vahune6cSK -7SDUwM9Ia1OAO/r2cdEAvCrQqaeDZQ== +AAOCAQEAcoUcdwgoAiFJcoS/t1IU2axEJeWncctYyVHt/ZfoZ8y/23XDA+kIfgSt +DZEqteGyVDSBbI/B45IzrKQuJzdT8B+9iDcOzLrA2R1432ASlMhHC5l3STBru0jl +oL9M8fJU6BwciCqY0Y2wFcCfVthN1rC8vNNSpwSwF74q87MMLZ/65Mi3hAB4177s +uNL6MXGta9fBK9MQxM3S/Kr7fmxOTQBlQtcA2Ha3Yog2+dkMXosoapjoMwWj36DS +j9v25/dFmS3dnCfhRHBSh9iUSnbOVZ/M+5Bv5hBPYbeSw24DXD1w9soEYL941D+c +enXV719UPw5bpBxhXjl9Hu0TQ2uoIw== -----END CERTIFICATE----- diff --git a/deploy/dockerephemeral/run.sh b/deploy/dockerephemeral/run.sh index 57d0e7223ae..8d9a98cc8be 100755 --- a/deploy/dockerephemeral/run.sh +++ b/deploy/dockerephemeral/run.sh @@ -1,6 +1,6 @@ #!/usr/bin/env bash -set -x +set -xe # run.sh should work no matter what is the current directory SCRIPT_DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" diff --git a/docs/src/developer/developer/coding-conventions.md b/docs/src/developer/developer/coding-conventions.md new file mode 100644 index 00000000000..b050c4533de --- /dev/null +++ b/docs/src/developer/developer/coding-conventions.md @@ -0,0 +1,25 @@ +# Coding conventions + +## On the topic of `cs` + +**TL;DR**: +use `cs` only in test-suites, *don't* use it in production code + +In wire we use all types of Strings; +- `String ~ [Char]` (`base` itself still does many things with `String`, also we use it in the `/integration` test suite) +- `Text` in both its strict and lazy versions +- `ByteString` in both its strict and lazy versions + +`ByteString` is literally a pointer to an Array of Bytes; there's no inherent encoding that makes it safe to +convert from and to `String` and `Text` which are nowadays typically `utf8` encoded; that means that using +`cs :: ConvertibleStrings a b => a -> b` is not a safe operation; the encoding between a given `ByteString` +and a `String` or `Text` can be different; e.g. we could decode a `ByteString` as ASCII-Chars or as utf8, just +to name a few. + +There's another inherent problem to `cs` in that context, namely **readability**; a `TL.fromStict` immediately tells +you what the code does; `cs`, however, says nothing; you know there's *some* conversion going on but not which. + +We have hence decided to not use the error-prone and hard-to-read `cs` in production code, i.e., in all libraries +and services, and instead only allow for use in test suites in general and `integration/` more specifically. + +As a consequence we also decided to drop `cs` from `Imports`. diff --git a/docs/src/developer/developer/pr-guidelines.md b/docs/src/developer/developer/pr-guidelines.md index 09b7e37fd22..06f0897f049 100644 --- a/docs/src/developer/developer/pr-guidelines.md +++ b/docs/src/developer/developer/pr-guidelines.md @@ -40,6 +40,7 @@ The following needs to be done, as part of a PR adding endpoints or changing end - [ ] Update nginz config in helm: `charts/nginz/values.yaml` - [ ] Update nginz config for the local integration tests: `services/nginz/integration-test/conf/nginz/nginx.conf` + - [ ] Update the API change documentation on Confluece for the correct version, e.g., [v5 -> v6](https://wearezeta.atlassian.net/wiki/spaces/ENGINEERIN/pages/1035632650/API+changes+v5+v6) ### Helm configuration diff --git a/docs/src/developer/reference/config-options.md b/docs/src/developer/reference/config-options.md index 595d683b68f..e6536ad8a81 100644 --- a/docs/src/developer/reference/config-options.md +++ b/docs/src/developer/reference/config-options.md @@ -24,15 +24,26 @@ For example: mlsPrivateKeyPaths: removal: ed25519: /etc/secrets/ed25519.pem + ecdsa_secp256r1_sha256: /etc/secrets/ecdsa_secp256r1_sha256 + ecdsa_secp384r1_sha384: /etc/secrets/ecdsa_secp384r1_sha384 + ecdsa_secp521r1_sha512: /etc/secrets/ecdsa_secp521r1_sha512 ``` A simple way to generate an ed25519 private key, discarding the corresponding certificate, is to run the following command: ``` -openssl req -nodes -newkey ed25519 -keyout ed25519.pem -out /dev/null -subj / +openssl genpkey -algorithm ed25519 ``` +ECDSA private keys can be generated with: + +``` +openssl genpkey -algorithm ec -genparam dsa -pkeyopt ec_paramgen_curve:P-256 +``` + +and similar (replace `P-256` with `P-384` or `P-521`). + ## Feature flags > Also see [Wire docs](https://docs.wire.com/how-to/install/team-feature-settings.html) where some of the feature flags are documented from an operations point of view. @@ -197,26 +208,7 @@ Individual teams can overwrite the default setting. ### Classified domains -To enable classified domains, the following needs to be in galley.yaml or wire-server/values.yaml under `settings` / `featureFlags`: - -```yaml -classifiedDomains: - status: enabled - config: - domains: ["example.com", "example2.com"] -``` - -Note that when enabling this feature, it is important to provide your own domain -too in the list of domains. In the example above, `example.com` or `example2.com` is your domain. - -To disable, either omit the entry entirely (it is disabled by default), or provide the following: - -```yaml -classifiedDomains: - status: disabled - config: - domains: [] -``` +To enable classified domains, see the documentation on classified domains: {ref}`classified-domains` ### Conference Calling @@ -536,6 +528,30 @@ This setting assumes that the sft load balancer has been deployed with the `sftd Additionally if `setSftListAllServers` is set to `enabled` (disabled by default) then the `/calls/config/v2` endpoint will include a list of all servers that are load balanced by `setSftStaticUrl` at field `sft_servers_all`. This is required to enable calls between federated instances of Wire. +Calls between federated SFT servers can be enabled using the optional boolean `multiSFT.enabled`. If provided, the field `is_federating` in the response of `/calls/config/v2` will reflect `multiSFT.enabled`'s value. + +``` +# [brig.yaml] +multiSFT: + enabled: true +``` + +Also, the optional object `sftToken` with its fields `ttl` and `secret` define whether an SFT credential would be rendered in the response of `/calls/config/v2`. The field `ttl` determines the seconds for the credential to be valid and `secret` is the path to the secret shared with SFT to create credentials. + +Example: + +``` +# [brig.yaml] +sft: + sftBaseDomain: sft.wire.example.com + sftSRVServiceName: sft + sftDiscoveryIntervalSeconds: 10 + sftListLength: 20 + sftToken: + ttl: 120 + secret: /path/to/secret +``` + ### Locale @@ -847,7 +863,8 @@ client), a **C**ertificate **A**uthority in PEM format needs to be configured. The ways differ regarding the kind of program: - *Services* expect a `cassandra.tlsCa: ` attribute in their config file. -- *CLI commands* (e.g. migrations) accept a `--tls-ca-certificate-file ` parameter. +- *\*-schema CLI commands* accept a `--tls-ca-certificate-file ` parameter. +- *brig-index migrate-data* accepts a `--cassandra-ca-cert ` parameter. When a CA PEM file is configured, all Cassandra connections are opened with TLS encryption i.e. there is no fallback to unencrypted connections. This ensures @@ -872,3 +889,142 @@ accessible to services (and not the private key.) The corresponding Cassandra options are described in Cassandra's documentation: [client_encryption_options](https://cassandra.apache.org/doc/stable/cassandra/configuration/cass_yaml_file.html#client_encryption_options) + +## Configure Elasticsearch basic authentication + +When the Wire backend is configured to work against a custom Elasticsearch +instance, it may be desired to enable basic authentication for the internal +communication between the Wire backend and the ES instance. To do so the +Elasticsearch credentials can be set in wire-server's secrets for `brig` and +`elasticsearch-index` as follows: + +```yaml +brig: + secrets: + elasticsearch: + username: elastic + password: changeme + +elasticsearch-index: + secrets: + elasticsearch: + username: elastic + password: changeme +``` + +In some cases an additional Elasticsearch instance is needed (e.g. for index +migrations). To configure credentials for the additional ES instance add the +secret as follows: + +```yaml +brig: + secrets: + elasticsearchAdditional: + username: elastic + password: changeme +``` + +## Configure TLS for Elasticsearch + +If the elasticsearch instance requires TLS, it can be configured like this: + +```yaml +brig: + config: + elasticsearch: + scheme: https + +elasticsearch-index: + elasticsearch: + scheme: https +``` + +In case a custom CA certificate is required it can be provided like this: + +```yaml +brig: + config: + elasticsearch: + tlsCa: +elasticsearch-index: + elasticsearch: + tlsCa: +``` + +There is another way to provide this, in case there already exists a kubernetes +secret containing the CA certificate(s): + +```yaml +brig: + config: + elasticsearch: + tlsCaSecretRef: + name: + key: +elasticsearch-index: + elasticsearch: + tlsCaSecretRef: + name: + key: +``` + +For configuring `addtionalWriteIndex` in brig (this is required during a +migration from one index to another or one ES instance to another), the settings +need to be like this: + +```yaml +brig: + config: + elasticsearch: + additionalWriteScheme: https + # One or none of these: + # addtionalTlsCa: + # addtionalTlsCaSecretRef: +``` + + +**WARNING:** Please do this only if you know what you're doing. + +In case it is not possible to verify TLS certificate of the elasticsearch +server, it can be turned off without tuning off TLS like this: + +```yaml +brig: + config: + elasticsearch: + insecureSkipVerifyTls: true + addtionalInsecureSkipVerifyTls: true # only required when addtional index is being used. +elasticsearch-index: + elasticsearch: + insecureSkipVerifyTls: true +``` + +## Configure Redis authentication + +If the redis used needs authentication with either username and password or just +password (legacy auth), it can be configured like this: + +```yaml +gundeck: + secrets: + redisUsername: + redisPassword: +``` + +**NOTE**: When using redis < 6, the `redisUsername` must not be set at all (not +even set to `null` or empty string, the key must be absent from the config). +When using redis >= 6 and using legacy auth, the `redisUsername` must either be +not set at all or set to `"default"`. + +While doing migrations to another redis instance, the credentials for the +addtional redis can be set as follows: + +```yaml +gundeck: + secrets: + redisAdditionalWriteUsername: # Do not set this at all when using legacy auth + redisAdditionalWritePassword: +``` + +**NOTE**: `redisAddtiionalWriteUsername` follows same restrictions as +`redisUsername` when using legacy auth. diff --git a/docs/src/how-to/install/img/architecture-server-ha.drawio b/docs/src/how-to/install/img/architecture-server-ha.drawio index ecc96bb9df9..1f1de668fbc 100644 --- a/docs/src/how-to/install/img/architecture-server-ha.drawio +++ b/docs/src/how-to/install/img/architecture-server-ha.drawio @@ -1 +1,324 @@ -7V1bd6M4Ev41PqfnITmIi8CPuXRm+rrZ6bPdnX2TQbHZxuABnNjz61eyhQFJtoktwPboJTECBHVTSZ+qqIF1N138nqLZ5EsS4GhgGsFiYN0PTBN4hkX+0ZblumUI3HXDOA0DdlHZ8C38G7NGg7XOwwBntQvzJInycFZv9JM4xn5ea0NpmrzWL3tOovpTZ2iMhYZvPoqK1munbP8RBvmEtQM4LE/8gcPxhD3cM+H6xAj5v8ZpMo/ZE+MkxuszU1R0w6jMJihIXitN1vuBdZcmSb7+NV3c4YgytuBZcV++LF50YN1O8mlEDgD5uTr9sOVm0ORmQleK47z6uG39QeQG3rNlYsMKhpZrXEFz3cULiubsCX8QBkXLK/SCwgiNyHNN40eY4qtvOH3BKTm6Sf1JmBMRzlMsvF+OF+RNbrM8TX7huyRKUtK+4qd1+xxGEddUoeU5iXOmVaZdHLOO6Xny8Dwk4r6JwnFM2qZhENCTt4g1+IQJ5AVlXGF8pF3gRaWJcel3nExxni7JJcVZyJRpWSg5k+NrqVjQYm2Tik7ZrA0xbR5vui7FQn4wycil9BlGf/5A4cNT9tfX5Xj48cP70ccrTxDUwIRRzhhVEwL8a54UJ66yFUtvyAWmO1uUJ8mvMfu/6mWU8i3kNddd15uD8OX4p3X8zqR59dqaEk2JpkRToinRlGhKNCWaEk2JpkRToim5eEoeJ8uMwgcrUMefhBThMcBB1Bz3Iu8SCqIweCWMwpzCDn8n6/f5besLcTjLCq3CAcNGXikg822GfHr2NUWzQQ1a2YBWBjnwk2nos991mGZgWtD38Oh5c6aA0SjsVEVvyJUBwt6zz4h+QNMwolDJd5wGKEaDOpzjDSQoDUp9dh7I4J08mW3oVgrlWJZZIIUVMMeyPRHMcYECNAf/F85R/v3mc55/RcP3C/Bv7z9XwJbAOZyIcTDGBQCWpPkkGScxit6XrbelElBhltd8TijzVqL/H87zJeMzmufJYCvmRrsgXE6XP1l/q4MnekD4xQ7vF9WT98viaBHmP8srydETewL9Xd5EDzb3xMENhX1LMJC0PISUj6vzW0WfJfPUxzuYy1iZo3SM8x3XMS2gfN6pSCmOUB6+1NFnmUqsbiVEoWXlglkSxnlW6fmRNpT6aXrDmn7CDZL9sO2OQnsOvwO69TvIj/V7lyq9YcDhWi6CyzWH0MDFbPMlR9zaYNw2ZOP2p/kIpzHOMZGl8f1Li0+qknVsH+3wUN96ardunR4Y+6cHvBfgPP3z87Pp+7LZQgBH0IGK3LRXH6Is15W46c1uY9VNbzbZlLtpSxjAcO4HzP5VslwBA8kUpsZA15AysK1Nq10etsI/H2UZioMUnQcTod0/E11RCSOUkclyhskcenIejPTM/hk5FBg5DeMwOQ8GurB/BgIgcDDFQZidBwc9z+mfg+KU+E+c5TTyRD0Pe/HjNmjix71O3TgQ/ZDAab3abnm1zeZSilfb4lLX5Dx4OQ0qOlmTxO7btWq2ua5coas11UJX54ABuGYnGACA2vZ6t71hR7YHrGvHBbbprf9ClzPF4bVRPX2gWVr2ddkJ+VtXa8u9huLZSzBYrxuDFdcb2mAbGuxeQ3SlhtjU0lsxWImxMIVzhvDaq9jz8FB73fUQqtUSa74Ae/XsbuxVFhms7VWNvRYr3lMy2B0ellpsxZRsqw0PS/X6Mi12aDidWKwIRMXjMF7Q++JxirNsO+5fAf3fzZLgtzfvBzQIF2gDi+E4bVsyVAA4ElgAtoUKFHBDRQyvNNElKxJd/GQ6I8PJSk2byGOKYkoyEUt2rnJxpJsGUrl4CuTyYTT/+Tj59K+rh/Tp6fH+18fg66crEWQ8oTCiywmI0pRoSjQlmhJNiaZEU6Ip0ZRoSjQlmhJNiabkTUk05kHUtJdEY+okGlkSjQAKSaCjrTgRBP0m0UiBIlNvfDTa+BA2L/aEGkiZbYk7JtLrHBX7Hm/dLHAtfrPA3AP9Q8hvFrz5Dugp3izYxXedQ6NzaPStl59Dc5yX5iKeLdeTRTy3lkMjHcDETNdWc2iOYyCXhOQaUga2FTK+3aF2nEOjlInQ7p+JYhBqNzk0Shnpmf0zUgwObDeHRq05w/4ZKEZrtZtCo1YDPdg7A8XgmdPLoDmK6R5s4sVby6CRx2SIsTICp/Vau+u1ti3XoyNjDKHLZ9Bs9O+tgYRwyGfQCF0pChfsAwFwzU4QAEnWpba93m3Pbcf2YD2+l0ugAYaKBBri1Xcm0HgdJND0Yq9eN/Zqans9PXuFrdnrrgQaV0UCDfR2J9B4HYTj92Gvnt2Nvcogdm2vPdur14N/pfaqIH1mt3+lWn2Z9jo0YCf2KiLKZ5A+cxwOw3HatmSQQGvpM3IxiMD0OabPKJWLI90v6Dh9RvbBhV7CmE4gYOlyQq80JZoSTYmmRFOiKdGUaEo0JZoSTYmmRFOimhJpkot1EDXtJblYOslFeZILMGw+y8XqP8tFf4+vy+2J4mtqe/cnKtW/O0x0KYuZN/7IFTD4IJwDblFeL2Yn83Wyi0520bfqZJc93lqIk+22Yox8CBPDk0833QUA/hPD3daM2eFYzynhRWBjx1Vj5GwUo0bPIOVFYGXHdWPkrDQFVp5w0oto1N1WjpGzUIyxOuG0F1ELuy0dI2ehGPZyYYkvwBw28ejdZr6YunbMKS6/1/Ms5fGBABh88svB5WMA4EvRtFY/pidYQH0JGbkJyiKatAn2bYJrKag3QWO4MwdGTREZ6uJrYbh1xe6kiExfVqu8joxcPTRufZJW207pp5XVwm32pKiSDDHaHQ/pppJMT0arvpiMXDt0MZmTNFqrD1erqJrMblfbTTWZnqxWfUEZuXqcZUGZI9F/jtUdV5SR57ZdRkUZtYI5hZIylriC/JygYIQiFPs4fUe52yZ85vlYDp+NPMd2VCUjcd/tAAU7e4MsrSZLgNLd+hHKMhpxVGVt6fpLb/9Uc/Zy16/QTdtuQzcNtiStVgQgU/ui7WjsivNxFj/QvQG5MuqqxMOrW9yyKodmNZmG9qw4fYnZdjiQ3DlQyraziW4T8XbF8y/ZswxOc1qYGNmiQz45PWo8APWlcK7FSc7humiqcK5lC0rQ3vegxGeBDhSuwW5RFK5WlfW4WbuudDOchuRdaPjr/Qj5v0Zk1vhYtt0y8kl/zu3Auaer7HlOO75L4hj7OdPByrwEeGpmGWbxeZvNN4lcYZYxdCQRsq0FyNoNZhlnznOv7o7JulLgOTAKv9AN08Ul58mNrH0NmEODd3bEIqRle986goo9tzeCyp7VwQjqaJfdwhzR0HPErQpnaoU7vi45V63b4h1P49LjfEcut1fUUnlxMrZ1gdQ6Tb419g91m8Cy+GkOvK7uDNj2YToldNx8DFMmdzF4b5fc2cZTVeiH7WS19A03Bqfu/0Bxr4PSEAgOxVAzD3O3TchVr2K5UargTLtjVJOIR0FXA5RNNtsO1YzS2pKLA8srC6QTHpdsg5M24HxS44HI2dNR26OQuFJ+nI8i4mBM4wNNto1xLoiaLFtzmUiLXQwm/+qWB2sSEnn5zN1pGASrgAHZ9kp9A6aFVTWwYU0aQLaqLoa6WrBxa6VeRNj7MQ1fUE4zvolsXpP01z9IPry1mJJtxE7lAxWsTfePh+0vJvb6bWvL15I7Apw5rwcO3eEAANZViN9gPni8JYdpQvNny8uJVUy+JAGmV/wf \ No newline at end of file + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/docs/src/how-to/install/img/architecture-server-ha.png b/docs/src/how-to/install/img/architecture-server-ha.png index 1702d79a213..6c8746bcae3 100644 Binary files a/docs/src/how-to/install/img/architecture-server-ha.png and b/docs/src/how-to/install/img/architecture-server-ha.png differ diff --git a/docs/src/how-to/install/sft.md b/docs/src/how-to/install/sft.md index 9074bd93a21..dec1f3bf113 100644 --- a/docs/src/how-to/install/sft.md +++ b/docs/src/how-to/install/sft.md @@ -123,6 +123,7 @@ An SFT instance does **not** communicate with other SFT instances, TURN does tal Recapitulation table: ```{eval-rst} + +----------------------------+-------------+-------------+-----------+----------+-----------------------------------------------------------------------------+--------------------------------------+-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+ | Name | Origin | Destination | Direction | Protocol | Ports | Action (Policy) | Description | +============================+=============+=============+===========+==========+=============================================================================+======================================+===============================================================================================================================================================================================+ @@ -136,8 +137,19 @@ Recapitulation table: +----------------------------+-------------+-------------+-----------+----------+-----------------------------------------------------------------------------+--------------------------------------+-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+ | Allowing SFT media ingress | Any | Here | Incoming | UDP | 32768-61000 | Allow | Allow ports in the "Ephemeral range" (https://en.wikipedia.org/wiki/Ephemeral_port), defined by the Linux Kernel ass the range from ports 32768 to 61000, used for UDP transmission of media. | +----------------------------+-------------+-------------+-----------+----------+-----------------------------------------------------------------------------+--------------------------------------+ | -| Allowing SFT media egress | Here | Anny | Outgoing | UDP | 32768-61000 | Allow | | +| Allowing SFT media egress | Here | Any | Outgoing | UDP | 32768-61000 | Allow | | ++----------------------------+-------------+-------------+-----------+----------+-----------------------------------------------------------------------------+--------------------------------------+-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+ +| Federation traffic in | Any | Here | Incoming | UDP/DTLS | 9191 | Allow | The TURN-servers communicate via this port. Either encrypted or unencrypted. | ++----------------------------+-------------+-------------+-----------+----------+-----------------------------------------------------------------------------+--------------------------------------+ | +| Federation traffic out | Here | Any | Outgoing | UDP/DTLS | 9191 | Allow | | ++----------------------------+-------------+-------------+-----------+----------+-----------------------------------------------------------------------------+--------------------------------------+-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+ +| Coturn control in | Any | Here | Incoming | TCP | 3478 | Allow | (STUN and TURN (TCP), helm setting: `coturn:coturnTurnListenPort`) | +----------------------------+-------------+-------------+-----------+----------+-----------------------------------------------------------------------------+--------------------------------------+-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+ +| Coturn control in (TLS) | Any | Here | Incoming | TCP/TLS | 3478 | Allow | (STUN and TURN (TLS via TCP), helm setting: `coturn:coturnTurnTlsListenPort`) | ++----------------------------+-------------+-------------+-----------+----------+-----------------------------------------------------------------------------+--------------------------------------+-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+ +| Coturn control in (UDP) | Any | Here | Incoming | UDP | 3478 | Allow | (STUN and TURN (UDP), helm setting: `coturn:coturnTurnListenPort`) | ++----------------------------+-------------+-------------+-----------+----------+-----------------------------------------------------------------------------+--------------------------------------+-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------+ + ``` *For more information, please refer to the source code of the Ansible role:* [sft-server](https://github.com/wireapp/ansible-sft/blob/develop/roles/sft-server/tasks/traffic.yml). diff --git a/docs/src/understand/classified-domains.md b/docs/src/understand/classified-domains.md index c2c631dbb5d..4551040911a 100644 --- a/docs/src/understand/classified-domains.md +++ b/docs/src/understand/classified-domains.md @@ -1,5 +1,7 @@ # Classified Domains +(classified-domains)= + As a backend administrator, if you want to control which other backends (identified by their domain) are "classified", change the following `galley` configuration in the `value.yaml.gotmpl` file of the wire-server chart: @@ -14,10 +16,20 @@ galley: classifiedDomains: status: enabled config: - domains: ["domain-that-is-classified.link"] + domains: ["domain-that-is-classified.link", "some-other-classified-domain.link"] ... ``` -Note: This is only a `backend` level configuration option, the `team` configuration mentioned below only exists for technical reasons and is not actually accessible in any way. + +```{note} +Note that when enabling this feature, it is important to provide your own domain too in the list of domains. + +In the example above, "domain-that-is-classified.link" and "some-other-classified-domain.link" are your domains. + +This is not only a `backend` configuration, but also a `team` configuration/feature. + +This means that different combinations of configurations will have different results. +``` + Here is a table to navigate the possible configurations: @@ -36,4 +48,11 @@ The table assumes the following: - When backend level config says that this feature is disabled, the list of domains is ignored. - When team level feature is disabled, the accompanying domains are ignored. -**Note:** When enabling this feature, it is important to provide your own domain in the list of domains, too. In the example above, `example.com` is your domain. +To disable, either omit the entry entirely (it is disabled by default), or provide the following: + +```yaml + classifiedDomains: + status: disabled + config: + domains: [] +``` diff --git a/docs/src/understand/single-sign-on/trouble-shooting.md b/docs/src/understand/single-sign-on/trouble-shooting.md index 776446be79f..59337fec96c 100644 --- a/docs/src/understand/single-sign-on/trouble-shooting.md +++ b/docs/src/understand/single-sign-on/trouble-shooting.md @@ -313,7 +313,16 @@ in your wire team: mapped on wire's email address, and provisioning works like in the team management app with invitation emails. -This means that if you use email/password authentication, you **must** +5. SCIM's `roles` is mapped to team role. Only lists of length 0 or 1 + are allowed. Valid values are: + + - `[member]` (same as `[]`, `null`, or missing field) + - `[admin]` + - `[owner]` + - `[partner]` + +The mapping of `externalId` implies that if you use email/password +authentication, you **must** map an email address to `externalId` on your side. With `userName` and `displayName`, you are more flexible. diff --git a/hack/bin/Sbom.hs b/hack/bin/Sbom.hs new file mode 100644 index 00000000000..74a1783a3a4 --- /dev/null +++ b/hack/bin/Sbom.hs @@ -0,0 +1,376 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -Wall #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +{- +- the only place that has the data we need about the package is the evaluated nix code, i.e. before + writing the derivation; this is where we have `meta` and friends to get the data we need +- say we now want to build a dependency tree; the issue is to find all dependencies of the derivation. + this is hard because + - there are normal input attrs that the builder will have a look at but also + - string contexts like + ```nix + x = /* bash */ '' + cp ${pkgs.bla}/bin $out + ''; + ``` + would ignore dependencies on `pkgs.bla` +- we can build the dependency graph independently (without knowing about the meta) but we somehow need + to obtain the meta itself +- people don't always have a complete package set but more commonly are hand assembling things; we need + to give the possibility to build meta "databases" from package sets +- we need to trace which dependencies are missing when querying the meta database against them +- collecting the meta also poses some issue + - nixpkgs is not a tree, but a more general graph + - it also not a DAG but it has loops + - this means more specifically that we cannot without care recurse into it + - even if we only recurse very shallowly, we soon start running out of memory, this means we probably need + to do some on the fly filtering by "actual" dependencies + - this is similarly an issue, because it means that for every package we have to evaluate the entirety + of the package set instead of being able to keep and persist the database + - a more clean solution would probably be to at each time we recurse, a derivation that does the evaluation + and outputs a JSON that can later be read + +how this relates to bombon: +- bombon uses a more coarse grained approach +- this builds a metadata "database" i.e. is two pass +- see the corresponding nix code in ./nix +-} + +module Sbom where + +import Control.Arrow ((&&&)) +import Data.Aeson +import Data.Aeson.Key qualified as KM +import Data.Aeson.KeyMap qualified as KM +import Data.Aeson.Types (typeMismatch) +import Data.Bifunctor (first) +import Data.Bitraversable (bitraverse) +import Data.ByteString (ByteString) +import Data.ByteString.Char8 qualified as C8 +import Data.ByteString.Lazy (LazyByteString) +import Data.ByteString.Lazy qualified as BSL +import Data.ByteString.Lazy.Char8 qualified as C8L +import Data.Containers.ListUtils (nubOrd, nubOrdOn) +import Data.Functor.Identity +import Data.Map (Map) +import Data.Map qualified as M +import Data.Maybe +import Data.Proxy +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.IO qualified as T +import Data.Time.Clock.POSIX +import Data.Traversable (for) +import Data.Tree +import Data.UUID qualified as UUID +import Data.UUID.V4 qualified as V4 +import Debug.Trace +import GHC.Generics hiding (Meta) +import GHC.IsList (IsList (fromList, toList)) +import Numeric.Natural (Natural) +import Options.Applicative (customExecParser, fullDesc, help, long, prefs, progDesc, showHelpOnEmpty, strOption, value) +import Options.Applicative qualified as Opt +import System.Directory +import System.Process + +data License = MkLicense + { id :: Maybe Text, + name :: Maybe Text + } + deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (FromJSON, ToJSON) + +sadSbomMeta :: Text -> Text -> [Text] -> SBomMeta Identity +sadSbomMeta drvPath outPath directDeps = + MkSBomMeta + { drvPath = drvPath, + outPath = Identity outPath, + directDeps = Identity directDeps, + description = Nothing, + homepage = Nothing, + licenseSpdxId = [], + name = Nothing, + typ = Nothing, + urls = [], + version = Nothing + } + +data SBomMeta f = MkSBomMeta + { drvPath :: Text, + description :: Maybe Text, + homepage :: Maybe Text, + licenseSpdxId :: [Maybe License], + name :: Maybe Text, + typ :: Maybe Text, + urls :: [Maybe Text], + version :: Maybe Text, + outPath :: f Text, + directDeps :: f [Text] + } + +deriving stock instance (Eq (f [Text]), Eq (f Text)) => Eq (SBomMeta f) + +deriving stock instance (Ord (f [Text]), Ord (f Text)) => Ord (SBomMeta f) + +deriving stock instance (Show (f [Text]), Show (f Text)) => Show (SBomMeta f) + +type Meta = SBomMeta Proxy + +instance FromJSON Meta where + parseJSON (Object val) = + MkSBomMeta + <$> do val .: "drvPath" + <*> do val .: "description" + <*> do val .: "homepage" + <*> do val .: "licenseSpdxId" + <*> do val .: "name" + <*> do val .: "type" + <*> do val .: "urls" + <*> do val .: "version" + <*> pure Proxy + <*> pure Proxy + parseJSON invalid = typeMismatch "Object" invalid + +type SBom = Map Text (SBomMeta Identity) + +type MetaDB = Map Text (SBomMeta Proxy) + +type ClosureInfo = Tree ByteString + +type PathInfo = [(Text, (Text, [Text]))] + +data Visit a = Seen a | Unseen a + deriving stock (Eq, Ord, Show) + +data SerializeSBom = MkSerializeSBom + { -- | the version of the SBom; this is version of the old SBom + 1 + sbom'version :: Natural, + -- | name of the component the SBom is generated for + sbom'component :: Text, + -- | the creator of the component the SBom is generated for + sbom'manufacture :: Text, + -- | the supplier (manufacturer or repackager or distributor) + sbom'supplier :: Maybe Text, + -- | (spdxids of) licenses of the product + sbom'licenses :: [Text] + } + +defaultSerializeSBom :: SerializeSBom +defaultSerializeSBom = + MkSerializeSBom + { sbom'version = 1, + sbom'component = "wire-server", + sbom'manufacture = "wire", + sbom'supplier = Nothing, + sbom'licenses = ["AGPL-3.0-or-later"] + } + +-- FUTUREWORK(mangoiv): we can also have +-- +-- - qualifiers: extra qualifying data for a package such as an OS, architecture, a distro, etc. Optional and type-specific. +-- - subpath: extra subpath within a package, relative to the package root. Optional. +-- - use heuristics based approach to finding original repositories for packages, e.g. pkg:hackage.... +mkPurl :: SBomMeta Identity -> Text +mkPurl meta = + mconcat + [ "pkg:", + repo, + "/", + fromMaybe (runIdentity meta.outPath) meta.name, + maybe "" ("@" <>) meta.version + ] + where + repo + | any (maybe False (T.isInfixOf "hackage.haskell.org")) meta.urls = "hackage" + | otherwise = "nixpkgs" + +-- | serializes an SBom to JSON format +-- conventions: +-- - bomRef == outPath +serializeSBom :: SerializeSBom -> SBom -> IO LazyByteString +serializeSBom settings bom = do + uuid <- V4.nextRandom + curTime <- getCurrentTime + -- FUTUREWORK(mangoiv): "tools" (the tools used in the creation of the bom) + let mkDependencies :: SBomMeta Identity -> Array + mkDependencies meta = do + let d = + object + [ "ref" .= meta.outPath, + "dependsOn" .= runIdentity meta.directDeps + ] + [d] + mkComponents :: SBomMeta Identity -> Array + mkComponents meta = do + let c :: Value + c = + -- FUTUREWORK(mangoiv): swid? https://www.iso.org/standard/65666.html + -- FUTUREWORK(mangoiv): CPE? + -- FUTUREWORK(mangoiv): more information in the supplier section + object + [ "type" .= meta.typ, + "bom-ref" .= String (runIdentity meta.outPath), + "supplier" .= object ["url" .= nubOrd (maybeToList meta.homepage <> catMaybes meta.urls)], + "name" .= String (fromMaybe (st'name $ splitStorePath $ runIdentity meta.outPath) meta.name), + "version" .= meta.version, + "description" .= meta.description, + "scope" .= String "required", + "licenses" .= ((\ln -> object ["license" .= ln]) <$> filter (isJust . (>>= (.id))) meta.licenseSpdxId), + "purl" .= mkPurl meta + ] + [c] + (dependencies, components) = foldMap (mkDependencies &&& mkComponents) bom + + pure $ + encode @Value $ + object + [ "bomFormat" .= String "CycloneDX", + "specVersion" .= String "1.5", + "serialNumber" .= String ("urn:uuid:" <> UUID.toText uuid), + "version" .= Number (fromIntegral settings.sbom'version), + "metadata" + .= object + [ "timestamp" .= String (T.pack (show curTime)), + "component" + .= object + [ "name" .= String settings.sbom'component, + "type" .= String "application" + -- FUTUREWORK(mangoiv): this should be a choice in the settings above + ], + -- FUTUREWORK(mangoiv): "manufacture" can also have url + "manufacture" .= object ["name" .= String settings.sbom'manufacture], + "supplier" .= object ["name" .= String (fromMaybe settings.sbom'manufacture settings.sbom'supplier)], + "licenses" .= Array (fromList $ object . (\n -> ["id" .= n]) . String <$> settings.sbom'licenses) + ], + "components" .= Array components, + -- FUTUREWORK(mangoiv): services: allow to tell the program the name of the services like brig, galley, ... + "dependencies" .= Array dependencies + ] + +buildMetaDB :: [Meta] -> MetaDB +buildMetaDB = foldMap \MkSBomMeta {..} -> [(drvPath, MkSBomMeta {..})] + +discoverSBom :: FilePath -> MetaDB -> IO SBom +discoverSBom outP metaDb = do + canonicalOutP <- canonicalizePath =<< getSymbolicLinkTarget outP + info <- pathInfo canonicalOutP + let go :: (Text, (Text, [Text])) -> IO SBom -> IO SBom + go (k, (deriver, deps)) = do + let proxyToIdentity :: SBomMeta Proxy -> SBomMeta Identity + proxyToIdentity (MkSBomMeta {..}) = MkSBomMeta {directDeps = Identity deps, outPath = Identity k, ..} + case M.lookup deriver metaDb of + Nothing -> \x -> do + T.putStrLn ("no meta found for drv: " <> deriver <> "\ntrying approximate match") + x >>= maybe + do + \m -> do + T.putStrLn ("no approximate match found for: " <> deriver) + pure $ M.insert k (sadSbomMeta deriver k deps) m + do \match -> pure . M.insert k (proxyToIdentity match) + do approximateMatch deriver metaDb + Just pmeta -> fmap $ M.insert k $ proxyToIdentity pmeta + + foldr go mempty info + +data StorePath = MkStorePath + { st'hash :: Text, + st'name :: Text, + st'original :: Text + } + deriving stock (Eq, Ord, Show) + +-- >>> splitStorePath "/nix/store/m306sk6syihxp80zrr9xs8hi5mjricgh-sop-core-0.5.0.2" +-- MkStorePath {st'hash = "m306sk6syihxp80zrr9xs8hi5mjricgh", st'name = "sop-core-0.5.0.2", st'original = "/nix/store/m306sk6syihxp80zrr9xs8hi5mjricgh-sop-core-0.5.0.2"} +splitStorePath :: Text -> StorePath +splitStorePath stp = do + let rest = T.drop (T.length "/nix/store/") stp + (hash, T.drop 1 -> name) = T.breakOn "-" rest + MkStorePath {st'original = stp, st'hash = hash, st'name = name} + +approximateMatch :: Text -> MetaDB -> Maybe (SBomMeta Proxy) +approximateMatch stp db = + let goal = splitStorePath stp + metas = first splitStorePath <$> M.toList db + in case filter (\(m, _) -> m.st'name == goal.st'name) metas of + [(_stp, meta)] -> pure meta + _ -> Nothing + +parse :: IO (String, String) +parse = customExecParser (prefs showHelpOnEmpty) do + Opt.info + do drvAndTlParser + do + mconcat + [ fullDesc, + progDesc "build an sbom from a derivation and a package set" + ] + +drvAndTlParser :: Opt.Parser (String, String) +drvAndTlParser = + (,) + <$> strOption (long "drv" <> help "outpath of the derivation to build the sbom for" <> value "result") + <*> strOption do + long "tldfp" + <> help "path to the derivation containing the output of the allLocalPackages drv" + <> value "wire-server" + +main :: IO () +main = parse >>= mainNoParse >>= BSL.writeFile "sbom.json" + +-- | by not always parsing, we have an easy time to call directly from haskell +mainNoParse :: (String, String) -> IO LazyByteString +mainNoParse (tldFp, drv) = do + let mkMeta :: LazyByteString -> Maybe Meta + mkMeta = decodeStrict . BSL.toStrict + metaDB <- buildMetaDB . mapMaybe mkMeta . C8L.lines <$> BSL.readFile tldFp + sbom <- discoverSBom drv metaDB + serializeSBom defaultSerializeSBom sbom + +pathInfo :: FilePath -> IO PathInfo +pathInfo path = do + let nixPathInfo = proc "nix" ["path-info", path, "--json", "--recursive"] + withCreateProcess nixPathInfo {std_out = CreatePipe} \_in (Just out) _err _ph -> do + Just refs' <- decodeStrict @Value <$> C8.hGetContents out + let failureBecauseNixHasZeroContracts = fail "unexpected format: this may be due to the output of `nix path-info` having changed randomly lol" + tryFindOutpath :: Value -> IO (Key, Value) + tryFindOutpath val + | Object pc <- val, + Just (String k) <- KM.lookup "path" pc = + pure (KM.fromText k, val) + tryFindOutpath _ = failureBecauseNixHasZeroContracts + refs <- case refs' of + Object refs -> pure $ KM.toList refs + Array refs -> traverse tryFindOutpath $ toList refs + _ -> failureBecauseNixHasZeroContracts + + let parseObj :: Value -> Maybe (Text, [Text]) + parseObj info + | Object mp <- info, + Just (Array rs) <- KM.lookup "references" mp, + Just (String deriver) <- KM.lookup "deriver" mp, + Just rs' <- for rs \case + String s -> Just s + _ -> Nothing = + Just (deriver, toList rs') + parseObj _ = trace "could not parse object" Nothing + -- some heuristics based filtering + pure + -- remove derivations with the same deriver + . nubOrdOn (fst . snd) + -- remove derivations that are just docs + . filter ((/= "doc") . T.takeEnd 3 . fst) + . mapMaybe (bitraverse (pure . KM.toText) parseObj) + $ refs diff --git a/hack/bin/bombon.hs b/hack/bin/bombon.hs index 0c01c4cf80f..d4bc7fdec0b 100755 --- a/hack/bin/bombon.hs +++ b/hack/bin/bombon.hs @@ -1,9 +1,11 @@ -#!/usr/bin/env -S nix -Lv run github:wireapp/ghc-flakr/99fe5a331fdd37d52043f14e5c565ac29a30bcb4 +#!/usr/bin/env -S nix -Lv run github:wireapp/ghc-flakr/6311bb166bf835d4a587fe1661b86c9a1426f212 {-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# OPTIONS_GHC -Wall #-} import Data.Aeson import qualified Data.ByteString.Base64.Lazy as Base64 -import qualified Data.ByteString.Lazy.Char8 as BL +import Data.ByteString.Lazy import Data.Proxy import Data.Text.Lazy import Data.Text.Lazy.Encoding @@ -11,8 +13,11 @@ import GHC.Generics import qualified Network.HTTP.Client as HTTP import Network.HTTP.Client.TLS (tlsManagerSettings) import Options.Applicative +import Sbom hiding (main) import Servant.API import Servant.Client +import System.Exit +import System.Process data Payload = Payload { bom :: Text, @@ -46,8 +51,7 @@ putBOM :: Payload -> Maybe String -> ClientM ApiResponse putBOM = client api data CliOptions = CliOptions - { opBomPath :: String, - opProjectName :: String, + { opProjectName :: String, opProjectVersion :: String, opAutoCreate :: Bool, opApiKey :: String @@ -58,12 +62,6 @@ cliParser :: Parser CliOptions cliParser = CliOptions <$> ( strOption - ( long "bom-filepath" - <> short 'f' - <> metavar "FILENAME" - ) - ) - <*> ( strOption ( long "project-name" <> short 'p' <> metavar "PROJECT_NAME" @@ -100,7 +98,16 @@ main :: IO () main = do options <- execParser fullCliParser manager' <- HTTP.newManager tlsManagerSettings - bom <- readFile $ opBomPath options + buildWire <- spawnCommand "nix -Lv build -f ../../nix wireServer.allLocalPackages -o wire-server" + buildMeta <- spawnCommand "nix -Lv build -f ../../nix wireServer.toplevel-derivations --impure -o meta" + waitForProcess buildWire >>= \case + ExitFailure _ -> fail "process for building wire failed" + ExitSuccess -> putStrLn "finished building Wire" + waitForProcess buildMeta >>= \case + ExitFailure _ -> fail "process for building meta for wire failed" + ExitSuccess -> putStrLn "finished building meta" + + bom <- mainNoParse ("./meta", "./wire-server") let payload = Payload { bom = toBase64Text bom, @@ -114,7 +121,7 @@ main = do (mkClientEnv manager' (BaseUrl Https "deptrack.wire.link" 443 "")) case res of Left err -> print $ "Error: " ++ show err - Right res -> print res + Right res' -> print res' -toBase64Text :: String -> Text -toBase64Text = decodeUtf8 . Base64.encode . BL.pack +toBase64Text :: LazyByteString -> Text +toBase64Text = decodeUtf8 . Base64.encode diff --git a/hack/bin/get-session-token b/hack/bin/get-session-token new file mode 100755 index 00000000000..e611bf84d7f --- /dev/null +++ b/hack/bin/get-session-token @@ -0,0 +1,44 @@ +#!/usr/bin/env bash + +#set -x +set -e -o pipefail + +WIRE_COOKIEJAR=/tmp/get-session-token.cookiejar + +#WIRE_HOST=https://prod-nginz-https.wire.com +#WIRE_USER='...' +#WIRE_PASSWORD='...' + +# run eg. './create_test_team_admins.sh -c', and fill user and password from the output: +WIRE_HOST=http://localhost:8080 +WIRE_USER='...' +WIRE_PASSWORD='...' + +function wire_login () { + curl -b $WIRE_COOKIEJAR -c $WIRE_COOKIEJAR -X POST \ + --header 'Content-Type: application/json' \ + --header 'Accept: application/json' \ + -d '{"email":"'"$WIRE_USER"'","password":"'"$WIRE_PASSWORD"'"}' \ + $WIRE_HOST/login'?persist=false' +} + +function wire_logout () { + curl -b $WIRE_COOKIEJAR -c $WIRE_COOKIEJAR -v -X POST \ + --header 'Content-Type: application/json' \ + --header 'Accept: application/json' \ + --header "Authorization: Bearer $BEARER" \ + "{$WIRE_HOST}/access/logout" +} + +export RESP +RESP=$(wire_login) +echo "[$RESP]" + +export BEARER +BEARER=$(echo "$RESP" | jq -r .access_token) +echo "Authorization: Bearer $BEARER" + +#cat $WIRE_COOKIEJAR +#export RESP +#RESP=$(wire_logout) +#echo "[$RESP]" diff --git a/hack/bin/integration-cleanup.sh b/hack/bin/integration-cleanup.sh index 578acb2a8c9..e814fa43852 100755 --- a/hack/bin/integration-cleanup.sh +++ b/hack/bin/integration-cleanup.sh @@ -8,7 +8,7 @@ set -euo pipefail DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" -releases=$(helm list -A -f 'test-' -o json | +releases=$(helm list -A -f '^test-' -o json | jq -r -f "$DIR/filter-old-releases.jq") if [ -n "$releases" ]; then diff --git a/hack/bin/integration-setup-federation.sh b/hack/bin/integration-setup-federation.sh index d7e19e66aeb..939f1d4f56d 100755 --- a/hack/bin/integration-setup-federation.sh +++ b/hack/bin/integration-setup-federation.sh @@ -25,9 +25,6 @@ charts=(fake-aws databases-ephemeral redis-cluster rabbitmq wire-server ingress- mkdir -p ~/.parallel && touch ~/.parallel/will-cite printf '%s\n' "${charts[@]}" | parallel -P "${HELM_PARALLELISM}" "$DIR/update.sh" "$CHARTS_DIR/{}" -# FUTUREWORK: use helm functions instead, see https://wearezeta.atlassian.net/browse/SQPIT-723 -echo "Generating self-signed certificates..." - KUBERNETES_VERSION_MAJOR="$(kubectl version -o json | jq -r .serverVersion.major)" KUBERNETES_VERSION_MINOR="$(kubectl version -o json | jq -r .serverVersion.minor)" KUBERNETES_VERSION_MINOR="${KUBERNETES_VERSION_MINOR//[!0-9]/}" # some clusters report minor versions as a string like '27+'. Strip any non-digit characters. @@ -39,18 +36,23 @@ else fi echo "kubeVersion: $KUBERNETES_VERSION and ingress controller=$INGRESS_CHART" export NAMESPACE_1="$NAMESPACE" -export FEDERATION_DOMAIN_BASE="$NAMESPACE_1.svc.cluster.local" -export FEDERATION_DOMAIN_1="federation-test-helper.$FEDERATION_DOMAIN_BASE" -"$DIR/selfsigned-kubernetes.sh" namespace1 +export FEDERATION_DOMAIN_BASE_1="$NAMESPACE_1.svc.cluster.local" +export FEDERATION_DOMAIN_1="federation-test-helper.$FEDERATION_DOMAIN_BASE_1" export NAMESPACE_2="$NAMESPACE-fed2" -export FEDERATION_DOMAIN_BASE="$NAMESPACE_2.svc.cluster.local" -export FEDERATION_DOMAIN_2="federation-test-helper.$FEDERATION_DOMAIN_BASE" -"$DIR/selfsigned-kubernetes.sh" namespace2 +export FEDERATION_DOMAIN_BASE_2="$NAMESPACE_2.svc.cluster.local" +export FEDERATION_DOMAIN_2="federation-test-helper.$FEDERATION_DOMAIN_BASE_2" + +echo "Fetch federation-ca secret from cert-manager namespace" +FEDERATION_CA_CERTIFICATE=$(kubectl -n cert-manager get secrets federation-ca -o json -o jsonpath="{.data['tls\.crt']}" | base64 -d) +export FEDERATION_CA_CERTIFICATE 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/ + helmfile --environment "$HELMFILE_ENV" --file "${TOP_LEVEL}/hack/helmfile.yaml" sync --skip-deps --concurrency 0 EXIT_CODE=$? diff --git a/hack/bin/selfsigned-kubernetes.sh b/hack/bin/selfsigned-kubernetes.sh deleted file mode 100755 index d0023cce0f3..00000000000 --- a/hack/bin/selfsigned-kubernetes.sh +++ /dev/null @@ -1,98 +0,0 @@ -#!/usr/bin/env bash - -# Create a self-signed x509 certificate in the hack/helm_vars directories (as helm yaml config). -# Requires 'cfssl' to be on your PATH (see https://github.com/cloudflare/cfssl) -# These certificates are only meant for integration tests. -# (The CA certificates are assumed to be re-used across the domains A and B for end2end integration tests.) - -set -e -SUFFIX=${1:?"need suffix argument"} -TEMP=${TEMP:-/tmp} -CSR="$TEMP/csr.json" -OUTPUTNAME_CA="integration-ca" -OUTPUTNAME_LEAF_CERT="integration-leaf" -OUTPUTNAME_CLIENT_CERT="integration-client" -DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" -TOP_LEVEL="$DIR/../.." -OUTPUT_CONFIG_FEDERATOR="$TOP_LEVEL/hack/helm_vars/wire-server/certificates-$SUFFIX.yaml" -OUTPUT_CONFIG_INGRESS="$TOP_LEVEL/hack/helm_vars/nginx-ingress-services/certificates-$SUFFIX.yaml" - -command -v cfssl >/dev/null 2>&1 || { - echo >&2 "cfssl is not installed, aborting. See https://github.com/cloudflare/cfssl" - exit 1 -} -command -v cfssljson >/dev/null 2>&1 || { - echo >&2 "cfssljson is not installed, aborting. See https://github.com/cloudflare/cfssl" - exit 1 -} - -FEDERATION_DOMAIN_BASE=${FEDERATION_DOMAIN_BASE:?"you must provide a FEDERATION_DOMAIN_BASE env variable"} - -# generate CA key and cert -if [ ! -f "$OUTPUTNAME_CA.pem" ]; then - echo "CA file not found, generating CA..." - echo '{ - "CN": "ca.example.com", - "key": { - "algo": "rsa", - "size": 2048 - } - }' >"$CSR" - cfssl gencert -initca "$CSR" | cfssljson -bare "$OUTPUTNAME_CA" - rm "$OUTPUTNAME_CA.csr" -else - echo "Re-using previous CA" -fi - -# For federation end2end tests, only the -# 'federation-test-helper.$FEDERATION_DOMAIN_BASE' is necessary for -# ingress->federator traffic. For other potential traffic in the integration -# tests of the future, we use a wildcard certificate here. -echo '{ - "key": { - "algo": "rsa", - "size": 2048 - } -}' >"$CSR" -# generate cert and key based on CA given comma-separated hostnames as SANs -cfssl gencert -ca "$OUTPUTNAME_CA.pem" -ca-key "$OUTPUTNAME_CA-key.pem" -hostname="*.$FEDERATION_DOMAIN_BASE" "$CSR" | cfssljson -bare "$OUTPUTNAME_LEAF_CERT" - -# generate client certificate and key -cfssl gencert -ca "$OUTPUTNAME_CA.pem" -ca-key "$OUTPUTNAME_CA-key.pem" -hostname="*.$FEDERATION_DOMAIN_BASE" "$CSR" | cfssljson -bare "$OUTPUTNAME_CLIENT_CERT" - -# the following yaml override file is needed as an override to -# nginx-ingress-services helm chart -# for domain A, ingress@A needs cert+key for A -{ - echo "secrets:" - echo " tlsWildcardCert: |" - sed -e 's/^/ /' $OUTPUTNAME_LEAF_CERT.pem - echo " tlsWildcardKey: |" - sed -e 's/^/ /' $OUTPUTNAME_LEAF_CERT-key.pem - echo " tlsClientCA: |" - sed -e 's/^/ /' $OUTPUTNAME_CA.pem -} >"$OUTPUT_CONFIG_INGRESS" - -# the following yaml override file is needed as an override to -# the wire-server (federator) helm chart -# e.g. for installing on domain A, federator@A needs the CA for B -# As a "shortcut" for integration tests, we re-use the same CA for both domains -# A and B. -{ - echo "federator:" - echo " remoteCAContents: |" - sed -e 's/^/ /' $OUTPUTNAME_CA.pem - echo " clientCertificateContents: |" - sed -e 's/^/ /' $OUTPUTNAME_CLIENT_CERT.pem - echo " clientPrivateKeyContents: |" - sed -e 's/^/ /' $OUTPUTNAME_CLIENT_CERT-key.pem -} >"$OUTPUT_CONFIG_FEDERATOR" - -# cleanup unneeded files -rm "$OUTPUTNAME_LEAF_CERT.csr" -rm "$OUTPUTNAME_LEAF_CERT.pem" -rm "$OUTPUTNAME_LEAF_CERT-key.pem" -rm "$OUTPUTNAME_CLIENT_CERT.csr" -rm "$OUTPUTNAME_CLIENT_CERT.pem" -rm "$OUTPUTNAME_CLIENT_CERT-key.pem" -rm "$CSR" diff --git a/hack/bin/selfsigned.sh b/hack/bin/selfsigned.sh index a7107c436ad..73e507358fc 100755 --- a/hack/bin/selfsigned.sh +++ b/hack/bin/selfsigned.sh @@ -9,10 +9,15 @@ set -euo pipefail SCRIPT_DIR=$(cd -- "$(dirname -- "${BASH_SOURCE[0]}" )" &> /dev/null && pwd ) ROOT_DIR=$(cd -- "$SCRIPT_DIR/../../" &> /dev/null && pwd) -TEMP=$(mktemp -d wire-server-self-signed-XXXXXX) -CSR="$TEMP/csr.json" -OUTPUTNAME_CA="$TEMP/integration-ca" -OUTPUTNAME_LEAF_CERT="$TEMP/integration-leaf" +TEMP=$(mktemp -d wire-server-self-signed-XXXXXX --tmpdir) +CSR_FEDERATION="$TEMP/csr-federation.json" +CSR_FEDERATION_CA="$TEMP/csr-federation-ca.json" +CSR_ELASTICSEARCH="$TEMP/csr-elasitcsearch.json" +CSR_ELASTICSEARCH_CA="$TEMP/csr-elasticsearch-ca.json" +FEDERATION_CA="$TEMP/integration-ca" +FEDERATION_LEAF_CERT="$TEMP/integration-leaf" +ELASTICSEARCH_CA="$TEMP/elasticsearch-ca" +ELASTICSEARCH_LEAF_CERT="$TEMP/elasticsearch-leaf" command -v cfssl >/dev/null 2>&1 || { echo >&2 "cfssl is not installed, aborting. See https://github.com/cloudflare/cfssl"; exit 1; } command -v cfssljson >/dev/null 2>&1 || { echo >&2 "cfssljson is not installed, aborting. See https://github.com/cloudflare/cfssl"; exit 1; } @@ -23,28 +28,66 @@ echo '{ "algo": "rsa", "size": 2048 } -}' > "$CSR" +}' > "$CSR_FEDERATION_CA" # generate CA key and cert -cfssl gencert -initca "$CSR" | cfssljson -bare "$OUTPUTNAME_CA" +cfssl gencert -initca "$CSR_FEDERATION_CA" | cfssljson -bare "$FEDERATION_CA" echo '{ "key": { "algo": "rsa", "size": 2048 } -}' > "$CSR" +}' > "$CSR_FEDERATION" # generate cert and key based on CA given comma-separated hostnames as SANs -cfssl gencert -ca "$OUTPUTNAME_CA.pem" -ca-key "$OUTPUTNAME_CA-key.pem" -hostname=*.integration.example.com,host.docker.internal,localhost "$CSR" | cfssljson -bare "$OUTPUTNAME_LEAF_CERT" +cfssl gencert \ + -ca "$FEDERATION_CA.pem" \ + -ca-key "$FEDERATION_CA-key.pem" \ + -hostname=*.integration.example.com,host.docker.internal,localhost \ + "$CSR_FEDERATION" \ + | cfssljson -bare "$FEDERATION_LEAF_CERT" -cp "$OUTPUTNAME_CA.pem" "$ROOT_DIR/services/nginz/integration-test/conf/nginz/" -cp "$OUTPUTNAME_CA-key.pem" "$ROOT_DIR/services/nginz/integration-test/conf/nginz/" -cp "$OUTPUTNAME_LEAF_CERT.pem" "$ROOT_DIR/services/nginz/integration-test/conf/nginz/" -cp "$OUTPUTNAME_LEAF_CERT-key.pem" "$ROOT_DIR/services/nginz/integration-test/conf/nginz/" +cp "$FEDERATION_CA.pem" "$ROOT_DIR/services/nginz/integration-test/conf/nginz/" +cp "$FEDERATION_CA-key.pem" "$ROOT_DIR/services/nginz/integration-test/conf/nginz/" +cp "$FEDERATION_LEAF_CERT.pem" "$ROOT_DIR/services/nginz/integration-test/conf/nginz/" +cp "$FEDERATION_LEAF_CERT-key.pem" "$ROOT_DIR/services/nginz/integration-test/conf/nginz/" -cp "$OUTPUTNAME_CA.pem" "$ROOT_DIR/deploy/dockerephemeral/federation-v0/" -cp "$OUTPUTNAME_LEAF_CERT.pem" "$ROOT_DIR/deploy/dockerephemeral/federation-v0/" -cp "$OUTPUTNAME_LEAF_CERT-key.pem" "$ROOT_DIR/deploy/dockerephemeral/federation-v0/" +cp "$FEDERATION_CA.pem" "$ROOT_DIR/deploy/dockerephemeral/federation-v0/" +cp "$FEDERATION_LEAF_CERT.pem" "$ROOT_DIR/deploy/dockerephemeral/federation-v0/" +cp "$FEDERATION_LEAF_CERT-key.pem" "$ROOT_DIR/deploy/dockerephemeral/federation-v0/" + +echo '{ + "CN": "elasticsearch.ca.example.com", + "key": { + "algo": "rsa", + "size": 2048 + } +}' > "$CSR_ELASTICSEARCH_CA" + +# generate CA key and cert +cfssl gencert -initca "$CSR_ELASTICSEARCH_CA" | cfssljson -bare "$ELASTICSEARCH_CA" + +echo '{ + "key": { + "algo": "rsa", + "size": 2048 + } +}' > "$CSR_ELASTICSEARCH" + +# generate cert and key based on CA given comma-separated hostnames as SANs +cfssl gencert \ + -ca "$ELASTICSEARCH_CA.pem" \ + -ca-key "$ELASTICSEARCH_CA-key.pem" \ + -hostname=localhost \ + "$CSR_ELASTICSEARCH" \ + | cfssljson -bare "$ELASTICSEARCH_LEAF_CERT" + +cp "$ELASTICSEARCH_CA.pem" "$ROOT_DIR/deploy/dockerephemeral/docker/elasticsearch-ca.pem" +cp "$ELASTICSEARCH_LEAF_CERT.pem" "$ROOT_DIR/deploy/dockerephemeral/docker/elasticsearch-cert.pem" +cp "$ELASTICSEARCH_LEAF_CERT-key.pem" "$ROOT_DIR/deploy/dockerephemeral/docker/elasticsearch-key.pem" + +cp "$ELASTICSEARCH_CA.pem" "$ROOT_DIR/hack/helm_vars/elasticsearch-certs/elasticsearch-ca.pem" +cp "$ELASTICSEARCH_CA-key.pem" "$ROOT_DIR/hack/helm_vars/elasticsearch-certs/elasticsearch-ca-key.pem" rm -rf "$TEMP" diff --git a/hack/helm_vars/.gitignore b/hack/helm_vars/.gitignore index 38a7ff397ae..9849d951a02 100644 --- a/hack/helm_vars/.gitignore +++ b/hack/helm_vars/.gitignore @@ -1,3 +1 @@ certificates.yaml -certificates-namespace1.yaml -certificates-namespace2.yaml diff --git a/hack/helm_vars/common.yaml.gotmpl b/hack/helm_vars/common.yaml.gotmpl index 56f209fcce8..4b296fb8fc4 100644 --- a/hack/helm_vars/common.yaml.gotmpl +++ b/hack/helm_vars/common.yaml.gotmpl @@ -1,7 +1,10 @@ namespace1: {{ requiredEnv "NAMESPACE_1" }} federationDomain1: {{ requiredEnv "FEDERATION_DOMAIN_1" }} +federationDomainBase1: {{ requiredEnv "FEDERATION_DOMAIN_BASE_1" }} namespace2: {{ requiredEnv "NAMESPACE_2" }} federationDomain2: {{ requiredEnv "FEDERATION_DOMAIN_2" }} +federationDomainBase2: {{ requiredEnv "FEDERATION_DOMAIN_BASE_2" }} +federationCACertificate: {{ requiredEnv "FEDERATION_CA_CERTIFICATE" | quote }} ingressChart: {{ requiredEnv "INGRESS_CHART" }} rabbitmqUsername: guest rabbitmqPassword: guest diff --git a/hack/helm_vars/elasticsearch-certs/elasticsearch-ca-key.pem b/hack/helm_vars/elasticsearch-certs/elasticsearch-ca-key.pem new file mode 100644 index 00000000000..0b9246b7ecb --- /dev/null +++ b/hack/helm_vars/elasticsearch-certs/elasticsearch-ca-key.pem @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEpAIBAAKCAQEAtEfj7ZOOh3fEq0fkv3TO5xr4WANhK1lBYaclA1ou1aVKU4LZ +ck85jYMQJYfUFp/Brqr8KghQZ24iy/jlehLE9f3yrf94mFb/psoOYAUzx7f0DWh2 +eRO8DHcA0R0bgCkCPZAnWWWe/6a1T00A8dBNdssTFmxPjYL2HzZpCV0ht2OUuYoR +PETviWWHnAFn3N4sBGXg+3fVp1bG9LDPoicDDjk5cSkiPAsPrpHF3U4faZsckDWV +XdbUhl/zR9vNRCq6CDy6iAMYMtXdnFKogiiH+KRhG4o2/JvzpKBXs/u745g+ewPL +krsMl8+/sRNrkSRQIrLoOc3W/ClgCQZRJIIFmwIDAQABAoIBAQCtn7L/IqYZB5rs +ToAad5ewcYQN16tkgUB7mOsHsHn8noTXquRat7w48qnBS3BSHaf93YSfwoQVKLfw +c5QmHh98vgdT1f/Bz7/FVUHE7h2xUhOEOkAnWX85Df9GZd8Pbe9PdR7AdSNNGbPy +XLn1KWUBbJDEfqmbIy6AXvmH4B7Rq0K/8nRdTJsZiGBwR3TZINWkVv43b4LMlqdn +QavTm2cO7wylN6QWtWbutFs2YrbG7LCdn1qOyMQgNAwzHbzatQjWl8M7K9xoNaec +pjIS7/Oobs4OVlMxLn/QWF2wCWt+r3i+USqoAw7qgPXMQ1b6h4vaKHJw8UCTeI42 +Xi5vvfC5AoGBAOIfQ8kNHFI+7/5aPa7SQC0tqwBT+HkAZY4DZsFeCe7aKIrvqwCj +/6ioGrfLhtjQTUnxN5D9DyJnbNAKSGwbuylVcJiARPv5NxXS9ES3QmgK/mqz+Ds3 +8SVM48tI4jAfeSuDW/qztVOXpzZYJmnjVO1Qu0pNnmTMAB3WE2vqZlRvAoGBAMwa +AxkI4O2CUeaOug+eG/+ztlpX79lU+DDLYtM8CH8MVBfqQtLg5UxUGE7eVkSZyOYN +STz6eKIh5tvPc91l9xSrL5wwGmSl48f3xxycJVF2UfD7LmlcvRHthLCQPWHcCAne +6RWinCiS4ATPU6p9DzR6XYyALB0vODr84qTb9a+VAoGASPP9UqhAMujLVSyYKgb7 +XZgWS4zL5X4TRbYjOM+2NLF90xVv/kzq9ucFd7baUqkhxnFklAqRD3B+0r/+jaKE +x9kg8pKvrvvAofHljSXy7s5dNt/JfpGV44rjE3r4Pr5owXkn+8JvBgEvmYDnI9KM +W+RoCJjyOWL3xqiCq5Z8XVECgYB3vD7a/fFuhIhlmI+gv+GvFY/B2lrUBdwATCDy +yQI2/lWLHhwLuHHsYF1OT3MOlaVdCKhRhKMmgnr7su1HEh1sW6z3lOS27Pb/BeYi +a5wc+SvDEqg8mXI1xUCVkFjiQwHYQJQ+5AF2cAvJ5pMvrmQwJiUhWsQGbwAu4tJX +Ys70LQKBgQC3jOZpW5MrBdyGRJwkGYrJ3oGvgM5HGqD/9088b42i7EoDroh43e1r +rX+6mkocXd1LU2+zRaCqxA58dNuqXvU1dESW0gLgUoe3ubIlfoaD9MBwlE0trBDw +iO3tSUQ3zzYh+Uu7xBywvDEGnRhJTBs1AuwdxsdSte2WrQ7KLHwncQ== +-----END RSA PRIVATE KEY----- diff --git a/hack/helm_vars/elasticsearch-certs/elasticsearch-ca.pem b/hack/helm_vars/elasticsearch-certs/elasticsearch-ca.pem new file mode 100644 index 00000000000..d4ef94d4d2a --- /dev/null +++ b/hack/helm_vars/elasticsearch-certs/elasticsearch-ca.pem @@ -0,0 +1,19 @@ +-----BEGIN CERTIFICATE----- +MIIDHjCCAgagAwIBAgIUXd/KjPrGXSmRyZ4Q/9O3LPGB70owDQYJKoZIhvcNAQEL +BQAwJzElMCMGA1UEAxMcZWxhc3RpY3NlYXJjaC5jYS5leGFtcGxlLmNvbTAeFw0y +NDA0MjIxMjA0MDBaFw0yOTA0MjExMjA0MDBaMCcxJTAjBgNVBAMTHGVsYXN0aWNz +ZWFyY2guY2EuZXhhbXBsZS5jb20wggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEK +AoIBAQC0R+Ptk46Hd8SrR+S/dM7nGvhYA2ErWUFhpyUDWi7VpUpTgtlyTzmNgxAl +h9QWn8GuqvwqCFBnbiLL+OV6EsT1/fKt/3iYVv+myg5gBTPHt/QNaHZ5E7wMdwDR +HRuAKQI9kCdZZZ7/prVPTQDx0E12yxMWbE+NgvYfNmkJXSG3Y5S5ihE8RO+JZYec +AWfc3iwEZeD7d9WnVsb0sM+iJwMOOTlxKSI8Cw+ukcXdTh9pmxyQNZVd1tSGX/NH +281EKroIPLqIAxgy1d2cUqiCKIf4pGEbijb8m/OkoFez+7vjmD57A8uSuwyXz7+x +E2uRJFAisug5zdb8KWAJBlEkggWbAgMBAAGjQjBAMA4GA1UdDwEB/wQEAwIBBjAP +BgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBQ1/LWQ/Ckxpc7HdBp6mNBfZNQssDAN +BgkqhkiG9w0BAQsFAAOCAQEAfGo1ONgSfTwRtT/ZsZgAnseqZSQCuvUQ4nrg2dDe +cFZtC05EczfmPx7G7Q2VeF9ZU56m/Ep57gE4W2wwVIwoG3Zam0kG4HirkgLNPagf +j3RkDrCvrjeESYFj7qwdnmgFNxotlC0KjHkGrfdT7gTDSWoNE3tobxyFaT1YQyBB +L6oRVlKa6O0ivgADUw/VMIARqFgCni/PhaHd4UlR9bgLVQ4MEVb463MMpGAdK4ZZ +l1bYVRf0pTeYnEiUG2HXt/1JFzSowFoZD8wVOXa0kcxy9SK/UCX8PVzMx06G4Ion +NNkzz9uSme9hAQlVsW6gxzl0NhwOtClpPIlvEqHwgF54KQ== +-----END CERTIFICATE----- diff --git a/hack/helm_vars/elasticsearch-certs/es-cert-issuer.yaml.gotmpl b/hack/helm_vars/elasticsearch-certs/es-cert-issuer.yaml.gotmpl new file mode 100644 index 00000000000..a9ef90fd0e8 --- /dev/null +++ b/hack/helm_vars/elasticsearch-certs/es-cert-issuer.yaml.gotmpl @@ -0,0 +1,17 @@ +resources: + - apiVersion: v1 + kind: Secret + metadata: + name: elasticsearch-ca + namespace: '{{ .Release.Namespace }}' + data: + tls.crt: {{ readFile "./elasticsearch-ca.pem" | b64enc | quote }} + tls.key: {{ readFile "./elasticsearch-ca-key.pem" | b64enc | quote }} + - apiVersion: cert-manager.io/v1 + kind: Issuer + metadata: + name: elasticsearch + namespace: '{{ .Release.Namespace }}' + spec: + ca: + secretName: elasticsearch-ca diff --git a/hack/helm_vars/ingress-nginx-controller/values.yaml.gotmpl b/hack/helm_vars/ingress-nginx-controller/values.yaml.gotmpl index dce7f5d0ab0..c137f045884 100644 --- a/hack/helm_vars/ingress-nginx-controller/values.yaml.gotmpl +++ b/hack/helm_vars/ingress-nginx-controller/values.yaml.gotmpl @@ -5,6 +5,7 @@ ingress-nginx: name: "nginx-{{ .Release.Namespace }}" # -- Is this ingressClass enabled or not enabled: true + controllerValue: "k8s.io/{{ .Release.Namespace }}-nginx-ingress" ingressClass: "nginx-{{ .Release.Namespace }}" kind: Deployment replicaCount: 1 diff --git a/hack/helm_vars/nginx-ingress-services/values.yaml.gotmpl b/hack/helm_vars/nginx-ingress-services/values.yaml.gotmpl index d1297da5fcc..9cc214d779b 100644 --- a/hack/helm_vars/nginx-ingress-services/values.yaml.gotmpl +++ b/hack/helm_vars/nginx-ingress-services/values.yaml.gotmpl @@ -6,7 +6,12 @@ federator: enabled: true integrationTestHelper: true tls: - useCertManager: false + useCertManager: true + issuer: + name: federation + kind: ClusterIssuer + createIssuer: false + caNamespace: wire-federation-v0 config: ingressClass: "nginx-{{ .Release.Namespace }}" @@ -18,6 +23,7 @@ config: teamSettings: "teams.{{ .Release.Namespace }}-integration.example.com" accountPages: "account.{{ .Release.Namespace }}-integration.example.com" # federator: dynamically set by hack/helmfile.yaml + # certificateDomain: dynamically set by hack/helmfile.yaml -# secrets/tlsWildcardCert, secrets/tlsWildcardKey and secrets/tlsClientCA -# are dynamically generated by hack/bin/selfsigned-kubernetes.sh +secrets: + tlsClientCA: {{ .Values.federationCACertificate | quote }} diff --git a/hack/helm_vars/redis-cluster/values.yaml.gotmpl b/hack/helm_vars/redis-cluster/values.yaml.gotmpl index 658cb795566..9d81712a59d 100644 --- a/hack/helm_vars/redis-cluster/values.yaml.gotmpl +++ b/hack/helm_vars/redis-cluster/values.yaml.gotmpl @@ -6,3 +6,4 @@ redis-cluster: size: 100Mi volumePermissions: enabled: true + password: very-secure-redis-cluster-password diff --git a/hack/helm_vars/wire-federation-v0/values.yaml.gotmpl b/hack/helm_vars/wire-federation-v0/values.yaml.gotmpl new file mode 100644 index 00000000000..c012a3b19f1 --- /dev/null +++ b/hack/helm_vars/wire-federation-v0/values.yaml.gotmpl @@ -0,0 +1,306 @@ +tags: + nginz: true + brig: true + galley: true + gundeck: true + cannon: true + cargohold: true + spar: true + federation: true # also see galley.config.enableFederation and brig.config.enableFederation + backoffice: true + proxy: false + webapp: false + team-settings: false + account-pages: false + legalhold: false + sftd: false + +cassandra-migrations: + cassandra: + host: cassandra-ephemeral + replicationFactor: 1 +elasticsearch-index: + elasticsearch: + host: elasticsearch-ephemeral + index: directory_test + cassandra: + host: cassandra-ephemeral + +brig: + replicaCount: 1 + resources: + requests: {} + limits: + memory: 512Mi + config: + externalUrls: + nginz: https://kube-staging-nginz-https.zinfra.io + teamCreatorWelcome: https://teams.wire.com/login + teamMemberWelcome: https://wire.com/download + cassandra: + host: cassandra-ephemeral + replicaCount: 1 + elasticsearch: + host: elasticsearch-ephemeral + index: directory_test + authSettings: + userTokenTimeout: 120 + sessionTokenTimeout: 20 + accessTokenTimeout: 30 + providerTokenTimeout: 60 + enableFederation: true # keep in sync with galley.config.enableFederation, cargohold.config.enableFederation and tags.federator! + optSettings: + setActivationTimeout: 10 + setVerificationTimeout: 10 + # keep this in sync with brigSettingsTeamInvitationTimeout in spar/templates/tests/configmap.yaml + setTeamInvitationTimeout: 10 + setExpiredUserCleanupTimeout: 1 + setUserMaxConnections: 16 + setCookieInsecure: true + setUserCookieRenewAge: 2 + setUserCookieLimit: 5 + setUserCookieThrottle: + stdDev: 5 + retryAfter: 5 + setLimitFailedLogins: + timeout: 5 # seconds. if you reach the limit, how long do you have to wait to try again. + retryLimit: 5 # how many times can you have a failed login in that timeframe. + setSuspendInactiveUsers: + suspendTimeout: 10 + setDefaultTemplateLocale: en + setDefaultUserLocale: en + setMaxConvAndTeamSize: 16 + setMaxTeamSize: 32 + setMaxConvSize: 16 + setFederationDomain: federation-test-helper.wire-federation-v0.svc.cluster.local + setFederationStrategy: allowAll + setFederationDomainConfigsUpdateFreq: 10 + set2FACodeGenerationDelaySecs: 5 + setNonceTtlSecs: 300 + setDpopMaxSkewSecs: 1 + setDpopTokenExpirationTimeSecs: 300 + setEnableMLS: true + setOAuthAuthCodeExpirationTimeSecs: 3 # 3 secs + setOAuthAccessTokenExpirationTimeSecs: 3 # 3 secs + setOAuthEnabled: true + setOAuthRefreshTokenExpirationTimeSecs: 14515200 # 24 weeks + setOAuthMaxActiveRefreshTokens: 10 + aws: + sesEndpoint: http://fake-aws-ses:4569 + sqsEndpoint: http://fake-aws-sqs:4568 + dynamoDBEndpoint: http://fake-aws-dynamodb:4567 + sesQueue: integration-brig-events + internalQueue: integration-brig-events-internal + prekeyTable: integration-brig-prekeys + emailSMS: + general: + emailSender: backend-integrationk8s@wire.com + smsSender: dummy + secrets: + # these secrets are only used during integration tests and should therefore be safe to include unencrypted in git. + # Normally these would live in a separately-encrypted secrets.yaml file and incorporated using the helm secrets plugin (wrapper around mozilla sops) + zAuth: + privateKeys: 7owt9MgvLd3D1nQ5s5Zm-5kOiUZcJ_iqASOYdzLUpjHRRbfyx7XJ6hzltU0S9_kvKsdYZmTK9wZNWKUraB4Z1Q== + publicKeys: 0UW38se1yeoc5bVNEvf5LyrHWGZkyvcGTVilK2geGdU= + turn: + secret: rPrUbws7PQZlfN2GG8Ggi7g5iOYPk7BiCoKHl3VoFZ + awsKeyId: dummykey + awsSecretKey: dummysecret + setTwilio: | + sid: "dummy" + token: "dummy" + setNexmo: |- + key: "dummy" + secret: "dummy" + smtpPassword: dummy-smtp-password + dpopSigKeyBundle: | + -----BEGIN PRIVATE KEY----- + MC4CAQAwBQYDK2VwBCIEIFANnxZLNE4p+GDzWzR3wm/v8x/0bxZYkCyke1aTRucX + -----END PRIVATE KEY----- + -----BEGIN PUBLIC KEY----- + MCowBQYDK2VwAyEACPvhIdimF20tOPjbb+fXJrwS2RKDp7686T90AZ0+Th8= + -----END PUBLIC KEY----- + oauthJwkKeyPair: | + { + "kty": "OKP", + "crv": "Ed25519", + "x": "mhP-NgFw3ifIXGZqJVB0kemt9L3BtD5P8q4Gah4Iklc", + "d": "R8-pV2-sPN7dykV8HFJ73S64F3kMHTNnJiSN8UdWk_o" + } + rabbitmq: + username: {{ .Values.rabbitmqUsername }} + password: {{ .Values.rabbitmqPassword }} + tests: + enableFederationTests: true +cannon: + replicaCount: 2 + resources: + requests: {} + limits: + memory: 512Mi + drainTimeout: 0 +cargohold: + replicaCount: 1 + resources: + requests: {} + limits: + memory: 512Mi + config: + aws: + s3Bucket: dummy-bucket + s3Endpoint: http://fake-aws-s3:9000 + enableFederation: true # keep in sync with brig.config.enableFederation, galley.config.enableFederation and tags.federator! + settings: + federationDomain: federation-test-helper.wire-federation-v0.svc.cluster.local + secrets: + awsKeyId: dummykey + awsSecretKey: dummysecret +galley: + replicaCount: 1 + config: + cassandra: + host: cassandra-ephemeral + replicaCount: 1 + enableFederation: true # keep in sync with brig.config.enableFederation, cargohold.config.enableFederation and tags.federator! + settings: + maxConvAndTeamSize: 16 + maxTeamSize: 32 + maxFanoutSize: 18 + maxConvSize: 16 + conversationCodeURI: https://kube-staging-nginz-https.zinfra.io/conversation-join/ + # See helmfile for the real value + federationDomain: federation-test-helper.wire-federation-v0.svc.cluster.local + featureFlags: + sso: disabled-by-default # this needs to be the default; tests can enable it when needed. + legalhold: whitelist-teams-and-implicit-consent + teamSearchVisibility: disabled-by-default + classifiedDomains: + status: enabled + config: + domains: ["example.com"] + journal: + endpoint: http://fake-aws-sqs:4568 + queueName: integration-team-events.fifo + secrets: + awsKeyId: dummykey + awsSecretKey: dummysecret + mlsPrivateKeys: + removal: + ed25519: | + -----BEGIN PRIVATE KEY----- + MC4CAQAwBQYDK2VwBCIEIAocCDXsKIAjb65gOUn5vEF0RIKnVJkKR4ebQzuZ709c + -----END PRIVATE KEY----- + rabbitmq: + username: {{ .Values.rabbitmqUsername }} + password: {{ .Values.rabbitmqPassword }} + +gundeck: + replicaCount: 1 + resources: + requests: {} + limits: + memory: 1024Mi + config: + cassandra: + host: cassandra-ephemeral + replicaCount: 1 + redis: + host: redis-ephemeral-master + connectionMode: master + aws: + account: "123456789012" + region: eu-west-1 + arnEnv: integration + queueName: integration-gundeck-events + sqsEndpoint: http://fake-aws-sqs:4568 + snsEndpoint: http://fake-aws-sns:4575 + bulkPush: true + setMaxConcurrentNativePushes: + hard: 30 + soft: 10 + secrets: + awsKeyId: dummykey + awsSecretKey: dummysecret +nginz: + replicaCount: 1 + nginx_conf: + env: staging + external_env_domain: zinfra.io + # NOTE: Web apps are disabled by default + allowlisted_origins: [] + randomport_allowlisted_origins: [] # default is empty by intention + rate_limit_reqs_per_user: "10r/s" + rate_limit_reqs_per_addr: "100r/s" + secrets: + basicAuth: "whatever" + zAuth: + # this must match the key in brig! + publicKeys: 0UW38se1yeoc5bVNEvf5LyrHWGZkyvcGTVilK2geGdU= + oAuth: + publicKeys: | + { + "kty": "OKP", + "crv": "Ed25519", + "x": "mhP-NgFw3ifIXGZqJVB0kemt9L3BtD5P8q4Gah4Iklc" + } +proxy: + replicaCount: 1 + secrets: + proxy_config: |- + secrets { + youtube = "..." + googlemaps = "..." + soundcloud = "..." + giphy = "..." + spotify = "Basic ..." + } +spar: + replicaCount: 1 + resources: + requests: {} + limits: + memory: 1024Mi + config: + tlsDisableCertValidation: true + cassandra: + host: cassandra-ephemeral + logLevel: Debug + domain: zinfra.io + appUri: http://spar:8080/ + ssoUri: http://spar:8080/sso + maxttlAuthreq: 5 + maxttlAuthresp: 7200 + maxScimTokens: 2 + contacts: + - type: ContactSupport + company: Example Company + email: email:backend+spar@wire.com + +federator: + replicaCount: 1 + resources: + requests: {} + config: + optSettings: + useSystemCAStore: false + remoteCAContents: {{ .Values.federationCACertificate | quote }} + tls: + useCertManager: true + useSharedFederatorSecret: true + +background-worker: + replicaCount: 1 + resources: + requests: {} + config: + backendNotificationPusher: + pushBackoffMinWait: 1000 # 1ms + pushBackoffMaxWait: 500000 # 0.5s + secrets: + rabbitmq: + username: {{ .Values.rabbitmqUsername }} + password: {{ .Values.rabbitmqPassword }} + +integration: + ingress: + class: "nginx-{{ .Release.Namespace }}" diff --git a/hack/helm_vars/wire-server/values.yaml.gotmpl b/hack/helm_vars/wire-server/values.yaml.gotmpl index 509da39f8e9..614b83441be 100644 --- a/hack/helm_vars/wire-server/values.yaml.gotmpl +++ b/hack/helm_vars/wire-server/values.yaml.gotmpl @@ -9,11 +9,9 @@ tags: federation: true # also see galley.config.enableFederation and brig.config.enableFederation backoffice: true proxy: false - webapp: false - team-settings: false - account-pages: false legalhold: false sftd: false + integration: true cassandra-migrations: imagePullPolicy: {{ .Values.imagePullPolicy }} @@ -29,8 +27,12 @@ cassandra-migrations: elasticsearch-index: imagePullPolicy: {{ .Values.imagePullPolicy }} elasticsearch: + scheme: https host: elasticsearch-ephemeral index: directory_test + tlsCaSecretRef: + name: "elasticsearch-ephemeral-certificate" + key: "ca.crt" cassandra: host: {{ .Values.cassandraHost }} {{- if .Values.useK8ssandraSSL.enabled }} @@ -38,6 +40,10 @@ elasticsearch-index: name: "cassandra-jks-keystore" key: "ca.crt" {{- end }} + secrets: + elasticsearch: + username: "elastic" + password: "changeme" brig: replicaCount: 1 @@ -60,14 +66,23 @@ brig: key: "ca.crt" {{- end }} elasticsearch: + scheme: https host: elasticsearch-ephemeral index: directory_test + tlsCaSecretRef: + name: "elasticsearch-ephemeral-certificate" + key: "ca.crt" + additionalTlsCaSecretRef: + name: "elasticsearch-ephemeral-certificate" + key: "ca.crt" authSettings: userTokenTimeout: 120 sessionTokenTimeout: 20 accessTokenTimeout: 30 providerTokenTimeout: 60 enableFederation: true # keep in sync with galley.config.enableFederation, cargohold.config.enableFederation and tags.federator! + multiSFT: + enabled: false # keep multiSFT default in sync with brig and sft chart's config.multiSFT optSettings: setActivationTimeout: 10 setVerificationTimeout: 10 @@ -151,6 +166,12 @@ brig: rabbitmq: username: {{ .Values.rabbitmqUsername }} password: {{ .Values.rabbitmqPassword }} + elasticsearch: + username: "elastic" + password: "changeme" + elasticsearchAdditional: + username: "elastic" + password: "changeme" tests: enableFederationTests: true {{- if .Values.uploadXml }} @@ -256,6 +277,28 @@ galley: -----BEGIN PRIVATE KEY----- MC4CAQAwBQYDK2VwBCIEIAocCDXsKIAjb65gOUn5vEF0RIKnVJkKR4ebQzuZ709c -----END PRIVATE KEY----- + ecdsa_secp256r1_sha256: | + -----BEGIN PRIVATE KEY----- + MIGHAgEAMBMGByqGSM49AgEGCCqGSM49AwEHBG0wawIBAQQg3qjgQ9U+/rTBObn9 + tXSVi2UtHksRDXmQ1VOszFZfjryhRANCAATNkLmZZLyORf5D3PUOxt+rkJTE5vuD + aCqZ7sE5NSN8InRRwuQ1kv0oblDVeQA89ZlHqyxx75JPK+/air7Z1n5I + -----END PRIVATE KEY----- + ecdsa_secp384r1_sha384: | + -----BEGIN PRIVATE KEY----- + MIG2AgEAMBAGByqGSM49AgEGBSuBBAAiBIGeMIGbAgEBBDBLwv3i5LDz9b++O0iw + QAit/Uq7L5PWPgKN99wCm8xkZnuyqWujXW4wvlVUVlZWgh2hZANiAAT0+RXKE31c + VxdYazaVopY50/nV9c18uRdqoENBvtxuD6oDtJtU6oCS/Htkd8JEArTQ9ZHqq144 + yRjuc3d2CqvJmEA/lzIBk9wnz+lghFhvB4TkSHvvLyEBc9DZvhb4EEQ= + -----END PRIVATE KEY----- + ecdsa_secp521r1_sha512: | + -----BEGIN PRIVATE KEY----- + MIHuAgEAMBAGByqGSM49AgEGBSuBBAAjBIHWMIHTAgEBBEIBiaEARm5BMaRct1xj + MlemUHijWGAoHtNMhSttSr4jo0WxMwfMnvnDQJSlO2Zs4Tzum2j5eO34EHu6MUrv + qquZYwyhgYkDgYYABAHuvCV/+gJitvAbDwgrBHZJ41oy8Lc+wPIM7Yp6s/vTzTsG + Klo7aMdkx6DUjv/56tVD9bZNulFAjwS8xoIyWg8NSAE1ofo8CBvN1XGZOWuMYjEh + zLrZADduEnOvayw5sEvm135WC0vWjPJaYwKZPdDIXUz9ILJPgNe3gEUvHsDEXvdX + lw== + -----END PRIVATE KEY----- rabbitmq: username: {{ .Values.rabbitmqUsername }} password: {{ .Values.rabbitmqPassword }} @@ -303,15 +346,19 @@ gundeck: secrets: awsKeyId: dummykey awsSecretKey: dummysecret + redisPassword: very-secure-redis-master-password tests: {{- if .Values.uploadXml }} config: uploadXml: baseUrl: {{ .Values.uploadXml.baseUrl }} + {{- end }} secrets: + {{- if .Values.uploadXml }} uploadXmlAwsAccessKeyId: {{ .Values.uploadXml.awsAccessKeyId }} uploadXmlAwsSecretAccessKey: {{ .Values.uploadXml.awsSecretAccessKey }} - {{- end }} + {{- end }} + redisAdditionalWritePassword: very-secure-redis-master-password-2 nginz: replicaCount: 1 @@ -393,6 +440,11 @@ federator: resources: requests: {} imagePullPolicy: {{ .Values.imagePullPolicy }} + remoteCAContents: {{ .Values.federationCACertificate | quote }} + tls: + useCertManager: true + useSharedFederatorSecret: true + config: optSettings: useSystemCAStore: false @@ -429,18 +481,28 @@ integration: host: {{ .Values.cassandraHost }} port: 9042 replicationFactor: 1 - {{- if .Values.useK8ssandraSSL.enabled }} + {{- if .Values.useK8ssandraSSL.enabled }} tlsCaSecretRef: name: cassandra-jks-keystore key: ca.crt - {{- end }} - {{- if .Values.uploadXml }} + {{- end }} + elasticsearch: + tlsCaSecretRef: + name: "elasticsearch-ephemeral-certificate" + key: "ca.crt" + {{- if .Values.uploadXml }} uploadXml: baseUrl: {{ .Values.uploadXml.baseUrl }} + {{- end }} secrets: + {{- if .Values.uploadXml }} uploadXmlAwsAccessKeyId: {{ .Values.uploadXml.awsAccessKeyId }} uploadXmlAwsSecretAccessKey: {{ .Values.uploadXml.awsSecretAccessKey }} - {{- end }} + {{- end }} + redisPassword: very-secure-redis-master-password + tls: + caNamespace: wire-federation-v0 + backoffice: tests: {{- if .Values.uploadXml }} diff --git a/hack/helmfile-federation-v0.yaml b/hack/helmfile-federation-v0.yaml new file mode 100644 index 00000000000..5400307d84b --- /dev/null +++ b/hack/helmfile-federation-v0.yaml @@ -0,0 +1,110 @@ +--- +helmDefaults: + wait: true + timeout: 600 + devel: true + createNamespace: true + +environments: + default: + values: + - federationCACertificate: {{ readFile "../services/nginz/integration-test/conf/nginz/integration-ca.pem" | quote }} + - rabbitmqUsername: guest + - rabbitmqPassword: guest +--- +repositories: + - name: jetstack + url: 'https://charts.jetstack.io' + + - name: bedag + url: 'https://bedag.github.io/helm-charts/' + + - name: wire + url: 'https://s3-eu-west-1.amazonaws.com/public.wire.com/charts-develop' + +releases: + - name: 'cert-manager' + namespace: cert-manager + chart: jetstack/cert-manager + set: + - name: installCRDs + value: true + + - name: 'federation-certs' + namespace: cert-manager + chart: bedag/raw + values: + - resources: + - apiVersion: v1 + kind: Secret + metadata: + name: federation-ca + namespace: cert-manager + data: + tls.crt: {{ readFile "../services/nginz/integration-test/conf/nginz/integration-ca.pem" | b64enc | quote }} + tls.key: {{ readFile "../services/nginz/integration-test/conf/nginz/integration-ca-key.pem" | b64enc | quote }} + - apiVersion: cert-manager.io/v1 + kind: ClusterIssuer + metadata: + name: federation + spec: + ca: + secretName: federation-ca + needs: + - 'cert-manager/cert-manager' + + - name: 'fake-aws' + namespace: wire-federation-v0 + chart: wire/fake-aws + version: 4.38.0-mandarin.14 + values: + - './helm_vars/fake-aws/values.yaml' + + - name: 'databases-ephemeral' + namespace: wire-federation-v0 + chart: 'wire/databases-ephemeral' + version: 4.38.0-mandarin.14 + + - name: 'rabbitmq' + namespace: wire-federation-v0 + chart: 'wire/rabbitmq' + version: 4.38.0-mandarin.14 + values: + - './helm_vars/rabbitmq/values.yaml.gotmpl' + + - name: 'ingress' + namespace: wire-federation-v0 + chart: 'wire/ingress-nginx-controller' + version: 4.38.0-mandarin.14 + values: + - './helm_vars/ingress-nginx-controller/values.yaml.gotmpl' + + - name: 'ingress-svc' + namespace: wire-federation-v0 + chart: 'wire/nginx-ingress-services' + version: 4.38.0-mandarin.14 + values: + - './helm_vars/nginx-ingress-services/values.yaml.gotmpl' + set: + # Federation domain is also the SRV record created by the + # federation-test-helper service. Maybe we can find a way to make these + # differ, so we don't make any silly assumptions in the code. + - name: config.dns.federator + value: wire-federation-v0.svc.cluster.local + - name: config.dns.certificateDomain + value: '*.wire-federation-v0.svc.cluster.local' + needs: + - 'ingress' + - 'cert-manager/cert-manager' + - 'cert-manager/federation-certs' + + - name: wire-server + namespace: wire-federation-v0 + chart: wire/wire-server + version: 4.38.0-mandarin.14 + values: + - './helm_vars/wire-federation-v0/values.yaml.gotmpl' + needs: + - 'cert-manager/cert-manager' + - 'cert-manager/federation-certs' + diff --git a/hack/helmfile.yaml b/hack/helmfile.yaml index e82a1373a3a..c8a9824ec8b 100644 --- a/hack/helmfile.yaml +++ b/hack/helmfile.yaml @@ -55,6 +55,9 @@ repositories: - name: ingress url: 'https://kubernetes.github.io/ingress-nginx' + - name: bedag + url: 'https://bedag.github.io/helm-charts/' + releases: - name: 'fake-aws' namespace: '{{ .Values.namespace1 }}' @@ -67,13 +70,62 @@ releases: chart: '../.local/charts/fake-aws' values: - './helm_vars/fake-aws/values.yaml' + + - name: 'elasticsearch-certs' + namespace: '{{ .Values.namespace1 }}' + chart: bedag/raw + values: + - './helm_vars/elasticsearch-certs/es-cert-issuer.yaml.gotmpl' + - name: 'databases-ephemeral' namespace: '{{ .Values.namespace1 }}' chart: '../.local/charts/databases-ephemeral' + values: + - redis-ephemeral: + redis-ephemeral: + usePassword: true + password: very-secure-redis-master-password + elasticsearch-ephemeral: + tls: + enabled: true + issuerRef: + name: elasticsearch + kind: Issuer + needs: + - elasticsearch-certs + + # Required for testing redis migration + - name: 'redis-ephemeral-2' + namespace: '{{ .Values.namespace1 }}' + chart: '../.local/charts/redis-ephemeral' + values: + - redis-ephemeral: + nameOverride: redis-ephemeral-2 + usePassword: true + password: very-secure-redis-master-password-2 + + - name: 'elasticsearch-certs' + namespace: '{{ .Values.namespace2 }}' + chart: bedag/raw + values: + - './helm_vars/elasticsearch-certs/es-cert-issuer.yaml.gotmpl' - name: 'databases-ephemeral' namespace: '{{ .Values.namespace2 }}' chart: '../.local/charts/databases-ephemeral' + values: + - redis-ephemeral: + redis-ephemeral: + usePassword: true + password: very-secure-redis-master-password + elasticsearch-ephemeral: + tls: + enabled: true + issuerRef: + name: elasticsearch + kind: Issuer + needs: + - elasticsearch-certs - name: k8ssandra-test-cluster chart: '../.local/charts/k8ssandra-test-cluster' @@ -118,13 +170,14 @@ releases: chart: '../.local/charts/nginx-ingress-services' values: - './helm_vars/nginx-ingress-services/values.yaml.gotmpl' - - './helm_vars/nginx-ingress-services/certificates-namespace1.yaml' set: # Federation domain is also the SRV record created by the # federation-test-helper service. Maybe we can find a way to make these # differ, so we don't make any silly assumptions in the code. - name: config.dns.federator value: '{{ .Values.federationDomain1 }}' + - name: config.dns.certificateDomain + value: '*.{{ .Values.federationDomainBase1 }}' needs: - 'ingress' @@ -133,13 +186,14 @@ releases: chart: '../.local/charts/nginx-ingress-services' values: - './helm_vars/nginx-ingress-services/values.yaml.gotmpl' - - './helm_vars/nginx-ingress-services/certificates-namespace2.yaml' set: # Federation domain is also the SRV record created by the # federation-test-helper service. Maybe we can find a way to make these # differ, so we don't make any silly assumptions in the code. - name: config.dns.federator value: '{{ .Values.federationDomain2 }}' + - name: config.dns.certificateDomain + value: '*.{{ .Values.federationDomainBase2 }}' needs: - 'ingress' @@ -153,7 +207,6 @@ releases: chart: '../.local/charts/wire-server' values: - './helm_vars/wire-server/values.yaml.gotmpl' - - './helm_vars/wire-server/certificates-namespace1.yaml' set: - name: brig.config.optSettings.setFederationDomain value: {{ .Values.federationDomain1 }} @@ -169,7 +222,6 @@ releases: chart: '../.local/charts/wire-server' values: - './helm_vars/wire-server/values.yaml.gotmpl' - - './helm_vars/wire-server/certificates-namespace2.yaml' set: - name: brig.config.optSettings.setFederationDomain value: {{ .Values.federationDomain2 }} diff --git a/integration/README.md b/integration/README.md index b725474d691..3a501089e2c 100644 --- a/integration/README.md +++ b/integration/README.md @@ -3,7 +3,8 @@ To develop a new test in a fast-loading ghci session: 1. Run `make cr` to build the whole project and start all services OR run `make cr package=galley` to build galley and start all services OR run `./dist/run-services` to just start all services without rebuilding -2.`TEST_INCLUDE=testFederationDomain make devtest` to start a ghcid session that re-runs the test after each successful build of the test suite +2. `TEST_INCLUDE=testFederationDomain,testFederationFoo make devtest` to start a ghcid session that re-runs the test after each successful build of the test suite. + This should provide faster feedback loops when you are only developing tests, e.g. when migrating tests. Note that `devtest` doesn't spawn static backends, so you need to run `make cr` prior in a separate terminal. Original design guidelines / goals: diff --git a/integration/default.nix b/integration/default.nix index 36f503e3c9c..a259708844e 100644 --- a/integration/default.nix +++ b/integration/default.nix @@ -4,6 +4,7 @@ # dependencies are added or removed. { mkDerivation , aeson +, aeson-diff , aeson-pretty , array , async @@ -72,6 +73,7 @@ , warp-tls , websockets , wire-message-proto-lens +, wreq , xml , yaml }: @@ -91,6 +93,7 @@ mkDerivation { ]; libraryHaskellDepends = [ aeson + aeson-diff aeson-pretty array async @@ -155,6 +158,7 @@ mkDerivation { warp-tls websockets wire-message-proto-lens + wreq xml yaml ]; diff --git a/integration/integration.cabal b/integration/integration.cabal index fdbcd8a5230..56bcb614de8 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -118,16 +118,19 @@ library Test.Connection Test.Conversation Test.Demo + Test.EJPD Test.Errors Test.ExternalPartner Test.FeatureFlags Test.Federation Test.Federator Test.LegalHold + Test.Login Test.MessageTimer Test.MLS Test.MLS.KeyPackage Test.MLS.Message + Test.MLS.Notifications Test.MLS.One2One Test.MLS.SubConversation Test.MLS.Unreachable @@ -136,6 +139,7 @@ library Test.Roles Test.Search Test.Services + Test.Spar Test.Swagger Test.TeamSettings Test.User @@ -164,6 +168,7 @@ library build-depends: , aeson + , aeson-diff , aeson-pretty , array , async @@ -228,5 +233,6 @@ library , warp-tls , websockets , wire-message-proto-lens + , wreq , xml , yaml diff --git a/integration/test/API/Brig.hs b/integration/test/API/Brig.hs index c09fc64ec38..ff825f0aa90 100644 --- a/integration/test/API/Brig.hs +++ b/integration/test/API/Brig.hs @@ -131,6 +131,7 @@ getUserByHandle user domain handle = do joinHttpPath ["users", "by-handle", domainStr, handle] submit "GET" req +-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_clients__client_ getClient :: (HasCallStack, MakesValue user, MakesValue client) => user -> @@ -143,13 +144,14 @@ getClient u cli = do joinHttpPath ["clients", c] submit "GET" req +-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/delete_self deleteUser :: (HasCallStack, MakesValue user) => user -> App Response deleteUser user = do req <- baseRequest user Brig Versioned "/self" submit "DELETE" $ req & addJSONObject ["password" .= defPassword] --- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/post_i_clients__uid_ +-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_clients addClient :: (HasCallStack, MakesValue user) => user -> @@ -320,9 +322,7 @@ uploadKeyPackages cid kps = do "/mls/key-packages/self/" <> cid.client submit "POST" - ( req - & addJSONObject ["key_packages" .= map (T.decodeUtf8 . Base64.encode) kps] - ) + (req & addJSONObject ["key_packages" .= map (T.decodeUtf8 . Base64.encode) kps]) claimKeyPackagesWithParams :: (MakesValue u, MakesValue v) => Ciphersuite -> u -> v -> [(String, String)] -> App Response claimKeyPackagesWithParams suite u v params = do @@ -334,7 +334,7 @@ claimKeyPackagesWithParams suite u v params = do req & addQueryParams ([("ciphersuite", suite.code)] <> params) -claimKeyPackages :: (MakesValue u, MakesValue v) => Ciphersuite -> u -> v -> App Response +claimKeyPackages :: (HasCallStack, MakesValue u, MakesValue v) => Ciphersuite -> u -> v -> App Response claimKeyPackages suite u v = claimKeyPackagesWithParams suite u v [] countKeyPackages :: Ciphersuite -> ClientIdentity -> App Response @@ -630,3 +630,15 @@ getMultiUserPrekeyBundle :: (HasCallStack, MakesValue caller, ToJSON userClients getMultiUserPrekeyBundle caller userClients = do req <- baseRequest caller Brig Versioned $ joinHttpPath ["users", "list-prekeys"] submit "POST" (addJSON userClients req) + +-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_access +renewToken :: (HasCallStack, MakesValue uid) => uid -> String -> App Response +renewToken caller cookie = do + req <- baseRequest caller Brig Versioned "access" + submit "POST" (addHeader "Cookie" ("zuid=" <> cookie) req) + +-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_calls_config_v2 +getCallsConfigV2 :: (HasCallStack, MakesValue user) => user -> App Response +getCallsConfigV2 user = do + req <- baseRequest user Brig Versioned $ joinHttpPath ["calls", "config", "v2"] + submit "GET" req diff --git a/integration/test/API/BrigInternal.hs b/integration/test/API/BrigInternal.hs index 7292946956e..71bde9877dd 100644 --- a/integration/test/API/BrigInternal.hs +++ b/integration/test/API/BrigInternal.hs @@ -236,3 +236,28 @@ addClient user args = do req <- baseRequest user Brig Unversioned $ "/i/clients/" <> uid val <- mkAddClientValue args submit "POST" $ req & addJSONObject val + +-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/post_i_clients_full +getClientsFull :: (HasCallStack, MakesValue users, MakesValue uid) => uid -> users -> App Response +getClientsFull user users = do + val <- make users + baseRequest user Brig Unversioned do joinHttpPath ["i", "clients", "full"] + >>= submit "POST" . addJSONObject ["users" .= val] + +-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/post_i_ejpd_request +getEJPDInfo :: (HasCallStack, MakesValue dom) => dom -> [String] -> String -> App Response +getEJPDInfo dom handles mode = do + req <- rawBaseRequest dom Brig Unversioned "/i/ejpd-request" + let query = case mode of + "" -> [] + "include_contacts" -> [("include_contacts", "true")] + bad -> error $ show bad + submit "POST" $ req & addJSONObject ["ejpd_request" .= handles] & addQueryParams query + +-- https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/get_i_users__uid__verification_code__action_ +getVerificationCode :: (HasCallStack, MakesValue user) => user -> String -> App Response +getVerificationCode user action = do + uid <- objId user + domain <- objDomain user + req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "users", uid, "verification-code", action] + submit "GET" req diff --git a/integration/test/API/Cargohold.hs b/integration/test/API/Cargohold.hs index 595ce75327a..0fe767fea35 100644 --- a/integration/test/API/Cargohold.hs +++ b/integration/test/API/Cargohold.hs @@ -37,7 +37,10 @@ uploadAssetV3 user isPublic retention mimeType bdy = do multipartMixedMime = "multipart/mixed; boundary=" <> multipartBoundary uploadAsset :: (HasCallStack, MakesValue user) => user -> App Response -uploadAsset user = do +uploadAsset = flip uploadFreshAsset "Hello World!" + +uploadFreshAsset :: (HasCallStack, MakesValue user) => user -> String -> App Response +uploadFreshAsset user payload = do uid <- user & objId req <- baseRequest user Cargohold Versioned "/assets" bdy <- txtAsset @@ -51,7 +54,7 @@ uploadAsset user = do buildUploadAssetRequestBody True (Nothing :: Maybe String) - (LBSC.pack "Hello World!") + (LBSC.pack payload) textPlainMime textPlainMime :: MIME.MIMEType @@ -104,13 +107,25 @@ instance MakesValue loc => IsAssetLocation loc where noRedirect :: Request -> Request noRedirect r = r {redirectCount = 0} -downloadAsset' :: (HasCallStack, MakesValue user, IsAssetLocation loc, IsAssetToken tok) => user -> loc -> tok -> App Response +downloadAsset' :: + (HasCallStack, MakesValue user, IsAssetLocation loc, IsAssetToken tok) => + user -> + loc -> + tok -> + App Response downloadAsset' user loc tok = do locPath <- locationPathFragment loc req <- baseRequest user Cargohold Unversioned $ locPath submit "GET" $ req & tokenParam tok & noRedirect -downloadAsset :: (HasCallStack, MakesValue user, MakesValue key, MakesValue assetDomain) => user -> assetDomain -> key -> String -> (HTTP.Request -> HTTP.Request) -> App Response +downloadAsset :: + (HasCallStack, MakesValue user, MakesValue key, MakesValue assetDomain) => + user -> + assetDomain -> + key -> + String -> + (HTTP.Request -> HTTP.Request) -> + App Response downloadAsset user assetDomain key zHostHeader trans = do domain <- objDomain assetDomain key' <- asString key diff --git a/integration/test/API/Common.hs b/integration/test/API/Common.hs index 42e33973294..066c360a422 100644 --- a/integration/test/API/Common.hs +++ b/integration/test/API/Common.hs @@ -14,8 +14,10 @@ teamRole "admin" = 5951 teamRole "owner" = 8191 teamRole bad = error $ "unknown team role: " <> bad +-- | please don't use special shell characters like '!' here. it makes writing shell lines +-- that use test data a lot less straight-forward. defPassword :: String -defPassword = "hunter2!" +defPassword = "hunter2." randomEmail :: App String randomEmail = do @@ -31,8 +33,11 @@ randomName = liftIO $ do pick = (chars !) <$> randomRIO (Array.bounds chars) randomHandle :: App String -randomHandle = liftIO $ do - n <- randomRIO (50, 256) +randomHandle = randomHandleWithRange 50 256 + +randomHandleWithRange :: Int -> Int -> App String +randomHandleWithRange min' max' = liftIO $ do + n <- randomRIO (min', max') replicateM n pick where chars = mkArray $ ['a' .. 'z'] <> ['0' .. '9'] <> "_-." diff --git a/integration/test/API/Galley.hs b/integration/test/API/Galley.hs index 14123b112f7..f169e341cb7 100644 --- a/integration/test/API/Galley.hs +++ b/integration/test/API/Galley.hs @@ -223,6 +223,11 @@ listConversations user cnvs = do req & addJSONObject ["qualified_ids" .= cnvs] +getMLSPublicKeys :: (HasCallStack, MakesValue user) => user -> App Response +getMLSPublicKeys user = do + req <- baseRequest user Galley Versioned "/mls/public-keys" + submit "GET" req + postMLSMessage :: HasCallStack => ClientIdentity -> ByteString -> App Response postMLSMessage cid msg = do req <- baseRequest cid Galley Versioned "/mls/messages" @@ -238,7 +243,7 @@ postProteusMessage user conv msgs = do convDomain <- objDomain conv convId <- objId conv let bytes = Proto.encodeMessage msgs - req <- baseRequest user Galley Versioned ("/conversations/" <> convDomain <> "/" <> convId <> "/proteus/messages") + req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convDomain, convId, "proteus", "messages"]) submit "POST" (addProtobuf bytes req) mkProteusRecipient :: (HasCallStack, MakesValue user, MakesValue client) => user -> client -> String -> App Proto.QualifiedUserEntry @@ -579,6 +584,14 @@ putTeamProperties tid caller properties = do req ) +-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_teams__tid__legalhold__uid_ +legalholdUserStatus :: (HasCallStack, MakesValue tid, MakesValue user, MakesValue owner) => tid -> owner -> user -> App Response +legalholdUserStatus tid ownerid user = do + tidS <- asString tid + uid <- objId user + req <- baseRequest ownerid Galley Versioned (joinHttpPath ["teams", tidS, "legalhold", uid]) + submit "GET" req + -- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_teams__tid__legalhold_settings enableLegalHold :: (HasCallStack, MakesValue tid, MakesValue ownerid) => tid -> ownerid -> App Response enableLegalHold tid ownerid = do @@ -586,16 +599,32 @@ enableLegalHold tid ownerid = do req <- baseRequest ownerid Galley Versioned (joinHttpPath ["teams", tidStr, "features", "legalhold"]) submit "PUT" (addJSONObject ["status" .= "enabled", "ttl" .= "unlimited"] req) --- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_teams__tid__legalhold_settings -postLegalHoldSettings :: (HasCallStack, MakesValue owner, MakesValue tid, MakesValue newService) => owner -> tid -> newService -> App Response -postLegalHoldSettings owner tid newSettings = retrying policy only412 $ \_ -> do +-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/delete_teams__tid__legalhold__uid_ +disableLegalHold :: + (HasCallStack, MakesValue tid, MakesValue ownerid, MakesValue uid) => + tid -> + ownerid -> + uid -> + -- | the password for user with $uid$ + String -> + App Response +disableLegalHold tid ownerid uid pw = do tidStr <- asString tid - req <- baseRequest owner Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", "settings"]) - newSettingsObj <- make newSettings - submit "POST" (addJSON newSettingsObj req) + uidStr <- objId uid + req <- baseRequest ownerid Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", uidStr]) + submit "DELETE" (addJSONObject ["password" .= pw] req) + +-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_teams__tid__legalhold_settings +postLegalHoldSettings :: (HasCallStack, MakesValue ownerid, MakesValue tid, MakesValue newService) => tid -> ownerid -> newService -> App Response +postLegalHoldSettings tid owner newSettings = + asks ((* 1_000_000) . timeOutSeconds) >>= \tSecs -> retrying (policy tSecs) only412 $ \_ -> do + tidStr <- asString tid + req <- baseRequest owner Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", "settings"]) + newSettingsObj <- make newSettings + submit "POST" (addJSON newSettingsObj req) where - policy :: RetryPolicy - policy = limitRetriesByCumulativeDelay 5_000_000 $ exponentialBackoff 50 + policy :: Int -> RetryPolicy + policy tSecs = limitRetriesByCumulativeDelay tSecs $ exponentialBackoff 50 only412 :: RetryStatus -> Response -> App Bool only412 _ resp = pure $ resp.status == 412 @@ -609,10 +638,18 @@ requestLegalHoldDevice tid ownerid uid = do submit "POST" req -- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/put_teams__tid__legalhold__uid__approve +-- +-- like approveLegalHoldDevice' but approves for the requesting party approveLegalHoldDevice :: (HasCallStack, MakesValue tid, MakesValue uid) => tid -> uid -> String -> App Response -approveLegalHoldDevice tid uid pwd = do +approveLegalHoldDevice tid uid = approveLegalHoldDevice' tid uid uid + +-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/put_teams__tid__legalhold__uid__approve +-- +-- useful for testing unauthorized requests +approveLegalHoldDevice' :: (HasCallStack, MakesValue tid, MakesValue uid, MakesValue forUid) => tid -> uid -> forUid -> String -> App Response +approveLegalHoldDevice' tid uid forUid pwd = do tidStr <- asString tid - uidStr <- asString $ uid %. "id" + uidStr <- asString $ forUid %. "id" req <- baseRequest uid Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", uidStr, "approve"]) submit "PUT" (addJSONObject ["password" .= pwd] req) @@ -630,3 +667,37 @@ getLegalHoldStatus tid zusr = do uidStr <- asString $ zusr %. "id" req <- baseRequest zusr Galley Versioned (joinHttpPath ["teams", tidStr, "legalhold", uidStr]) submit "GET" req + +-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/put_teams__tid__features_legalhold +putLegalholdStatus :: + (HasCallStack, MakesValue tid, MakesValue usr) => + tid -> + usr -> + -- | the status to put to + String -> + App Response +putLegalholdStatus tid usr status = do + tidStr <- asString tid + + baseRequest usr Galley Versioned (joinHttpPath ["teams", tidStr, "features", "legalhold"]) + >>= submit "PUT" + . addJSONObject ["status" .= status, "ttl" .= "unlimited"] + +-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_feature_configs +getFeatureConfigs :: (HasCallStack, MakesValue user) => user -> App Response +getFeatureConfigs user = do + req <- baseRequest user Galley Versioned "/feature-configs" + submit "GET" req + +-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_teams__tid__features +getTeamFeatures :: (HasCallStack, MakesValue user, MakesValue tid) => user -> tid -> App Response +getTeamFeatures user tid = do + tidStr <- asString tid + req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tidStr, "features"]) + submit "GET" req + +getTeamFeature :: (HasCallStack, MakesValue user, MakesValue tid) => user -> tid -> String -> App Response +getTeamFeature user tid featureName = do + tidStr <- asString tid + req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tidStr, "features", featureName]) + submit "GET" req diff --git a/integration/test/API/GalleyInternal.hs b/integration/test/API/GalleyInternal.hs index 89f3eac5716..281c86e6a18 100644 --- a/integration/test/API/GalleyInternal.hs +++ b/integration/test/API/GalleyInternal.hs @@ -33,16 +33,27 @@ putTeamMember user team perms = do req getTeamFeature :: (HasCallStack, MakesValue domain_) => domain_ -> String -> String -> App Response -getTeamFeature domain_ featureName tid = do +getTeamFeature domain_ tid featureName = do req <- baseRequest domain_ Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName] submit "GET" $ req setTeamFeatureStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> App () setTeamFeatureStatus domain team featureName status = do + setTeamFeatureStatusExpectHttpStatus domain team featureName status 200 + +setTeamFeatureStatusExpectHttpStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> Int -> App () +setTeamFeatureStatusExpectHttpStatus domain team featureName status httpStatus = do tid <- asString team req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName] - res <- submit "PATCH" $ req & addJSONObject ["status" .= status] - res.status `shouldMatchInt` 200 + bindResponse (submit "PATCH" $ req & addJSONObject ["status" .= status]) $ \res -> do + res.status `shouldMatchInt` httpStatus + +setTeamFeatureLockStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> App () +setTeamFeatureLockStatus domain team featureName status = do + tid <- asString team + req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName, status] + bindResponse (submit "PUT" $ req) $ \res -> + res.status `shouldMatchInt` 200 getFederationStatus :: ( HasCallStack, @@ -59,14 +70,34 @@ getFederationStatus user domains = "GET" $ req & addJSONObject ["domains" .= domainList] -legalholdWhitelistTeam :: (HasCallStack, MakesValue uid, MakesValue tid) => uid -> tid -> App Response -legalholdWhitelistTeam uid tid = do +-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/galley/#/galley/put_i_legalhold_whitelisted_teams__tid_ +legalholdWhitelistTeam :: (HasCallStack, MakesValue uid, MakesValue tid) => tid -> uid -> App Response +legalholdWhitelistTeam tid uid = do tidStr <- asString tid req <- baseRequest uid Galley Unversioned $ joinHttpPath ["i", "legalhold", "whitelisted-teams", tidStr] submit "PUT" req -legalholdIsTeamInWhitelist :: (HasCallStack, MakesValue uid, MakesValue tid) => uid -> tid -> App Response -legalholdIsTeamInWhitelist uid tid = do +-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/galley/#/galley/get_i_legalhold_whitelisted_teams__tid_ +legalholdIsTeamInWhitelist :: (HasCallStack, MakesValue uid, MakesValue tid) => tid -> uid -> App Response +legalholdIsTeamInWhitelist tid uid = do tidStr <- asString tid req <- baseRequest uid Galley Unversioned $ joinHttpPath ["i", "legalhold", "whitelisted-teams", tidStr] submit "GET" req + +-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/galley/#/galley/get_i_teams__tid__features_legalhold +legalholdIsEnabled :: (HasCallStack, MakesValue tid, MakesValue uid) => tid -> uid -> App Response +legalholdIsEnabled tid uid = do + tidStr <- asString tid + baseRequest uid Galley Unversioned do joinHttpPath ["i", "teams", tidStr, "features", "legalhold"] + >>= submit "GET" + +generateVerificationCode :: (HasCallStack, MakesValue domain, MakesValue email) => domain -> email -> App () +generateVerificationCode domain email = do + res <- generateVerificationCode' domain email + res.status `shouldMatchInt` 200 + +generateVerificationCode' :: (HasCallStack, MakesValue domain, MakesValue email) => domain -> email -> App Response +generateVerificationCode' domain email = do + req <- baseRequest domain Brig Versioned "/verification-code/send" + emailStr <- asString email + submit "POST" $ req & addJSONObject ["email" .= emailStr, "action" .= "login"] diff --git a/integration/test/API/Nginz.hs b/integration/test/API/Nginz.hs index 4c34ef639d3..b4c2f08db5b 100644 --- a/integration/test/API/Nginz.hs +++ b/integration/test/API/Nginz.hs @@ -14,6 +14,14 @@ login domain email pw = do pwStr <- make pw >>= asString submit "POST" (req & addJSONObject ["email" .= emailStr, "password" .= pwStr, "label" .= "auth"]) +loginWith2ndFactor :: (HasCallStack, MakesValue domain, MakesValue email, MakesValue password, MakesValue sndFactor) => domain -> email -> password -> sndFactor -> App Response +loginWith2ndFactor domain email pw sf = do + req <- rawBaseRequest domain Nginz Unversioned "/login" + emailStr <- make email >>= asString + pwStr <- make pw >>= asString + sfStr <- make sf >>= asString + submit "POST" (req & addJSONObject ["email" .= emailStr, "password" .= pwStr, "label" .= "auth", "verification_code" .= sfStr]) + access :: (HasCallStack, MakesValue domain, MakesValue cookie) => domain -> cookie -> App Response access domain cookie = do req <- rawBaseRequest domain Nginz Unversioned "/access" diff --git a/integration/test/API/Spar.hs b/integration/test/API/Spar.hs index aff62ca6d5a..e8d1e7cc2f3 100644 --- a/integration/test/API/Spar.hs +++ b/integration/test/API/Spar.hs @@ -1,5 +1,6 @@ module API.Spar where +import API.Common (defPassword) import GHC.Stack import Testlib.Prelude @@ -8,3 +9,15 @@ getScimTokens :: (HasCallStack, MakesValue caller) => caller -> App Response getScimTokens caller = do req <- baseRequest caller Spar Versioned "/scim/auth-tokens" submit "GET" req + +-- https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_scim_auth_tokens +createScimToken :: (HasCallStack, MakesValue caller) => caller -> App Response +createScimToken caller = do + req <- baseRequest caller Spar Versioned "/scim/auth-tokens" + submit "POST" $ req & addJSONObject ["password" .= defPassword, "description" .= "integration test"] + +createScimUser :: (HasCallStack, MakesValue domain, MakesValue scimUser) => domain -> String -> scimUser -> App Response +createScimUser domain token scimUser = do + req <- baseRequest domain Spar Versioned "/scim/v2/Users" + body <- make scimUser + submit "POST" $ req & addJSON body . addHeader "Authorization" ("Bearer " <> token) diff --git a/integration/test/MLS/Util.hs b/integration/test/MLS/Util.hs index 2f42556489a..eeb69bae965 100644 --- a/integration/test/MLS/Util.hs +++ b/integration/test/MLS/Util.hs @@ -3,7 +3,6 @@ module MLS.Util where import API.Brig -import qualified API.BrigCommon as BrigC import API.Galley import Control.Concurrent.Async hiding (link) import Control.Monad @@ -37,7 +36,6 @@ import System.IO hiding (print, putStrLn) import System.IO.Temp import System.Posix.Files import System.Process -import Testlib.App import Testlib.Assertions import Testlib.HTTP import Testlib.JSON @@ -81,6 +79,8 @@ mlscli :: (HasCallStack) => ClientIdentity -> [String] -> Maybe ByteString -> Ap mlscli cid args mbstdin = do groupOut <- randomFileName let substOut = argSubst "" groupOut + cs <- (.ciphersuite) <$> getMLSState + let scheme = csSignatureScheme cs gs <- getClientGroupState cid @@ -89,23 +89,24 @@ mlscli cid args mbstdin = do Just groupData -> do fn <- toRandomFile groupData pure (argSubst "" fn) - store <- maybe randomFileName toRandomFile gs.keystore + store <- case Map.lookup scheme gs.keystore of + Nothing -> do + bd <- getBaseDir + liftIO $ createDirectory (bd cid2Str cid) + + -- initialise new keystore + path <- randomFileName + ctype <- make gs.credType & asString + void $ runCli path ["init", "--ciphersuite", cs.code, "-t", ctype, cid2Str cid] Nothing + pure path + Just s -> toRandomFile s let args' = map (substIn . substOut) args for_ args' $ \arg -> when (arg `elem` ["", ""]) $ assertFailure ("Unbound arg: " <> arg) - out <- - spawn - ( proc - "mls-test-cli" - ( ["--store", store] - <> args' - ) - ) - mbstdin - + out <- runCli store args' mbstdin setGroup <- do groupOutWritten <- liftIO $ doesFileExist groupOut if groupOutWritten @@ -115,32 +116,32 @@ mlscli cid args mbstdin = do else pure id setStore <- do storeData <- liftIO (BS.readFile store) - pure $ \x -> x {keystore = Just storeData} + pure $ \x -> x {keystore = Map.insert scheme storeData x.keystore} - setClientGroupState cid ((setGroup . setStore) gs) + setClientGroupState cid (setGroup (setStore gs)) pure out +runCli :: HasCallStack => FilePath -> [String] -> Maybe ByteString -> App ByteString +runCli store args mStdin = + spawn + ( proc + "mls-test-cli" + ( ["--store", store] + <> args + ) + ) + mStdin + argSubst :: String -> String -> String -> String argSubst from to_ s = if s == from then to_ else s createWireClient :: (MakesValue u, HasCallStack) => u -> App ClientIdentity createWireClient u = do - lpk <- getLastPrekey - c <- addClient u def {BrigC.lastPrekey = Just lpk} >>= getJSON 201 - mkClientIdentity u c - -data CredentialType = BasicCredentialType | X509CredentialType - -instance MakesValue CredentialType where - make BasicCredentialType = make "basic" - make X509CredentialType = make "x509" - -instance (HasTests x) => HasTests (CredentialType -> x) where - mkTests m n s f x = - mkTests m (n <> "[ctype=basic]") s f (x BasicCredentialType) - <> mkTests m (n <> "[ctype=x509]") s f (x X509CredentialType) + addClient u def + >>= getJSON 201 + >>= mkClientIdentity u data InitMLSClient = InitMLSClient {credType :: CredentialType} @@ -148,28 +149,21 @@ data InitMLSClient = InitMLSClient instance Default InitMLSClient where def = InitMLSClient {credType = BasicCredentialType} -initMLSClient :: (HasCallStack) => InitMLSClient -> ClientIdentity -> App () -initMLSClient opts cid = do - bd <- getBaseDir - mls <- getMLSState - liftIO $ createDirectory (bd cid2Str cid) - ctype <- make opts.credType & asString - void $ mlscli cid ["init", "--ciphersuite", mls.ciphersuite.code, "-t", ctype, cid2Str cid] Nothing - -- | Create new mls client and register with backend. createMLSClient :: (MakesValue u, HasCallStack) => InitMLSClient -> u -> App ClientIdentity createMLSClient opts u = do cid <- createWireClient u - initMLSClient opts cid + setClientGroupState cid def {credType = opts.credType} -- set public key pkey <- mlscli cid ["public-key"] Nothing + ciphersuite <- (.ciphersuite) <$> getMLSState bindResponse ( updateClient cid def { mlsPublicKeys = - Just (object ["ed25519" .= T.decodeUtf8 (Base64.encode pkey)]) + Just (object [csSignatureScheme ciphersuite .= T.decodeUtf8 (Base64.encode pkey)]) } ) $ \resp -> resp.status `shouldMatchInt` 200 @@ -178,8 +172,7 @@ createMLSClient opts u = do -- | create and upload to backend uploadNewKeyPackage :: (HasCallStack) => ClientIdentity -> App String uploadNewKeyPackage cid = do - mls <- getMLSState - (kp, ref) <- generateKeyPackage cid mls.ciphersuite + (kp, ref) <- generateKeyPackage cid -- upload key package bindResponse (uploadKeyPackages cid [kp]) $ \resp -> @@ -187,8 +180,9 @@ uploadNewKeyPackage cid = do pure ref -generateKeyPackage :: (HasCallStack) => ClientIdentity -> Ciphersuite -> App (ByteString, String) -generateKeyPackage cid suite = do +generateKeyPackage :: HasCallStack => ClientIdentity -> App (ByteString, String) +generateKeyPackage cid = do + suite <- (.ciphersuite) <$> getMLSState kp <- mlscli cid ["key-package", "create", "--ciphersuite", suite.code] Nothing ref <- B8.unpack . Base64.encode <$> mlscli cid ["key-package", "ref", "-"] (Just kp) fp <- keyPackageFile cid ref @@ -245,8 +239,11 @@ resetGroup cid conv = do resetClientGroup :: ClientIdentity -> String -> App () resetClientGroup cid gid = do - removalKeyPath <- asks (.removalKeyPath) mls <- getMLSState + removalKeyPaths <- asks (.removalKeyPaths) + removalKeyPath <- + assertOne $ + Map.lookup (csSignatureScheme mls.ciphersuite) removalKeyPaths void $ mlscli cid @@ -707,7 +704,7 @@ spawn cp minput = do getClientGroupState :: (HasCallStack) => ClientIdentity -> App ClientGroupState getClientGroupState cid = do mls <- getMLSState - pure $ Map.findWithDefault emptyClientGroupState cid mls.clientGroupState + pure $ Map.findWithDefault def cid mls.clientGroupState setClientGroupState :: (HasCallStack) => ClientIdentity -> ClientGroupState -> App () setClientGroupState cid g = @@ -762,6 +759,17 @@ createApplicationMessage cid messageContent = do setMLSCiphersuite :: Ciphersuite -> App () setMLSCiphersuite suite = modifyMLSState $ \mls -> mls {ciphersuite = suite} +withCiphersuite :: HasCallStack => Ciphersuite -> App a -> App a +withCiphersuite suite action = do + suite0 <- (.ciphersuite) <$> getMLSState + setMLSCiphersuiteIO <- appToIOKleisli setMLSCiphersuite + actionIO <- appToIO action + liftIO $ + bracket + (setMLSCiphersuiteIO suite) + (const (setMLSCiphersuiteIO suite0)) + (const actionIO) + leaveCurrentConv :: (HasCallStack) => ClientIdentity -> @@ -779,7 +787,7 @@ leaveCurrentConv cid = do { members = Set.difference mls.members (Set.singleton cid) } -getCurrentConv :: (HasCallStack) => ClientIdentity -> App Value +getCurrentConv :: HasCallStack => ClientIdentity -> App Value getCurrentConv cid = do mls <- getMLSState (conv, mSubId) <- objSubConv mls.convId diff --git a/integration/test/Notifications.hs b/integration/test/Notifications.hs index 9ea53706223..9186f325f07 100644 --- a/integration/test/Notifications.hs +++ b/integration/test/Notifications.hs @@ -2,11 +2,48 @@ module Notifications where import API.Gundeck +import Control.Error (lastMay) import Control.Monad.Extra import Control.Monad.Reader (asks) import Testlib.Prelude +import UnliftIO (timeout) import UnliftIO.Concurrent +-- | assert that no notifications with the predicate happen within the timeout +assertNoNotifications :: + (HasCallStack, MakesValue user, MakesValue client) => + -- | the user + user -> + -- | the client of that user + client -> + -- | the last notif + Maybe String -> + -- | the predicate + (Value -> App Bool) -> + App () +assertNoNotifications u uc since0 p = do + ucid <- objId uc + let go since = do + notifs <- + getNotifications u def {client = Just ucid, since = since} + `bindResponse` asList + . (%. "notifications") + . (.json) + partitionM p notifs >>= \case + ([], nonMatching) -> + threadDelay 1_000 *> case nonMatching of + (lastMay -> Just lst) -> objId lst >>= go . Just + _ -> go Nothing + (matching, _) -> do + pj <- prettyJSON matching + assertFailure $ + unlines + [ "Expected no matching events but got:", + pj + ] + Nothing <- asks timeOutSeconds >>= flip timeout (go since0) + pure () + awaitNotifications :: (HasCallStack, MakesValue user, MakesValue client) => user -> @@ -18,34 +55,35 @@ awaitNotifications :: (Value -> App Bool) -> App [Value] awaitNotifications user client since0 n selector = do - tSecs <- asks timeOutSeconds + tSecs <- asks ((* 1000) . timeOutSeconds) assertAwaitResult =<< go tSecs since0 (AwaitResult False n [] []) where - go 0 _ res = pure res - go timeRemaining since res0 = do - c <- make client & asString - notifs <- bindResponse - ( getNotifications - user - def {since = since, client = Just c} - ) - $ \resp -> asList (resp.json %. "notifications") - lastNotifId <- case notifs of - [] -> pure since - _ -> Just <$> objId (last notifs) - (matching, notMatching) <- partitionM selector notifs - let matchesSoFar = res0.matches <> matching - res = - res0 - { matches = matchesSoFar, - nonMatches = res0.nonMatches <> notMatching, - success = length matchesSoFar >= res0.nMatchesExpected - } - if res.success - then pure res - else do - threadDelay (1_000_000) - go (timeRemaining - 1) lastNotifId res + go timeRemaining since res0 + | timeRemaining <= 0 = pure res0 + | otherwise = + do + c <- make client & asString + notifs <- + getNotifications + user + def {since = since, client = Just c} + `bindResponse` \resp -> asList (resp.json %. "notifications") + lastNotifId <- case notifs of + [] -> pure since + _ -> Just <$> objId (last notifs) + (matching, notMatching) <- partitionM selector notifs + let matchesSoFar = res0.matches <> matching + res = + res0 + { matches = matchesSoFar, + nonMatches = res0.nonMatches <> notMatching, + success = length matchesSoFar >= res0.nMatchesExpected + } + if res.success + then pure res + else do + threadDelay 1_000 + go (timeRemaining - 1) lastNotifId res awaitNotification :: (HasCallStack, MakesValue user, MakesValue client, MakesValue lastNotifId) => @@ -77,6 +115,11 @@ isMemberJoinNotif n = fieldEquals n "payload.0.type" "conversation.member-join" isConvLeaveNotif :: MakesValue a => a -> App Bool isConvLeaveNotif n = fieldEquals n "payload.0.type" "conversation.member-leave" +isConvLeaveNotifWithLeaver :: (MakesValue user, MakesValue a) => user -> a -> App Bool +isConvLeaveNotifWithLeaver user n = + fieldEquals n "payload.0.type" "conversation.member-leave" + &&~ (n %. "payload.0.data.user_ids.0") `isEqual` (user %. "id") + isNotifConv :: (MakesValue conv, MakesValue a, HasCallStack) => conv -> a -> App Bool isNotifConv conv n = fieldEquals n "payload.0.qualified_conversation" (objQidObject conv) @@ -107,11 +150,49 @@ isConvAccessUpdateNotif n = isConvCreateNotif :: MakesValue a => a -> App Bool isConvCreateNotif n = fieldEquals n "payload.0.type" "conversation.create" +-- | like 'isConvCreateNotif' but excludes self conversations +isConvCreateNotifNotSelf :: MakesValue a => a -> App Bool +isConvCreateNotifNotSelf n = + fieldEquals n "payload.0.type" "conversation.create" + &&~ do not <$> fieldEquals n "payload.0.data.access" ["private"] + isConvDeleteNotif :: MakesValue a => a -> App Bool isConvDeleteNotif n = fieldEquals n "payload.0.type" "conversation.delete" +notifTypeIsEqual :: MakesValue a => String -> a -> App Bool +notifTypeIsEqual typ n = nPayload n %. "type" `isEqual` typ + isTeamMemberLeaveNotif :: MakesValue a => a -> App Bool -isTeamMemberLeaveNotif n = nPayload n %. "type" `isEqual` "team.member-leave" +isTeamMemberLeaveNotif = notifTypeIsEqual "team.member-leave" + +isUserActivateNotif :: MakesValue a => a -> App Bool +isUserActivateNotif = notifTypeIsEqual "user.activate" + +isUserClientAddNotif :: MakesValue a => a -> App Bool +isUserClientAddNotif = notifTypeIsEqual "user.client-add" + +isUserClientRemoveNotif :: MakesValue a => a -> App Bool +isUserClientRemoveNotif = notifTypeIsEqual "user.client-remove" + +isUserLegalholdRequestNotif :: MakesValue a => a -> App Bool +isUserLegalholdRequestNotif = notifTypeIsEqual "user.legalhold-request" + +isUserLegalholdEnabledNotif :: MakesValue a => a -> App Bool +isUserLegalholdEnabledNotif = notifTypeIsEqual "user.legalhold-enable" + +isUserLegalholdDisabledNotif :: MakesValue a => a -> App Bool +isUserLegalholdDisabledNotif = notifTypeIsEqual "user.legalhold-disable" + +isUserConnectionNotif :: MakesValue a => a -> App Bool +isUserConnectionNotif = notifTypeIsEqual "user.connection" + +isConnectionNotif :: MakesValue a => String -> a -> App Bool +isConnectionNotif status n = + -- NB: + -- (&&) <$> (print "hello" *> pure False) <*> fail "bla" === _|_ + -- runMaybeT $ (lift (print "hello") *> MaybeT (pure Nothing)) *> lift (fail "bla") === pure Nothing + nPayload n %. "type" `isEqual` "user.connection" + &&~ nPayload n %. "connection.status" `isEqual` status assertLeaveNotification :: ( HasCallStack, diff --git a/integration/test/SetupHelpers.hs b/integration/test/SetupHelpers.hs index 2f765cea618..1d6803e0beb 100644 --- a/integration/test/SetupHelpers.hs +++ b/integration/test/SetupHelpers.hs @@ -5,19 +5,24 @@ module SetupHelpers where import API.Brig import API.BrigInternal +import API.Cargohold import API.Common import API.Galley +import API.GalleyInternal (legalholdWhitelistTeam) import Control.Monad.Reader import Crypto.Random (getRandomBytes) import Data.Aeson hiding ((.=)) import qualified Data.Aeson.Types as Aeson import qualified Data.ByteString.Base64.URL as B64Url import Data.ByteString.Char8 (unpack) +import qualified Data.CaseInsensitive as CI import Data.Default import Data.Function +import Data.String.Conversions (cs) import Data.UUID.V1 (nextUUID) import Data.UUID.V4 (nextRandom) import GHC.Stack +import Testlib.MockIntegrationService (mkLegalHoldSettings) import Testlib.Prelude randomUser :: (HasCallStack, MakesValue domain) => domain -> CreateUser -> App Value @@ -88,7 +93,7 @@ connectTwoUsers alice bob = do bindResponse (postConnection alice bob) (\resp -> resp.status `shouldMatchInt` 201) bindResponse (putConnection bob alice "accepted") (\resp -> resp.status `shouldMatchInt` 200) -connectUsers :: HasCallStack => [Value] -> App () +connectUsers :: (HasCallStack, MakesValue usr) => [usr] -> App () connectUsers users = traverse_ (uncurry connectTwoUsers) $ do t <- tails users (a, others) <- maybeToList (uncons t) @@ -276,3 +281,93 @@ setupProvider u np@(NewProvider {..}) = do pure (k, c) activateProvider dom key code loginProvider dom newProviderEmail pass $> provider + +-- | setup a legalhold device for @uid@, authorised by @owner@ +-- at the specified port +setUpLHDevice :: + (HasCallStack, MakesValue tid, MakesValue owner, MakesValue uid) => + tid -> + owner -> + uid -> + -- | the host and port the LH service is running on + (String, Int) -> + App () +setUpLHDevice tid alice bob lhPort = do + legalholdWhitelistTeam tid alice + >>= assertStatus 200 + + -- the status messages for these have already been tested + postLegalHoldSettings tid alice (mkLegalHoldSettings lhPort) + >>= assertStatus 201 + + requestLegalHoldDevice tid alice bob + >>= assertStatus 201 + + approveLegalHoldDevice tid bob defPassword + >>= assertStatus 200 + +lhDeviceIdOf :: MakesValue user => user -> App String +lhDeviceIdOf bob = do + bobId <- objId bob + getClientsFull bob [bobId] `bindResponse` \resp -> + do + resp.json %. bobId + & asList + >>= filterM \val -> (== "legalhold") <$> (val %. "type" & asString) + >>= assertOne + >>= (%. "id") + >>= asString + +randomScimUser :: App Value +randomScimUser = do + email <- randomEmail + handle <- randomHandleWithRange 12 128 + pure $ + object + [ "schemas" .= ["urn:ietf:params:scim:schemas:core:2.0:User"], + "externalId" .= email, + "userName" .= handle, + "displayName" .= handle + ] + +-- | This adds one random asset to the `assets` field in the user record and returns an asset +-- key. The asset carries a fresh UUIDv4 in text form (even though it is typed 'preview` and +-- `image'). +uploadProfilePicture :: (HasCallStack, MakesValue usr) => usr -> App (String, String, String) +uploadProfilePicture usr = do + payload <- ("asset_contents=" <>) <$> randomId + asset <- bindResponse (uploadFreshAsset usr payload) (getJSON 201) + dom <- asset %. "domain" & asString + key <- asset %. "key" & asString + Success (oldAssets :: [Value]) <- bindResponse (getSelf usr) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "assets" <&> fromJSON + bindResponse + (putSelf usr def {assets = Just (object ["key" .= key, "size" .= "preview", "type" .= "image"] : oldAssets)}) + assertSuccess + pure (dom, key, payload) + +-- | Take a calling user (any user will do) and an asset domain and key, and return a +-- (temporarily valid) s3 url plus asset payload (if created with `uploadProfilePicture`, +-- that's a UUIDv4). +downloadProfilePicture :: (HasCallStack, MakesValue caller) => caller -> String -> String -> App (String, String) +downloadProfilePicture caller assetDomain assetKey = do + locurl <- bindResponse (downloadAsset caller caller assetKey assetDomain noRedirect) $ \resp -> do + resp.status `shouldMatchInt` 302 + maybe + (error "no location header in 302 response!?") + (pure . cs) + (lookup (CI.mk (cs "Location")) resp.headers) + + payload <- bindResponse (downloadAsset caller caller assetKey assetDomain id) $ \resp -> do + resp.status `shouldMatchInt` 200 + pure $ cs resp.body + + pure (locurl, payload) + +-- | Call 'uploadProfilePicture' and 'downloadPicture', returning the return value of the +-- latter. +uploadDownloadProfilePicture :: (HasCallStack, MakesValue usr) => usr -> App (String, String) +uploadDownloadProfilePicture usr = do + (dom, key, _payload) <- uploadProfilePicture usr + downloadProfilePicture usr dom key diff --git a/integration/test/Test/AssetDownload.hs b/integration/test/Test/AssetDownload.hs index 2d73fb7ff9e..68b60c85453 100644 --- a/integration/test/Test/AssetDownload.hs +++ b/integration/test/Test/AssetDownload.hs @@ -2,8 +2,6 @@ module Test.AssetDownload where import API.Cargohold import GHC.Stack -import Network.HTTP.Client (Request (redirectCount)) -import qualified Network.HTTP.Client as HTTP import SetupHelpers import Testlib.Prelude @@ -28,16 +26,16 @@ testDownloadAssetMultiIngressS3DownloadUrl = do -- multi-ingress disabled key <- doUploadAsset user - bindResponse (downloadAsset user user key "nginz-https.example.com" noRedirects) $ \resp -> do + bindResponse (downloadAsset user user key "nginz-https.example.com" noRedirect) $ \resp -> do resp.status `shouldMatchInt` 302 - bindResponse (downloadAsset user user key "red.example.com" noRedirects) $ \resp -> do + bindResponse (downloadAsset user user key "red.example.com" noRedirect) $ \resp -> do resp.status `shouldMatchInt` 302 - bindResponse (downloadAsset user user key "green.example.com" noRedirects) $ \resp -> do + bindResponse (downloadAsset user user key "green.example.com" noRedirect) $ \resp -> do resp.status `shouldMatchInt` 302 - bindResponse (downloadAsset user user key "unknown.example.com" noRedirects) $ \resp -> do + bindResponse (downloadAsset user user key "unknown.example.com" noRedirect) $ \resp -> do resp.status `shouldMatchInt` 302 -- multi-ingress enabled @@ -45,25 +43,22 @@ testDownloadAssetMultiIngressS3DownloadUrl = do user' <- randomUser domain def key' <- doUploadAsset user' - bindResponse (downloadAsset user' user' key' "nginz-https.example.com" noRedirects) $ \resp -> do + bindResponse (downloadAsset user' user' key' "nginz-https.example.com" noRedirect) $ \resp -> do resp.status `shouldMatchInt` 404 resp.json %. "label" `shouldMatch` "not-found" - bindResponse (downloadAsset user' user' key' "red.example.com" noRedirects) $ \resp -> do + bindResponse (downloadAsset user' user' key' "red.example.com" noRedirect) $ \resp -> do resp.status `shouldMatchInt` 302 locationHeaderHost resp `shouldMatch` "s3-download.red.example.com" - bindResponse (downloadAsset user' user' key' "green.example.com" noRedirects) $ \resp -> do + bindResponse (downloadAsset user' user' key' "green.example.com" noRedirect) $ \resp -> do resp.status `shouldMatchInt` 302 locationHeaderHost resp `shouldMatch` "s3-download.green.example.com" - bindResponse (downloadAsset user' user' key' "unknown.example.com" noRedirects) $ \resp -> do + bindResponse (downloadAsset user' user' key' "unknown.example.com" noRedirect) $ \resp -> do resp.status `shouldMatchInt` 404 resp.json %. "label" `shouldMatch` "not-found" where - noRedirects :: HTTP.Request -> HTTP.Request - noRedirects req = (req {redirectCount = 0}) - modifyConfig :: ServiceOverrides modifyConfig = def diff --git a/integration/test/Test/Brig.hs b/integration/test/Test/Brig.hs index 17753fd3ea9..0feb154388e 100644 --- a/integration/test/Test/Brig.hs +++ b/integration/test/Test/Brig.hs @@ -1,15 +1,19 @@ module Test.Brig where +import API.Brig import qualified API.BrigInternal as BrigI -import API.Common (randomName) +import API.Common import Data.Aeson.Types hiding ((.=)) +import Data.List.Split import Data.String.Conversions import qualified Data.UUID as UUID import qualified Data.UUID.V4 as UUID import GHC.Stack import SetupHelpers +import System.IO.Extra import Testlib.Assertions import Testlib.Prelude +import UnliftIO.Temporary testCrudFederationRemotes :: HasCallStack => App () testCrudFederationRemotes = do @@ -124,3 +128,104 @@ testCrudFederationRemoteTeams = do l <- resp.json & asList remoteTeams <- forM l (\e -> e %. "team_id" & asString) when (any (\t -> t `notElem` remoteTeams) tids) $ assertFailure "Expected response to contain all of the teams" + +testSFTCredentials :: HasCallStack => App () +testSFTCredentials = do + let ttl = (60 :: Int) + withSystemTempFile "sft-secret" $ \secretFile secretHandle -> do + liftIO $ do + hPutStr secretHandle "xMtZyTpu=Leb?YKCoq#BXQR:gG^UrE83dNWzFJ2VcD" + hClose secretHandle + withModifiedBackend + ( def + { brigCfg = + ( setField "sft.sftBaseDomain" "integration-tests.zinfra.io" + . setField "sft.sftToken.ttl" ttl + . setField "sft.sftToken.secret" secretFile + . setField "optSettings.setSftListAllServers" "enabled" + ) + } + ) + $ \domain -> do + user <- randomUser domain def + bindResponse (getCallsConfigV2 user) \resp -> do + sftServersAll <- resp.json %. "sft_servers_all" & asList + when (null sftServersAll) $ assertFailure "sft_servers_all missing" + for_ sftServersAll $ \s -> do + cred <- s %. "credential" & asString + when (null cred) $ assertFailure "credential missing" + usr <- s %. "username" & asString + let parts = splitOn "." usr + when (length parts /= 5) $ assertFailure "username should have 5 parts" + when (take 2 (head parts) /= "d=") $ assertFailure "missing expiry time identifier" + when (take 2 (parts !! 1) /= "v=") $ assertFailure "missing version identifier" + when (take 2 (parts !! 2) /= "k=") $ assertFailure "missing key ID identifier" + when (take 2 (parts !! 3) /= "s=") $ assertFailure "missing federation identifier" + when (take 2 (parts !! 4) /= "r=") $ assertFailure "missing random data identifier" + for_ parts $ \part -> when (length part < 3) $ assertFailure ("value missing for " <> part) + +testSFTNoCredentials :: HasCallStack => App () +testSFTNoCredentials = withModifiedBackend + ( def + { brigCfg = + ( setField "sft.sftBaseDomain" "integration-tests.zinfra.io" + . setField "optSettings.setSftListAllServers" "enabled" + ) + } + ) + $ \domain -> do + user <- randomUser domain def + bindResponse (getCallsConfigV2 user) \resp -> do + sftServersAll <- resp.json %. "sft_servers_all" & asList + when (null sftServersAll) $ assertFailure "sft_servers_all missing" + for_ sftServersAll $ \s -> do + credM <- lookupField s "credential" + when (isJust credM) $ assertFailure "should not generate credential" + usrM <- lookupField s "username" + when (isJust usrM) $ assertFailure "should not generate username" + +testSFTFederation :: HasCallStack => App () +testSFTFederation = do + withModifiedBackend + ( def + { brigCfg = + ( setField "sft.sftBaseDomain" "integration-tests.zinfra.io" + . removeField "multiSFT" + ) + } + ) + $ \domain -> do + user <- randomUser domain def + bindResponse (getCallsConfigV2 user) \resp -> do + isFederatingM <- lookupField resp.json "is_federating" + when (isJust isFederatingM) $ assertFailure "is_federating should not be present" + withModifiedBackend + ( def + { brigCfg = + ( setField "sft.sftBaseDomain" "integration-tests.zinfra.io" + . setField "multiSFT" True + ) + } + ) + $ \domain -> do + user <- randomUser domain def + bindResponse (getCallsConfigV2 user) \resp -> do + isFederating <- + maybe (assertFailure "is_federating missing") asBool + =<< lookupField resp.json "is_federating" + unless isFederating $ assertFailure "is_federating should be true" + withModifiedBackend + ( def + { brigCfg = + ( setField "sft.sftBaseDomain" "integration-tests.zinfra.io" + . setField "multiSFT" False + ) + } + ) + $ \domain -> do + user <- randomUser domain def + bindResponse (getCallsConfigV2 user) \resp -> do + isFederating <- + maybe (assertFailure "is_federating missing") asBool + =<< lookupField resp.json "is_federating" + when isFederating $ assertFailure "is_federating should be false" diff --git a/integration/test/Test/Connection.hs b/integration/test/Test/Connection.hs index 0852552c1d4..f982df677d4 100644 --- a/integration/test/Test/Connection.hs +++ b/integration/test/Test/Connection.hs @@ -19,6 +19,7 @@ module Test.Connection where import API.Brig (getConnection, postConnection, putConnection) import API.BrigInternal import API.Galley +import Notifications import SetupHelpers import Testlib.Prelude import UnliftIO.Async (forConcurrently_) @@ -401,3 +402,14 @@ testFederationAllowMixedConnectWithRemote = connectTwoUsers alice bob where defSearchPolicy = "full_search" + +testPendingConnectionUserDeleted :: HasCallStack => Domain -> App () +testPendingConnectionUserDeleted bobsDomain = do + alice <- randomUser OwnDomain def + bob <- randomUser bobsDomain def + + withWebSockets [bob] $ \[bobWs] -> do + void $ postConnection alice bob >>= getBody 201 + void $ awaitMatch (isConnectionNotif "pending") bobWs + void $ deleteUser alice + void $ awaitMatch (isConnectionNotif "cancelled") bobWs diff --git a/integration/test/Test/Conversation.hs b/integration/test/Test/Conversation.hs index 9ff4641bbcc..81a15c7e16f 100644 --- a/integration/test/Test/Conversation.hs +++ b/integration/test/Test/Conversation.hs @@ -850,3 +850,24 @@ testGuestLinksExpired = do liftIO $ threadDelay (1_100_000) bindResponse (getJoinCodeConv tm k v) $ \resp -> do resp.status `shouldMatchInt` 404 + +testConversationWithFedV0 :: HasCallStack => App () +testConversationWithFedV0 = do + alice <- randomUser OwnDomain def + bob <- randomUser FedV0Domain def + withAPIVersion 4 $ connectTwoUsers alice bob + + conv <- + postConversation alice (defProteus {qualifiedUsers = [bob]}) + >>= getJSON 201 + + withWebSocket bob $ \ws -> do + void $ changeConversationName alice conv "foobar" >>= getJSON 200 + void $ awaitMatch isConvNameChangeNotif ws + +testConversationWithoutFederation :: HasCallStack => App () +testConversationWithoutFederation = withModifiedBackend + (def {galleyCfg = removeField "federator" >=> removeField "rabbitmq"}) + $ \domain -> do + [alice, bob] <- createAndConnectUsers [domain, domain] + void $ postConversation alice (defProteus {qualifiedUsers = [bob]}) >>= getJSON 201 diff --git a/integration/test/Test/Demo.hs b/integration/test/Test/Demo.hs index 509a879bcdb..8b255f1c0d2 100644 --- a/integration/test/Test/Demo.hs +++ b/integration/test/Test/Demo.hs @@ -37,7 +37,7 @@ testModifiedGalley = do let getFeatureStatus :: (MakesValue domain) => domain -> String -> App Value getFeatureStatus domain team = do - bindResponse (GalleyI.getTeamFeature domain "searchVisibility" team) $ \res -> do + bindResponse (GalleyI.getTeamFeature domain team "searchVisibility") $ \res -> do res.status `shouldMatchInt` 200 res.json %. "status" @@ -75,7 +75,7 @@ testModifiedServices = do withModifiedBackend serviceMap $ \domain -> do (_user, tid, _) <- createTeam domain 1 - bindResponse (GalleyI.getTeamFeature domain "searchVisibility" tid) $ \res -> do + bindResponse (GalleyI.getTeamFeature domain tid "searchVisibility") $ \res -> do res.status `shouldMatchInt` 200 res.json %. "status" `shouldMatch` "enabled" @@ -194,3 +194,16 @@ testUnrace = do True `shouldMatch` False -} retryT $ True `shouldMatch` True + +testFedV0Instance :: HasCallStack => App () +testFedV0Instance = do + res <- BrigP.getAPIVersion FedV0Domain >>= getJSON 200 + res %. "domain" `shouldMatch` FedV0Domain + +testFedV0Federation :: HasCallStack => App () +testFedV0Federation = do + alice <- randomUser OwnDomain def + bob <- randomUser FedV0Domain def + + bob' <- BrigP.getUser alice bob >>= getJSON 200 + bob' %. "qualified_id" `shouldMatch` (bob %. "qualified_id") diff --git a/integration/test/Test/EJPD.hs b/integration/test/Test/EJPD.hs new file mode 100644 index 00000000000..b20e74a6634 --- /dev/null +++ b/integration/test/Test/EJPD.hs @@ -0,0 +1,172 @@ +{-# OPTIONS -Wno-ambiguous-fields #-} +module Test.EJPD (testEJPDRequest) where + +import API.Brig +import qualified API.BrigInternal as BI +import API.Gundeck +import Control.Lens hiding ((.=)) +import Control.Monad.Reader +import qualified Data.Aeson as A +import Data.Aeson.Lens +import Data.String.Conversions (cs) +import qualified Data.UUID as UUID +import qualified Data.UUID.V4 as UUID +import qualified Network.Wreq as Wreq +import SetupHelpers +import Testlib.JSON +import Testlib.Prelude + +-- | Create some teams & users, and return their expected ejpd response values. +setupEJPD :: HasCallStack => App (A.Value, A.Value, A.Value, A.Value, A.Value) +setupEJPD = + do + (owner1, _tid1, [usr1, usr2]) <- createTeam OwnDomain 3 + handle1 <- liftIO $ UUID.nextRandom <&> ("usr1-handle-" <>) . UUID.toString + handle2 <- liftIO $ UUID.nextRandom <&> ("usr2-handle-" <>) . UUID.toString + void $ putHandle usr1 handle1 + void $ putHandle usr2 handle2 + email3 <- liftIO $ UUID.nextRandom <&> \uuid -> "usr3-" <> UUID.toString uuid <> "@example.com" + email4 <- liftIO $ UUID.nextRandom <&> \uuid -> "usr4-" <> UUID.toString uuid <> "@example.com" + email5 <- liftIO $ UUID.nextRandom <&> \uuid -> "usr5-" <> UUID.toString uuid <> "@example.com" + usr3 <- randomUser OwnDomain def {BI.email = Just email3, BI.name = Just "usr3"} + usr4 <- randomUser OwnDomain def {BI.email = Just email4, BI.name = Just "usr4"} + usr5 <- randomUser OwnDomain def {BI.email = Just email5, BI.name = Just "usr5"} + handle3 <- liftIO $ UUID.nextRandom <&> ("usr3-handle-" <>) . UUID.toString + handle4 <- liftIO $ UUID.nextRandom <&> ("usr4-handle-" <>) . UUID.toString + handle5 <- liftIO $ UUID.nextRandom <&> ("usr5-handle-" <>) . UUID.toString + void $ putHandle usr3 handle3 + void $ putHandle usr4 handle4 + void $ putHandle usr5 handle5 + + connectTwoUsers usr3 usr5 + connectTwoUsers usr2 usr4 + connectTwoUsers usr4 usr5 + + toks1 <- do + cl11 <- objId $ addClient (usr1 %. "qualified_id") def >>= getJSON 201 + bindResponse (postPushToken usr1 cl11 def) $ \resp -> do + resp.status `shouldMatchInt` 201 + tok <- resp.json %. "token" & asString + pure [tok] + toks2 <- do + cl21 <- objId $ addClient (usr2 %. "qualified_id") def >>= getJSON 201 + cl22 <- objId $ addClient (usr2 %. "qualified_id") def >>= getJSON 201 + t1 <- bindResponse (postPushToken usr2 cl21 def) $ \resp -> do + resp.status `shouldMatchInt` 201 + resp.json %. "token" & asString + t2 <- bindResponse (postPushToken usr2 cl22 def) $ \resp -> do + resp.status `shouldMatchInt` 201 + resp.json %. "token" & asString + pure [t1, t2] + toks4 <- do + cl41 <- objId $ addClient (usr4 %. "qualified_id") def >>= getJSON 201 + bindResponse (postPushToken usr4 cl41 def) $ \resp -> do + resp.status `shouldMatchInt` 201 + tok <- resp.json %. "token" & asString + pure [tok] + + assets1 <- do + a1 <- uploadDownloadProfilePicture usr1 + a2 <- uploadDownloadProfilePicture usr1 + pure $ snd <$> [a1, a2] + assets2 <- do + (: []) . snd <$> uploadDownloadProfilePicture usr2 + assets3 <- do + (: []) . snd <$> uploadDownloadProfilePicture usr3 + assets4 <- do + (: []) . snd <$> uploadDownloadProfilePicture usr4 + + (convs1, convs2, convs4) <- do + -- FUTUREWORKI(fisx): implement this (create both team convs and regular convs) + pure (Nothing, Nothing, Nothing) + + let usr2contacts = Just $ (,"accepted") <$> [ejpd4] + usr3contacts = Just $ (,"accepted") <$> [ejpd5] + usr4contacts = Just $ (,"accepted") <$> [ejpd2, ejpd5] + usr5contacts = Just $ (,"accepted") <$> [ejpd3, ejpd4] + + ejpd0 = mkUsr owner1 Nothing [] Nothing (Just ([ejpd1, ejpd2], "list_complete")) Nothing Nothing + ejpd1 = mkUsr usr1 (Just handle1) toks1 Nothing (Just ([ejpd0, ejpd2], "list_complete")) convs1 (Just assets1) + ejpd2 = mkUsr usr2 (Just handle2) toks2 usr2contacts (Just ([ejpd0, ejpd1], "list_complete")) convs2 (Just assets2) + ejpd3 = mkUsr usr3 (Just handle3) [] usr3contacts Nothing Nothing (Just assets3) + ejpd4 = mkUsr usr4 (Just handle4) toks4 usr4contacts Nothing convs4 (Just assets4) + ejpd5 = mkUsr usr5 (Just handle5) [] usr5contacts Nothing Nothing Nothing + + pure (ejpd1, ejpd2, ejpd3, ejpd4, ejpd5) + where + -- Return value is a 'EJPDResponseItem'. + mkUsr :: + HasCallStack => + A.Value {- user -} -> + Maybe String {- handle (in case usr is not up to date, we pass this separately) -} -> + [String {- push tokens -}] -> + Maybe [(A.Value {- ejpd response item of contact -}, String {- relation -})] -> + Maybe ([A.Value {- ejpd response item -}], String {- pagination flag -}) -> + Maybe [(String {- conv name -}, String {- conv id -})] -> + Maybe [String {- asset url -}] -> + A.Value + mkUsr usr handle toks contacts teamContacts convs assets = result + where + result = + object + [ -- (We know we have "id", but using ^? instead of ^. avoids the need for a Monoid instance for Value.) + "ejpd_response_user_id" .= (usr ^? key (fromString "id")), + "ejpd_response_team_id" .= (usr ^? key (fromString "team")), + "ejpd_response_name" .= (usr ^? key (fromString "name")), + "ejpd_response_handle" .= handle, + "ejpd_response_email" .= (usr ^? key (fromString "email")), + "ejpd_response_phone" .= (usr ^? key (fromString "phone")), + "ejpd_response_push_tokens" .= toks, + "ejpd_response_contacts" .= (trimContacts _1 <$> contacts), + "ejpd_response_team_contacts" .= (teamContacts & _Just . _1 %~ trimContacts id), + "ejpd_response_conversations" .= convs, + "ejpd_response_assets" .= assets + ] + + trimContacts :: forall x. Lens' x A.Value -> [x] -> [x] + trimContacts lns = + fmap + ( lns + %~ ( \case + trimmable@(A.Object _) -> trimItem trimmable + other -> error $ show other + ) + ) + + trimItem :: A.Value -> A.Value + trimItem = + (key (fromString "ejpd_response_contacts") .~ A.Null) + . (key (fromString "ejpd_response_team_contacts") .~ A.Null) + . (key (fromString "ejpd_response_conversations") .~ A.Null) + +testEJPDRequest :: HasCallStack => App () +testEJPDRequest = do + (usr1, usr2, usr3, usr4, usr5) <- setupEJPD + + let check :: HasCallStack => [A.Value] -> App () + check want = do + let handle = cs . (^?! (key (fromString "ejpd_response_handle") . _String)) + have <- BI.getEJPDInfo OwnDomain (handle <$> want) "include_contacts" + have.json `shouldMatchSpecial` object ["ejpd_response" .= want] + + shouldMatchSpecial :: (MakesValue a, MakesValue b, HasCallStack) => a -> b -> App () + shouldMatchSpecial = shouldMatchWithRules [minBound ..] resolveAssetLinks + + -- query params and even the uuid in the path of asset urls may differ between actual + -- and expected value because they are re-generated non-deterministically. so we fetch + -- the actual content. + resolveAssetLinks :: A.Value -> App (Maybe A.Value) + resolveAssetLinks = \case + (A.String (cs -> url)) | isProbablyAssetUrl url -> (Just . toJSON) <$> fetchIt url + _ -> pure Nothing + where + isProbablyAssetUrl :: String -> Bool + isProbablyAssetUrl url = all (`isInfixOf` url) ["http", "://", "/dummy-bucket/v3/persistent/"] + + fetchIt :: String -> App String + fetchIt url = liftIO $ (cs . view Wreq.responseBody) <$> Wreq.get url + + check [usr1] + check [usr2] + check [usr3] + check [usr4, usr5] diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index f31e1ed4250..6d68d58845d 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -17,19 +17,167 @@ module Test.FeatureFlags where -import API.GalleyInternal +import qualified API.Galley as Public +import qualified API.GalleyInternal as Internal +import Control.Monad.Codensity (Codensity (runCodensity)) +import Control.Monad.Reader import SetupHelpers import Testlib.Prelude +import Testlib.ResourcePool (acquireResources) testLimitedEventFanout :: HasCallStack => App () testLimitedEventFanout = do let featureName = "limitedEventFanout" (_alice, team, _) <- createTeam OwnDomain 1 -- getTeamFeatureStatus OwnDomain team "limitedEventFanout" "enabled" - bindResponse (getTeamFeature OwnDomain featureName team) $ \resp -> do + bindResponse (Internal.getTeamFeature OwnDomain team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "disabled" - setTeamFeatureStatus OwnDomain team featureName "enabled" - bindResponse (getTeamFeature OwnDomain featureName team) $ \resp -> do + Internal.setTeamFeatureStatus OwnDomain team featureName "enabled" + bindResponse (Internal.getTeamFeature OwnDomain team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" + +disabled :: Value +disabled = object ["lockStatus" .= "unlocked", "status" .= "disabled", "ttl" .= "unlimited"] + +disabledLocked :: Value +disabledLocked = object ["lockStatus" .= "locked", "status" .= "disabled", "ttl" .= "unlimited"] + +enabled :: Value +enabled = object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited"] + +-- always disabled +testLegalholdDisabledPermanently :: HasCallStack => App () +testLegalholdDisabledPermanently = do + let cfgLhDisabledPermanently = + def + { galleyCfg = setField "settings.featureFlags.legalhold" "disabled-permanently" + } + cfgLhDisabledByDefault = + def + { galleyCfg = setField "settings.featureFlags.legalhold" "disabled-by-default" + } + resourcePool <- asks (.resourcePool) + runCodensity (acquireResources 1 resourcePool) $ \[testBackend] -> do + let domain = testBackend.berDomain + + -- Happy case: DB has no config for the team + runCodensity (startDynamicBackend testBackend cfgLhDisabledPermanently) $ \_ -> do + (owner, tid, _) <- createTeam domain 1 + checkFeature "legalhold" owner tid disabled + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "enabled" 403 + + -- Inteteresting case: The team had LH enabled before backend config was + -- changed to disabled-permanently + (owner, tid) <- runCodensity (startDynamicBackend testBackend cfgLhDisabledByDefault) $ \_ -> do + (owner, tid, _) <- createTeam domain 1 + checkFeature "legalhold" owner tid disabled + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "enabled" 200 + checkFeature "legalhold" owner tid enabled + pure (owner, tid) + + runCodensity (startDynamicBackend testBackend cfgLhDisabledPermanently) $ \_ -> do + checkFeature "legalhold" owner tid disabled + +-- can be enabled for a team, disabled if unset +testLegalholdDisabledByDefault :: HasCallStack => App () +testLegalholdDisabledByDefault = do + withModifiedBackend + (def {galleyCfg = setField "settings.featureFlags.legalhold" "disabled-by-default"}) + $ \domain -> do + (owner, tid, _) <- createTeam domain 1 + checkFeature "legalhold" owner tid disabled + Internal.setTeamFeatureStatus domain tid "legalhold" "enabled" + checkFeature "legalhold" owner tid enabled + Internal.setTeamFeatureStatus domain tid "legalhold" "disabled" + checkFeature "legalhold" owner tid disabled + +-- enabled if team is allow listed, disabled in any other case +testLegalholdWhitelistTeamsAndImplicitConsent :: HasCallStack => App () +testLegalholdWhitelistTeamsAndImplicitConsent = do + let cfgLhWhitelistTeamsAndImplicitConsent = + def + { galleyCfg = setField "settings.featureFlags.legalhold" "whitelist-teams-and-implicit-consent" + } + cfgLhDisabledByDefault = + def + { galleyCfg = setField "settings.featureFlags.legalhold" "disabled-by-default" + } + resourcePool <- asks (.resourcePool) + runCodensity (acquireResources 1 resourcePool) $ \[testBackend] -> do + let domain = testBackend.berDomain + + -- Happy case: DB has no config for the team + (owner, tid) <- runCodensity (startDynamicBackend testBackend cfgLhWhitelistTeamsAndImplicitConsent) $ \_ -> do + (owner, tid, _) <- createTeam domain 1 + checkFeature "legalhold" owner tid disabled + Internal.legalholdWhitelistTeam tid owner >>= assertSuccess + checkFeature "legalhold" owner tid enabled + + -- Disabling it doesn't work + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "disabled" 403 + checkFeature "legalhold" owner tid enabled + pure (owner, tid) + + -- Interesting case: The team had LH disabled before backend config was + -- changed to "whitelist-teams-and-implicit-consent". It should still show + -- enabled when the config gets changed. + runCodensity (startDynamicBackend testBackend cfgLhDisabledByDefault) $ \_ -> do + checkFeature "legalhold" owner tid disabled + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "disabled" 200 + checkFeature "legalhold" owner tid disabled + + runCodensity (startDynamicBackend testBackend cfgLhWhitelistTeamsAndImplicitConsent) $ \_ -> do + checkFeature "legalhold" owner tid enabled + +testExposeInvitationURLsToTeamAdminConfig :: HasCallStack => App () +testExposeInvitationURLsToTeamAdminConfig = do + let cfgExposeInvitationURLsTeamAllowlist tids = + def + { galleyCfg = setField "settings.exposeInvitationURLsTeamAllowlist" tids + } + resourcePool <- asks (.resourcePool) + runCodensity (acquireResources 1 resourcePool) $ \[testBackend] -> do + let domain = testBackend.berDomain + + let testNoAllowlistEntry = runCodensity (startDynamicBackend testBackend $ cfgExposeInvitationURLsTeamAllowlist ([] :: [String])) $ \_ -> do + (owner, tid, _) <- createTeam domain 1 + checkFeature "exposeInvitationURLsToTeamAdmin" owner tid disabledLocked + -- here we get a response with HTTP status 200 and feature status unchanged (disabled), which we find weird, but we're just testing the current behavior + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" 200 + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "disabled" 200 + pure (owner, tid) + + -- Happy case: DB has no config for the team + (owner, tid) <- testNoAllowlistEntry + + -- Interesting case: The team is in the allow list + runCodensity (startDynamicBackend testBackend $ cfgExposeInvitationURLsTeamAllowlist [tid]) $ \_ -> do + checkFeature "exposeInvitationURLsToTeamAdmin" owner tid disabled + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" 200 + checkFeature "exposeInvitationURLsToTeamAdmin" owner tid enabled + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "disabled" 200 + checkFeature "exposeInvitationURLsToTeamAdmin" owner tid disabled + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" 200 + checkFeature "exposeInvitationURLsToTeamAdmin" owner tid enabled + + -- Interesting case: The team had the feature enabled but is not in allow list + void testNoAllowlistEntry + +checkFeature :: (HasCallStack, MakesValue user, MakesValue tid) => String -> user -> tid -> Value -> App () +checkFeature feature user tid expected = do + tidStr <- asString tid + domain <- objDomain user + bindResponse (Internal.getTeamFeature domain tidStr feature) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json `shouldMatch` expected + bindResponse (Public.getTeamFeatures user tid) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. feature `shouldMatch` expected + bindResponse (Public.getTeamFeature user tid feature) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json `shouldMatch` expected + bindResponse (Public.getFeatureConfigs user) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. feature `shouldMatch` expected diff --git a/integration/test/Test/LegalHold.hs b/integration/test/Test/LegalHold.hs index d35af907b28..175721bf399 100644 --- a/integration/test/Test/LegalHold.hs +++ b/integration/test/Test/LegalHold.hs @@ -14,21 +14,28 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . - module Test.LegalHold where import API.Brig -import API.BrigCommon +import API.BrigCommon as BrigC import qualified API.BrigInternal as BrigI import API.Common import API.Galley import API.GalleyInternal +import Control.Error (MaybeT (MaybeT), runMaybeT) import Control.Lens ((.~), (^?!)) +import Control.Monad.Reader (asks, local) +import Control.Monad.Trans.Class (lift) +import qualified Data.ByteString.Char8 as BS8 +import Data.ByteString.Lazy (LazyByteString) import qualified Data.Map as Map import qualified Data.ProtoLens as Proto import Data.ProtoLens.Labels () import qualified Data.Set as Set +import qualified Data.Text as T import GHC.Stack +import Network.Wai (Request (pathInfo, requestMethod)) +import Notifications import Numeric.Lens (hex) import qualified Proto.Otr as Proto import qualified Proto.Otr_Fields as Proto @@ -36,45 +43,43 @@ import SetupHelpers import Testlib.MockIntegrationService import Testlib.Prekeys import Testlib.Prelude +import UnliftIO (Chan, readChan, timeout) testLHPreventAddingNonConsentingUsers :: App () testLHPreventAddingNonConsentingUsers = do - startDynamicBackends [mempty] $ \[dom] -> do - withMockServer lhMockApp $ \lhPort _chan -> do - (owner, tid, [alice, alex]) <- createTeam dom 3 - - void $ legalholdWhitelistTeam owner tid >>= assertSuccess - void $ legalholdIsTeamInWhitelist owner tid >>= assertSuccess - void $ postLegalHoldSettings owner tid (mkLegalHoldSettings lhPort) >>= getJSON 201 - - george <- randomUser dom def - georgeQId <- george %. "qualified_id" - connectUsers =<< forM [alice, george] make - connectUsers =<< forM [alex, george] make - conv <- postConversation alice (defProteus {qualifiedUsers = [alex], team = Just tid}) >>= getJSON 201 - - -- the guest should be added to the conversation - bindResponse (addMembers alice conv def {users = [georgeQId]}) $ \resp -> do - resp.status `shouldMatchInt` 200 - resp.json %. "type" `shouldMatch` "conversation.member-join" + withMockServer lhMockApp $ \lhDomAndPort _chan -> do + (owner, tid, [alice, alex]) <- createTeam OwnDomain 3 + + legalholdWhitelistTeam tid owner >>= assertSuccess + legalholdIsTeamInWhitelist tid owner >>= assertSuccess + postLegalHoldSettings tid owner (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 + + george <- randomUser OwnDomain def + georgeQId <- george %. "qualified_id" + connectUsers =<< forM [alice, george] make + connectUsers =<< forM [alex, george] make + conv <- postConversation alice (defProteus {qualifiedUsers = [alex], team = Just tid}) >>= getJSON 201 - -- assert that the guest is in the conversation - checkConvHasOtherMembers conv alice [alex, george] + -- the guest should be added to the conversation + bindResponse (addMembers alice conv def {users = [georgeQId]}) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "type" `shouldMatch` "conversation.member-join" - -- now request legalhold for alex (but not alice) - requestLegalHoldDevice tid owner alex >>= assertSuccess + -- assert that the guest is in the conversation + checkConvHasOtherMembers conv alice [alex, george] - -- the guest should be removed from the conversation - checkConvHasOtherMembers conv alice [alex] + -- now request legalhold for alex (but not alice) + requestLegalHoldDevice tid owner alex >>= assertSuccess - -- it should not be possible neither for alex nor for alice to add the guest back - bindResponse (addMembers alex conv def {users = [georgeQId]}) $ \resp -> do - resp.status `shouldMatchInt` 403 - resp.json %. "label" `shouldMatch` "not-connected" + -- the guest should be removed from the conversation + checkConvHasOtherMembers conv alice [alex] - bindResponse (addMembers alice conv def {users = [georgeQId]}) $ \resp -> do - resp.status `shouldMatchInt` 403 - resp.json %. "label" `shouldMatch` "missing-legalhold-consent" + -- it should not be possible neither for alex nor for alice to add the guest back + addMembers alex conv def {users = [georgeQId]} + >>= assertLabel 403 "not-connected" + + addMembers alice conv def {users = [georgeQId]} + >>= assertLabel 403 "missing-legalhold-consent" where checkConvHasOtherMembers :: HasCallStack => Value -> Value -> [Value] -> App () checkConvHasOtherMembers conv u us = @@ -93,169 +98,166 @@ testLHMessageExchange :: TaggedBool "consentFrom2" -> App () testLHMessageExchange (TaggedBool clients1New) (TaggedBool clients2New) (TaggedBool consentFrom1) (TaggedBool consentFrom2) = do - startDynamicBackends [mempty] $ \[dom] -> do - withMockServer lhMockApp $ \lhPort _chan -> do - (owner, tid, [mem1, mem2]) <- createTeam dom 3 - - let clientSettings :: Bool -> AddClient - clientSettings allnew = - if allnew - then def -- (`{acapabilities = Just ["legalhold-implicit-consent"]}` is the default) - else def {acapabilities = Nothing} - client1 <- objId $ addClient (mem1 %. "qualified_id") (clientSettings clients1New) >>= getJSON 201 - _client2 <- objId $ addClient (mem2 %. "qualified_id") (clientSettings clients2New) >>= getJSON 201 - - void $ legalholdWhitelistTeam owner tid >>= assertSuccess - void $ legalholdIsTeamInWhitelist owner tid >>= assertSuccess - void $ postLegalHoldSettings owner tid (mkLegalHoldSettings lhPort) >>= getJSON 201 - - conv <- postConversation mem1 (defProteus {qualifiedUsers = [mem2], team = Just tid}) >>= getJSON 201 - - requestLegalHoldDevice tid owner mem1 >>= assertSuccess - requestLegalHoldDevice tid owner mem2 >>= assertSuccess - when consentFrom1 $ do - approveLegalHoldDevice tid (mem1 %. "qualified_id") defPassword >>= assertSuccess - when consentFrom2 $ do - approveLegalHoldDevice tid (mem2 %. "qualified_id") defPassword >>= assertSuccess - - let getCls :: Value -> App [String] - getCls mem = do - res <- getClientsQualified mem dom mem - val <- getJSON 200 res - cls <- asList val - objId `mapM` cls - cs1 :: [String] <- getCls mem1 -- it's ok to include the sender, backend will filter it out. - cs2 :: [String] <- getCls mem2 - - length cs1 `shouldMatchInt` if consentFrom1 then 2 else 1 - length cs2 `shouldMatchInt` if consentFrom2 then 2 else 1 - - void $ do - successfulMsgForOtherUsers <- mkProteusRecipients mem1 [(mem1, cs1), (mem2, cs2)] "hey there" - let successfulMsg = - Proto.defMessage @Proto.QualifiedNewOtrMessage - & #sender . Proto.client .~ (client1 ^?! hex) - & #recipients .~ [successfulMsgForOtherUsers] - & #reportAll .~ Proto.defMessage - bindResponse (postProteusMessage mem1 (conv %. "qualified_id") successfulMsg) $ \resp -> do - let check :: HasCallStack => Int -> Maybe String -> App () - check status Nothing = do - resp.status `shouldMatchInt` status - check status (Just label) = do - resp.status `shouldMatchInt` status - resp.json %. "label" `shouldMatch` label - - let -- there are two equally valid ways to write this down (feel free to remove one if it gets in your way): - _oneWay = case (clients1New, clients2New, consentFrom1, consentFrom2) of - (_, _, False, False) -> - -- no LH in the picture - check 201 Nothing - (True, True, _, _) -> - if consentFrom1 /= consentFrom2 - then -- no old clients, but users disagree on LH - check 403 (Just "missing-legalhold-consent") - else -- everybody likes LH - check 201 Nothing - _ -> - -- everything else - check 403 (Just "missing-legalhold-consent-old-clients") - - theOtherWay = case (clients1New, clients2New, consentFrom1, consentFrom2) of - -- NB: "consent" always implies "has an active LH device" - (False, False, False, False) -> - -- no LH in the picture - check 201 Nothing - (False, True, False, False) -> - -- no LH in the picture - check 201 Nothing - (True, False, False, False) -> - -- no LH in the picture - check 201 Nothing - (True, True, False, False) -> - -- no LH in the picture - check 201 Nothing - (True, True, False, True) -> - -- all clients new, no consent from sender, recipient has LH device - check 403 (Just "missing-legalhold-consent") - (True, True, True, False) -> - -- all clients new, no consent from recipient, sender has LH device - check 403 (Just "missing-legalhold-consent") - (True, True, True, True) -> - -- everybody happy with LH - check 201 Nothing - _ -> pure () - - -- _oneWay -- run this if you want to make sure both ways are equivalent, but please don't commit! - theOtherWay + withMockServer lhMockApp $ \lhDomAndPort _chan -> do + (owner, tid, [mem1, mem2]) <- createTeam OwnDomain 3 + + let clientSettings :: Bool -> AddClient + clientSettings allnew = + if allnew + then def -- (`{acapabilities = Just ["legalhold-implicit-consent"]}` is the default) + else def {acapabilities = Nothing} + client1 <- objId $ addClient (mem1 %. "qualified_id") (clientSettings clients1New) >>= getJSON 201 + _client2 <- objId $ addClient (mem2 %. "qualified_id") (clientSettings clients2New) >>= getJSON 201 + + legalholdWhitelistTeam tid owner >>= assertSuccess + legalholdIsTeamInWhitelist tid owner >>= assertSuccess + postLegalHoldSettings tid owner (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 + + conv <- postConversation mem1 (defProteus {qualifiedUsers = [mem2], team = Just tid}) >>= getJSON 201 + + requestLegalHoldDevice tid owner mem1 >>= assertSuccess + requestLegalHoldDevice tid owner mem2 >>= assertSuccess + when consentFrom1 $ do + approveLegalHoldDevice tid (mem1 %. "qualified_id") defPassword >>= assertSuccess + when consentFrom2 $ do + approveLegalHoldDevice tid (mem2 %. "qualified_id") defPassword >>= assertSuccess + + let getCls :: Value -> App [String] + getCls mem = do + res <- getClientsQualified mem OwnDomain mem + val <- getJSON 200 res + cls <- asList val + objId `mapM` cls + cs1 :: [String] <- getCls mem1 -- it's ok to include the sender, backend will filter it out. + cs2 :: [String] <- getCls mem2 + + length cs1 `shouldMatchInt` if consentFrom1 then 2 else 1 + length cs2 `shouldMatchInt` if consentFrom2 then 2 else 1 + + do + successfulMsgForOtherUsers <- mkProteusRecipients mem1 [(mem1, cs1), (mem2, cs2)] "hey there" + let successfulMsg = + Proto.defMessage @Proto.QualifiedNewOtrMessage + & #sender . Proto.client .~ (client1 ^?! hex) + & #recipients .~ [successfulMsgForOtherUsers] + & #reportAll .~ Proto.defMessage + bindResponse (postProteusMessage mem1 (conv %. "qualified_id") successfulMsg) $ \resp -> do + let check :: HasCallStack => Int -> Maybe String -> App () + check status Nothing = do + resp.status `shouldMatchInt` status + check status (Just label) = do + resp.status `shouldMatchInt` status + resp.json %. "label" `shouldMatch` label + + let -- there are two equally valid ways to write this down (feel free to remove one if it gets in your way): + _oneWay = case (clients1New, clients2New, consentFrom1, consentFrom2) of + (_, _, False, False) -> + -- no LH in the picture + check 201 Nothing + (True, True, _, _) -> + if consentFrom1 /= consentFrom2 + then -- no old clients, but users disagree on LH + check 403 (Just "missing-legalhold-consent") + else -- everybody likes LH + check 201 Nothing + _ -> + -- everything else + check 403 (Just "missing-legalhold-consent-old-clients") + + theOtherWay = case (clients1New, clients2New, consentFrom1, consentFrom2) of + -- NB: "consent" always implies "has an active LH device" + (False, False, False, False) -> + -- no LH in the picture + check 201 Nothing + (False, True, False, False) -> + -- no LH in the picture + check 201 Nothing + (True, False, False, False) -> + -- no LH in the picture + check 201 Nothing + (True, True, False, False) -> + -- no LH in the picture + check 201 Nothing + (True, True, False, True) -> + -- all clients new, no consent from sender, recipient has LH device + check 403 (Just "missing-legalhold-consent") + (True, True, True, False) -> + -- all clients new, no consent from recipient, sender has LH device + check 403 (Just "missing-legalhold-consent") + (True, True, True, True) -> + -- everybody happy with LH + check 201 Nothing + _ -> pure () + + -- _oneWay -- run this if you want to make sure both ways are equivalent, but please don't commit! + theOtherWay data TestClaimKeys = TCKConsentMissing -- (team not whitelisted, that is) | TCKConsentAndNewClients - deriving (Show, Bounded, Enum) + deriving (Show, Generic) -- | Cannot fetch prekeys of LH users if requester has not given consent or has old clients. -testLHClaimKeys :: WithBoundedEnumArg TestClaimKeys (App ()) -testLHClaimKeys = WithBoundedEnumArg $ \testmode -> do - startDynamicBackends [mempty] $ \[dom] -> do - withMockServer lhMockApp $ \lhPort _chan -> do - (lowner, ltid, [lmem]) <- createTeam dom 2 - (powner, ptid, [pmem]) <- createTeam dom 2 - - legalholdWhitelistTeam lowner ltid >>= assertSuccess - legalholdIsTeamInWhitelist lowner ltid >>= assertSuccess - void $ postLegalHoldSettings lowner ltid (mkLegalHoldSettings lhPort) >>= getJSON 201 - - requestLegalHoldDevice ltid lowner lmem >>= assertSuccess - approveLegalHoldDevice ltid (lmem %. "qualified_id") defPassword >>= assertSuccess - - let addc caps = addClient pmem (settings caps) >>= assertSuccess - settings caps = - def - { prekeys = Just $ take 10 somePrekeysRendered, - lastPrekey = Just $ head someLastPrekeysRendered, - acapabilities = caps - } - in case testmode of - TCKConsentMissing -> - addc $ Just ["legalhold-implicit-consent"] - TCKConsentAndNewClients -> do - addc $ Just ["legalhold-implicit-consent"] - void $ legalholdWhitelistTeam powner ptid >>= assertSuccess - void $ legalholdIsTeamInWhitelist powner ptid >>= assertSuccess - - llhdev :: String <- do - let getCls :: Value -> App [String] - getCls mem = do - res <- getClientsQualified mem dom mem - val <- getJSON 200 res - cls <- asList val - objId `mapM` cls - getCls lmem <&> \case - [d] -> d - bad -> error $ show bad - - let assertResp :: HasCallStack => Response -> App () - assertResp resp = case testmode of - TCKConsentMissing -> do - resp.status `shouldMatchInt` 403 - resp.json %. "label" `shouldMatch` "missing-legalhold-consent" - TCKConsentAndNewClients -> do - resp.status `shouldMatchInt` 200 - - bindResponse (getUsersPrekeysClient pmem (lmem %. "qualified_id") llhdev) $ assertResp - bindResponse (getUsersPrekeyBundle pmem (lmem %. "qualified_id")) $ assertResp - - slmemdom <- asString $ lmem %. "qualified_id.domain" - slmemid <- asString $ lmem %. "qualified_id.id" - let userClients = Map.fromList [(slmemdom, Map.fromList [(slmemid, Set.fromList [llhdev])])] - bindResponse (getMultiUserPrekeyBundle pmem userClients) $ assertResp +testLHClaimKeys :: TestClaimKeys -> App () +testLHClaimKeys testmode = do + withMockServer lhMockApp $ \lhDomAndPort _chan -> do + (lowner, ltid, [lmem]) <- createTeam OwnDomain 2 + (powner, ptid, [pmem]) <- createTeam OwnDomain 2 + + legalholdWhitelistTeam ltid lowner >>= assertSuccess + legalholdIsTeamInWhitelist ltid lowner >>= assertSuccess + postLegalHoldSettings ltid lowner (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 + + requestLegalHoldDevice ltid lowner lmem >>= assertSuccess + approveLegalHoldDevice ltid (lmem %. "qualified_id") defPassword >>= assertSuccess + + let addc caps = addClient pmem (settings caps) >>= assertSuccess + settings caps = + def + { prekeys = Just $ take 10 somePrekeysRendered, + lastPrekey = Just $ head someLastPrekeysRendered, + acapabilities = caps + } + in case testmode of + TCKConsentMissing -> + addc $ Just ["legalhold-implicit-consent"] + TCKConsentAndNewClients -> do + addc $ Just ["legalhold-implicit-consent"] + legalholdWhitelistTeam ptid powner >>= assertSuccess + legalholdIsTeamInWhitelist ptid powner >>= assertSuccess + + llhdev :: String <- do + let getCls :: Value -> App [String] + getCls mem = do + res <- getClientsQualified mem OwnDomain mem + val <- getJSON 200 res + cls <- asList val + objId `mapM` cls + getCls lmem <&> \case + [d] -> d + bad -> error $ show bad + + let assertResp :: HasCallStack => Response -> App () + assertResp resp = case testmode of + TCKConsentMissing -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "missing-legalhold-consent" + TCKConsentAndNewClients -> do + resp.status `shouldMatchInt` 200 + + bindResponse (getUsersPrekeysClient pmem (lmem %. "qualified_id") llhdev) $ assertResp + bindResponse (getUsersPrekeyBundle pmem (lmem %. "qualified_id")) $ assertResp + + slmemdom <- asString $ lmem %. "qualified_id.domain" + slmemid <- asString $ lmem %. "qualified_id.id" + let userClients = Map.fromList [(slmemdom, Map.fromList [(slmemid, Set.fromList [llhdev])])] + bindResponse (getMultiUserPrekeyBundle pmem userClients) $ assertResp testLHAddClientManually :: App () testLHAddClientManually = do (_owner, _tid, [mem1]) <- createTeam OwnDomain 2 bindResponse (addClient mem1 def {ctype = "legalhold"}) $ \resp -> do - resp.status `shouldMatchInt` 400 - resp.json %. "label" `shouldMatch` "client-error" + assertLabel 400 "client-error" resp -- we usually don't test the human-readable "message", but in this case it is important to -- make sure the reason is the right one, and not eg. "LH service not present", or some -- other unspecific client error. @@ -274,3 +276,639 @@ testLHDeleteClientManually = do -- make sure the reason is the right one, and not eg. "LH service not present", or some -- other unspecific client error. resp.json %. "message" `shouldMatch` "LegalHold clients cannot be deleted. LegalHold must be disabled on this user by an admin" + +testLHRequestDevice :: App () +testLHRequestDevice = do + (alice, tid, [bob]) <- createTeam OwnDomain 2 + let reqNotEnabled requester requestee = + requestLegalHoldDevice tid requester requestee + >>= assertLabel 403 "legalhold-not-enabled" + + reqNotEnabled alice bob + + lpk <- getLastPrekey + pks <- replicateM 3 getPrekey + + withMockServer (lhMockAppWithPrekeys MkCreateMock {nextLastPrey = pure lpk, somePrekeys = pure pks}) \lhDomAndPort _chan -> do + let statusShouldBe :: String -> App () + statusShouldBe status = + legalholdUserStatus tid alice bob `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` status + + -- the user has not agreed to be under legalhold + for_ [alice, bob] \requester -> do + reqNotEnabled requester bob + statusShouldBe "no_consent" + + legalholdWhitelistTeam tid alice >>= assertSuccess + postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) >>= assertSuccess + + statusShouldBe "disabled" + + requestLegalHoldDevice tid alice bob >>= assertStatus 201 + statusShouldBe "pending" + + -- requesting twice should be idempotent wrt the approval + -- mind that requesting twice means two "user.legalhold-request" notifications + -- for the clients of the user under legalhold (bob) + requestLegalHoldDevice tid alice bob >>= assertStatus 204 + statusShouldBe "pending" + + [bobc1, bobc2] <- replicateM 2 do + objId $ addClient bob def `bindResponse` getJSON 201 + for_ [bobc1, bobc2] \client -> + awaitNotification bob client noValue isUserLegalholdRequestNotif >>= \notif -> do + notif %. "payload.0.last_prekey" `shouldMatch` lpk + notif %. "payload.0.id" `shouldMatch` objId bob + +-- | pops a channel until it finds an event that returns a 'Just' +-- upon running the matcher function +checkChan :: HasCallStack => Chan t -> (t -> App (Maybe a)) -> App a +checkChan chan match = do + tSecs <- asks ((* 1_000_000) . timeOutSeconds) + + maybe (assertFailure "checkChan: timed out") pure =<< timeout tSecs do + let go = readChan chan >>= match >>= maybe go pure + go + +-- | like 'checkChan' but throws away the request and decodes the body +checkChanVal :: HasCallStack => Chan (t, LazyByteString) -> (Value -> MaybeT App a) -> App a +checkChanVal chan match = checkChan chan \(_, bs) -> runMaybeT do + MaybeT (pure (decode bs)) >>= match + +testLHApproveDevice :: App () +testLHApproveDevice = do + -- team users + -- alice (boss) and bob and charlie (member) + (alice, tid, [bob, charlie]) <- createTeam OwnDomain 3 + + -- ollie the outsider + ollie <- do + o <- randomUser OwnDomain def + connectTwoUsers o alice + pure o + + -- sandy the stranger + sandy <- randomUser OwnDomain def + + legalholdWhitelistTeam tid alice >>= assertStatus 200 + approveLegalHoldDevice tid (bob %. "qualified_id") defPassword + >>= assertLabel 412 "legalhold-not-pending" + + withMockServer lhMockApp \lhDomAndPort chan -> do + legalholdWhitelistTeam tid alice + >>= assertStatus 200 + postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) + >>= assertStatus 201 + requestLegalHoldDevice tid alice bob + >>= assertStatus 201 + + let uidsAndTidMatch val = do + actualTid <- + lookupFieldM val "team_id" + >>= lift . asString + actualUid <- + lookupFieldM val "user_id" + >>= lift . asString + bobUid <- lift $ objId bob + + -- we pass the check on equality + unless ((actualTid, actualUid) == (tid, bobUid)) do + mzero + + checkChanVal chan uidsAndTidMatch + + -- the team owner cannot approve for bob + approveLegalHoldDevice' tid alice bob defPassword + >>= assertLabel 403 "access-denied" + -- bob needs to provide a password + approveLegalHoldDevice tid bob "wrong-password" + >>= assertLabel 403 "access-denied" + -- now bob finally found his password + approveLegalHoldDevice tid bob defPassword + >>= assertStatus 200 + + let matchAuthToken val = + lookupFieldM val "refresh_token" + >>= lift . asString + + checkChanVal chan matchAuthToken + >>= renewToken bob + >>= assertStatus 200 + + lhdId <- lhDeviceIdOf bob + + legalholdUserStatus tid alice bob `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "client.id" `shouldMatch` lhdId + resp.json %. "status" `shouldMatch` "enabled" + + replicateM 2 do + objId $ addClient bob def `bindResponse` getJSON 201 + >>= traverse_ \client -> + awaitNotification bob client noValue isUserClientAddNotif >>= \notif -> do + notif %. "payload.0.client.type" `shouldMatch` "legalhold" + notif %. "payload.0.client.class" `shouldMatch` "legalhold" + + -- the other team members receive a notification about the + -- legalhold device being approved in their team + for_ [alice, charlie] \user -> do + client <- objId $ addClient user def `bindResponse` getJSON 201 + awaitNotification user client noValue isUserLegalholdEnabledNotif >>= \notif -> do + notif %. "payload.0.id" `shouldMatch` objId bob + for_ [ollie, sandy] \outsider -> do + outsiderClient <- objId $ addClient outsider def `bindResponse` getJSON 201 + assertNoNotifications outsider outsiderClient Nothing isUserLegalholdEnabledNotif + +testLHGetDeviceStatus :: App () +testLHGetDeviceStatus = do + -- team users + -- alice (team owner) and bob (member) + (alice, tid, [bob]) <- createTeam OwnDomain 2 + for_ [alice, bob] \user -> do + legalholdUserStatus tid alice user `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` "no_consent" + + lpk <- getLastPrekey + pks <- replicateM 3 getPrekey + + withMockServer + do lhMockAppWithPrekeys MkCreateMock {nextLastPrey = pure lpk, somePrekeys = pure pks} + \lhDomAndPort _chan -> do + legalholdWhitelistTeam tid alice + >>= assertStatus 200 + + legalholdUserStatus tid alice bob `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` "disabled" + lookupField resp.json "last_prekey" + >>= assertNothing + runMaybeT (lookupFieldM resp.json "client" >>= flip lookupFieldM "id") + >>= assertNothing + + -- the status messages for these have already been tested + postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) + >>= assertStatus 201 + + requestLegalHoldDevice tid alice bob + >>= assertStatus 201 + + approveLegalHoldDevice tid bob defPassword + >>= assertStatus 200 + + lhdId <- lhDeviceIdOf bob + legalholdUserStatus tid alice bob `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` "enabled" + resp.json %. "last_prekey" `shouldMatch` lpk + resp.json %. "client.id" `shouldMatch` lhdId + + requestLegalHoldDevice tid alice bob + >>= assertLabel 409 "legalhold-already-enabled" + +-- | this sets the timeout to a higher number; we need +-- this because the SQS queue on the brig is super slow +-- and that's why client.remove events arrive really late +-- +-- FUTUREWORK(mangoiv): improve the speed of internal +-- event queuing +setTimeoutTo :: Int -> Env -> Env +setTimeoutTo tSecs env = env {timeOutSeconds = tSecs} + +testLHDisableForUser :: App () +testLHDisableForUser = do + (alice, tid, [bob]) <- createTeam OwnDomain 2 + + withMockServer lhMockApp \lhDomAndPort chan -> do + setUpLHDevice tid alice bob lhDomAndPort + + bobc <- objId $ addClient bob def `bindResponse` getJSON 201 + + awaitNotification bob bobc noValue isUserClientAddNotif >>= \notif -> do + notif %. "payload.0.client.type" `shouldMatch` "legalhold" + notif %. "payload.0.client.class" `shouldMatch` "legalhold" + + -- only an admin can disable legalhold + disableLegalHold tid bob bob defPassword + >>= assertLabel 403 "operation-denied" + + disableLegalHold tid alice bob "fix ((\"the password always is \" <>) . show)" + >>= assertLabel 403 "access-denied" + + disableLegalHold tid alice bob defPassword + >>= assertStatus 200 + + checkChan chan \(req, _) -> runMaybeT do + unless + do + BS8.unpack req.requestMethod == "POST" + && req.pathInfo == (T.pack <$> ["legalhold", "remove"]) + mzero + + void $ local (setTimeoutTo 90) do + awaitNotification bob bobc noValue isUserClientRemoveNotif + *> awaitNotification bob bobc noValue isUserLegalholdDisabledNotif + + bobId <- objId bob + lhClients <- + BrigI.getClientsFull bob [bobId] `bindResponse` \resp -> do + resp.json %. bobId + & asList + >>= filterM \val -> (== "legalhold") <$> (val %. "type" & asString) + + shouldBeEmpty lhClients + +testLHEnablePerTeam :: App () +testLHEnablePerTeam = do + -- team users + -- alice (team owner) and bob (member) + (alice, tid, [bob]) <- createTeam OwnDomain 2 + legalholdIsEnabled tid alice `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "lockStatus" `shouldMatch` "unlocked" + resp.json %. "status" `shouldMatch` "disabled" + + withMockServer lhMockApp \lhDomAndPort _chan -> do + setUpLHDevice tid alice bob lhDomAndPort + + legalholdUserStatus tid alice bob `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` "enabled" + + putLegalholdStatus tid alice "disabled" + `bindResponse` assertLabel 403 "legalhold-whitelisted-only" + + -- the put doesn't have any influence on the status being "enabled" + legalholdUserStatus tid alice bob `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` "enabled" + +testLHGetMembersIncludesStatus :: App () +testLHGetMembersIncludesStatus = do + -- team users + -- alice (team owner) and bob (member) + (alice, tid, [bob]) <- createTeam OwnDomain 2 + + let statusShouldBe :: String -> App () + statusShouldBe status = do + getTeamMembers alice tid `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + [bobMember] <- + resp.json %. "members" & asList >>= filterM \u -> do + (==) <$> asString (u %. "user") <*> objId bob + bobMember %. "legalhold_status" `shouldMatch` status + + statusShouldBe "no_consent" + withMockServer lhMockApp \lhDomAndPort _chan -> do + statusShouldBe "no_consent" + + legalholdWhitelistTeam tid alice + >>= assertStatus 200 + + -- the status messages for these have already been tested + postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) + >>= assertStatus 201 + + -- legalhold has been requested but is disabled + statusShouldBe "disabled" + + requestLegalHoldDevice tid alice bob + >>= assertStatus 201 + + -- legalhold has been set to pending after requesting device + statusShouldBe "pending" + + approveLegalHoldDevice tid bob defPassword + >>= assertStatus 200 + + -- bob has accepted the legalhold device + statusShouldBe "enabled" + +type TB s = TaggedBool s + +testLHNoConsentBlockOne2OneConv :: TB "connect first" -> TB "team peer" -> TB "approve LH" -> TB "test pending connection" -> App () +testLHNoConsentBlockOne2OneConv + (MkTagged connectFirst) + (MkTagged teampeer) + (MkTagged approveLH) + (MkTagged testPendingConnection) = do + -- team users + -- alice (team owner) and bob (member) + (alice, tid, []) <- createTeam OwnDomain 1 + bob <- + if teampeer + then do + (walice, _tid, []) <- createTeam OwnDomain 1 + -- FUTUREWORK(mangoiv): creating a team on a second backend + -- causes this bug: https://wearezeta.atlassian.net/browse/WPB-6640 + pure walice + else randomUser OwnDomain def + + legalholdWhitelistTeam tid alice + >>= assertStatus 200 + + let doEnableLH :: HasCallStack => App (Maybe String) + doEnableLH = do + -- alice requests a legalhold device for herself + requestLegalHoldDevice tid alice alice + >>= assertStatus 201 + + when approveLH do + approveLegalHoldDevice tid alice defPassword + >>= assertStatus 200 + legalholdUserStatus tid alice alice `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` if approveLH then "enabled" else "pending" + if approveLH + then Just <$> lhDeviceIdOf alice + else pure Nothing + + doDisableLH :: HasCallStack => App () + doDisableLH = + disableLegalHold tid alice alice defPassword + >>= assertStatus 200 + + withMockServer lhMockApp \lhDomAndPort _chan -> do + postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) + >>= assertStatus 201 + + if not connectFirst + then do + void doEnableLH + postConnection alice bob + >>= assertLabel 403 "missing-legalhold-consent" + + postConnection bob alice + >>= assertLabel 403 "missing-legalhold-consent" + else do + alicec <- objId $ addClient alice def >>= getJSON 201 + bobc <- objId $ addClient bob def >>= getJSON 201 + + postConnection alice bob + >>= assertStatus 201 + mbConvId <- + if testPendingConnection + then pure Nothing + else + Just + <$> do + putConnection bob alice "accepted" + >>= getJSON 200 + %. "qualified_conversation" + + -- we need to take away the pending/ sent status for the connections + [lastNotifAlice, lastNotifBob] <- for [(alice, alicec), (bob, bobc)] \(user, client) -> do + -- we get two events if bob accepts alice's request + let numEvents = if testPendingConnection then 1 else 2 + last <$> awaitNotifications user client Nothing numEvents isUserConnectionNotif + + mbLHDevice <- doEnableLH + + let assertConnectionsMissingLHConsent = + for_ [(bob, alice), (alice, bob)] \(a, b) -> + getConnections a `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + conn <- assertOne =<< do resp.json %. "connections" & asList + conn %. "status" `shouldMatch` "missing-legalhold-consent" + conn %. "from" `shouldMatch` objId a + conn %. "to" `shouldMatch` objId b + + assertConnectionsMissingLHConsent + + [lastNotifAlice', lastNotifBob'] <- for [(alice, alicec, lastNotifAlice), (bob, bobc, lastNotifBob)] \(user, client, lastNotif) -> do + awaitNotification user client (Just lastNotif) isUserConnectionNotif >>= \notif -> + notif %. "payload.0.connection.status" `shouldMatch` "missing-legalhold-consent" + $> notif + + for_ [(bob, alice), (alice, bob)] \(a, b) -> + putConnection a b "accepted" + >>= assertLabel 403 "bad-conn-update" + + -- putting the connection to "accepted" with 403 doesn't change the + -- connection status + assertConnectionsMissingLHConsent + + bobc2 <- objId $ addClient bob def >>= getJSON 201 + + let -- \| we send a message from bob to alice, but only if + -- we have a conversation id and a legalhold device + -- we first create a message that goes to recipients + -- chosen by the first callback passed + -- then send the message using proteus + -- and in the end running the assertino callback to + -- verify the result + sendMessageFromBobToAlice :: + HasCallStack => + (String -> [String]) -> + -- \^ if we have the legalhold device registered, this + -- callback will be passed the lh device + (Response -> App ()) -> + -- \^ the callback to verify our response (an assertion) + App () + sendMessageFromBobToAlice recipients assertion = + for_ ((,) <$> mbConvId <*> mbLHDevice) \(convId, device) -> do + successfulMsgForOtherUsers <- + mkProteusRecipients + bob -- bob is the sender + [(alice, recipients device), (bob, [bobc])] + -- we send to clients of alice, maybe the legalhold device + -- we need to send to our other clients (bobc) + "hey alice (and eve)" -- the message + let bobaliceMessage = + Proto.defMessage @Proto.QualifiedNewOtrMessage + & #sender . Proto.client .~ (bobc2 ^?! hex) + & #recipients .~ [successfulMsgForOtherUsers] + & #reportAll .~ Proto.defMessage + -- make sure that `convId` is not just the `convId` but also + -- contains the domain because `postProteusMessage` will take the + -- comain from the `convId` json object + postProteusMessage bob convId bobaliceMessage + `bindResponse` assertion + + sendMessageFromBobToAlice (\device -> [alicec, device]) \resp -> do + resp.status `shouldMatchInt` 404 + + -- now we disable legalhold + doDisableLH + + for_ mbLHDevice \lhd -> + local (setTimeoutTo 90) $ + awaitNotification alice alicec noValue isUserClientRemoveNotif >>= \notif -> + notif %. "payload.0.client.id" `shouldMatch` lhd + + let assertStatusFor user status = + getConnections user `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + conn <- assertOne =<< do resp.json %. "connections" & asList + conn %. "status" `shouldMatch` status + + if testPendingConnection + then do + assertStatusFor alice "sent" + assertStatusFor bob "pending" + else do + assertStatusFor alice "accepted" + assertStatusFor bob "accepted" + + for_ [(alice, alicec, lastNotifAlice'), (bob, bobc, lastNotifBob')] \(user, client, lastNotif) -> do + awaitNotification user client (Just lastNotif) isUserConnectionNotif >>= \notif -> + notif %. "payload.0.connection.status" `shouldMatchOneOf` ["sent", "pending", "accepted"] + + sendMessageFromBobToAlice (const [alicec]) \resp -> do + resp.status `shouldMatchInt` 201 + + sendMessageFromBobToAlice (\device -> [device]) \resp -> do + resp.status `shouldMatchInt` 412 + +data GroupConvAdmin + = LegalholderIsAdmin + | PeerIsAdmin + | BothAreAdmins + deriving (Show, Generic) + +-- | If a member of an existing conversation is assigned a LH device, users are removed from +-- the conversation until policy conflicts are resolved. +-- +-- As to who gets to stay: +-- - admins will stay over members +-- - local members will stay over remote members. +testLHNoConsentRemoveFromGroup :: GroupConvAdmin -> App () +testLHNoConsentRemoveFromGroup admin = do + (alice, tidAlice, []) <- createTeam OwnDomain 1 + (bob, tidBob, []) <- createTeam OwnDomain 1 + legalholdWhitelistTeam tidAlice alice >>= assertStatus 200 + withMockServer lhMockApp \lhDomAndPort _chan -> do + postLegalHoldSettings tidAlice alice (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 + withWebSockets [alice, bob] \[aws, bws] -> do + connectTwoUsers alice bob + (convId, qConvId) <- do + let (inviter, tidInviter, invitee, inviteeRole) = case admin of + LegalholderIsAdmin -> (alice, tidAlice, bob, "wire_member") + BothAreAdmins -> (alice, tidAlice, bob, "wire_admin") + PeerIsAdmin -> (bob, tidBob, alice, "wire_member") + + let createConv = defProteus {qualifiedUsers = [invitee], newUsersRole = inviteeRole, team = Just tidInviter} + postConversation inviter createConv `bindResponse` \resp -> do + resp.json %. "members.self.conversation_role" `shouldMatch` "wire_admin" + resp.json %. "members.others.0.conversation_role" `shouldMatch` case admin of + BothAreAdmins -> "wire_admin" + PeerIsAdmin -> "wire_member" + LegalholderIsAdmin -> "wire_member" + (,) <$> resp.json %. "id" <*> resp.json %. "qualified_id" + for_ [aws, bws] \ws -> do + awaitMatch isConvCreateNotifNotSelf ws >>= \pl -> pl %. "payload.0.conversation" `shouldMatch` convId + + for_ [alice, bob] \user -> + getConversation user qConvId >>= assertStatus 200 + + requestLegalHoldDevice tidAlice alice alice >>= assertStatus 201 + approveLegalHoldDevice tidAlice alice defPassword >>= assertStatus 200 + legalholdUserStatus tidAlice alice alice `bindResponse` \resp -> do + resp.json %. "status" `shouldMatch` "enabled" + resp.status `shouldMatchInt` 200 + + case admin of + LegalholderIsAdmin -> do + for_ [aws, bws] do awaitMatch (isConvLeaveNotifWithLeaver bob) + getConversation alice qConvId >>= assertStatus 200 + getConversation bob qConvId >>= assertLabel 403 "access-denied" + PeerIsAdmin -> do + for_ [aws, bws] do awaitMatch (isConvLeaveNotifWithLeaver alice) + getConversation bob qConvId >>= assertStatus 200 + getConversation alice qConvId >>= assertLabel 403 "access-denied" + BothAreAdmins -> do + for_ [aws, bws] do awaitMatch (isConvLeaveNotifWithLeaver bob) + getConversation alice qConvId >>= assertStatus 200 + getConversation bob qConvId >>= assertLabel 403 "access-denied" + +testLHHappyFlow :: App () +testLHHappyFlow = do + (alice, tid, [bob]) <- createTeam OwnDomain 2 + let statusShouldBe :: String -> App () + statusShouldBe status = + legalholdUserStatus tid alice bob `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` status + + legalholdWhitelistTeam tid alice >>= assertStatus 200 + lpk <- getLastPrekey + pks <- replicateM 3 getPrekey + + withMockServer (lhMockAppWithPrekeys MkCreateMock {nextLastPrey = pure lpk, somePrekeys = pure pks}) \lhDomAndPort _chan -> do + postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 + + -- implicit consent + statusShouldBe "disabled" + -- whitelisting is idempotent + legalholdWhitelistTeam tid alice >>= assertStatus 200 + statusShouldBe "disabled" + + -- memmbers cannot request LH devices + requestLegalHoldDevice tid bob alice >>= assertLabel 403 "operation-denied" + + -- owners can; bob should now have a pending request + requestLegalHoldDevice tid alice bob >>= assertStatus 201 + statusShouldBe "pending" + + -- owner cannot approve on behalf on user under legalhold + approveLegalHoldDevice' tid alice bob defPassword >>= assertLabel 403 "access-denied" + + -- user can approve the request, however + approveLegalHoldDevice tid bob defPassword `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + + legalholdUserStatus tid alice bob `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` "enabled" + _ <- + resp.json `lookupField` "client.id" + >>= assertJust "client id is present" + resp.json %. "last_prekey" `shouldMatch` lpk + +testLHGetStatus :: App () +testLHGetStatus = do + (alice, tid, [bob]) <- createTeam OwnDomain 2 + (charlie, _tidCharlie, [debora]) <- createTeam OwnDomain 2 + emil <- randomUser OwnDomain def + + let check :: HasCallStack => (MakesValue getter, MakesValue target) => getter -> target -> String -> App () + check getter target status = do + profile <- getUser getter target >>= getJSON 200 + pStatus <- profile %. "legalhold_status" & asString + status `shouldMatch` pStatus + + for_ [alice, bob, charlie, debora, emil] \u -> do + check u bob "no_consent" + check u emil "no_consent" + legalholdWhitelistTeam tid alice >>= assertStatus 200 + withMockServer lhMockApp \lhDomAndPort _chan -> do + postLegalHoldSettings tid alice (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 + for_ [alice, bob, charlie, debora, emil] \u -> do + check u bob "disabled" + requestLegalHoldDevice tid alice bob >>= assertStatus 201 + check debora bob "pending" + approveLegalHoldDevice tid bob defPassword >>= assertStatus 200 + check debora bob "enabled" + +testLHCannotCreateGroupWithUsersInConflict :: App () +testLHCannotCreateGroupWithUsersInConflict = do + (alice, tidAlice, [bob]) <- createTeam OwnDomain 2 + (charlie, _tidCharlie, [debora]) <- createTeam OwnDomain 2 + legalholdWhitelistTeam tidAlice alice >>= assertStatus 200 + connectTwoUsers bob charlie + connectTwoUsers bob debora + withMockServer lhMockApp \lhDomAndPort _chan -> do + postLegalHoldSettings tidAlice alice (mkLegalHoldSettings lhDomAndPort) >>= assertStatus 201 + postConversation bob defProteus {qualifiedUsers = [charlie, alice], newUsersRole = "wire_member", team = Just tidAlice} + >>= assertStatus 201 + + requestLegalHoldDevice tidAlice alice alice >>= assertStatus 201 + approveLegalHoldDevice tidAlice alice defPassword >>= assertStatus 200 + legalholdUserStatus tidAlice alice alice `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` "enabled" + + postConversation bob defProteus {qualifiedUsers = [debora, alice], newUsersRole = "wire_member", team = Just tidAlice} + >>= assertLabel 403 "missing-legalhold-consent" diff --git a/integration/test/Test/Login.hs b/integration/test/Test/Login.hs new file mode 100644 index 00000000000..1617e8b3a0f --- /dev/null +++ b/integration/test/Test/Login.hs @@ -0,0 +1,124 @@ +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} + +module Test.Login where + +import API.BrigInternal (getVerificationCode) +import API.Common (defPassword) +import API.GalleyInternal +import API.Nginz (login, loginWith2ndFactor) +import Control.Concurrent (threadDelay) +import qualified Data.Aeson as Aeson +import SetupHelpers +import Testlib.Prelude +import Text.Printf (printf) + +testLoginVerify6DigitEmailCodeSuccess :: HasCallStack => App () +testLoginVerify6DigitEmailCodeSuccess = do + (owner, team, []) <- createTeam OwnDomain 0 + email <- owner %. "email" + setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked" + setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" + generateVerificationCode owner email + code <- getVerificationCode owner "login" >>= getJSON 200 >>= asString + bindResponse (loginWith2ndFactor owner email defPassword code) $ \resp -> do + resp.status `shouldMatchInt` 200 + +-- @SF.Channel @TSFI.RESTfulAPI @S2 +-- +-- Test that login fails with wrong second factor email verification code +testLoginVerify6DigitWrongCodeFails :: HasCallStack => App () +testLoginVerify6DigitWrongCodeFails = do + (owner, team, []) <- createTeam OwnDomain 0 + email <- owner %. "email" + setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked" + setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" + generateVerificationCode owner email + correctCode <- getVerificationCode owner "login" >>= getJSON 200 >>= asString + let wrongCode :: String = printf "%06d" $ (read @Int correctCode) + 1 `mod` 1000000 + bindResponse (loginWith2ndFactor owner email defPassword wrongCode) $ \resp -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "code-authentication-failed" + +-- @END + +-- @SF.Channel @TSFI.RESTfulAPI @S2 +-- +-- Test that login without verification code fails if SndFactorPasswordChallenge feature is enabled in team +testLoginVerify6DigitMissingCodeFails :: HasCallStack => App () +testLoginVerify6DigitMissingCodeFails = do + (owner, team, []) <- createTeam OwnDomain 0 + email <- owner %. "email" + setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked" + setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" + bindResponse (login owner email defPassword) $ \resp -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "code-authentication-required" + +-- @END + +-- @SF.Channel @TSFI.RESTfulAPI @S2 +-- +-- Test that login fails with expired second factor email verification code +testLoginVerify6DigitExpiredCodeFails :: HasCallStack => App () +testLoginVerify6DigitExpiredCodeFails = do + withModifiedBackend + (def {brigCfg = setField "optSettings.setVerificationTimeout" (Aeson.Number 2)}) + $ \domain -> do + (owner, team, []) <- createTeam domain 0 + email <- owner %. "email" + setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked" + setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" + bindResponse (getTeamFeature owner team "sndFactorPasswordChallenge") $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "status" `shouldMatch` "enabled" + generateVerificationCode owner email + code <- bindResponse (getVerificationCode owner "login") $ \resp -> do + resp.status `shouldMatchInt` 200 + asString resp.json + liftIO $ threadDelay 2_000_100 + bindResponse (loginWith2ndFactor owner email defPassword code) \resp -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "code-authentication-failed" + +-- @END + +testLoginVerify6DigitResendCodeSuccessAndRateLimiting :: HasCallStack => App () +testLoginVerify6DigitResendCodeSuccessAndRateLimiting = do + (owner, team, []) <- createTeam OwnDomain 0 + email <- owner %. "email" + setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked" + setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" + generateVerificationCode owner email + fstCode <- getVerificationCode owner "login" >>= getJSON 200 >>= asString + bindResponse (generateVerificationCode' owner email) $ \resp -> do + resp.status `shouldMatchInt` 429 + mostRecentCode <- retryT $ do + resp <- generateVerificationCode' owner email + resp.status `shouldMatchInt` 200 + getVerificationCode owner "login" >>= getJSON 200 >>= asString + + bindResponse (loginWith2ndFactor owner email defPassword fstCode) \resp -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "code-authentication-failed" + + bindResponse (loginWith2ndFactor owner email defPassword mostRecentCode) \resp -> do + resp.status `shouldMatchInt` 200 + +testLoginVerify6DigitLimitRetries :: HasCallStack => App () +testLoginVerify6DigitLimitRetries = do + (owner, team, []) <- createTeam OwnDomain 0 + email <- owner %. "email" + setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked" + setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" + generateVerificationCode owner email + correctCode <- getVerificationCode owner "login" >>= getJSON 200 >>= asString + let wrongCode :: String = printf "%06d" $ (read @Int correctCode) + 1 `mod` 1000000 + -- try login with wrong code should fail 3 times + forM_ [1 .. 3] $ \(_ :: Int) -> do + bindResponse (loginWith2ndFactor owner email defPassword wrongCode) \resp -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "code-authentication-failed" + -- after 3 failed attempts, login with correct code should fail as well + bindResponse (loginWith2ndFactor owner email defPassword correctCode) \resp -> do + resp.status `shouldMatchInt` 403 + resp.json %. "label" `shouldMatch` "code-authentication-failed" diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs index 049d3d8d4a7..db831848077 100644 --- a/integration/test/Test/MLS.hs +++ b/integration/test/Test/MLS.hs @@ -4,8 +4,10 @@ module Test.MLS where import API.Brig (claimKeyPackages, deleteClient) import API.Galley +import qualified Data.Aeson.KeyMap as KM import qualified Data.ByteString.Base64 as Base64 import qualified Data.ByteString.Char8 as B8 +import qualified Data.Set as Set import qualified Data.Text.Encoding as T import MLS.Util import Notifications @@ -24,7 +26,7 @@ testSendMessageNoReturnToSender = do -- the message withWebSockets [alice1, alice2, bob1, bob2] $ \(wsSender : wss) -> do mp <- createApplicationMessage alice1 "hello, bob" - void . bindResponse (postMLSMessage mp.sender mp.message) $ \resp -> do + bindResponse (postMLSMessage mp.sender mp.message) $ \resp -> do resp.status `shouldMatchInt` 201 for_ wss $ \ws -> do n <- awaitMatch (\n -> nPayload n %. "type" `isEqual` "conversation.mls-message-add") ws @@ -323,9 +325,12 @@ testAddUserSimple :: HasCallStack => Ciphersuite -> CredentialType -> App () testAddUserSimple suite ctype = do setMLSCiphersuite suite [alice, bob] <- createAndConnectUsers [OwnDomain, OwnDomain] - [alice1, bob1, bob2] <- traverse (createMLSClient def {credType = ctype}) [alice, bob, bob] - traverse_ uploadNewKeyPackage [bob1, bob2] + bob1 <- createMLSClient def {credType = ctype} bob + void $ uploadNewKeyPackage bob1 + [alice1, bob2] <- traverse (createMLSClient def {credType = ctype}) [alice, bob] + + traverse_ uploadNewKeyPackage [bob2] (_, qcnv) <- createNewGroup alice1 resp <- createAddCommit alice1 [bob] >>= sendAndConsumeCommitBundle @@ -365,8 +370,9 @@ testRemoteAddUser = do resp.status `shouldMatchInt` 500 resp.json %. "label" `shouldMatch` "federation-not-implemented" -testRemoteRemoveClient :: HasCallStack => App () -testRemoteRemoveClient = do +testRemoteRemoveClient :: HasCallStack => Ciphersuite -> App () +testRemoteRemoveClient suite = do + setMLSCiphersuite suite [alice, bob] <- createAndConnectUsers [OwnDomain, OtherDomain] [alice1, bob1] <- traverse (createMLSClient def) [alice, bob] void $ uploadNewKeyPackage bob1 @@ -478,8 +484,9 @@ testRemoveClientsIncomplete = do err <- postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON 409 err %. "label" `shouldMatch` "mls-client-mismatch" -testAdminRemovesUserFromConv :: HasCallStack => App () -testAdminRemovesUserFromConv = do +testAdminRemovesUserFromConv :: HasCallStack => Ciphersuite -> App () +testAdminRemovesUserFromConv suite = do + setMLSCiphersuite suite [alice, bob] <- createAndConnectUsers [OwnDomain, OwnDomain] [alice1, bob1, bob2] <- traverse (createMLSClient def) [alice, bob, bob] @@ -674,7 +681,7 @@ testCommitNotReferencingAllProposals = do testUnsupportedCiphersuite :: HasCallStack => App () testUnsupportedCiphersuite = do - setMLSCiphersuite (Ciphersuite "0x0002") + setMLSCiphersuite (Ciphersuite "0x0003") alice <- randomUser OwnDomain def alice1 <- createMLSClient def alice void $ createNewGroup alice1 @@ -684,3 +691,59 @@ testUnsupportedCiphersuite = do bindResponse (postMLSCommitBundle alice1 (mkBundle mp)) $ \resp -> do resp.status `shouldMatchInt` 400 resp.json %. "label" `shouldMatch` "mls-protocol-error" + +testBackendRemoveProposal :: HasCallStack => Ciphersuite -> Domain -> App () +testBackendRemoveProposal suite domain = do + setMLSCiphersuite suite + [alice, bob] <- createAndConnectUsers [OwnDomain, domain] + (alice1 : bobClients) <- traverse (createMLSClient def) [alice, bob, bob] + traverse_ uploadNewKeyPackage bobClients + void $ createNewGroup alice1 + + void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommitBundle + + let isRemoveProposalFor :: Int -> Value -> App Bool + isRemoveProposalFor index e = + isNewMLSMessageNotif e &&~ do + msgData <- e %. "payload.0.data" & asByteString + msg <- showMessage alice1 msgData + fieldEquals msg "message.content.body.Proposal.Remove.removed" index + + withWebSocket alice1 \ws -> do + deleteUser bob + for_ (zip [1 ..] bobClients) \(index, _) -> do + void $ consumeMessageWithPredicate (isRemoveProposalFor index) alice1 Nothing ws + + bobUser <- asString $ bob %. "id" + modifyMLSState $ \mls -> + mls + { members = Set.filter (\m -> m.user /= bobUser) mls.members + } + + -- alice commits the external proposals + r <- createPendingProposalCommit alice1 >>= sendAndConsumeCommitBundle + shouldBeEmpty $ r %. "events" + +testPublicKeys :: HasCallStack => App () +testPublicKeys = do + alice <- randomUserId OwnDomain + let expectedKeys = + [ "ed25519", + "ecdsa_secp256r1_sha256", + "ecdsa_secp384r1_sha384", + "ecdsa_secp521r1_sha512" + ] + bindResponse (getMLSPublicKeys alice) $ \resp -> do + resp.status `shouldMatchInt` 200 + (KM.keys <$> asObject (resp.json %. "removal")) `shouldMatchSet` expectedKeys + +testPublicKeysMLSNotEnabled :: HasCallStack => App () +testPublicKeysMLSNotEnabled = withModifiedBackend + def + { galleyCfg = removeField "settings.mlsPrivateKeyPaths" + } + $ \domain -> do + alice <- randomUserId domain + bindResponse (getMLSPublicKeys alice) $ \resp -> do + resp.status `shouldMatchInt` 400 + resp.json %. "label" `shouldMatch` "mls-not-enabled" diff --git a/integration/test/Test/MLS/KeyPackage.hs b/integration/test/Test/MLS/KeyPackage.hs index 69e8c84fbdf..cf6b721db88 100644 --- a/integration/test/Test/MLS/KeyPackage.hs +++ b/integration/test/Test/MLS/KeyPackage.hs @@ -54,12 +54,9 @@ testKeyPackageMultipleCiphersuites = do testKeyPackageUploadNoKey :: App () testKeyPackageUploadNoKey = do alice <- randomUser OwnDomain def - alice1 <- do - cid <- createWireClient alice - initMLSClient def cid - pure cid + alice1 <- createWireClient alice - (kp, _) <- generateKeyPackage alice1 def + (kp, _) <- generateKeyPackage alice1 -- if we upload a keypackage without a key, -- we get a bad request @@ -184,6 +181,7 @@ testKeyPackageRemoteClaim = do testKeyPackageCount :: HasCallStack => Ciphersuite -> App () testKeyPackageCount cs = do + setMLSCiphersuite cs alice <- randomUser OwnDomain def alice1 <- createMLSClient def alice @@ -192,7 +190,7 @@ testKeyPackageCount cs = do resp.json %. "count" `shouldMatchInt` 0 let count = 10 - kps <- map fst <$> replicateM count (generateKeyPackage alice1 cs) + kps <- map fst <$> replicateM count (generateKeyPackage alice1) void $ uploadKeyPackages alice1 kps >>= getBody 201 bindResponse (countKeyPackages cs alice1) $ \resp -> do @@ -201,11 +199,11 @@ testKeyPackageCount cs = do testUnsupportedCiphersuite :: HasCallStack => App () testUnsupportedCiphersuite = do - let suite = Ciphersuite "0x0002" + let suite = Ciphersuite "0x0003" setMLSCiphersuite suite bob <- randomUser OwnDomain def bob1 <- createMLSClient def bob - (kp, _) <- generateKeyPackage bob1 suite + (kp, _) <- generateKeyPackage bob1 bindResponse (uploadKeyPackages bob1 [kp]) $ \resp -> do resp.status `shouldMatchInt` 400 resp.json %. "label" `shouldMatch` "mls-protocol-error" @@ -223,12 +221,12 @@ testReplaceKeyPackages = do -- setup: upload a batch of key packages for each ciphersuite void $ - replicateM 4 (fmap fst (generateKeyPackage alice1 def)) + replicateM 4 (fmap fst (generateKeyPackage alice1)) >>= uploadKeyPackages alice1 >>= getBody 201 setMLSCiphersuite suite void $ - replicateM 5 (fmap fst (generateKeyPackage alice1 suite)) + replicateM 5 (fmap fst (generateKeyPackage alice1)) >>= uploadKeyPackages alice1 >>= getBody 201 @@ -237,7 +235,7 @@ testReplaceKeyPackages = do do -- generate a new batch of key packages - (kps, refs) <- unzip <$> replicateM 3 (generateKeyPackage alice1 suite) + (kps, refs) <- unzip <$> replicateM 3 (generateKeyPackage alice1) -- replace old key packages with new void $ replaceKeyPackages alice1 [suite] kps >>= getBody 201 @@ -262,7 +260,7 @@ testReplaceKeyPackages = do do -- replenish key packages for the second ciphersuite void $ - replicateM 5 (fmap fst (generateKeyPackage alice1 suite)) + replicateM 5 (fmap fst (generateKeyPackage alice1)) >>= uploadKeyPackages alice1 >>= getBody 201 @@ -270,8 +268,10 @@ testReplaceKeyPackages = do checkCount suite 5 -- replace all key packages with fresh ones - kps1 <- replicateM 2 (fmap fst (generateKeyPackage alice1 def)) - kps2 <- replicateM 2 (fmap fst (generateKeyPackage alice1 suite)) + setMLSCiphersuite def + kps1 <- replicateM 2 (fmap fst (generateKeyPackage alice1)) + setMLSCiphersuite suite + kps2 <- replicateM 2 (fmap fst (generateKeyPackage alice1)) void $ replaceKeyPackages alice1 [def, suite] (kps1 <> kps2) >>= getBody 201 diff --git a/integration/test/Test/MLS/Notifications.hs b/integration/test/Test/MLS/Notifications.hs new file mode 100644 index 00000000000..ad0595a48c6 --- /dev/null +++ b/integration/test/Test/MLS/Notifications.hs @@ -0,0 +1,30 @@ +module Test.MLS.Notifications where + +import API.Gundeck +import MLS.Util +import Notifications +import SetupHelpers +import Testlib.Prelude + +testWelcomeNotification :: HasCallStack => App () +testWelcomeNotification = do + [alice, bob] <- createAndConnectUsers [OwnDomain, OtherDomain] + [alice1, alice2, bob1, bob2] <- traverse (createMLSClient def) [alice, alice, bob, bob] + traverse_ uploadNewKeyPackage [alice2, bob1, bob2] + + void $ createNewGroup alice1 + notif <- withWebSocket bob $ \ws -> do + void $ createAddCommit alice1 [alice, bob] >>= sendAndConsumeCommitBundle + awaitMatch isWelcomeNotif ws + + notifId <- notif %. "id" & asString + + for_ [bob1, bob2] $ \cid -> + getNotifications + bob + def + { since = Just notifId, + client = Just cid.client, + size = Just 10000 + } + >>= getJSON 200 diff --git a/integration/test/Test/MLS/One2One.hs b/integration/test/Test/MLS/One2One.hs index ccd8365477e..8c6ce11355d 100644 --- a/integration/test/Test/MLS/One2One.hs +++ b/integration/test/Test/MLS/One2One.hs @@ -17,9 +17,11 @@ module Test.MLS.One2One where +import API.Brig import API.Galley import qualified Data.ByteString.Base64 as Base64 import qualified Data.ByteString.Char8 as B8 +import qualified Data.Set as Set import MLS.Util import Notifications import SetupHelpers @@ -47,6 +49,39 @@ testGetMLSOne2One otherDomain = do conv2 %. "qualified_id" `shouldMatch` convId conv2 %. "epoch" `shouldMatch` (conv %. "epoch") +testMLSOne2OneOtherMember :: HasCallStack => One2OneScenario -> App () +testMLSOne2OneOtherMember scenario = do + alice <- randomUser OwnDomain def + let otherDomain = one2OneScenarioUserDomain scenario + convDomain = one2OneScenarioConvDomain scenario + bob <- createMLSOne2OnePartner otherDomain alice convDomain + conv <- getMLSOne2OneConversation alice bob >>= getJSON 200 + do + convId <- conv %. "qualified_id" + bobConv <- getMLSOne2OneConversation bob alice >>= getJSON 200 + convId `shouldMatch` (bobConv %. "qualified_id") + + [alice1, bob1] <- traverse (createMLSClient def) [alice, bob] + traverse_ uploadNewKeyPackage [bob1] + resetGroup alice1 conv + withWebSocket bob1 $ \ws -> do + commit <- createAddCommit alice1 [bob] + void $ sendAndConsumeCommitBundle commit + let isMessage n = nPayload n %. "type" `isEqual` "conversation.mls-welcome" + n <- awaitMatch isMessage ws + nPayload n %. "data" `shouldMatch` B8.unpack (Base64.encode (fold commit.welcome)) + + -- Make sure the membership info is OK both for the MLS 1-to-1 endpoint and + -- for the general conversation fetching endpoint. + let assertOthers other resp = do + bdy <- getJSON 200 resp + othersObj <- bdy %. "members.others" & asList + otherActual <- assertOne othersObj + otherActual %. "qualified_id" `shouldMatch` (other %. "qualified_id") + forM_ [(alice, bob), (bob, alice)] $ \(self, other) -> do + getMLSOne2OneConversation self other `bindResponse` assertOthers other + getConversation self conv `bindResponse` assertOthers other + testGetMLSOne2OneUnconnected :: HasCallStack => Domain -> App () testGetMLSOne2OneUnconnected otherDomain = do [alice, bob] <- for [OwnDomain, otherDomain] $ \domain -> randomUser domain def @@ -54,6 +89,107 @@ testGetMLSOne2OneUnconnected otherDomain = do bindResponse (getMLSOne2OneConversation alice bob) $ \resp -> resp.status `shouldMatchInt` 403 +testMLSOne2OneBlocked :: HasCallStack => Domain -> App () +testMLSOne2OneBlocked otherDomain = do + [alice, bob] <- for [OwnDomain, otherDomain] $ flip randomUser def + void $ postConnection bob alice >>= getBody 201 + void $ putConnection alice bob "blocked" >>= getBody 200 + void $ getMLSOne2OneConversation alice bob >>= getJSON 403 + void $ getMLSOne2OneConversation bob alice >>= getJSON 403 + +-- | Alice and Bob are initially connected, but then Alice blocks Bob. +testMLSOne2OneBlockedAfterConnected :: HasCallStack => One2OneScenario -> App () +testMLSOne2OneBlockedAfterConnected scenario = do + alice <- randomUser OwnDomain def + let otherDomain = one2OneScenarioUserDomain scenario + convDomain = one2OneScenarioConvDomain scenario + bob <- createMLSOne2OnePartner otherDomain alice convDomain + conv <- getMLSOne2OneConversation alice bob >>= getJSON 200 + convId <- conv %. "qualified_id" + do + bobConv <- getMLSOne2OneConversation bob alice >>= getJSON 200 + convId `shouldMatch` (bobConv %. "qualified_id") + + [alice1, bob1] <- traverse (createMLSClient def) [alice, bob] + traverse_ uploadNewKeyPackage [bob1] + resetGroup alice1 conv + commit <- createAddCommit alice1 [bob] + withWebSocket bob1 $ \ws -> do + void $ sendAndConsumeCommitBundle commit + let isMessage n = nPayload n %. "type" `isEqual` "conversation.mls-welcome" + n <- awaitMatch isMessage ws + nPayload n %. "data" `shouldMatch` B8.unpack (Base64.encode (fold commit.welcome)) + + withWebSocket bob1 $ \ws -> do + -- Alice blocks Bob + void $ putConnection alice bob "blocked" >>= getBody 200 + -- There is also a proteus 1-to-1 conversation. Neither it nor the MLS + -- 1-to-1 conversation should get any events. + awaitAnyEvent 2 ws `shouldMatch` (Nothing :: Maybe Value) + -- Alice is not in the MLS 1-to-1 conversation given that she has blocked + -- Bob. + void $ getMLSOne2OneConversation alice bob >>= getJSON 403 + + mp <- createApplicationMessage bob1 "hello, world, again" + withWebSocket alice1 $ \ws -> do + void $ postMLSMessage mp.sender mp.message >>= getJSON 201 + awaitAnyEvent 2 ws `shouldMatch` (Nothing :: Maybe Value) + +-- | Alice and Bob are initially connected, then Alice blocks Bob, and finally +-- Alice unblocks Bob. +testMLSOne2OneUnblocked :: HasCallStack => One2OneScenario -> App () +testMLSOne2OneUnblocked scenario = do + alice <- randomUser OwnDomain def + let otherDomain = one2OneScenarioUserDomain scenario + convDomain = one2OneScenarioConvDomain scenario + bob <- createMLSOne2OnePartner otherDomain alice convDomain + conv <- getMLSOne2OneConversation alice bob >>= getJSON 200 + do + convId <- conv %. "qualified_id" + bobConv <- getMLSOne2OneConversation bob alice >>= getJSON 200 + convId `shouldMatch` (bobConv %. "qualified_id") + + [alice1, bob1] <- traverse (createMLSClient def) [alice, bob] + traverse_ uploadNewKeyPackage [bob1] + resetGroup alice1 conv + withWebSocket bob1 $ \ws -> do + commit <- createAddCommit alice1 [bob] + void $ sendAndConsumeCommitBundle commit + let isMessage n = nPayload n %. "type" `isEqual` "conversation.mls-welcome" + n <- awaitMatch isMessage ws + nPayload n %. "data" `shouldMatch` B8.unpack (Base64.encode (fold commit.welcome)) + + -- Alice blocks Bob + void $ putConnection alice bob "blocked" >>= getBody 200 + void $ getMLSOne2OneConversation alice bob >>= getJSON 403 + + -- Reset the group membership in the test setup as only 'bob1' is left in + -- reality, even though the test state believes 'alice1' is still part of the + -- conversation. + modifyMLSState $ \s -> s {members = Set.singleton bob1} + + -- Bob creates a new client and adds it to the one-to-one conversation just so + -- that the epoch advances. + bob2 <- createMLSClient def bob + traverse_ uploadNewKeyPackage [bob2] + void $ createAddCommit bob1 [bob] >>= sendAndConsumeCommitBundle + + -- Alice finally unblocks Bob + void $ putConnection alice bob "accepted" >>= getBody 200 + void $ getMLSOne2OneConversation alice bob >>= getJSON 200 + + -- Alice rejoins via an external commit + void $ createExternalCommit alice1 Nothing >>= sendAndConsumeCommitBundle + + -- Check that an application message can get to Bob + withWebSockets [bob1, bob2] $ \wss -> do + mp <- createApplicationMessage alice1 "hello, I've always been here" + void $ sendAndConsumeMessage mp + let isMessage n = nPayload n %. "type" `isEqual` "conversation.mls-message-add" + forM_ wss $ \ws -> do + n <- awaitMatch isMessage ws + nPayload n %. "data" `shouldMatch` B8.unpack (Base64.encode mp.message) + testGetMLSOne2OneSameTeam :: App () testGetMLSOne2OneSameTeam = do (alice, _, _) <- createTeam OwnDomain 1 @@ -68,15 +204,16 @@ data One2OneScenario | -- | One user is remote, conversation is remote One2OneScenarioRemoteConv -instance HasTests x => HasTests (One2OneScenario -> x) where - mkTests m n s f x = - mkTests m (n <> "[domain=own]") s f (x One2OneScenarioLocal) - <> mkTests m (n <> "[domain=other;conv=own]") s f (x One2OneScenarioLocalConv) - <> mkTests m (n <> "[domain=other;conv=other]") s f (x One2OneScenarioRemoteConv) +instance TestCases One2OneScenario where + testCases = + [ MkTestCase "[domain=own]" One2OneScenarioLocal, + MkTestCase "[domain=other;conv=own]" One2OneScenarioLocalConv, + MkTestCase "[domain=other;conv=other]" One2OneScenarioRemoteConv + ] -one2OneScenarioDomain :: One2OneScenario -> Domain -one2OneScenarioDomain One2OneScenarioLocal = OwnDomain -one2OneScenarioDomain _ = OtherDomain +one2OneScenarioUserDomain :: One2OneScenario -> Domain +one2OneScenarioUserDomain One2OneScenarioLocal = OwnDomain +one2OneScenarioUserDomain _ = OtherDomain one2OneScenarioConvDomain :: One2OneScenario -> Domain one2OneScenarioConvDomain One2OneScenarioLocal = OwnDomain @@ -86,7 +223,7 @@ one2OneScenarioConvDomain One2OneScenarioRemoteConv = OtherDomain testMLSOne2One :: HasCallStack => One2OneScenario -> App () testMLSOne2One scenario = do alice <- randomUser OwnDomain def - let otherDomain = one2OneScenarioDomain scenario + let otherDomain = one2OneScenarioUserDomain scenario convDomain = one2OneScenarioConvDomain scenario bob <- createMLSOne2OnePartner otherDomain alice convDomain [alice1, bob1] <- traverse (createMLSClient def) [alice, bob] diff --git a/integration/test/Test/MLS/SubConversation.hs b/integration/test/Test/MLS/SubConversation.hs index 42cdb0ec95f..d73095030da 100644 --- a/integration/test/Test/MLS/SubConversation.hs +++ b/integration/test/Test/MLS/SubConversation.hs @@ -102,15 +102,11 @@ testDeleteSubConversation otherDomain = do sub2' <- getSubConversation alice1 qcnv "conference2" >>= getJSON 200 sub2 `shouldNotMatch` sub2' -data LeaveSubConvVariant = AliceLeaves | BobLeaves +data Leaver = Alice | Bob + deriving stock (Generic) -instance HasTests x => HasTests (LeaveSubConvVariant -> x) where - mkTests m n s f x = - mkTests m (n <> "[leaver=alice]") s f (x AliceLeaves) - <> mkTests m (n <> "[leaver=bob]") s f (x BobLeaves) - -testLeaveSubConv :: HasCallStack => LeaveSubConvVariant -> App () -testLeaveSubConv variant = do +testLeaveSubConv :: HasCallStack => Leaver -> App () +testLeaveSubConv leaver = do [alice, bob, charlie] <- createAndConnectUsers [OwnDomain, OwnDomain, OtherDomain] clients@[alice1, bob1, bob2, charlie1] <- traverse (createMLSClient def) [alice, bob, bob, charlie] traverse_ uploadNewKeyPackage [bob1, bob2, charlie1] @@ -126,9 +122,9 @@ testLeaveSubConv variant = do void $ createExternalCommit charlie1 Nothing >>= sendAndConsumeCommitBundle -- a member leaves the subconversation - let (firstLeaver, idxFirstLeaver) = case variant of - BobLeaves -> (bob1, 0) - AliceLeaves -> (alice1, 1) + let (firstLeaver, idxFirstLeaver) = case leaver of + Bob -> (bob1, 0) + Alice -> (alice1, 1) let idxCharlie1 = 3 let others = filter (/= firstLeaver) clients diff --git a/integration/test/Test/Notifications.hs b/integration/test/Test/Notifications.hs index 741d9b10b0a..14078b5b56e 100644 --- a/integration/test/Test/Notifications.hs +++ b/integration/test/Test/Notifications.hs @@ -1,9 +1,11 @@ {-# OPTIONS -Wno-ambiguous-fields #-} module Test.Notifications where +import API.Brig import API.Common import API.Gundeck import API.GundeckInternal +import Notifications import SetupHelpers import Testlib.Prelude @@ -89,3 +91,20 @@ testInvalidNotification = do void $ getNotifications user def {since = Just notifId} >>= getJSON 404 + +-- | Check that client-add notifications use the V5 format: +-- @ +-- "capabilities": { "capabilities": [..] } +-- @ +-- +-- Migration plan: clients must be able to parse both old and new schema starting from V6. Once V5 is deprecated, the backend can start sending notifications in the new form. +testAddClientNotification :: HasCallStack => App () +testAddClientNotification = do + alice <- randomUser OwnDomain def + + e <- withWebSocket alice $ \ws -> do + void $ addClient alice def + n <- awaitMatch isUserClientAddNotif ws + nPayload n + + void $ e %. "client.capabilities.capabilities" & asList diff --git a/integration/test/Test/Search.hs b/integration/test/Test/Search.hs index ac66155b1b6..7d93b4ff015 100644 --- a/integration/test/Test/Search.hs +++ b/integration/test/Test/Search.hs @@ -76,7 +76,7 @@ data FedUserSearchTestCase = FedUserSearchTestCase testFederatedUserSearch :: HasCallStack => App () testFederatedUserSearch = do - let testCases = + let tcs = [ -- no search FedUserSearchTestCase "no_search" AllowAll AllowAll False False, FedUserSearchTestCase "no_search" TeamAllowed TeamAllowed False False, @@ -100,7 +100,7 @@ testFederatedUserSearch = do startDynamicBackends [def, def] $ \[d1, d2] -> do void $ BrigI.createFedConn d2 (BrigI.FedConn d1 "full_search" Nothing) void $ BrigI.createFedConn d1 (BrigI.FedConn d2 "full_search" Nothing) - forM_ testCases (federatedUserSearch d1 d2) + forM_ tcs (federatedUserSearch d1 d2) federatedUserSearch :: HasCallStack => String -> String -> FedUserSearchTestCase -> App () federatedUserSearch d1 d2 test = do diff --git a/integration/test/Test/Spar.hs b/integration/test/Test/Spar.hs new file mode 100644 index 00000000000..d1e14e85984 --- /dev/null +++ b/integration/test/Test/Spar.hs @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} + +module Test.Spar where + +import API.Spar +import Control.Concurrent (threadDelay) +import SetupHelpers +import Testlib.Prelude + +testSparUserCreationInvitationTimeout :: HasCallStack => App () +testSparUserCreationInvitationTimeout = do + (owner, _tid, _) <- createTeam OwnDomain 1 + tok <- createScimToken owner >>= \resp -> resp.json %. "token" >>= asString + scimUser <- randomScimUser + bindResponse (createScimUser OwnDomain tok scimUser) $ \res -> do + res.status `shouldMatchInt` 201 + + -- Trying to create the same user again right away should fail + bindResponse (createScimUser OwnDomain tok scimUser) $ \res -> do + res.status `shouldMatchInt` 409 + + -- However, if we wait until the invitation timeout has passed + -- (assuming it is configured to 10s locally and in CI)... + liftIO $ threadDelay (11_000_000) + + -- ...we should be able to create the user again + retryT $ bindResponse (createScimUser OwnDomain tok scimUser) $ \res -> do + res.status `shouldMatchInt` 201 diff --git a/integration/test/Test/User.hs b/integration/test/Test/User.hs index 903de5a0724..89af540d2eb 100644 --- a/integration/test/Test/User.hs +++ b/integration/test/Test/User.hs @@ -63,11 +63,11 @@ testUpdateHandle = do mem1id <- asString $ mem1 %. "id" let featureName = "mlsE2EId" - bindResponse (getTeamFeature owner featureName team) $ \resp -> do + bindResponse (getTeamFeature owner team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "disabled" setTeamFeatureStatus owner team featureName "enabled" - bindResponse (getTeamFeature owner featureName team) $ \resp -> do + bindResponse (getTeamFeature owner team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" @@ -120,17 +120,17 @@ testUpdateHandle = do -- | For now this only tests attempts to update one's own display name, email address, or -- language in E2EId-enabled teams (ie., everything except handle). More tests can be found -- under `/services/brig/test/integration` (and should be moved here). -testUpdateSelf :: HasCallStack => TestUpdateSelfMode -> App () -testUpdateSelf mode = do +testUpdateSelf :: HasCallStack => Tagged "mode" TestUpdateSelfMode -> App () +testUpdateSelf (MkTagged mode) = do -- create team with one member, without scim, but with `mlsE2EId` enabled. (owner, team, [mem1]) <- createTeam OwnDomain 2 let featureName = "mlsE2EId" - bindResponse (getTeamFeature owner featureName team) $ \resp -> do + bindResponse (getTeamFeature owner team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "disabled" setTeamFeatureStatus owner team featureName "enabled" - bindResponse (getTeamFeature owner featureName team) $ \resp -> do + bindResponse (getTeamFeature owner team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" @@ -162,11 +162,4 @@ data TestUpdateSelfMode = TestUpdateDisplayName | TestUpdateEmailAddress | TestUpdateLocale - deriving (Eq, Show, Bounded, Enum) - -instance HasTests x => HasTests (TestUpdateSelfMode -> x) where - mkTests m n s f x = - mconcat - [ mkTests m (n <> "[mode=" <> show mode <> "]") s f (x mode) - | mode <- [minBound ..] - ] + deriving (Eq, Show, Generic) diff --git a/integration/test/Test/Version.hs b/integration/test/Test/Version.hs index e6996107fc2..31295918468 100644 --- a/integration/test/Test/Version.hs +++ b/integration/test/Test/Version.hs @@ -8,13 +8,14 @@ import Testlib.Prelude newtype Versioned' = Versioned' Versioned -- | This instance is used to generate tests for some of the versions. (Not checking all of them for time efficiency reasons) -instance HasTests x => HasTests (Versioned' -> x) where - mkTests m n s f x = - mkTests m (n <> "[version=unversioned]") s f (x (Versioned' Unversioned)) - <> mkTests m (n <> "[version=versioned]") s f (x (Versioned' Versioned)) - <> mkTests m (n <> "[version=v1]") s f (x (Versioned' (ExplicitVersion 1))) - <> mkTests m (n <> "[version=v3]") s f (x (Versioned' (ExplicitVersion 3))) - <> mkTests m (n <> "[version=v6]") s f (x (Versioned' (ExplicitVersion 6))) +instance TestCases Versioned' where + testCases = + [ MkTestCase "[version=unversioned]" (Versioned' Unversioned), + MkTestCase "[version=versioned]" (Versioned' Versioned), + MkTestCase "[version=v1]" (Versioned' (ExplicitVersion 1)), + MkTestCase "[version=v3]" (Versioned' (ExplicitVersion 3)), + MkTestCase "[version=v6]" (Versioned' (ExplicitVersion 6)) + ] testVersion :: Versioned' -> App () testVersion (Versioned' v) = withModifiedBackend diff --git a/integration/test/Testlib/App.hs b/integration/test/Testlib/App.hs index e0978f4e382..904386a791e 100644 --- a/integration/test/Testlib/App.hs +++ b/integration/test/Testlib/App.hs @@ -1,12 +1,17 @@ module Testlib.App where +import Control.Applicative ((<|>)) import Control.Monad.Reader +import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT) import qualified Control.Retry as Retry import Data.Aeson hiding ((.=)) +import Data.Bool (bool) import Data.IORef +import Data.Maybe (isJust) import qualified Data.Text as T import qualified Data.Yaml as Yaml import GHC.Exception +import GHC.Generics (Generic) import GHC.Stack (HasCallStack) import System.FilePath import Testlib.JSON @@ -52,11 +57,17 @@ readServiceConfig' srvName = do Right value -> pure value data Domain = OwnDomain | OtherDomain + deriving stock (Eq, Show, Generic) instance MakesValue Domain where make OwnDomain = asks (String . T.pack . (.domain1)) make OtherDomain = asks (String . T.pack . (.domain2)) +data FedDomain = FedV0Domain + +instance MakesValue FedDomain where + make FedV0Domain = asks (String . T.pack . (.federationV0Domain)) + -- | Run an action, `recoverAll`ing with exponential backoff (min step 8ms, total timeout -- ~15s). Search this package for examples how to use it. -- @@ -65,3 +76,27 @@ instance MakesValue Domain where -- backwards-compatible way so everybody can benefit. retryT :: App a -> App a retryT action = Retry.recoverAll (Retry.exponentialBackoff 8000 <> Retry.limitRetries 10) (const action) + +-- | make Bool lazy +liftBool :: Functor f => f Bool -> BoolT f +liftBool = MaybeT . fmap (bool Nothing (Just ())) + +-- | make Bool strict +unliftBool :: Functor f => BoolT f -> f Bool +unliftBool = fmap isJust . runMaybeT + +-- | lazy (&&) +(&&~) :: App Bool -> App Bool -> App Bool +b1 &&~ b2 = unliftBool $ liftBool b1 *> liftBool b2 + +infixr 3 &&~ + +-- | lazy (||) +(||~) :: App Bool -> App Bool -> App Bool +b1 ||~ b2 = unliftBool $ liftBool b1 <|> liftBool b2 + +infixr 2 ||~ + +-- | lazy (&&): (*>) +-- lazy (||): (<|>) +type BoolT f = MaybeT f () diff --git a/integration/test/Testlib/Assertions.hs b/integration/test/Testlib/Assertions.hs index 390615730c9..ac86c962147 100644 --- a/integration/test/Testlib/Assertions.hs +++ b/integration/test/Testlib/Assertions.hs @@ -2,11 +2,17 @@ module Testlib.Assertions where +import Control.Applicative ((<|>)) import Control.Exception as E +import Control.Lens ((^?)) +import qualified Control.Lens.Plated as LP import Control.Monad.Reader import Data.Aeson (Value) import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Diff as AD import qualified Data.Aeson.Encode.Pretty as Aeson +import qualified Data.Aeson.KeyMap as Aeson +import Data.Aeson.Lens (_Array, _Object) import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Lazy as BS import Data.Char @@ -14,6 +20,7 @@ import Data.Foldable import Data.Hex import Data.List 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.Lazy as TL @@ -52,13 +59,94 @@ shouldMatch :: -- | The expected value b -> App () -a `shouldMatch` b = do +shouldMatch = shouldMatchWithMsg Nothing + +shouldMatchWithMsg :: + (MakesValue a, MakesValue b, HasCallStack) => + -- | Message to be added to failure report + Maybe String -> + -- | The actual value + a -> + -- | The expected value + b -> + App () +shouldMatchWithMsg msg a b = do xa <- make a xb <- make b - unless (xa == xb) $ do + unless (xa == xb) do pa <- prettyJSON xa pb <- prettyJSON xb - assertFailure $ "Actual:\n" <> pa <> "\nExpected:\n" <> pb + diff <- -- show diff, but only in the interesting cases. + if (isJust (xa ^? _Object) && isJust (xb ^? _Object)) + || (isJust (xa ^? _Array) && isJust (xb ^? _Array)) + then ("\nDiff:\n" <>) <$> prettyJSON (AD.diff xa xb) + else pure "" + assertFailure $ (maybe "" (<> "\n") msg) <> "Actual:\n" <> pa <> "\nExpected:\n" <> pb <> diff + +-- | apply some canonicalization transformations that *usually* do not change semantics before +-- comparing. +shouldMatchLeniently :: (MakesValue a, MakesValue b, HasCallStack) => a -> b -> App () +shouldMatchLeniently = shouldMatchWithRules [EmptyArrayIsNull, RemoveNullFieldsFromObjects] (const $ pure Nothing) + +-- | apply *all* canonicalization transformations before comparing. some of these may not be +-- valid on your input, see 'LenientMatchRule' for details. +shouldMatchSloppily :: (MakesValue a, MakesValue b, HasCallStack) => a -> b -> App () +shouldMatchSloppily = shouldMatchWithRules [minBound ..] (const $ pure Nothing) + +-- | apply *all* canonicalization transformations before comparing. some of these may not be +-- valid on your input, see 'LenientMatchRule' for details. +shouldMatchALittle :: (MakesValue a, MakesValue b, HasCallStack) => (Aeson.Value -> App (Maybe Aeson.Value)) -> a -> b -> App () +shouldMatchALittle = shouldMatchWithRules [minBound ..] + +data LenientMatchRule + = EmptyArrayIsNull + | ArraysAreSets + | RemoveNullFieldsFromObjects + deriving (Eq, Ord, Show, Bounded, Enum) + +shouldMatchWithRules :: + (MakesValue a, MakesValue b, HasCallStack) => + [LenientMatchRule] -> + (Aeson.Value -> App (Maybe Aeson.Value)) -> + a -> + b -> + App () +shouldMatchWithRules rules customRules a b = do + xa <- make a + xb <- make b + simplify xa `shouldMatch` simplify xb + where + simplify :: Aeson.Value -> App Aeson.Value + simplify = LP.rewriteM $ (\v -> foldM (tryApplyRule v) Nothing compiledRules) + + tryApplyRule :: + Aeson.Value -> + Maybe Aeson.Value -> + (Aeson.Value -> App (Maybe Aeson.Value)) -> + App (Maybe Aeson.Value) + tryApplyRule v bresult arule = (bresult <|>) <$> arule v + + compiledRules :: [Aeson.Value -> App (Maybe Aeson.Value)] + compiledRules = customRules : ((\r v -> pure $ runRule r v) <$> rules) + + runRule :: LenientMatchRule -> Aeson.Value -> Maybe Aeson.Value + runRule EmptyArrayIsNull = \case + Aeson.Array arr + | arr == mempty -> + Just Aeson.Null + _ -> Nothing + runRule ArraysAreSets = \case + Aeson.Array (toList -> arr) -> + let arr' = sort arr + in if arr == arr' then Nothing else Just $ Aeson.toJSON arr' + _ -> Nothing + runRule RemoveNullFieldsFromObjects = \case + Aeson.Object (Aeson.toList -> obj) + | any ((== Aeson.Null) . snd) obj -> + let rmNulls (_, Aeson.Null) = Nothing + rmNulls (k, v) = Just (k, v) + in Just . Aeson.Object . Aeson.fromList $ mapMaybe rmNulls obj + _ -> Nothing shouldMatchBase64 :: (MakesValue a, MakesValue b, HasCallStack) => diff --git a/integration/test/Testlib/Cannon.hs b/integration/test/Testlib/Cannon.hs index 2eb1be2be7f..8ab338df38a 100644 --- a/integration/test/Testlib/Cannon.hs +++ b/integration/test/Testlib/Cannon.hs @@ -28,6 +28,7 @@ module Testlib.Cannon awaitNMatchesResult, awaitNMatches, awaitMatch, + awaitAnyEvent, awaitAtLeastNMatchesResult, awaitAtLeastNMatches, awaitNToMMatchesResult, @@ -282,7 +283,7 @@ printAwaitResult = prettyAwaitResult >=> liftIO . putStrLn printAwaitAtLeastResult :: AwaitAtLeastResult -> App () printAwaitAtLeastResult = prettyAwaitAtLeastResult >=> liftIO . putStrLn -awaitAnyEvent :: MonadIO m => Int -> WebSocket -> m (Maybe Value) +awaitAnyEvent :: Int -> WebSocket -> App (Maybe Value) awaitAnyEvent tSecs = liftIO . timeout (tSecs * 1000 * 1000) . atomically . readTChan . wsChan -- | 'await' an expected number of notification events on the websocket that diff --git a/integration/test/Testlib/Env.hs b/integration/test/Testlib/Env.hs index 39f274b1f94..336383deb72 100644 --- a/integration/test/Testlib/Env.hs +++ b/integration/test/Testlib/Env.hs @@ -4,6 +4,7 @@ module Testlib.Env where import Control.Monad.Codensity import Control.Monad.IO.Class +import Control.Monad.Reader import Data.Default import Data.Function ((&)) import Data.Functor @@ -86,23 +87,26 @@ mkGlobalEnv cfgFile = do let sm = Map.fromList $ [ (intConfig.backendOne.originDomain, intConfig.backendOne.beServiceMap), - (intConfig.backendTwo.originDomain, intConfig.backendTwo.beServiceMap) + (intConfig.backendTwo.originDomain, intConfig.backendTwo.beServiceMap), + (intConfig.federationV0.originDomain, intConfig.federationV0.beServiceMap) ] <> [(berDomain resource, resourceServiceMap resource) | resource <- resources] tempDir <- Codensity $ withSystemTempDirectory "test" timeOutSeconds <- liftIO $ - fromMaybe 10 . (readMaybe @Int =<<) <$> (lookupEnv "TEST_TIMEOUT_SECONDS") + fromMaybe 10 . (readMaybe @Int =<<) <$> lookupEnv "TEST_TIMEOUT_SECONDS" pure GlobalEnv { gServiceMap = sm, gDomain1 = intConfig.backendOne.originDomain, gDomain2 = intConfig.backendTwo.originDomain, + gIntegrationTestHostName = intConfig.integrationTestHostName, + gFederationV0Domain = intConfig.federationV0.originDomain, gDynamicDomains = (.domain) <$> Map.elems intConfig.dynamicBackends, gDefaultAPIVersion = 6, gManager = manager, gServicesCwdBase = devEnvProjectRoot <&> ( "services"), - gRemovalKeyPath = error "Uninitialised removal key path", + gRemovalKeyPaths = mempty, gBackendResourcePool = resourcePool, gRabbitMQConfig = intConfig.rabbitmq, gTempDir = tempDir, @@ -135,11 +139,13 @@ mkEnv ge = do { serviceMap = gServiceMap ge, domain1 = gDomain1 ge, domain2 = gDomain2 ge, + integrationTestHostName = gIntegrationTestHostName ge, + federationV0Domain = gFederationV0Domain ge, dynamicDomains = gDynamicDomains ge, defaultAPIVersion = gDefaultAPIVersion ge, manager = gManager ge, servicesCwdBase = gServicesCwdBase ge, - removalKeyPath = gRemovalKeyPath ge, + removalKeyPaths = gRemovalKeyPaths ge, prekeys = pks, lastPrekeys = lpks, mls = mls, @@ -160,11 +166,9 @@ create ioRef = Nothing -> error "No resources available" Just (r, s') -> (s', r) -emptyClientGroupState :: ClientGroupState -emptyClientGroupState = ClientGroupState Nothing Nothing - allCiphersuites :: [Ciphersuite] -allCiphersuites = map Ciphersuite ["0x0001", "0xf031"] +-- FUTUREWORK: add 0x0005 to this list once openmls supports it +allCiphersuites = map Ciphersuite ["0x0001", "0xf031", "0x0002", "0x0007"] mkMLSState :: Codensity IO MLSState mkMLSState = Codensity $ \k -> @@ -181,3 +185,6 @@ mkMLSState = Codensity $ \k -> ciphersuite = def, protocol = MLSProtocolMLS } + +withAPIVersion :: Int -> App a -> App a +withAPIVersion v = local $ \e -> e {defaultAPIVersion = v} diff --git a/integration/test/Testlib/HTTP.hs b/integration/test/Testlib/HTTP.hs index 721700df3e2..e21b6e3c588 100644 --- a/integration/test/Testlib/HTTP.hs +++ b/integration/test/Testlib/HTTP.hs @@ -16,6 +16,7 @@ import Data.String import Data.String.Conversions (cs) import qualified Data.Text as T import qualified Data.Text.Encoding as T +import GHC.Generics import GHC.Stack import qualified Network.HTTP.Client as HTTP import Network.HTTP.Types (hLocation) @@ -85,23 +86,36 @@ contentTypeMixed = addHeader "Content-Type" "multipart/mixed" bindResponse :: HasCallStack => App Response -> (Response -> App a) -> App a bindResponse m k = m >>= \r -> withResponse r k +infixl 1 `bindResponse` + withResponse :: HasCallStack => Response -> (Response -> App a) -> App a withResponse r k = onFailureAddResponse r (k r) -- | Check response status code, then return body. getBody :: HasCallStack => Int -> Response -> App ByteString -getBody status resp = withResponse resp $ \r -> do - r.status `shouldMatch` status - pure r.body +getBody status = flip withResponse \resp -> do + resp.status `shouldMatch` status + pure resp.body -- | Check response status code, then return JSON body. getJSON :: HasCallStack => Int -> Response -> App Aeson.Value -getJSON status resp = withResponse resp $ \r -> do - r.status `shouldMatch` status - r.json +getJSON status = flip withResponse \resp -> do + resp.status `shouldMatch` status + resp.json +-- | assert a response code in the 2** range assertSuccess :: HasCallStack => Response -> App () -assertSuccess resp = withResponse resp $ \r -> r.status `shouldMatchRange` (200, 299) +assertSuccess = flip withResponse \resp -> resp.status `shouldMatchRange` (200, 299) + +-- | assert a response status code +assertStatus :: HasCallStack => Int -> Response -> App () +assertStatus status = flip withResponse \resp -> resp.status `shouldMatchInt` status + +-- | assert a failure with some failure code and label +assertLabel :: HasCallStack => Int -> String -> Response -> App () +assertLabel status label resp = do + j <- getJSON status resp + j %. "label" `shouldMatch` label onFailureAddResponse :: HasCallStack => Response -> App a -> App a onFailureAddResponse r m = App $ do @@ -110,6 +124,7 @@ onFailureAddResponse r m = App $ do E.throw (AssertionFailure stack (Just r) msg) data Versioned = Versioned | Unversioned | ExplicitVersion Int + deriving stock (Generic) -- | If you don't know what domain is for or what you should put in there, try `rawBaseRequest -- OwnDomain ...`. diff --git a/integration/test/Testlib/JSON.hs b/integration/test/Testlib/JSON.hs index 59aa2400ff4..5faa2b97f05 100644 --- a/integration/test/Testlib/JSON.hs +++ b/integration/test/Testlib/JSON.hs @@ -189,6 +189,15 @@ renameField old new obj = o :: Value <- maybe mzero pure =<< lift (lookupField obj old) lift (removeField old obj >>= setField new o) +-- | like 'lookupField' but wrapped in 'MaybeT' for convenience +lookupFieldM :: + (HasCallStack, MakesValue a) => + a -> + -- | A plain key, e.g. "id", or a nested key "user.profile.id" + String -> + MaybeT App Value +lookupFieldM = fmap MaybeT . lookupField + -- | Look up (nested) field of a JSON object -- -- If the field key has no dots then returns Nothing if the key is missing from the @@ -227,8 +236,9 @@ lookupField val selector = do go k [] v = get v k go k (k2 : ks) v = get v k >>= assertField v k >>= go k2 ks --- Update nested fields +-- | Update nested fields -- E.g. ob & "foo.bar.baz" %.= ("quux" :: String) +-- The selector path will be created if non-existing. setField :: forall a b. (HasCallStack, MakesValue a, ToJSON b) => @@ -244,7 +254,8 @@ setField selector v x = do member :: (HasCallStack, MakesValue a) => String -> a -> App Bool member k x = KM.member (KM.fromString k) <$> (make x >>= asObject) --- Update nested fields, using the old value with a stateful action +-- | Update nested fields, using the old value with a stateful action +-- The selector path will be created if non-existing. modifyField :: (HasCallStack, MakesValue a, ToJSON b) => String -> (Maybe Value -> App b) -> a -> App Value modifyField selector up x = do v <- make x @@ -259,7 +270,7 @@ modifyField selector up x = do newValue <- toJSON <$> up (KM.lookup k' ob) pure $ Object $ KM.insert k' newValue ob go k (k2 : ks) v = do - val <- v %. k + val <- fromMaybe (Object $ KM.empty) <$> lookupField v k newValue <- go k2 ks val ob <- asObject v pure $ Object $ KM.insert (KM.fromString k) newValue ob @@ -292,6 +303,10 @@ assertFailureWithJSON v msg = do printJSON :: MakesValue a => a -> App () printJSON = prettyJSON >=> liftIO . putStrLn +-- | useful for debugging, same as 'printJSON' but returns input JSON +traceJSON :: MakesValue a => a -> App a +traceJSON a = printJSON a $> a + prettyJSON :: MakesValue a => a -> App String prettyJSON x = make x <&> LC8.unpack . Aeson.encodePretty @@ -326,9 +341,9 @@ objQid ob = do Just v -> pure v where select x = runMaybeT $ do - vdom <- MaybeT $ lookupField x "domain" + vdom <- lookupFieldM x "domain" dom <- MaybeT $ asStringM vdom - vid <- MaybeT $ lookupField x "id" + vid <- lookupFieldM x "id" id_ <- MaybeT $ asStringM vid pure (dom, id_) @@ -412,3 +427,7 @@ instance MakesValue ClientIdentity where "id" .= cid.user, "client_id" .= cid.client ] + +instance MakesValue CredentialType where + make BasicCredentialType = make "basic" + make X509CredentialType = make "x509" diff --git a/integration/test/Testlib/MockIntegrationService.hs b/integration/test/Testlib/MockIntegrationService.hs index 4d7c64a5150..7e91be4b7b5 100644 --- a/integration/test/Testlib/MockIntegrationService.hs +++ b/integration/test/Testlib/MockIntegrationService.hs @@ -1,4 +1,4 @@ -module Testlib.MockIntegrationService (withMockServer, lhMockApp, mkLegalHoldSettings) where +module Testlib.MockIntegrationService (withMockServer, lhMockAppWithPrekeys, lhMockApp, mkLegalHoldSettings, CreateMock (..)) where import Control.Monad.Catch import Control.Monad.Reader @@ -13,8 +13,8 @@ import Network.Wai as Wai import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Handler.Warp.Internal as Warp import qualified Network.Wai.Handler.WarpTLS as Warp -import Testlib.Prekeys -import Testlib.Prelude +import Testlib.Prelude hiding (IntegrationConfig (integrationTestHostName)) +import UnliftIO (MonadUnliftIO (withRunInIO)) import UnliftIO.Async import UnliftIO.Chan import UnliftIO.MVar @@ -86,51 +86,76 @@ mockServerCert = \T45GXxRd18neXtuYa/OoAw9UQFDN5XfXN0g=\n\ \-----END CERTIFICATE-----" -botHost :: String -botHost = "localhost" - withFreePortAnyAddr :: (MonadMask m, MonadIO m) => ((Warp.Port, Socket) -> m a) -> m a withFreePortAnyAddr = bracket openFreePortAnyAddr (liftIO . Socket.close . snd) openFreePortAnyAddr :: MonadIO m => m (Warp.Port, Socket) -openFreePortAnyAddr = liftIO $ bindRandomPortTCP (fromString "*") +openFreePortAnyAddr = liftIO $ bindRandomPortTCP (fromString "*6") + +type LiftedApplication = Request -> (Wai.Response -> App ResponseReceived) -> App ResponseReceived withMockServer :: - HasCallStack => + (HasCallStack) => -- | the mock server - (Chan e -> Application) -> + (Chan e -> LiftedApplication) -> -- | the test - (Warp.Port -> Chan e -> App a) -> + ((String, Warp.Port) -> Chan e -> App a) -> App a -withMockServer mkApp go = withFreePortAnyAddr $ \(sPort, sock) -> do +withMockServer mkApp go = withFreePortAnyAddr \(sPort, sock) -> do serverStarted <- newEmptyMVar + host <- asks integrationTestHostName let tlss = Warp.tlsSettingsMemory (cs mockServerCert) (cs mockServerPrivKey) let defs = Warp.defaultSettings {Warp.settingsPort = sPort, Warp.settingsBeforeMainLoop = putMVar serverStarted ()} buf <- newChan - srv <- async . liftIO . Warp.runTLSSocket tlss defs sock $ mkApp buf + srv <- async $ withRunInIO \inIO -> do + Warp.runTLSSocket tlss defs sock \req respond -> do + inIO $ mkApp buf req (liftIO . respond) srvMVar <- UnliftIO.Timeout.timeout 5_000_000 (takeMVar serverStarted) case srvMVar of - Just () -> go sPort buf `finally` cancel srv + Just () -> go (host, sPort) buf `finally` cancel srv Nothing -> error . show =<< poll srv +lhMockApp :: Chan (Wai.Request, LBS.ByteString) -> LiftedApplication +lhMockApp = lhMockAppWithPrekeys def + +data CreateMock f = MkCreateMock + { -- | how to obtain the next last prekey of a mock app + nextLastPrey :: f Value, + -- | how to obtain some prekeys of a mock app + somePrekeys :: f [Value] + } + +instance (App ~ f) => Default (CreateMock f) where + def = + MkCreateMock + { nextLastPrey = getLastPrekey, + somePrekeys = replicateM 3 getPrekey + } + -- | LegalHold service. Just fake the API, do not maintain any internal state. -lhMockApp :: Chan (Wai.Request, LBS.ByteString) -> Wai.Application -lhMockApp ch req cont = do +lhMockAppWithPrekeys :: + CreateMock App -> Chan (Wai.Request, LBS.ByteString) -> LiftedApplication +lhMockAppWithPrekeys mks ch req cont = withRunInIO \inIO -> do reqBody <- Wai.strictRequestBody req writeChan ch (req, reqBody) - case (cs <$> pathInfo req, cs $ requestMethod req, cs @_ @String <$> getRequestHeader "Authorization" req) of - (["legalhold", "status"], "GET", _) -> cont respondOk - (_, _, Nothing) -> cont missingAuth - (["legalhold", "initiate"], "POST", Just _) -> cont initiateResp - (["legalhold", "confirm"], "POST", Just _) -> cont respondOk - (["legalhold", "remove"], "POST", Just _) -> cont respondOk - _ -> cont respondBad + inIO do + (nextLastPrekey, threePrekeys) <- + (,) + <$> mks.nextLastPrey + <*> mks.somePrekeys + case (cs <$> pathInfo req, cs $ requestMethod req, cs @_ @String <$> getRequestHeader "Authorization" req) of + (["legalhold", "status"], "GET", _) -> cont respondOk + (_, _, Nothing) -> cont missingAuth + (["legalhold", "initiate"], "POST", Just _) -> cont (initiateResp nextLastPrekey threePrekeys) + (["legalhold", "confirm"], "POST", Just _) -> cont respondOk + (["legalhold", "remove"], "POST", Just _) -> cont respondOk + _ -> cont respondBad where - initiateResp :: Wai.Response - initiateResp = + initiateResp :: Value -> [Value] -> Wai.Response + initiateResp npk pks = responseLBS status200 [(hContentType, cs "application/json")] . encode . Data.Aeson.object $ - [ "prekeys" .= drop 3 somePrekeysRendered, - "last_prekey" .= (someLastPrekeysRendered !! 2) + [ "prekeys" .= pks, + "last_prekey" .= npk ] respondOk :: Wai.Response @@ -145,8 +170,8 @@ lhMockApp ch req cont = do getRequestHeader :: String -> Wai.Request -> Maybe ByteString getRequestHeader name = lookup (fromString name) . requestHeaders -mkLegalHoldSettings :: Warp.Port -> Value -mkLegalHoldSettings lhPort = +mkLegalHoldSettings :: (String, Warp.Port) -> Value +mkLegalHoldSettings (botHost, lhPort) = object [ "base_url" .= ("https://" <> botHost <> ":" <> show lhPort <> "/legalhold"), "public_key" .= mockServerPubKey, diff --git a/integration/test/Testlib/ModService.hs b/integration/test/Testlib/ModService.hs index 98084b097b9..f4390d7286f 100644 --- a/integration/test/Testlib/ModService.hs +++ b/integration/test/Testlib/ModService.hs @@ -117,7 +117,7 @@ traverseConcurrentlyCodensity f args = do pure result -startDynamicBackends :: HasCallStack => [ServiceOverrides] -> (HasCallStack => [String] -> App a) -> App a +startDynamicBackends :: [ServiceOverrides] -> ([String] -> App a) -> App a startDynamicBackends beOverrides k = runCodensity do @@ -128,7 +128,7 @@ startDynamicBackends beOverrides k = pure $ map (.berDomain) resources k -startDynamicBackend :: HasCallStack => BackendResource -> ServiceOverrides -> Codensity App () +startDynamicBackend :: BackendResource -> ServiceOverrides -> Codensity App () startDynamicBackend resource beOverrides = do let overrides = mconcat diff --git a/integration/test/Testlib/PTest.hs b/integration/test/Testlib/PTest.hs index 56d6d7be10c..037cb276260 100644 --- a/integration/test/Testlib/PTest.hs +++ b/integration/test/Testlib/PTest.hs @@ -1,8 +1,12 @@ module Testlib.PTest where +import Data.Bifunctor (bimap) +import Data.Char (toLower) +import Data.Functor ((<&>)) +import Data.Kind import Data.Proxy +import GHC.Generics import GHC.TypeLits -import Testlib.App import Testlib.Env import Testlib.Types import Prelude @@ -15,38 +19,102 @@ class HasTests x where instance HasTests (App ()) where mkTests m n s f x = [(m, n, s, f, x)] -instance HasTests x => HasTests (Domain -> x) where +instance (HasTests x, TestCases a) => HasTests (a -> x) where mkTests m n s f x = - mkTests m (n <> "[domain=own]") s f (x OwnDomain) - <> mkTests m (n <> "[domain=other]") s f (x OtherDomain) + flip foldMap (testCases @a) \tc -> + mkTests m (n <> tc.testCaseName) s f (x tc.testCase) -instance HasTests x => HasTests (Ciphersuite -> x) where - mkTests m n s f x = - mconcat - [ mkTests m (n <> "[suite=" <> suite.code <> "]") s f (x suite) - | suite <- allCiphersuites - ] +data TestCase a = MkTestCase {testCaseName :: String, testCase :: a} + deriving stock (Eq, Ord, Show, Generic) --- | this is to resolve overlapping instances issues. -newtype WithBoundedEnumArg arg x = WithBoundedEnumArg (arg -> x) +-- | enumerate all members of a bounded enum type +-- +-- >>> testCases @Bool +-- [MkTestCase {testCaseName = "[bool=false]", testCase = False},MkTestCase {testCaseName = "[bool=true]", testCase = True}] +-- >>> testCases @Domain +-- [MkTestCase {testCaseName = "[domain=owndomain]", testCase = OwnDomain},MkTestCase {testCaseName = "[domain=otherdomain]", testCase = OtherDomain}] +-- >>> testCases @Ciphersuite +-- [MkTestCase {testCaseName = "[suite=0x0001]", testCase = Ciphersuite {code = "0x0001"}},MkTestCase {testCaseName = "[suite=0xf031]", testCase = Ciphersuite {code = "0xf031"}}] +-- >>> testCases @(Tagged "foo" Bool) +-- [MkTestCase {testCaseName = "[foo=false]", testCase = MkTagged {unTagged = False}},MkTestCase {testCaseName = "[foo=true]", testCase = MkTagged {unTagged = True}}] +class TestCases a where + testCases :: [TestCase a] -instance (HasTests x, Enum arg, Bounded arg, Show arg) => HasTests (WithBoundedEnumArg arg x) where - mkTests m n s f (WithBoundedEnumArg x) = - mconcat - [ mkTests m (n <> "[" <> show arg <> "]") s f (x arg) - | arg <- [minBound ..] - ] +type Tagged :: Symbol -> Type -> Type +newtype Tagged s a = MkTagged {unTagged :: a} + deriving stock (Eq, Ord, Show, Generic) --- | bool with a tag to prevent boolean blindness in test output. -newtype TaggedBool (tag :: Symbol) = TaggedBool {untag :: Bool} - deriving newtype (Eq, Ord, Bounded, Enum) +type TaggedBool s = Tagged s Bool -instance KnownSymbol tag => Show (TaggedBool tag) where - show (TaggedBool b) = show (symbolVal (Proxy @tag)) <> "=" <> show b +pattern TaggedBool :: Bool -> Tagged s Bool +pattern TaggedBool a = MkTagged a -instance (KnownSymbol tag, HasTests x) => HasTests (TaggedBool tag -> x) where - mkTests m n s f x = - mconcat - [ mkTests m (n <> "[" <> show arg <> "]") s f (x arg) - | arg <- [minBound ..] - ] +{-# COMPLETE TaggedBool #-} + +-- | only works for outer-most use of `Tagged` (not: `Maybe (Tagged "bla" Bool)`) +-- +-- >>> testCases @(Tagged "bla" Bool) +instance (GEnum (Rep a), KnownSymbol s, Generic a) => TestCases (Tagged s a) where + testCases = + uni @(Rep a) <&> \case + -- replace the toplevel + (Left _ : ls, tc) -> + MkTestCase + { testCaseName = foldr mkName "" (Left (symbolVal @s Proxy) : ls), + testCase = MkTagged $ to tc + } + _ -> error "tagged test cases: impossible" + +instance TestCases Ciphersuite where + testCases = do + suite <- allCiphersuites + pure $ + MkTestCase + { testCaseName = mkName (Left "suite") suite.code, + testCase = suite + } + +instance TestCases CredentialType where + testCases = + [ MkTestCase "[ctype=basic]" BasicCredentialType, + MkTestCase "[ctype=x509]" X509CredentialType + ] + +-- | a default instance, normally we don't do such things but this is more convenient in +-- the test suite as you don't have to derive anything +instance {-# OVERLAPPABLE #-} (Generic a, GEnum (Rep a)) => TestCases a where + testCases = + uni @(Rep a) <&> \(tcn, tc) -> + MkTestCase + { testCaseName = foldr mkName "" tcn, + testCase = to tc + } + +{-# INLINE [1] mkName #-} +mkName :: Either String String -> String -> String +mkName (Left a) = \acc -> mconcat ["[", toLower <$> a, "=" <> acc <> "]"] +mkName (Right (fmap toLower -> a)) = \case + [] -> a + acc@('[' : _) -> a <> acc + acc -> a <> "." <> acc + +class GEnum f where + uni :: [([Either String String], f x)] + +instance (GEnum k, KnownSymbol n) => GEnum (D1 (MetaData n m p b) k) where + uni = bimap (Left (symbolVal @n Proxy) :) M1 <$> uni @k + +instance (GEnum k) => GEnum (S1 md k) where + uni = fmap M1 <$> uni @k + +instance (GEnum k, KnownSymbol n) => GEnum (C1 (MetaCons n p b) k) where + uni = bimap (Right (symbolVal @n Proxy) :) M1 <$> uni @k + +instance (GEnum k1, GEnum k2) => GEnum (k1 :+: k2) where + uni = (fmap L1 <$> uni @k1) <> (fmap R1 <$> uni @k2) + +instance GEnum U1 where + uni = [([Right ""], U1)] + +instance (GEnum (Rep k), Generic k) => GEnum (K1 r k) where + uni = fmap (K1 . to) <$> uni @(Rep k) diff --git a/integration/test/Testlib/Run.hs b/integration/test/Testlib/Run.hs index de574293eec..431530c91e0 100644 --- a/integration/test/Testlib/Run.hs +++ b/integration/test/Testlib/Run.hs @@ -8,12 +8,15 @@ import Control.Monad.IO.Class import Control.Monad.Reader import Crypto.Error import qualified Crypto.PubKey.Ed25519 as Ed25519 +import Data.Aeson (Value) import Data.ByteArray (convert) +import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Foldable import Data.Function import Data.Functor import Data.List +import qualified Data.Map as Map import Data.PEM import Data.Time.Clock import Data.Traversable (for) @@ -39,7 +42,12 @@ runTest ge action = lowerCodensity $ do env <- mkEnv ge liftIO $ (Right <$> runAppWithEnv env action) - `E.catches` [ E.Handler -- AssertionFailure + `E.catches` [ E.Handler $ \(e :: SomeAsyncException) -> do + -- AsyncExceptions need rethrowing + -- to prevent the last handler from handling async exceptions. + -- This ensures things like UserInterrupt are properly handled. + E.throw e, + E.Handler -- AssertionFailure (fmap Left . printFailureDetails), E.Handler (fmap Left . printExceptionDetails) @@ -106,30 +114,63 @@ main = do createGlobalEnv :: FilePath -> Codensity IO GlobalEnv createGlobalEnv cfg = do genv0 <- mkGlobalEnv cfg + -- Run codensity locally here, because we only need the environment to get at + -- Galley's configuration. Accessing the environment has the side effect of + -- creating a temporary mls directory, which we don't need here. - pubkey <- liftIO . lowerCodensity $ do + let removalKeysDir = gTempDir genv0 "removal-keys" + keys <- liftIO . lowerCodensity $ do env <- mkEnv genv0 + liftIO $ createDirectoryIfMissing True removalKeysDir liftIO . runAppWithEnv env $ do config <- readServiceConfig Galley - relPath <- config %. "settings.mlsPrivateKeyPaths.removal.ed25519" & asString - path <- asks \env' -> case env'.servicesCwdBase of - Nothing -> relPath - Just dir -> dir "galley" relPath - bs <- liftIO $ B.readFile path - pems <- case pemParseBS bs of - Left err -> assertFailure $ "Could not parse removal key PEM: " <> err - Right x -> pure x - asn1 <- pemContent <$> assertOne pems - -- quick and dirty ASN.1 decoding: assume the key is of the correct - -- format, and simply skip the 16 byte header - let bytes = B.drop 16 asn1 - priv <- liftIO . throwCryptoErrorIO $ Ed25519.secretKey bytes - pure (convert (Ed25519.toPublic priv)) + for + [ ("ed25519", loadEd25519Key), + ("ecdsa_secp256r1_sha256", loadEcKey "ecdsa_secp256r1_sha256" 73), + ("ecdsa_secp384r1_sha384", loadEcKey "ecdsa_secp384r1_sha384" 88), + ("ecdsa_secp521r1_sha512", loadEcKey "ecdsa_secp521r1_sha512" 108) + ] + $ \(sigScheme, load) -> do + key <- load config + let path = removalKeysDir (sigScheme <> ".key") + liftIO $ B.writeFile path key + pure (sigScheme, path) -- save removal key to a temporary file - let removalPath = gTempDir genv0 "removal.key" - liftIO $ B.writeFile removalPath pubkey - pure genv0 {gRemovalKeyPath = removalPath} + pure genv0 {gRemovalKeyPaths = Map.fromList keys} + +getPrivateKeyPath :: Value -> String -> App FilePath +getPrivateKeyPath config signatureScheme = do + relPath <- config %. "settings.mlsPrivateKeyPaths.removal" %. signatureScheme & asString + asks \env' -> case env'.servicesCwdBase of + Nothing -> relPath + Just dir -> dir "galley" relPath + +loadEcKey :: String -> Int -> Value -> App ByteString +loadEcKey sigScheme offset config = do + path <- getPrivateKeyPath config sigScheme + bs <- liftIO $ B.readFile path + pems <- case pemParseBS bs of + Left err -> assertFailure $ "Could not parse removal key PEM: " <> err + Right x -> pure x + asn1 <- pemContent <$> assertOne pems + -- quick and dirty ASN.1 decoding: assume the key is of the correct + -- format, and simply skip the header + pure $ B.drop offset asn1 + +loadEd25519Key :: Value -> App ByteString +loadEd25519Key config = do + path <- getPrivateKeyPath config "ed25519" + bs <- liftIO $ B.readFile path + pems <- case pemParseBS bs of + Left err -> assertFailure $ "Could not parse removal key PEM: " <> err + Right x -> pure x + asn1 <- pemContent <$> assertOne pems + -- quick and dirty ASN.1 decoding: assume the key is of the correct + -- format, and simply skip the 16 byte header + let bytes = B.drop 16 asn1 + priv <- liftIO . throwCryptoErrorIO $ Ed25519.secretKey bytes + pure (convert (Ed25519.toPublic priv)) runTests :: [(String, x, y, App ())] -> Maybe FilePath -> FilePath -> IO () runTests tests mXMLOutput cfg = do @@ -142,24 +183,24 @@ runTests tests mXMLOutput cfg = do runCodensity (createGlobalEnv cfg) $ \genv -> withAsync displayOutput $ \displayThread -> do - report <- fmap mconcat $ for tests $ \(qname, _, _, action) -> do - do - (mErr, tm) <- withTime (runTest genv action) - case mErr of - Left err -> do - writeOutput $ - "----- " - <> qname - <> colored red " FAIL" - <> " (" - <> printTime tm - <> ") -----\n" - <> err - <> "\n" - pure (TestSuiteReport [TestCaseReport qname (TestFailure err) tm]) - Right _ -> do - writeOutput $ qname <> colored green " OK" <> " (" <> printTime tm <> ")" <> "\n" - pure (TestSuiteReport [TestCaseReport qname TestSuccess tm]) + -- Currently 4 seems to be stable, more seems to create more timeouts. + report <- fmap mconcat $ pooledForConcurrentlyN 4 tests $ \(qname, _, _, action) -> do + (mErr, tm) <- withTime (runTest genv action) + case mErr of + Left err -> do + writeOutput $ + "----- " + <> qname + <> colored red " FAIL" + <> " (" + <> printTime tm + <> ") -----\n" + <> err + <> "\n" + pure (TestSuiteReport [TestCaseReport qname (TestFailure err) tm]) + Right _ -> do + writeOutput $ qname <> colored green " OK" <> " (" <> printTime tm <> ")" <> "\n" + pure (TestSuiteReport [TestCaseReport qname TestSuccess tm]) writeChan output Nothing wait displayThread printReport report diff --git a/integration/test/Testlib/Types.hs b/integration/test/Testlib/Types.hs index 025ef39ba76..ae166c33b4c 100644 --- a/integration/test/Testlib/Types.hs +++ b/integration/test/Testlib/Types.hs @@ -102,11 +102,13 @@ data GlobalEnv = GlobalEnv { gServiceMap :: Map String ServiceMap, gDomain1 :: String, gDomain2 :: String, + gIntegrationTestHostName :: String, + gFederationV0Domain :: String, gDynamicDomains :: [String], gDefaultAPIVersion :: Int, gManager :: HTTP.Manager, gServicesCwdBase :: Maybe FilePath, - gRemovalKeyPath :: FilePath, + gRemovalKeyPaths :: Map String FilePath, gBackendResourcePool :: ResourcePool BackendResource, gRabbitMQConfig :: RabbitMQConfig, gTempDir :: FilePath, @@ -116,6 +118,8 @@ data GlobalEnv = GlobalEnv data IntegrationConfig = IntegrationConfig { backendOne :: BackendConfig, backendTwo :: BackendConfig, + federationV0 :: BackendConfig, + integrationTestHostName :: String, dynamicBackends :: Map String DynamicBackendConfig, rabbitmq :: RabbitMQConfig, cassandra :: CassandraConfig @@ -128,6 +132,8 @@ instance FromJSON IntegrationConfig where IntegrationConfig <$> parseJSON (Object o) <*> o .: fromString "backendTwo" + <*> o .: fromString "federation-v0" + <*> o .: fromString "integrationTestHostName" <*> o .: fromString "dynamicBackends" <*> o .: fromString "rabbitmq" <*> o .: fromString "cassandra" @@ -192,11 +198,14 @@ data Env = Env { serviceMap :: Map String ServiceMap, domain1 :: String, domain2 :: String, + integrationTestHostName :: String, + federationV0Domain :: String, dynamicDomains :: [String], defaultAPIVersion :: Int, manager :: HTTP.Manager, servicesCwdBase :: Maybe FilePath, - removalKeyPath :: FilePath, + -- | paths to removal keys by signature scheme + removalKeyPaths :: Map String FilePath, prekeys :: IORef [(Int, String)], lastPrekeys :: IORef [String], mls :: IORef MLSState, @@ -217,6 +226,9 @@ data Response = Response instance HasField "json" Response (App Aeson.Value) where getField response = maybe (assertFailure "Response has no json body") pure response.jsonBody +data CredentialType = BasicCredentialType | X509CredentialType + deriving (Eq, Show) + data ClientIdentity = ClientIdentity { domain :: String, user :: String, @@ -225,17 +237,34 @@ data ClientIdentity = ClientIdentity deriving stock (Show, Eq, Ord, Generic) newtype Ciphersuite = Ciphersuite {code :: String} - deriving (Eq, Ord, Show) + deriving (Eq, Ord, Show, Generic) instance Default Ciphersuite where def = Ciphersuite "0x0001" data ClientGroupState = ClientGroupState { group :: Maybe ByteString, - keystore :: Maybe ByteString + -- | mls-test-cli stores by signature scheme + keystore :: Map String ByteString, + credType :: CredentialType } deriving (Show) +instance Default ClientGroupState where + def = + ClientGroupState + { group = Nothing, + keystore = mempty, + credType = BasicCredentialType + } + +csSignatureScheme :: Ciphersuite -> String +csSignatureScheme (Ciphersuite code) = case code of + "0x0002" -> "ecdsa_secp256r1_sha256" + "0x0005" -> "ecdsa_secp521r1_sha512" + "0x0007" -> "ecdsa_secp384r1_sha384" + _ -> "ed25519" + data MLSProtocol = MLSProtocolMLS | MLSProtocolMixed deriving (Eq, Show) @@ -359,6 +388,9 @@ assertJust :: HasCallStack => String -> Maybe a -> App a assertJust _ (Just x) = pure x assertJust msg Nothing = assertFailure msg +assertNothing :: (HasCallStack) => Maybe a -> App () +assertNothing = maybe (pure ()) $ const $ assertFailure "Maybe value was Just, not Nothing" + addFailureContext :: String -> App a -> App a addFailureContext msg = modifyFailureMsg (\m -> m <> "\nThis failure happened in this context:\n" <> msg) @@ -438,7 +470,17 @@ lookupConfigOverride overrides = \case Stern -> overrides.sternCfg FederatorInternal -> overrides.federatorInternalCfg -data Service = Brig | Galley | Cannon | Gundeck | Cargohold | Nginz | Spar | BackgroundWorker | Stern | FederatorInternal +data Service + = Brig + | Galley + | Cannon + | Gundeck + | Cargohold + | Nginz + | Spar + | BackgroundWorker + | Stern + | FederatorInternal deriving ( Show, Eq, diff --git a/libs/bilge/src/Bilge/Request.hs b/libs/bilge/src/Bilge/Request.hs index 30c15eee8e0..1acd96aa03e 100644 --- a/libs/bilge/src/Bilge/Request.hs +++ b/libs/bilge/src/Bilge/Request.hs @@ -82,7 +82,7 @@ import Data.ByteString.Lazy qualified as Lazy import Data.ByteString.Lazy.Char8 qualified as LC import Data.CaseInsensitive (original) import Data.Id (RequestId (..)) -import Imports hiding (cs, intercalate) +import Imports hiding (intercalate) import Network.HTTP.Client (Cookie, GivesPopper, Request, RequestBody (..)) import Network.HTTP.Client qualified as Rq import Network.HTTP.Client.Internal (CookieJar (..), brReadSome, throwHttp) diff --git a/libs/brig-types/brig-types.cabal b/libs/brig-types/brig-types.cabal index d7a933c90bb..4d4d0640dd1 100644 --- a/libs/brig-types/brig-types.cabal +++ b/libs/brig-types/brig-types.cabal @@ -23,7 +23,6 @@ library Brig.Types.Team.LegalHold Brig.Types.Test.Arbitrary Brig.Types.User - Brig.Types.User.Event other-modules: Paths_brig_types hs-source-dirs: src @@ -85,7 +84,6 @@ library , imports , QuickCheck >=2.9 , text >=0.11 - , tinylog , types-common >=0.16 , wire-api diff --git a/libs/brig-types/default.nix b/libs/brig-types/default.nix index 173b83591b0..78932b5d379 100644 --- a/libs/brig-types/default.nix +++ b/libs/brig-types/default.nix @@ -19,7 +19,6 @@ , tasty-hunit , tasty-quickcheck , text -, tinylog , types-common , wire-api }: @@ -38,7 +37,6 @@ mkDerivation { imports QuickCheck text - tinylog types-common wire-api ]; diff --git a/libs/brig-types/src/Brig/Types/Search.hs b/libs/brig-types/src/Brig/Types/Search.hs index cbd6eb0a986..2bf55eb1ea8 100644 --- a/libs/brig-types/src/Brig/Types/Search.hs +++ b/libs/brig-types/src/Brig/Types/Search.hs @@ -26,6 +26,7 @@ module Brig.Types.Search ) where +import Cassandra qualified as C import Data.Aeson import Data.Attoparsec.ByteString import Data.ByteString.Builder @@ -77,6 +78,16 @@ instance FromByteString SearchVisibilityInbound where SearchableByOwnTeam <$ string "searchable-by-own-team" <|> SearchableByAllTeams <$ string "searchable-by-all-teams" +instance C.Cql SearchVisibilityInbound where + ctype = C.Tagged C.IntColumn + + toCql SearchableByOwnTeam = C.CqlInt 0 + toCql SearchableByAllTeams = C.CqlInt 1 + + fromCql (C.CqlInt 0) = pure SearchableByOwnTeam + fromCql (C.CqlInt 1) = pure SearchableByAllTeams + fromCql n = Left $ "Unexpected SearchVisibilityInbound: " ++ show n + defaultSearchVisibilityInbound :: SearchVisibilityInbound defaultSearchVisibilityInbound = SearchableByOwnTeam diff --git a/libs/brig-types/src/Brig/Types/User/Event.hs b/libs/brig-types/src/Brig/Types/User/Event.hs deleted file mode 100644 index 19bfc56315e..00000000000 --- a/libs/brig-types/src/Brig/Types/User/Event.hs +++ /dev/null @@ -1,220 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Brig.Types.User.Event where - -import Data.ByteString.Conversion -import Data.Handle (Handle) -import Data.Id -import Data.Qualified -import Imports -import System.Logger.Class -import Wire.API.Connection -import Wire.API.Properties -import Wire.API.User -import Wire.API.User.Client -import Wire.API.User.Client.Prekey - -data Event - = UserEvent !UserEvent - | ConnectionEvent !ConnectionEvent - | PropertyEvent !PropertyEvent - | ClientEvent !ClientEvent - -data UserEvent - = UserCreated !User - | -- | A user is activated when the first user identity (email address or phone number) - -- is verified. {#RefActivationEvent} - UserActivated !User - | -- | Account & API access of a user has been suspended. - UserSuspended !UserId - | -- | Account & API access of a previously suspended user - -- has been restored. - UserResumed !UserId - | -- | The user account has been deleted. - UserDeleted !(Qualified UserId) - | UserUpdated !UserUpdatedData - | UserIdentityUpdated !UserIdentityUpdatedData - | UserIdentityRemoved !UserIdentityRemovedData - | UserLegalHoldDisabled !UserId - | UserLegalHoldEnabled !UserId - | LegalHoldClientRequested LegalHoldClientRequestedData - -data ConnectionEvent = ConnectionUpdated - { ucConn :: !UserConnection, - ucPrev :: !(Maybe Relation), - ucName :: !(Maybe Name) - } - -data PropertyEvent - = PropertySet !UserId !PropertyKey !PropertyValue - | PropertyDeleted !UserId !PropertyKey - | PropertiesCleared !UserId - -data ClientEvent - = ClientAdded !UserId !Client - | ClientRemoved !UserId !ClientId - -data UserUpdatedData = UserUpdatedData - { eupId :: !UserId, - eupName :: !(Maybe Name), - -- | DEPRECATED - eupPict :: !(Maybe Pict), - eupAccentId :: !(Maybe ColourId), - eupAssets :: !(Maybe [Asset]), - eupHandle :: !(Maybe Handle), - eupLocale :: !(Maybe Locale), - eupManagedBy :: !(Maybe ManagedBy), - eupSSOId :: !(Maybe UserSSOId), - eupSSOIdRemoved :: Bool, - eupSupportedProtocols :: !(Maybe (Set BaseProtocolTag)) - } - deriving stock (Show) - -data UserIdentityUpdatedData = UserIdentityUpdatedData - { eiuId :: !UserId, - eiuEmail :: !(Maybe Email), - eiuPhone :: !(Maybe Phone) - } - deriving stock (Show) - -data UserIdentityRemovedData = UserIdentityRemovedData - { eirId :: !UserId, - eirEmail :: !(Maybe Email), - eirPhone :: !(Maybe Phone) - } - deriving stock (Show) - -data LegalHoldClientRequestedData = LegalHoldClientRequestedData - { lhcTargetUser :: !UserId, - lhcLastPrekey :: !LastPrekey, - lhcClientId :: !ClientId - } - deriving stock (Show) - -emailRemoved :: UserId -> Email -> UserEvent -emailRemoved u e = - UserIdentityRemoved $ UserIdentityRemovedData u (Just e) Nothing - -phoneRemoved :: UserId -> Phone -> UserEvent -phoneRemoved u p = - UserIdentityRemoved $ UserIdentityRemovedData u Nothing (Just p) - -emailUpdated :: UserId -> Email -> UserEvent -emailUpdated u e = - UserIdentityUpdated $ UserIdentityUpdatedData u (Just e) Nothing - -phoneUpdated :: UserId -> Phone -> UserEvent -phoneUpdated u p = - UserIdentityUpdated $ UserIdentityUpdatedData u Nothing (Just p) - -handleUpdated :: UserId -> Handle -> UserEvent -handleUpdated u h = - UserUpdated $ (emptyUserUpdatedData u) {eupHandle = Just h} - -localeUpdate :: UserId -> Locale -> UserEvent -localeUpdate u loc = - UserUpdated $ (emptyUserUpdatedData u) {eupLocale = Just loc} - -managedByUpdate :: UserId -> ManagedBy -> UserEvent -managedByUpdate u mb = - UserUpdated $ (emptyUserUpdatedData u) {eupManagedBy = Just mb} - -supportedProtocolUpdate :: UserId -> Set BaseProtocolTag -> UserEvent -supportedProtocolUpdate u prots = - UserUpdated $ (emptyUserUpdatedData u) {eupSupportedProtocols = Just prots} - -profileUpdated :: UserId -> UserUpdate -> UserEvent -profileUpdated u UserUpdate {..} = - UserUpdated $ - (emptyUserUpdatedData u) - { eupName = uupName, - eupPict = uupPict, - eupAccentId = uupAccentId, - eupAssets = uupAssets - } - -emptyUpdate :: UserId -> UserEvent -emptyUpdate = UserUpdated . emptyUserUpdatedData - -emptyUserUpdatedData :: UserId -> UserUpdatedData -emptyUserUpdatedData u = - UserUpdatedData - { eupId = u, - eupName = Nothing, - eupPict = Nothing, - eupAccentId = Nothing, - eupAssets = Nothing, - eupHandle = Nothing, - eupLocale = Nothing, - eupManagedBy = Nothing, - eupSSOId = Nothing, - eupSSOIdRemoved = False, - eupSupportedProtocols = Nothing - } - -connEventUserId :: ConnectionEvent -> UserId -connEventUserId ConnectionUpdated {..} = ucFrom ucConn - -propEventUserId :: PropertyEvent -> UserId -propEventUserId (PropertySet u _ _) = u -propEventUserId (PropertyDeleted u _) = u -propEventUserId (PropertiesCleared u) = u - -logConnection :: UserId -> Qualified UserId -> Msg -> Msg -logConnection from (Qualified toUser toDomain) = - "connection.from" .= toByteString from - ~~ "connection.to" .= toByteString toUser - ~~ "connection.to_domain" .= toByteString toDomain - -logLocalConnection :: UserId -> UserId -> Msg -> Msg -logLocalConnection from to = - "connection.from" .= toByteString from - ~~ "connection.to" .= toByteString to - -instance ToBytes Event where - bytes (UserEvent e) = bytes e - bytes (ConnectionEvent e) = bytes e - bytes (PropertyEvent e) = bytes e - bytes (ClientEvent e) = bytes e - -instance ToBytes UserEvent where - bytes (UserCreated u) = val "user.new: " +++ toByteString (userId u) - bytes (UserActivated u) = val "user.activate: " +++ toByteString (userId u) - bytes (UserUpdated u) = val "user.update: " +++ toByteString (eupId u) - bytes (UserIdentityUpdated u) = val "user.update: " +++ toByteString (eiuId u) - bytes (UserIdentityRemoved u) = val "user.identity-remove: " +++ toByteString (eirId u) - bytes (UserSuspended u) = val "user.suspend: " +++ toByteString u - bytes (UserResumed u) = val "user.resume: " +++ toByteString u - bytes (UserDeleted u) = val "user.delete: " +++ toByteString (qUnqualified u) +++ val "@" +++ toByteString (qDomain u) - bytes (UserLegalHoldDisabled u) = val "user.legalhold-disable: " +++ toByteString u - bytes (UserLegalHoldEnabled u) = val "user.legalhold-enable: " +++ toByteString u - bytes (LegalHoldClientRequested payload) = val "user.legalhold-request: " +++ show payload - -instance ToBytes ConnectionEvent where - bytes e@ConnectionUpdated {} = val "user.connection: " +++ toByteString (connEventUserId e) - -instance ToBytes PropertyEvent where - bytes e@PropertySet {} = val "user.properties-set: " +++ toByteString (propEventUserId e) - bytes e@PropertyDeleted {} = val "user.properties-delete: " +++ toByteString (propEventUserId e) - bytes e@PropertiesCleared {} = val "user.properties-clear: " +++ toByteString (propEventUserId e) - -instance ToBytes ClientEvent where - bytes (ClientAdded u _) = val "user.client-add: " +++ toByteString u - bytes (ClientRemoved u _) = val "user.client-remove: " +++ toByteString u diff --git a/libs/brig-types/test/unit/Test/Brig/Types/User.hs b/libs/brig-types/test/unit/Test/Brig/Types/User.hs index da85beb6253..dee80388143 100644 --- a/libs/brig-types/test/unit/Test/Brig/Types/User.hs +++ b/libs/brig-types/test/unit/Test/Brig/Types/User.hs @@ -65,7 +65,7 @@ testCaseUserAccount = testCase "UserAcccount" $ do assertEqual "2" (Just json2) (encode <$> decode @UserAccount json2) where json1 :: LByteString - json1 = "{\"accent_id\":1,\"assets\":[],\"deleted\":true,\"expires_at\":\"1864-05-09T17:20:22.192Z\",\"handle\":\"-ve\",\"id\":\"00000001-0000-0000-0000-000000000001\",\"locale\":\"lu\",\"managed_by\":\"wire\",\"name\":\"bla\",\"phone\":\"+433017355611929\",\"picture\":[],\"qualified_id\":{\"domain\":\"4-o60.j7-i\",\"id\":\"00000000-0000-0001-0000-000100000000\"},\"service\":{\"id\":\"00000000-0000-0001-0000-000000000001\",\"provider\":\"00000001-0000-0001-0000-000000000001\"},\"status\":\"suspended\",\"supported_protocols\":[\"proteus\"],\"team\":\"00000000-0000-0001-0000-000100000001\"}" + json1 = "{\"accent_id\":1,\"assets\":[],\"deleted\":true,\"expires_at\":\"1864-05-09T17:20:22.192Z\",\"handle\":\"-ve\",\"id\":\"00000000-0000-0001-0000-000100000000\",\"locale\":\"lu\",\"managed_by\":\"wire\",\"name\":\"bla\",\"phone\":\"+433017355611929\",\"picture\":[],\"qualified_id\":{\"domain\":\"4-o60.j7-i\",\"id\":\"00000000-0000-0001-0000-000100000000\"},\"service\":{\"id\":\"00000000-0000-0001-0000-000000000001\",\"provider\":\"00000001-0000-0001-0000-000000000001\"},\"status\":\"suspended\",\"supported_protocols\":[\"proteus\"],\"team\":\"00000000-0000-0001-0000-000100000001\"}" json2 :: LByteString - json2 = "{\"accent_id\":0,\"assets\":[{\"key\":\"3-4-00000000-0000-0001-0000-000000000000\",\"size\":\"preview\",\"type\":\"image\"}],\"email\":\"@\",\"expires_at\":\"1864-05-10T22:45:44.823Z\",\"handle\":\"b8m\",\"id\":\"00000001-0000-0000-0000-000100000000\",\"locale\":\"tk-KZ\",\"managed_by\":\"wire\",\"name\":\"name2\",\"picture\":[],\"qualified_id\":{\"domain\":\"1-8wq0.b22k1.w5\",\"id\":\"00000000-0000-0000-0000-000000000001\"},\"service\":{\"id\":\"00000000-0000-0001-0000-000000000001\",\"provider\":\"00000001-0000-0001-0000-000100000000\"},\"status\":\"pending-invitation\",\"supported_protocols\":[\"proteus\"],\"team\":\"00000000-0000-0001-0000-000000000001\"}" + json2 = "{\"accent_id\":0,\"assets\":[{\"key\":\"3-4-00000000-0000-0001-0000-000000000000\",\"size\":\"preview\",\"type\":\"image\"}],\"email\":\"@\",\"expires_at\":\"1864-05-10T22:45:44.823Z\",\"handle\":\"b8m\",\"id\":\"00000000-0000-0000-0000-000000000001\",\"locale\":\"tk-KZ\",\"managed_by\":\"wire\",\"name\":\"name2\",\"picture\":[],\"qualified_id\":{\"domain\":\"1-8wq0.b22k1.w5\",\"id\":\"00000000-0000-0000-0000-000000000001\"},\"service\":{\"id\":\"00000000-0000-0001-0000-000000000001\",\"provider\":\"00000001-0000-0001-0000-000100000000\"},\"status\":\"pending-invitation\",\"supported_protocols\":[\"proteus\"],\"team\":\"00000000-0000-0001-0000-000000000001\"}" diff --git a/libs/extended/default.nix b/libs/extended/default.nix index ad03254ed71..66687c40075 100644 --- a/libs/extended/default.nix +++ b/libs/extended/default.nix @@ -29,6 +29,7 @@ , servant-client-core , servant-openapi3 , servant-server +, string-conversions , temporary , text , time @@ -69,7 +70,14 @@ mkDerivation { unliftio wai ]; - testHaskellDepends = [ aeson base hspec imports temporary ]; + testHaskellDepends = [ + aeson + base + hspec + imports + string-conversions + temporary + ]; testToolDepends = [ hspec-discover ]; description = "Extended versions of common modules"; license = lib.licenses.agpl3Only; diff --git a/libs/extended/extended.cabal b/libs/extended/extended.cabal index 2bfb4d92022..087fb75843a 100644 --- a/libs/extended/extended.cabal +++ b/libs/extended/extended.cabal @@ -172,6 +172,7 @@ test-suite extended-tests , extended , hspec , imports + , string-conversions , temporary default-language: GHC2021 diff --git a/libs/extended/src/Servant/API/Extended.hs b/libs/extended/src/Servant/API/Extended.hs index c1e87f38beb..a531f141bd7 100644 --- a/libs/extended/src/Servant/API/Extended.hs +++ b/libs/extended/src/Servant/API/Extended.hs @@ -19,6 +19,7 @@ -- errors instead of plaintext. module Servant.API.Extended where +import Data.ByteString import Data.ByteString.Lazy qualified as BL import Data.EitherR (fmapL) import Data.Kind @@ -92,7 +93,7 @@ instance fromMaybe "application/octet-stream" $ lookup hContentType $ requestHeaders request - case canHandleCTypeH (Proxy :: Proxy list) (cs contentTypeH) :: Maybe (BL.ByteString -> Either String a) of + case canHandleCTypeH (Proxy :: Proxy list) (fromStrict contentTypeH) :: Maybe (BL.ByteString -> Either String a) of Nothing -> delayedFail err415 Just f -> pure f -- Body check, we get a body parsing functions as the first argument. diff --git a/libs/extended/src/System/Logger/Extended.hs b/libs/extended/src/System/Logger/Extended.hs index e360da4e852..2b45c3f746c 100644 --- a/libs/extended/src/System/Logger/Extended.hs +++ b/libs/extended/src/System/Logger/Extended.hs @@ -37,9 +37,12 @@ import Control.Monad.Catch import Data.Aeson as Aeson import Data.Aeson.Encoding (list, pair, text) import Data.Aeson.Key qualified as Key +import Data.ByteString (toStrict) import Data.ByteString.Builder qualified as B import Data.ByteString.Lazy.Char8 qualified as L import Data.Map.Lazy qualified as Map +import Data.Text.Encoding +import Data.Text.Encoding.Error import GHC.Generics import Imports import System.Logger as Log @@ -65,7 +68,14 @@ elementToEncoding :: Element' -> Encoding elementToEncoding (Element' fields msgs) = pairs $ fields <> msgsToSeries msgs where msgsToSeries :: [Builder] -> Series - msgsToSeries = pair "msgs" . list (text . cs . eval) + msgsToSeries = + pair "msgs" + . list + ( text + . decodeUtf8With lenientDecode + . toStrict + . eval + ) collect :: [Element] -> Element' collect = foldr go (Element' mempty []) @@ -74,7 +84,14 @@ collect = foldr go (Element' mempty []) go (Bytes b) (Element' f m) = Element' f (b : m) go (Field k v) (Element' f m) = - Element' (f <> pair (Key.fromText . cs . eval $ k) (text . cs . eval $ v)) m + Element' + ( f + <> pair + (Key.fromText . dec . toStrict . eval $ k) + (text . dec . toStrict . eval $ v) + ) + m + dec = decodeUtf8With lenientDecode jsonRenderer :: Renderer jsonRenderer _sep _dateFormat _logLevel = fromEncoding . elementToEncoding . collect @@ -105,7 +122,7 @@ structuredJSONRenderer _sep _dateFmt _lvlThreshold logElems = renderTextList xs = toJSON xs builderToText :: Builder -> Text - builderToText = cs . eval + builderToText = decodeUtf8With lenientDecode . toStrict . eval -- We need to do this to work around https://gitlab.com/twittner/tinylog/-/issues/5 parseLevel :: Text -> Maybe Level diff --git a/libs/extended/test/Test/System/Logger/ExtendedSpec.hs b/libs/extended/test/Test/System/Logger/ExtendedSpec.hs index 7516a6f7014..753ba59ada7 100644 --- a/libs/extended/test/Test/System/Logger/ExtendedSpec.hs +++ b/libs/extended/test/Test/System/Logger/ExtendedSpec.hs @@ -19,6 +19,7 @@ module Test.System.Logger.ExtendedSpec where import Data.Aeson ((.=)) import Data.Aeson qualified as Aeson +import Data.String.Conversions import Imports import System.IO.Temp import System.Logger.Extended hiding ((.=)) diff --git a/libs/galley-types/default.nix b/libs/galley-types/default.nix index 9fb082913eb..5a6070c01a4 100644 --- a/libs/galley-types/default.nix +++ b/libs/galley-types/default.nix @@ -18,10 +18,10 @@ , QuickCheck , schema-profunctor , tasty -, tasty-hunit , tasty-quickcheck , text , types-common +, utf8-string , uuid , wire-api }: @@ -44,18 +44,16 @@ mkDerivation { schema-profunctor text types-common + utf8-string uuid wire-api ]; testHaskellDepends = [ aeson base - containers imports - lens QuickCheck tasty - tasty-hunit tasty-quickcheck wire-api ]; diff --git a/libs/galley-types/galley-types.cabal b/libs/galley-types/galley-types.cabal index 97c786cf57f..4953776a8ae 100644 --- a/libs/galley-types/galley-types.cabal +++ b/libs/galley-types/galley-types.cabal @@ -85,6 +85,7 @@ library , schema-profunctor , text >=0.11 , types-common >=0.16 + , utf8-string , uuid , wire-api @@ -97,7 +98,6 @@ test-suite galley-types-tests -- cabal-fmt: expand test other-modules: Paths_galley_types - Test.Galley.Permissions Test.Galley.Roundtrip Test.Galley.Types @@ -153,13 +153,10 @@ test-suite galley-types-tests build-depends: aeson , base - , containers , galley-types , imports - , lens , QuickCheck , tasty - , tasty-hunit , tasty-quickcheck , wire-api diff --git a/libs/galley-types/src/Galley/Types.hs b/libs/galley-types/src/Galley/Types.hs index 8e035a40e02..b08103a22cd 100644 --- a/libs/galley-types/src/Galley/Types.hs +++ b/libs/galley-types/src/Galley/Types.hs @@ -26,7 +26,7 @@ where import Data.Aeson import Data.Id (ClientId, UserId) import Data.Map.Strict qualified as Map -import Imports hiding (cs) +import Imports import Wire.API.Message -------------------------------------------------------------------------------- diff --git a/libs/galley-types/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs index ef54abdd5dc..715377e42bb 100644 --- a/libs/galley-types/src/Galley/Types/Teams.hs +++ b/libs/galley-types/src/Galley/Types/Teams.hs @@ -56,95 +56,22 @@ module Galley.Types.Teams isTeamMember, isTeamOwner, canSeePermsOf, - rolePermissions, - roleHiddenPermissions, - permissionsRole, - isAdminOrOwner, - HiddenPerm (..), - IsPerm (..), ) where -import Control.Lens (makeLenses, view, (^.)) +import Control.Lens (makeLenses, view) import Data.Aeson import Data.Aeson.Types qualified as A +import Data.ByteString (toStrict) +import Data.ByteString.UTF8 qualified as UTF8 import Data.Id (UserId) -import Data.Maybe qualified as Maybe import Data.Schema qualified as Schema import Data.Set qualified as Set import Imports import Test.QuickCheck (Arbitrary) -import Wire.API.Error.Galley import Wire.API.Team.Feature import Wire.API.Team.Member import Wire.API.Team.Permission -import Wire.API.Team.Role - -rolePermissions :: Role -> Permissions -rolePermissions role = Permissions p p where p = rolePerms role - -permissionsRole :: Permissions -> Maybe Role -permissionsRole (Permissions p p') = - if p /= p' - then do - -- we never did use @p /= p'@ for anything, fingers crossed that it doesn't occur anywhere - -- in the wild. but if it does, this implementation prevents privilege escalation. - let p'' = Set.intersection p p' - in permissionsRole (Permissions p'' p'') - else permsRole p - where - permsRole :: Set Perm -> Maybe Role - permsRole perms = - Maybe.listToMaybe - [ role - | role <- [minBound ..], - -- if a there is a role that is strictly less permissive than the perms set that - -- we encounter, we downgrade. this shouldn't happen in real life, but it has - -- happened to very old users on a staging environment, where a user (probably) - -- was create before the current publicly visible permissions had been stabilized. - rolePerms role `Set.isSubsetOf` perms - ] - -isAdminOrOwner :: Permissions -> Bool -isAdminOrOwner perms = - case permissionsRole perms of - Just RoleOwner -> True - Just RoleAdmin -> True - Just RoleMember -> False - Just RoleExternalPartner -> False - Nothing -> False - --- | Internal function for 'rolePermissions'. (It works iff the two sets in 'Permissions' are --- identical for every 'Role', otherwise it'll need to be specialized for the resp. sides.) -rolePerms :: Role -> Set Perm -rolePerms RoleOwner = - rolePerms RoleAdmin - <> Set.fromList - [ GetBilling, - SetBilling, - DeleteTeam - ] -rolePerms RoleAdmin = - rolePerms RoleMember - <> Set.fromList - [ AddTeamMember, - RemoveTeamMember, - SetTeamData, - SetMemberPermissions - ] -rolePerms RoleMember = - rolePerms RoleExternalPartner - <> Set.fromList - [ DeleteConversation, - AddRemoveConvMember, - ModifyConvName, - GetMemberPermissions - ] -rolePerms RoleExternalPartner = - Set.fromList - [ CreateConversation, - GetTeamConversations - ] -- This is the cassandra timestamp of writetime(binding) newtype TeamCreationTime = TeamCreationTime @@ -274,7 +201,7 @@ instance ToJSON FeatureFlags where instance FromJSON FeatureSSO where parseJSON (String "enabled-by-default") = pure FeatureSSOEnabledByDefault parseJSON (String "disabled-by-default") = pure FeatureSSODisabledByDefault - parseJSON bad = fail $ "FeatureSSO: " <> cs (encode bad) + parseJSON bad = fail $ "FeatureSSO: " <> (UTF8.toString . toStrict . encode $ bad) instance ToJSON FeatureSSO where toJSON FeatureSSOEnabledByDefault = String "enabled-by-default" @@ -284,7 +211,7 @@ instance FromJSON FeatureLegalHold where parseJSON (String "disabled-permanently") = pure $ FeatureLegalHoldDisabledPermanently parseJSON (String "disabled-by-default") = pure $ FeatureLegalHoldDisabledByDefault parseJSON (String "whitelist-teams-and-implicit-consent") = pure FeatureLegalHoldWhitelistTeamsAndImplicitConsent - parseJSON bad = fail $ "FeatureLegalHold: " <> cs (encode bad) + parseJSON bad = fail $ "FeatureLegalHold: " <> (UTF8.toString . toStrict . encode $ bad) instance ToJSON FeatureLegalHold where toJSON FeatureLegalHoldDisabledPermanently = String "disabled-permanently" @@ -294,7 +221,7 @@ instance ToJSON FeatureLegalHold where instance FromJSON FeatureTeamSearchVisibilityAvailability where parseJSON (String "enabled-by-default") = pure FeatureTeamSearchVisibilityAvailableByDefault parseJSON (String "disabled-by-default") = pure FeatureTeamSearchVisibilityUnavailableByDefault - parseJSON bad = fail $ "FeatureSearchVisibility: " <> cs (encode bad) + parseJSON bad = fail $ "FeatureSearchVisibility: " <> (UTF8.toString . toStrict . encode $ bad) instance ToJSON FeatureTeamSearchVisibilityAvailability where toJSON FeatureTeamSearchVisibilityAvailableByDefault = String "enabled-by-default" @@ -304,104 +231,6 @@ makeLenses ''TeamCreationTime makeLenses ''FeatureFlags makeLenses ''Defaults --- Note [hidden team roles] --- --- The problem: the mapping between 'Role' and 'Permissions' is fixed by external contracts: --- client apps treat permission bit matrices as opaque role identifiers, so if we add new --- permission flags, things will break there. --- --- "Hidden" in "HiddenPerm", therefore, refers to a permission hidden from --- clients, thereby making it internal to the backend. --- --- The solution: add new permission bits to 'HiddenPerm', 'HiddenPermissions', and make --- 'hasPermission', 'mayGrantPermission' polymorphic. Now you can check both for the hidden --- permission bits and the old ones that we share with the client apps. - --- | See Note [hidden team roles] -data HiddenPerm - = ChangeLegalHoldTeamSettings - | ChangeLegalHoldUserSettings - | ViewLegalHoldUserSettings - | ChangeTeamFeature - | ChangeTeamSearchVisibility - | ViewTeamSearchVisibility - | ViewSameTeamEmails - | ReadIdp - | CreateUpdateDeleteIdp - | CreateReadDeleteScimToken - | -- | this has its own permission because we're not sure how - -- efficient this end-point is. better not let all team members - -- play with it unless we have to. - DownloadTeamMembersCsv - | ChangeTeamMemberProfiles - | SearchContacts - deriving (Eq, Ord, Show) - --- | See Note [hidden team roles] -data HiddenPermissions = HiddenPermissions - { _hself :: Set HiddenPerm, - _hcopy :: Set HiddenPerm - } - deriving (Eq, Ord, Show) - -makeLenses ''HiddenPermissions - -roleHiddenPermissions :: Role -> HiddenPermissions -roleHiddenPermissions role = HiddenPermissions p p - where - p = roleHiddenPerms role - roleHiddenPerms :: Role -> Set HiddenPerm - roleHiddenPerms RoleOwner = roleHiddenPerms RoleAdmin - roleHiddenPerms RoleAdmin = - (roleHiddenPerms RoleMember <>) $ - Set.fromList - [ ChangeLegalHoldTeamSettings, - ChangeLegalHoldUserSettings, - ChangeTeamSearchVisibility, - ChangeTeamFeature, - ChangeTeamMemberProfiles, - ReadIdp, - CreateUpdateDeleteIdp, - CreateReadDeleteScimToken, - DownloadTeamMembersCsv - ] - roleHiddenPerms RoleMember = - (roleHiddenPerms RoleExternalPartner <>) $ - Set.fromList - [ ViewSameTeamEmails, - SearchContacts - ] - roleHiddenPerms RoleExternalPartner = - Set.fromList - [ ViewLegalHoldUserSettings, - ViewTeamSearchVisibility - ] - --- | See Note [hidden team roles] -class IsPerm perm where - type PermError (e :: perm) :: GalleyError - - roleHasPerm :: Role -> perm -> Bool - roleGrantsPerm :: Role -> perm -> Bool - hasPermission :: TeamMember -> perm -> Bool - hasPermission tm perm = maybe False (`roleHasPerm` perm) . permissionsRole $ tm ^. permissions - mayGrantPermission :: TeamMember -> perm -> Bool - mayGrantPermission tm perm = maybe False (`roleGrantsPerm` perm) . permissionsRole $ tm ^. permissions - -instance IsPerm Perm where - type PermError p = 'MissingPermission ('Just p) - - roleHasPerm r p = p `Set.member` (rolePermissions r ^. self) - roleGrantsPerm r p = p `Set.member` (rolePermissions r ^. copy) - hasPermission tm p = p `Set.member` (tm ^. permissions . self) - mayGrantPermission tm p = p `Set.member` (tm ^. permissions . copy) - -instance IsPerm HiddenPerm where - type PermError p = OperationDenied - - roleHasPerm r p = p `Set.member` (roleHiddenPermissions r ^. hself) - roleGrantsPerm r p = p `Set.member` (roleHiddenPermissions r ^. hcopy) - notTeamMember :: [UserId] -> [TeamMember] -> [UserId] notTeamMember uids tmms = Set.toList $ diff --git a/libs/galley-types/test/unit/Main.hs b/libs/galley-types/test/unit/Main.hs index c45ccb60b3d..90b692813d3 100644 --- a/libs/galley-types/test/unit/Main.hs +++ b/libs/galley-types/test/unit/Main.hs @@ -21,15 +21,8 @@ module Main where import Imports -import Test.Galley.Permissions qualified import Test.Galley.Types qualified import Test.Tasty main :: IO () -main = - defaultMain $ - testGroup - "Tests" - [ Test.Galley.Types.tests, - Test.Galley.Permissions.tests - ] +main = defaultMain $ testGroup "Tests" [Test.Galley.Types.tests] diff --git a/libs/galley-types/test/unit/Test/Galley/Types.hs b/libs/galley-types/test/unit/Test/Galley/Types.hs index 3381fe49ef5..aa2c03a1411 100644 --- a/libs/galley-types/test/unit/Test/Galley/Types.hs +++ b/libs/galley-types/test/unit/Test/Galley/Types.hs @@ -20,63 +20,16 @@ module Test.Galley.Types where -import Control.Lens -import Data.Set hiding (drop) -import Data.Set qualified as Set import Galley.Types.Teams import Imports import Test.Galley.Roundtrip (testRoundTrip) import Test.QuickCheck qualified as QC import Test.Tasty -import Test.Tasty.HUnit import Test.Tasty.QuickCheck import Wire.API.Team.Feature as Public -import Wire.API.Team.Permission -import Wire.API.Team.Role tests :: TestTree -tests = - testGroup - "Tests" - [ testCase "owner has all permissions" $ - rolePermissions RoleOwner @=? fullPermissions, - testCase "smaller roles (further to the left/top in the type def) are strictly more powerful" $ - -- we may not want to maintain this property in the future when adding more roles, but for - -- now it's true, and it's nice to have that written down somewhere. - forM_ [(r1, r2) | r1 <- [minBound ..], r2 <- drop 1 [r1 ..]] $ - \(r1, r2) -> do - assertBool "owner.self" ((rolePermissions r2 ^. self) `isSubsetOf` (rolePermissions r1 ^. self)) - assertBool "owner.copy" ((rolePermissions r2 ^. copy) `isSubsetOf` (rolePermissions r1 ^. copy)), - testRoundTrip @FeatureFlags, - testGroup - "permissionsRole, rolePermissions" - [ testCase "'Role' maps to expected permissions" $ do - assertEqual "role type changed" [minBound ..] [RoleOwner, RoleAdmin, RoleMember, RoleExternalPartner] - assertEqual "owner" (permissionsRole =<< newPermissions (intToPerms 8191) (intToPerms 8191)) (Just RoleOwner) - assertEqual "admin" (permissionsRole =<< newPermissions (intToPerms 5951) (intToPerms 5951)) (Just RoleAdmin) - assertEqual "member" (permissionsRole =<< newPermissions (intToPerms 1587) (intToPerms 1587)) (Just RoleMember) - assertEqual "external partner" (permissionsRole =<< newPermissions (intToPerms 1025) (intToPerms 1025)) (Just RoleExternalPartner), - testCase "Role <-> Permissions roundtrip" $ do - assertEqual "admin" (permissionsRole . rolePermissions <$> [minBound ..]) (Just <$> [minBound ..]), - testProperty "Random, incoherent 'Permission' values gracefully translate to subsets." $ - let fakeSort (w, w') = (w `Set.union` w', w') - in \(fakeSort -> (w, w')) -> do - let Just perms = newPermissions w w' - case permissionsRole perms of - Just role -> do - let perms' = rolePermissions role - assertEqual "eq" (perms' ^. self) (perms' ^. copy) - assertBool "self" ((perms' ^. self) `Set.isSubsetOf` (perms ^. self)) - assertBool "copy" ((perms' ^. copy) `Set.isSubsetOf` (perms ^. copy)) - Nothing -> do - let leastPermissions = rolePermissions maxBound - assertBool "no role for perms, but strictly more perms than max role" $ - not - ( (leastPermissions ^. self) `Set.isSubsetOf` w - && (leastPermissions ^. copy) `Set.isSubsetOf` w' - ) - ] - ] +tests = testGroup "Tests" [testRoundTrip @FeatureFlags] instance Arbitrary FeatureFlags where arbitrary = diff --git a/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs b/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs index 0dc12e508e8..c087d911135 100644 --- a/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs +++ b/libs/gundeck-types/src/Gundeck/Types/Push/V2.hs @@ -83,7 +83,7 @@ import Data.List1 qualified as List1 import Data.Range import Data.Range qualified as Range import Data.Set qualified as Set -import Imports hiding (cs) +import Imports import Wire.API.Message (Priority (..)) import Wire.API.Push.V2.Token import Wire.Arbitrary @@ -178,17 +178,14 @@ newtype ApsLocKey = ApsLocKey {fromLocKey :: Text} data ApsPreference = ApsStdPreference - | ApsVoIPPreference deriving (Eq, Show, Generic) deriving (Arbitrary) via GenericUniform ApsPreference instance ToJSON ApsPreference where - toJSON ApsVoIPPreference = "voip" toJSON ApsStdPreference = "std" instance FromJSON ApsPreference where parseJSON = withText "ApsPreference" $ \case - "voip" -> pure ApsVoIPPreference "std" -> pure ApsStdPreference x -> fail $ "Invalid preference: " ++ show x diff --git a/libs/hscim/CHANGELOG b/libs/hscim/CHANGELOG index a9fcfb821fa..6da7d28ec7e 100644 --- a/libs/hscim/CHANGELOG +++ b/libs/hscim/CHANGELOG @@ -1,3 +1,6 @@ +0.4.0: + - update dependencies + 0.3.6: - fix serialization: json attributes in scim are case-insensitive diff --git a/libs/hscim/default.nix b/libs/hscim/default.nix index 175f532a31e..85fc2e7cd5e 100644 --- a/libs/hscim/default.nix +++ b/libs/hscim/default.nix @@ -47,7 +47,7 @@ }: mkDerivation { pname = "hscim"; - version = "0.3.6"; + version = "0.4.0.2"; src = gitignoreSource ./.; isLibrary = true; isExecutable = true; diff --git a/libs/hscim/hscim.cabal b/libs/hscim/hscim.cabal index 0a0484ca848..a2a5a9c19b4 100644 --- a/libs/hscim/hscim.cabal +++ b/libs/hscim/hscim.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: hscim -version: 0.3.6 +version: 0.4.0.2 synopsis: hscim json schema and server implementation description: The README file will answer all the questions you might have @@ -81,42 +81,42 @@ library TypeOperators TypeSynonymInstances - ghc-options: -Wall -Werror -Wredundant-constraints -Wunused-packages + ghc-options: -Wall -Wredundant-constraints -Wunused-packages build-depends: - aeson - , aeson-qq - , attoparsec - , base - , bytestring - , case-insensitive - , email-validate - , hashable - , hspec - , hspec-expectations - , hspec-wai - , http-api-data - , http-media - , http-types - , list-t - , microlens - , mmorph - , mtl - , network-uri - , retry - , scientific - , servant - , servant-client - , servant-client-core - , servant-server - , stm - , stm-containers - , string-conversions - , template-haskell - , text - , time - , uuid - , wai - , wai-extra + aeson >=2.1.2 && <2.2 + , aeson-qq >=0.8.4 && <0.9 + , attoparsec >=0.14.4 && <0.15 + , base >=4.17.2 && <4.18 + , bytestring >=0.10.4 && <0.12 + , case-insensitive >=1.2.1 && <1.3 + , email-validate >=2.3.2 && <2.4 + , hashable >=1.4.3 && <1.5 + , hspec >=2.10.10 && <2.11 + , hspec-expectations >=0.8.2 && <0.9 + , hspec-wai >=0.11.1 && <0.12 + , http-api-data >=0.5 && <0.6 + , http-media >=0.8.1 && <0.9 + , http-types >=0.12.3 && <0.13 + , list-t >=1.0.5 && <1.1 + , microlens >=0.4.13 && <0.5 + , mmorph >=1.2.0 && <1.3 + , mtl >=2.2.2 && <2.3 + , network-uri >=2.6.4 && <2.7 + , retry >=0.9.3 && <0.10 + , scientific >=0.3.7 && <0.4 + , servant >=0.19.1 && <0.20 + , servant-client >=0.19 && <0.20 + , servant-client-core >=0.19 && <0.20 + , servant-server >=0.19.2 && <0.20 + , stm >=2.5.1 && <2.6 + , stm-containers >=1.2.0 && <1.3 + , string-conversions >=0.4.0 && <0.5 + , template-haskell >=2.19.0 && <2.20 + , text >=2.0.2 && <2.1 + , time >=1.12.2 && <1.13 + , uuid >=1.3.15 && <1.4 + , wai >=3.2.3 && <3.3 + , wai-extra >=3.1.13 && <3.2 default-language: Haskell2010 @@ -143,8 +143,8 @@ executable hscim-server TypeSynonymInstances ghc-options: - -Wall -Werror -threaded -rtsopts -with-rtsopts=-N - -Wredundant-constraints -Wunused-packages + -Wall -threaded -rtsopts -with-rtsopts=-N -Wredundant-constraints + -Wunused-packages build-depends: base @@ -198,8 +198,8 @@ test-suite spec TypeSynonymInstances ghc-options: - -Wall -Werror -threaded -rtsopts -with-rtsopts=-N - -Wredundant-constraints -Wunused-packages + -Wall -threaded -rtsopts -with-rtsopts=-N -Wredundant-constraints + -Wunused-packages build-tool-depends: hspec-discover:hspec-discover build-depends: diff --git a/libs/hscim/src/Web/Scim/Schema/User.hs b/libs/hscim/src/Web/Scim/Schema/User.hs index 16cac92a880..84655c898a0 100644 --- a/libs/hscim/src/Web/Scim/Schema/User.hs +++ b/libs/hscim/src/Web/Scim/Schema/User.hs @@ -95,7 +95,7 @@ import Web.Scim.Schema.User.Phone (Phone) import Web.Scim.Schema.User.Photo (Photo) import Web.Scim.Schema.UserTypes --- | SCIM user record, parametrized with type-level tag @t@ (see 'UserTypes'). +-- | SCIM user record, parametrized with type-level @tag@ (see 'UserTypes'). data User tag = User { schemas :: [Schema], -- Mandatory fields diff --git a/libs/hscim/test/Test/Class/UserSpec.hs b/libs/hscim/test/Test/Class/UserSpec.hs index 3d3d16d0e17..8bfc45bb945 100644 --- a/libs/hscim/test/Test/Class/UserSpec.hs +++ b/libs/hscim/test/Test/Class/UserSpec.hs @@ -17,10 +17,7 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Test.Class.UserSpec - ( spec, - ) -where +module Test.Class.UserSpec (spec) where import Data.ByteString.Lazy (ByteString) import Network.Wai (Application) diff --git a/libs/http2-manager/test/resources/gen-certs.sh b/libs/http2-manager/test/resources/gen-certs.sh index d24151e67bf..de1e377ee7a 100755 --- a/libs/http2-manager/test/resources/gen-certs.sh +++ b/libs/http2-manager/test/resources/gen-certs.sh @@ -48,7 +48,7 @@ generate() { fi } -generate cert and key based on CA given comma-separated hostnames as SANs +# generate cert and key based on CA given comma-separated hostnames as SANs generate "localhost" "$OUTPUTNAME_LOCALHOST_CERT" generate "localhost.example.com" "$OUTPUTNAME_EXAMPLE_COM_CERT" diff --git a/libs/http2-manager/test/resources/localhost-key.pem b/libs/http2-manager/test/resources/localhost-key.pem index 49d2f111296..d11ceae9ab3 100644 --- a/libs/http2-manager/test/resources/localhost-key.pem +++ b/libs/http2-manager/test/resources/localhost-key.pem @@ -1,27 +1,27 @@ -----BEGIN RSA PRIVATE KEY----- -MIIEpAIBAAKCAQEAyEWHRBYdUDzWzqAToCFI1Pdp4sntIEvTxjurRdFzNv11rgch -A5L0U/gsOp6kaybdqN5TGe1oaCDOM44hMyeZB95WCq8bzIbALPI+0EMc0sHzNI8C -s8dMgdrviXpO06X4WNamZUFgTs0vNmy1SzSZMhMveAEe5k1B1JIdueheQAnjayIp -lZno/hD0ndl7Pvb+14Jm2INCHI/DuhV0qkebRLO/ierNb2b4xQcnTBu3TyYeDnJ6 -sVvJz3uEx35byaG+SVyZq7Hrjaz6jHxEpmHSZpuGjFTSgXkoq1WzISR/ohuRq6Y3 -uGJYmmXFbJQoUekIxOPWPFVuKPJ3UY/rFZUA7QIDAQABAoIBAD5qdOrCXaZpH6VL -/HHWjcVZypVUy2NaXokUhZ9/1IGZ4rg3HpHnleApo1ctpB6FAWYkzA9zjyuMtdcZ -f71apPXv1C8GPgqzIGeho/PyRqRkr/B8daIkBfMekbLt/G0397twQnGiO2qzxfgX -TzU+ElSp6AxlhQTPpSmj1EHhaqZYISc0UBJwHJEC4KXa/GmFIMOpq4QL1OAAPSs9 -vAD4Y919E++GTuOOeYT/k+hd0z65VfkBS5Kptj/FuJxm3rO/07qr186Vb9ulym3K -QisPG3T1jj9GRDFxmg8bP5bC2LBOVgaLLH9fZMxWk6tHeA1n0zrxhsq5ArM+ZcZN -S0EgRMECgYEA8esVOLoMJFDhvW2WXwAE9rRqA8npqicsHQ9N7tACxM3ljQYou0DX -LQMI4OV54ugcpWRbkPSSulGEI0SR2uudWFoJJbWwSTVan/vWV2F30NeTW8dF5mqa -smRUOju3ecvGZYMTIXlQKTzYy5IRReUSw+yglUdmh2KeQ2UZWQRw89ECgYEA0+3a -I3JU1x/f2ByNIXqGEDLoRJqSUAFB2Ht9uLr+EyQb7P7V6Bh11nfXyQo5jfTZG5XO -gultPXJpIbBAhxnr442xszm8N5t4CqFvRJ/0g+7aAMWHM69rMjkm9tjJVxDjwFIF -V92ivwEpDryHbhbbjNdM+HvpIXRB3aiEcDiHDl0CgYBGMbgOpa0wPGfD1zBykEbg -bqj0QHoUbRlXtUEfsiubf0LEEK1w5/eHkAHbf7pGJKNrOht3i/+nIE//C75mj0cw -g69zyaxFEb4h/ajL4fQqHOMdFk0p9nS8nm/yFbG/HWmLuuSqKdEgpg8hwlhQt48i -Wl6d8gHF9s+FLqiUM72ygQKBgQCqNfJpXb4+OV9zFxtStDFQeVKLJwo0L45O7IAB -Ck5d2TaElff/PQYHhqFM2mV3Whu1SBBgnFIcc/N0Fzb8Sxll3bvHEqvUjY1QHHBd -UYr1G7UDwaHhJRaXc8eTonGy9+Gz6SxZcazwc2Iib9Dl3n3fFFzBheOr9s+f02Tr -LLtsEQKBgQDCHhg20OwIpHj+L+QflTB021DiKqiQl8uxcTqfv0M0GvF6fbau6gZh -rtqRoycubeNIu33jsupRbOX8VSy/DBy8O69e0T6/drYLyXsDDb3pUmk/v6Y/F8Qz -QCe0EZF8c9KELbBp9Q3PduvntlMJ3GTKGK1ZfPXXJxkSAeLlfNs/kw== +MIIEpAIBAAKCAQEA0r4IgyNodKaYcz363YNCjsUNgzIi3upmANohDkW+D4k/q8IR +bQjR9/fdO1jgWt6NnbkMa79OdwEj7RUwCMI2fjvOgA78CEn1/3JgZQ7YV/RtiavM +awET2SHDldwzhY77J/EuvM2arog4KJCOqEsQl9a0+T3bbz0dAzQWNELp7z/P0Swt +Iw087bjY2VfcKlCZJqwpacQES2fGEtImHLJlpkQaWdyvURHf23KIraRm60A9aDOu +oKl+7C5Wp7NI3AlkDuGrAXR841Mc7qqvhEzNIfrabHTjrwVrwgijcPkkgPNzlmzn +I4sr5EBCx8imMdFcmOFRStXFEJDa47459Zz1lQIDAQABAoIBAGQqqwUZ2VZIsQFl +nk2XTBVsF+YZ+HUX2G/jPf74q0PbKoZK8dlvbc185IyGy+ylB47GG99CyNrLkfXo +MjKXjSsm5hn8BVMzRFesV6DxE2eK6F2daMYbdwGniL08MsjykvIDMwHOgA0g9gBh +5UyckUB6bv5gpmITHC0fnsYsX+C1CNrNHuSoUoBO9Ikz8YKVOTu+khHpVCkwiMWN +ViB75ncCgSANqADupfzcrCLF+IoWeaBzMae/UJyn/GYAXkzE5M/X6WwY+2QC9L3z +WdEeOy43oXQgAYi3sBVWPOezIhku9cOoKrmC1XP4lca+QBOwYyVogGqWdDOQzCcp +tqJsOgECgYEA8zVLmbTtTBtL54RCRCv+ag4erbw8quyP8OAyKQnlG1Fi1nk6np2p +EgfUclRtVl3UjlLE/NYcoHaXqDMCehzPDwzVeD2i9wrD13f7NIFTbI/qP5kqMr0b +3TINrD077LSktMMRVSPFZDo0KDFBR8cY6d/KkzTk71dmXRsZAJNAEtUCgYEA3dOY +9tL4QNSEeRS29l44+MPXDgqyP365cR1Ws062jP2tAxikf1Sp2j2DWmrAh5HAZoZk +9pIVJFCqxlaa+jIs9MQCjll8nZayAxoD4mTaiir7+sSNdZ6NY+rfQGUQptuJHtOj +P0a/2tbR/HLk3rBGv9Qprc31Lx8uAtaeG9i3N8ECgYAItqQawayuyVuS09476weW +bSMUPmY+CXOuwZmKdtxKekP8QyOigyuHhdhKsFOqgHoZD0YXeORVq2oLkKhKD7Yr +Z95ODIdGKpCRq67IVsnSXeWambY1UykoZ56tyRPYizBLeaGpVzq/OIad2gXouG1g +E7CCTabWHF+CfnIK3zuwcQKBgQC7NDPHOcwgijkyJfUyfdn+tufrBcPgKgY+G9Br +imYtHnjAQC+y9bRSZc9Qov7QaoTBAXJ7VFVbTGiS8cvgki+2cSTnFUZBiEe6rl3Q +1eRI7nWw7+eh96jDRhgatDAVYPibd2gxonePK/QS5LOZ65IJmfeComnk1p9x7cWJ +Ip+dAQKBgQCtujz5v7VAmA/y53DacAmjjSP3ByFNgKfU5e7XhERgOhd4nwfpvoea ++adi5F10u3AsKwYQ/54NGltn59L1Axf/uR33MxJ+a3kPr9faKhoFG6SjvD3SiaQL +AClUVS4LxQ7AJjoM/ilrQbhc+vz7BNDYN3rzMW2XAqrrs6eTIz2SHA== -----END RSA PRIVATE KEY----- diff --git a/libs/http2-manager/test/resources/localhost.example.com-key.pem b/libs/http2-manager/test/resources/localhost.example.com-key.pem index 0ed64c38cfd..e7ecac84c8e 100644 --- a/libs/http2-manager/test/resources/localhost.example.com-key.pem +++ b/libs/http2-manager/test/resources/localhost.example.com-key.pem @@ -1,27 +1,27 @@ -----BEGIN RSA PRIVATE KEY----- -MIIEpQIBAAKCAQEA7FcFU2mPY8aUXvz6ulx+dTAIyJ+Ny9+H+S/aYsCNoEA8/YwN -G9jtAyLVnFk2OzIoRC1inU1jDWRDwLKJpfn/y0QSHVtXZKq8qNeyWZXWDzMUxogu -4lDR/Bi6LpqwcovHc5hzvzddXsyWY5NcYHgmZA4C7yurySS3z11f5GodziOrax0Y -aQ7QaugiZVe9+tDvjw1FO4DPKlr+KyARyJTYw/zUNNTqsftHIb+Slnt90vEm+Aex -RPku/msmMxmX1VUnBXe1xkgVQsfMIekB8q8XJgZmtHO2eKBiK7eo+h1Cvp62aZ1J -5o3PM3WMqeSfKYxzDaNYwDNdliUNahCbucEqrwIDAQABAoIBAQCt34uchUGnvxWz -GF0BtECYyID90FyKi+ZGTo1VL6JCLmBwjJOsVBhywTL0NrHuNQVouxcc8S0ZUhWC -dBdOk7E7gtXs4SFXf0ES2rVssQ5t2j/Dm7caaylBVZPL66Q6cVmIUrV9DSdVMiDG -G0jP9DUSUTiZasCUV74fAewlaGiLGUr2VXpV2QS/20aiS3asK6Ls3wuoYjqBg+3m -eGk3rupAz2ZKMk2IEPnvwdGwf3xhc0elk0qN5Zsw9A7c6Ik1ShBaSWmlOlGNcjeW -mRaYjYoOCv0Ra7NbKm6kgK0a+oAAMfXvTcv0AScpi3JZsiKdTSok3NJOI8fUHBjx -xKt2sLjhAoGBAPiMd9hYawLcdpN/3VlW5SVH3JxMQTKg9dM3SPqbdi/3Qyng/f6R -HjIGabczkg63G0Vl/QjAvuJy8NCLVt/2aUvwI/j+63TEaOTdowtN796PkEU/lDaj -Yfe0UE+KtezodjHOsFZvce8iTk9XpBXtL6MlNj0BW1lxGlQqw6WrK+nxAoGBAPNs -2qvhBvi5Ro20O0NC2EsACXToyDSf9V4fs2QJbEZUikQ2B1CoTru+Pouxkmk/UNFl -+l4tLp4WALL10cv35rvmARrws8IA4tGpwadaROgxVz/vvhp8J+5S+9qxVZ4QYg01 -OPolTzOphKq9YV0Gsd0MhU2Y2SRZAx1gIFaler6fAoGBALT8RECLkdDRjJ63Ww01 -E0LkYyaE+GzPfHHDLicekR84Y/XY2dtG/L/cn5pBuTdx6i/MpkZ7ZAQtQmH5NNd8 -7QvY37jul7G9W8xb/9+5btOXoqxqMZjfu/TNnjVtgi/yzi5SnWEzYbmKN4/a96bn -weqArFAb7tLgYxWq1jCKxj1hAoGBAMaMgCP3rKcNABYu7rOi/ybVheEcycfavNkk -BD9RTEZlSE3wv7CzR1ztBLkOgnxkD3hstHVCZya8jZ9qz8+NiV6zcS1XLVfNPzSC -QRlOkKvPKvpUgvu5TxyeBR1QzaPaew+I3MtzyRE7cKGPTK4C+upw/v3W8S4riFXa -hSYHXYHDAoGAVMtszMBWS6SWkHDpFn6vpz3EIvq7vkCxBCMNAmdEfAWKuneOcri2 -we2SEB2eXM7XQ6iUT/ScnUPgJ5gOHb2x9H6JKY8PDvG2mwmrl4l2fqGrvTxZfMeH -uHwDsKvVhx8tWJqEQ9+9F9VFIOpWsmww8NE4tiNBMZFKbCaRHh1mLuQ= +MIIEogIBAAKCAQEAsk6VVVl3CLj7aBLK6APqM/jZ1eqoB+XvY47GcmwGyvnqJaWB +T6nNxnNKLD4bFPzNy+3V3fa4H/HAgJDT2mjASkvG1HV8QMnqfN5fi2sbtlxWrEpB +VTUCiUfBeN/nSsyzXkaKjGMMrdvgX9HPEOAQ7dhYc+rhpGt1GKN0DYzNwR5szscZ +E/TfDl7s0+rQdmD4xLYkI6RvmqF3wFbu1nS9Nhbbm1dlr5imTIWJyPTv5QOTxJ0A +npmkilqaXA/1zhmh8Lmi+NRa1d0k5+YVd6OFKTAiWK4vXHseFYY3Kn4knYzC4MQe +PPfHR2rTqyUKzFrTtDXtSjnm9YnsWidaxwA+tQIDAQABAoIBABk3K78qK788CbGq +Fq/A/fnjk0rBKIoVZkk6A65iwIMr3IT+Zs8RQFx0KWUgU0wghCn2tGvzXA6IbaTA +1nToo2jeVnvtMWkoJNULzY810nFzlX4/8gVOvdEUKLQjVd4qHKOUbjt0NnLPyWdD +kHjedwZrtfaOnOJXn/OgCeVwqBhLLIu9bEfNjbxpDCcT7bgVxMbTduOzGIrJKNMc +HnAkOTEBBhZ8bbb2woq5/mdDLLLCbY5KbmjUOXxZFEhhmZwHRqkU76VIOxyRk+uD +TcBPGm8jHITBAxHbaaoywsh5XrsUW8jX2RZlioW9p+QksVLY016X7H3caiIb3mgb +NA7QMQECgYEAxG83yMg/dnOQtjUlA3jQPKBPu7Hh+Jlx2kF7fMe5d3PtV08uma+E +CHhYR+NkHTLViXyh8FOT3H2AtpKcoSyXDok2Pv1UJ8VNxejOrmmWuafSkK2MZRMQ +i90j2p0GrpCMP0qQO/h8qMXBPIfWm+zKpstAqFYGaO70IQ6hzF2a3qUCgYEA6GAr +Gcqbu6MgLf+rCmvYo3ysTJ/jfndAFrFvPD4q8FFLBQd6HDstp9eWTMziJJ/c7viK +WMsdlTXFbqEuVM6QiJERWN9Ub3q4PO+lA0uRajbapo3rxD2/G4MP6R00+DFgq3CJ +WRcbvi5ZjV2Ea8rXtdH/BH2DJ3Gz8Wn4ylnPctECgYBEeTRr5AnjQ4OVUE83t5x3 +FbbVibtoiiya1Sqzo3duQVXhknN/FSSkQzca0BQs7XRsOarFeIzZVlJQ0iiRMlbx +tTjYmjwEpQ1oSLALMjldPDf1QNnovc2Nw6dk5EnY/gA1a8t9bDAgMNccP4m6zr8R +h1Zhl6MiXvFwuIYEFDkRFQKBgDG6it69HjC8iyFs6mSTicwK3TCUsvGYgY2ZsS1a +PIQrUXulCvvJqk6V82NCIU8nKve1Fp5D8XPCCxtOwQSDJCklqmmzeXVV9OGNg2m+ +HUN2s7oa+w6HDEPN+3SuvGw03PQzZCE9scE0WBPJpJIQ2bLeWs3SMmQZkCGkxQpA +yAVRAoGATyvQwajxCB6Q5GvoaE+CGNRMgpG6e9Kn0UIme7HPDesMrz/J5LAOHUHf +Fhe9bMR7VhGjFQW7LPoIHC8M4D6zRKFpwKf+ZeqraqCrwpzeBRnJ6QlJx8+ePytW +wt/kvg2gvCvnqPU4FLxlOd2v8uznBwfxbaOfUGp+LFq+xGLuEcI= -----END RSA PRIVATE KEY----- diff --git a/libs/http2-manager/test/resources/localhost.example.com.pem b/libs/http2-manager/test/resources/localhost.example.com.pem index 9e53052017f..68129459c33 100644 --- a/libs/http2-manager/test/resources/localhost.example.com.pem +++ b/libs/http2-manager/test/resources/localhost.example.com.pem @@ -1,20 +1,20 @@ -----BEGIN CERTIFICATE----- -MIIDTTCCAjWgAwIBAgIUIkVuiJvGrfJmLrIQFccHMcUzaWgwDQYJKoZIhvcNAQEL -BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjMwNDA2MDc0MzAwWhcN -MjQwNDA1MDc0MzAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA -7FcFU2mPY8aUXvz6ulx+dTAIyJ+Ny9+H+S/aYsCNoEA8/YwNG9jtAyLVnFk2OzIo -RC1inU1jDWRDwLKJpfn/y0QSHVtXZKq8qNeyWZXWDzMUxogu4lDR/Bi6LpqwcovH -c5hzvzddXsyWY5NcYHgmZA4C7yurySS3z11f5GodziOrax0YaQ7QaugiZVe9+tDv -jw1FO4DPKlr+KyARyJTYw/zUNNTqsftHIb+Slnt90vEm+AexRPku/msmMxmX1VUn -BXe1xkgVQsfMIekB8q8XJgZmtHO2eKBiK7eo+h1Cvp62aZ1J5o3PM3WMqeSfKYxz -DaNYwDNdliUNahCbucEqrwIDAQABo4GlMIGiMA4GA1UdDwEB/wQEAwIFoDAdBgNV +MIIDTTCCAjWgAwIBAgIURyxnGa6NsfEvToQDEhdfX8LlzhAwDQYJKoZIhvcNAQEL +BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjQwNDExMDgwMzAwWhcN +MjUwNDExMDgwMzAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA +sk6VVVl3CLj7aBLK6APqM/jZ1eqoB+XvY47GcmwGyvnqJaWBT6nNxnNKLD4bFPzN +y+3V3fa4H/HAgJDT2mjASkvG1HV8QMnqfN5fi2sbtlxWrEpBVTUCiUfBeN/nSsyz +XkaKjGMMrdvgX9HPEOAQ7dhYc+rhpGt1GKN0DYzNwR5szscZE/TfDl7s0+rQdmD4 +xLYkI6RvmqF3wFbu1nS9Nhbbm1dlr5imTIWJyPTv5QOTxJ0AnpmkilqaXA/1zhmh +8Lmi+NRa1d0k5+YVd6OFKTAiWK4vXHseFYY3Kn4knYzC4MQePPfHR2rTqyUKzFrT +tDXtSjnm9YnsWidaxwA+tQIDAQABo4GlMIGiMA4GA1UdDwEB/wQEAwIFoDAdBgNV HSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAdBgNVHQ4E -FgQUVijlGqw4qU0eIIoAMKhTCmovOHowHwYDVR0jBBgwFoAUA3gYvghrcPIXmtrg +FgQUo8perUMimbM3e3wRmxXbOy0i9XswHwYDVR0jBBgwFoAUA3gYvghrcPIXmtrg 72RjCnGSl4UwIwYDVR0RAQH/BBkwF4IVbG9jYWxob3N0LmV4YW1wbGUuY29tMA0G -CSqGSIb3DQEBCwUAA4IBAQCfZfwgGZI7nIURdMemkKTURMSL/NwJ3NFsIKXzzzCe -inkfuvyZsFK9el5ioE7Dn9KxDJsOrjg9T2eIgTLnkDzw7jnTvlUlt7/w73CEE78H -33QGNurOFGmHLTXymcznrdlKsEd+cNJPMR/beQYZ2rAEvIhKFnEPC/FXlo1JHB6p -mZ6vbWD6UeDiiqd8BmIP1n6cfyVhDa7ivkXg90Y32aGQAjBCN/s83n4FPnMuTOPV -t+yrkxK79Q4fUveOGpLSOckdieOZ7d9VW/MEQ1ozK4DUCdxVQRlZ5NFwFWSFe8M5 -vUNkVlJvQ8h8lQTYlfi83c9kg7Pxqe2OV2X97IP/pSXI +CSqGSIb3DQEBCwUAA4IBAQBKMDMxn2ztyFLEORoXObkJcryVCPMNlYzRhhhEwyMH ++7jHxIrYiT0yHeJc9slPLuodz656XuMqIYjzA3LjtdAMPyTiq8DRBlz7ZCWSbMF6 +ok6fJ2W1QVZqGxgEFfNDe3BFN90H3hygtDwZ53jKY5IWY6lb/t8OL5WSCMQvVZC7 +rCaMKvzUePBv6lE0rcE1nLLI+0KQOObWYXp1JeFTYhet3Y5+AZyaUliT0OzFgWqE +mmfFxK7mmoB76mlKAwQKceZCA9BtmPYCTTZvIo8m0zrRodZKA4HbUqTOt2JEFo82 +jWPfvtYi2WmkS/J3ta6gvtQspiu9FgyT8vS4pB8ZA9GO -----END CERTIFICATE----- diff --git a/libs/http2-manager/test/resources/localhost.pem b/libs/http2-manager/test/resources/localhost.pem index 6e976ce4094..a4057c8e7f7 100644 --- a/libs/http2-manager/test/resources/localhost.pem +++ b/libs/http2-manager/test/resources/localhost.pem @@ -1,20 +1,20 @@ -----BEGIN CERTIFICATE----- -MIIDQTCCAimgAwIBAgIUGQi379sMAQZkgFfBZEqkvMHbVfwwDQYJKoZIhvcNAQEL -BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjMwNDA2MDc0MzAwWhcN -MjQwNDA1MDc0MzAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA -yEWHRBYdUDzWzqAToCFI1Pdp4sntIEvTxjurRdFzNv11rgchA5L0U/gsOp6kaybd -qN5TGe1oaCDOM44hMyeZB95WCq8bzIbALPI+0EMc0sHzNI8Cs8dMgdrviXpO06X4 -WNamZUFgTs0vNmy1SzSZMhMveAEe5k1B1JIdueheQAnjayIplZno/hD0ndl7Pvb+ -14Jm2INCHI/DuhV0qkebRLO/ierNb2b4xQcnTBu3TyYeDnJ6sVvJz3uEx35byaG+ -SVyZq7Hrjaz6jHxEpmHSZpuGjFTSgXkoq1WzISR/ohuRq6Y3uGJYmmXFbJQoUekI -xOPWPFVuKPJ3UY/rFZUA7QIDAQABo4GZMIGWMA4GA1UdDwEB/wQEAwIFoDAdBgNV +MIIDQTCCAimgAwIBAgIUH7ZhadI1BvsW7XjGhI9Eso8ol3gwDQYJKoZIhvcNAQEL +BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjQwNDExMDgwMzAwWhcN +MjUwNDExMDgwMzAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA +0r4IgyNodKaYcz363YNCjsUNgzIi3upmANohDkW+D4k/q8IRbQjR9/fdO1jgWt6N +nbkMa79OdwEj7RUwCMI2fjvOgA78CEn1/3JgZQ7YV/RtiavMawET2SHDldwzhY77 +J/EuvM2arog4KJCOqEsQl9a0+T3bbz0dAzQWNELp7z/P0SwtIw087bjY2VfcKlCZ +JqwpacQES2fGEtImHLJlpkQaWdyvURHf23KIraRm60A9aDOuoKl+7C5Wp7NI3Alk +DuGrAXR841Mc7qqvhEzNIfrabHTjrwVrwgijcPkkgPNzlmznI4sr5EBCx8imMdFc +mOFRStXFEJDa47459Zz1lQIDAQABo4GZMIGWMA4GA1UdDwEB/wQEAwIFoDAdBgNV HSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAdBgNVHQ4E -FgQUMtICpNlqVmbe9tZlvdfnUBYmu5kwHwYDVR0jBBgwFoAUA3gYvghrcPIXmtrg +FgQUj3Fih2asl1UHZ26Ls/iZxaBuJq8wHwYDVR0jBBgwFoAUA3gYvghrcPIXmtrg 72RjCnGSl4UwFwYDVR0RAQH/BA0wC4IJbG9jYWxob3N0MA0GCSqGSIb3DQEBCwUA -A4IBAQBOXrdbiQI7jprgB80hYyA82axsw+5COWQvECKZTmP7zTfPsqlmsNWYT3tP -9nhe9EEl6JjOkikClO6kpRxz3EWZ+neraufetzf+VJ/6cCv9tVRaozQPJE98myWd -hdpZ9+0ZCDl2oknDWuBwze+4phd+OV0IW0rm17oJX2YBuqs4HEnbdi+2N1/8twSt -MAhoG460aYWc2IzWEIS7OmBEjJAcjTag5s+tYXDa5GF5hnDiu+d6iIM0ct2oqSqh -e3IJgIcpb6GKSyNILvYPLuzarH0xnuIMX6/3NsMNukC9P9pz3RyE/FT1q+umjzXj -R2fcA2K2hLPfE1l3GH5LLMfirqNB +A4IBAQAOeD/2dPIbs4qQXVrlemxspeU4VRn0Pybxihxhwyy15d4v3l0bJkBXhSmh +ve8AzEbsVDvF34B6i82uDsas5DxRs5BUIW3svbJzGUMgVtfRal2gpUQVdlKS5FDF +rbQGqMs0NogdUkQ24JKElCoysgMAcsXEE1Kpgdr7ZxeZkhJHu20imXuBa7sC4s+I +Z24W2cU3HfF+5YNZd/kNUjY9StbiibHsSMcRcmW9Rq8ij3RCOoSFJ7HzCj4PVZKa +3+U82PjotZK3h6c2jPjaPbkh5Ua/+gBmebdWBqSyGqSV94CYbESqTMckXytx9Bx2 +BI9HpBioQiwTxadmALmv1guCQzV8 -----END CERTIFICATE----- diff --git a/libs/imports/default.nix b/libs/imports/default.nix index b1b77f2c86e..728fca8f3b5 100644 --- a/libs/imports/default.nix +++ b/libs/imports/default.nix @@ -11,7 +11,6 @@ , gitignoreSource , lib , mtl -, string-conversions , text , transformers , unliftio @@ -29,7 +28,6 @@ mkDerivation { deepseq extra mtl - string-conversions text transformers unliftio diff --git a/libs/imports/imports.cabal b/libs/imports/imports.cabal index 845228c8f10..a1ddc13d9bb 100644 --- a/libs/imports/imports.cabal +++ b/libs/imports/imports.cabal @@ -75,7 +75,6 @@ library , deepseq , extra , mtl - , string-conversions , text , transformers , unliftio diff --git a/libs/imports/src/Imports.hs b/libs/imports/src/Imports.hs index d44ab47c404..91841bbdd8c 100644 --- a/libs/imports/src/Imports.hs +++ b/libs/imports/src/Imports.hs @@ -114,7 +114,6 @@ module Imports -- * Extra Helpers whenM, unlessM, - cs, -- * Functor (<$$>), @@ -165,7 +164,6 @@ import Data.Ord import Data.Semigroup hiding (diff) import Data.Set (Set) import Data.String -import Data.String.Conversions (cs) import Data.Text (Text) import Data.Text.Lazy qualified import Data.Traversable diff --git a/libs/jwt-tools/default.nix b/libs/jwt-tools/default.nix index a6cdf09b241..1314bde5186 100644 --- a/libs/jwt-tools/default.nix +++ b/libs/jwt-tools/default.nix @@ -12,7 +12,9 @@ , imports , lib , rusty_jwt_tools_ffi +, string-conversions , transformers +, utf8-string }: mkDerivation { pname = "jwt-tools"; @@ -24,9 +26,16 @@ mkDerivation { http-types imports transformers + utf8-string ]; librarySystemDepends = [ rusty_jwt_tools_ffi ]; - testHaskellDepends = [ bytestring hspec imports transformers ]; + testHaskellDepends = [ + bytestring + hspec + imports + string-conversions + transformers + ]; description = "FFI to rusty-jwt-tools"; license = lib.licenses.agpl3Only; } diff --git a/libs/jwt-tools/jwt-tools.cabal b/libs/jwt-tools/jwt-tools.cabal index 57f815466ab..e2f12a9b352 100644 --- a/libs/jwt-tools/jwt-tools.cabal +++ b/libs/jwt-tools/jwt-tools.cabal @@ -68,6 +68,7 @@ library , http-types , imports , transformers + , utf8-string default-language: GHC2021 other-extensions: ForeignFunctionInterface @@ -83,6 +84,7 @@ test-suite jwt-tools-tests , hspec , imports , jwt-tools + , string-conversions , transformers hs-source-dirs: test diff --git a/libs/jwt-tools/src/Data/Jwt/Tools.hs b/libs/jwt-tools/src/Data/Jwt/Tools.hs index 3e2804db8e4..e9c3ce549de 100644 --- a/libs/jwt-tools/src/Data/Jwt/Tools.hs +++ b/libs/jwt-tools/src/Data/Jwt/Tools.hs @@ -34,6 +34,7 @@ module Data.Jwt.Tools NowEpoch (..), PemBundle (..), Handle (..), + DisplayName (..), TeamId (..), ) where @@ -41,6 +42,7 @@ where import Control.Exception hiding (handle) import Control.Monad.Trans.Except import Data.ByteString.Conversion +import Data.ByteString.UTF8 qualified as UTF8 import Foreign.C.String (CString, newCString, peekCString) import Foreign.Ptr (Ptr, nullPtr) import Imports @@ -74,12 +76,15 @@ type EpochWord64 = Word64 type BackendBundleCStr = CString +type DisplayNameCStr = CString + foreign import ccall unsafe "generate_dpop_access_token" generate_dpop_access_token :: ProofCStr -> UserIdCStr -> ClientIdWord64 -> HandleCStr -> + DisplayNameCStr -> TeamIdCStr -> DomainCStr -> NonceCStr -> @@ -102,6 +107,7 @@ generateDpopAccessTokenFfi :: UserIdCStr -> ClientIdWord64 -> HandleCStr -> + DisplayNameCStr -> TeamIdCStr -> DomainCStr -> NonceCStr -> @@ -112,8 +118,8 @@ generateDpopAccessTokenFfi :: EpochWord64 -> BackendBundleCStr -> IO (Maybe (Ptr HsResult)) -generateDpopAccessTokenFfi dpopProof user client handle tid domain nonce uri method maxSkewSecs expiration now backendKeys = do - ptr <- generate_dpop_access_token dpopProof user client handle tid domain nonce uri method maxSkewSecs expiration now backendKeys +generateDpopAccessTokenFfi dpopProof user client handle displayName tid domain nonce uri method maxSkewSecs expiration now backendKeys = do + ptr <- generate_dpop_access_token dpopProof user client handle displayName tid domain nonce uri method maxSkewSecs expiration now backendKeys if ptr /= nullPtr then pure $ Just ptr else pure Nothing @@ -138,6 +144,7 @@ generateDpopToken :: UserId -> ClientId -> Handle -> + DisplayName -> TeamId -> Domain -> Nonce -> @@ -148,15 +155,16 @@ generateDpopToken :: NowEpoch -> PemBundle -> ExceptT DPoPTokenGenerationError m ByteString -generateDpopToken dpopProof uid cid handle tid domain nonce uri method maxSkewSecs maxExpiration now backendPubkeyBundle = do +generateDpopToken dpopProof uid cid handle displayName tid domain nonce uri method maxSkewSecs maxExpiration now backendPubkeyBundle = do dpopProofCStr <- toCStr dpopProof uidCStr <- toCStr uid handleCStr <- toCStr handle + displayNameCStr <- toCStr displayName tidCStr <- toCStr tid domainCStr <- toCStr domain nonceCStr <- toCStr nonce uriCStr <- toCStr uri - methodCStr <- liftIO $ newCString $ cs $ methodToBS method + methodCStr <- liftIO $ newCString $ UTF8.toString $ methodToBS method backendPubkeyBundleCStr <- toCStr backendPubkeyBundle -- log all variable inputs (can comment in if need to generate new test data) @@ -165,6 +173,7 @@ generateDpopToken dpopProof uid cid handle tid domain nonce uri method maxSkewSe -- traceM $ "nonce = Nonce " <> show (_unNonce nonce) -- traceM $ "expires = ExpiryEpoch " <> show (_unExpiryEpoch maxExpiration) -- traceM $ "handle = Handle " <> show (_unHandle handle) + -- traceM $ "displayName = DisplayName " <> show (_unDisplayName displayName) -- traceM $ "tid = TeamId " <> show (_unTeamId tid) let before = @@ -173,6 +182,7 @@ generateDpopToken dpopProof uid cid handle tid domain nonce uri method maxSkewSe uidCStr (_unClientId cid) handleCStr + displayNameCStr tidCStr domainCStr nonceCStr @@ -196,7 +206,7 @@ generateDpopToken dpopProof uid cid handle tid domain nonce uri method maxSkewSe toCStr = liftIO . newCString . toStr where toStr :: a -> String - toStr = cs . toByteString' + toStr = UTF8.toString . toByteString' methodToBS :: StdMethod -> ByteString methodToBS = \case @@ -212,8 +222,8 @@ generateDpopToken dpopProof uid cid handle tid domain nonce uri method maxSkewSe toResult :: Maybe Word8 -> Maybe String -> Either DPoPTokenGenerationError ByteString -- the only valid cases are when the error=0 (meaning no error) or nothing and the token is not null -toResult (Just 0) (Just token) = Right $ cs token -toResult Nothing (Just token) = Right $ cs token +toResult (Just 0) (Just token) = Right $ UTF8.fromString token +toResult Nothing (Just token) = Right $ UTF8.fromString token -- errors toResult (Just errNo) _ = Left $ fromInt (fromIntegral errNo) where @@ -273,6 +283,10 @@ newtype PemBundle = PemBundle {_unPemBundle :: ByteString} deriving (Eq, Show) deriving newtype (ToByteString) +newtype DisplayName = DisplayName {_unDisplayName :: ByteString} + deriving (Eq, Show) + deriving newtype (ToByteString) + data DPoPTokenGenerationError = NoError | -- | Unmapped error @@ -359,4 +373,6 @@ data DPoPTokenGenerationError DpopHandleMismatch | -- Client team does not match the supplied team DpopTeamMismatch + | -- Client display name does not match the supplied display name + DpopDisplayNameMismatch deriving (Eq, Show, Generic, Bounded, Enum) diff --git a/libs/jwt-tools/test/Spec.hs b/libs/jwt-tools/test/Spec.hs index ac3bbfd3aca..664c18d3874 100644 --- a/libs/jwt-tools/test/Spec.hs +++ b/libs/jwt-tools/test/Spec.hs @@ -18,6 +18,7 @@ import Control.Monad.Trans.Except import Data.ByteString.Char8 (split) import Data.Jwt.Tools +import Data.String.Conversions import Imports import Test.Hspec @@ -25,7 +26,7 @@ main :: IO () main = hspec $ do describe "generateDpopToken FFI when passing valid inputs" $ do it "should return an access token with the correct header" $ do - actual <- runExceptT $ generateDpopToken proof uid cid handle tid domain nonce uri method maxSkewSecs expires now pem + actual <- runExceptT $ generateDpopToken proof uid cid handle displayName tid domain nonce uri method maxSkewSecs expires now pem -- The actual payload of the DPoP token is not deterministic as it depends on the current time. -- We therefore only check the header, because if the header is correct, it means the token creation was successful.s let expectedHeader = "eyJhbGciOiJFZERTQSIsInR5cCI6ImF0K2p3dCIsImp3ayI6eyJrdHkiOiJPS1AiLCJjcnYiOiJFZDI1NTE5IiwieCI6ImRZSTM4VWR4a3NDMEs0UXg2RTlKSzlZZkdtLWVoblkxOG9LbUhMMllzWmsifX0" @@ -33,7 +34,7 @@ main = hspec $ do actualHeader `shouldBe` expectedHeader describe "generateDpopToken FFI when passing a wrong nonce value" $ do it "should return BackendNonceMismatchError" $ do - actual <- runExceptT $ generateDpopToken proof uid cid handle tid domain (Nonce "foobar") uri method maxSkewSecs expires now pem + actual <- runExceptT $ generateDpopToken proof uid cid handle displayName tid domain (Nonce "foobar") uri method maxSkewSecs expires now pem actual `shouldBe` Left BackendNonceMismatchError describe "toResult" $ do it "should convert to correct error" $ do @@ -74,15 +75,41 @@ main = hspec $ do toResult (Just 17) (Just token) `shouldBe` Left ExpMismatchError toResult (Just 18) Nothing `shouldBe` Left Expired toResult (Just 18) (Just token) `shouldBe` Left Expired + toResult (Just 19) (Just token) `shouldBe` Left InvalidUserId + toResult (Just 20) (Just token) `shouldBe` Left NotYetValid + toResult (Just 21) (Just token) `shouldBe` Left JwtSimpleError + toResult (Just 22) (Just token) `shouldBe` Left RandError + toResult (Just 23) (Just token) `shouldBe` Left Sec1Error + toResult (Just 24) (Just token) `shouldBe` Left UrlParseError + toResult (Just 25) (Just token) `shouldBe` Left UuidError + toResult (Just 26) (Just token) `shouldBe` Left Utf8Error + toResult (Just 27) (Just token) `shouldBe` Left Base64DecodeError + toResult (Just 28) (Just token) `shouldBe` Left JsonError + toResult (Just 29) (Just token) `shouldBe` Left InvalidJsonPath + toResult (Just 30) (Just token) `shouldBe` Left JsonPathError + toResult (Just 31) (Just token) `shouldBe` Left InvalidJwkThumbprint + toResult (Just 32) (Just token) `shouldBe` Left MissingDpopHeader + toResult (Just 33) (Just token) `shouldBe` Left MissingIssuer + toResult (Just 34) (Just token) `shouldBe` Left DpopChallengeMismatch + toResult (Just 35) (Just token) `shouldBe` Left DpopHtuMismatch + toResult (Just 36) (Just token) `shouldBe` Left DpopHtmMismatch + toResult (Just 37) (Just token) `shouldBe` Left InvalidBackendKeys + toResult (Just 38) (Just token) `shouldBe` Left InvalidClientId + toResult (Just 39) (Just token) `shouldBe` Left UnsupportedApiVersion + toResult (Just 40) (Just token) `shouldBe` Left UnsupportedScope + toResult (Just 41) (Just token) `shouldBe` Left DpopHandleMismatch + toResult (Just 42) (Just token) `shouldBe` Left DpopTeamMismatch + toResult (Just 43) (Just token) `shouldBe` Left DpopDisplayNameMismatch toResult Nothing Nothing `shouldBe` Left UnknownError where token = "" - proof = Proof "eyJhbGciOiJFZERTQSIsImp3ayI6eyJjcnYiOiJFZDI1NTE5Iiwia3R5IjoiT0tQIiwieCI6Im5MSkdOLU9hNkpzcTNLY2xaZ2dMbDdVdkFWZG1CMFE2QzNONUJDZ3BoSHcifSwidHlwIjoiZHBvcCtqd3QifQ.eyJhdWQiOiJodHRwczovL3dpcmUuY29tL2FjbWUvY2hhbGxlbmdlL2FiY2QiLCJjaGFsIjoid2EyVnJrQ3RXMXNhdUoyRDN1S1k4cmM3eTRrbDR1c0giLCJleHAiOjE4MzE3MzcyNzEsImhhbmRsZSI6IndpcmVhcHA6Ly8lNDB2bHVwZHlwbml4dm1vdnZzeW1ndHdAZXhhbXBsZS5jb20iLCJodG0iOiJQT1NUIiwiaHR1IjoiaHR0cHM6Ly9leGFtcGxlLmNvbS9jbGllbnRzL2NjNmU2NDBlMjk2ZThiYmEvYWNjZXNzLXRva2VuIiwiaWF0IjoxNzA1NTkzMjcxLCJqdGkiOiI2ZmM1OWU3Zi1iNjY2LTRmZmMtYjczOC00ZjQ3NjBjODg0Y2EiLCJuYmYiOjE3MDU1OTMyNzEsIm5vbmNlIjoibVJDdjNKQS1TNDI0dUJyLVk2QzFndyIsInN1YiI6IndpcmVhcHA6Ly9WNVc3ZnRNeVRJNlBNYlE0Y3ZkazRnIWNjNmU2NDBlMjk2ZThiYmFAZXhhbXBsZS5jb20iLCJ0ZWFtIjoiZmZhODY1ZmEtYjI0YS00Njk3LWFhMDUtMWZjM2YzNjU0ZGI5In0.BVdawX_84Mpmvzbs3v52t3GtCgSKzxgnFDkwf4QK6AusoyfsjhK6grs9GLEe2Lfb1eDrBUJgo-nobeIWmRumBQ" - uid = UserId "5795bb7e-d332-4c8e-8f31-b43872f764e2" - nonce = Nonce "mRCv3JA-S424uBr-Y6C1gw" - expires = ExpiryEpoch 1831823671 - handle = Handle "vlupdypnixvmovvsymgtw" - tid = TeamId "ffa865fa-b24a-4697-aa05-1fc3f3654db9" + proof = Proof "eyJhbGciOiJFZERTQSIsImp3ayI6eyJjcnYiOiJFZDI1NTE5Iiwia3R5IjoiT0tQIiwieCI6Im5MSkdOLU9hNkpzcTNLY2xaZ2dMbDdVdkFWZG1CMFE2QzNONUJDZ3BoSHcifSwidHlwIjoiZHBvcCtqd3QifQ.eyJhdWQiOiJodHRwczovL3dpcmUuY29tL2FjbWUvY2hhbGxlbmdlL2FiY2QiLCJjaGFsIjoid2EyVnJrQ3RXMXNhdUoyRDN1S1k4cmM3eTRrbDR1c0giLCJleHAiOjE3Mzk4ODA2NzQsImhhbmRsZSI6IndpcmVhcHA6Ly8lNDB5d2Z5ZG5pZ2Jud2h1b3pldGphZ3FAZXhhbXBsZS5jb20iLCJodG0iOiJQT1NUIiwiaHR1IjoiaHR0cHM6Ly9leGFtcGxlLmNvbS9jbGllbnRzL2NjNmU2NDBlMjk2ZThiYmEvYWNjZXNzLXRva2VuIiwiaWF0IjoxNzA4MzQ0Njc0LCJqdGkiOiI2ZmM1OWU3Zi1iNjY2LTRmZmMtYjczOC00ZjQ3NjBjODg0Y2EiLCJuYW1lIjoi5reB4qqu5KSq5rK255Kh4bKV6re14Y2q6omE6Jy16Iu17ICV54Kb66-v56qp5KqW766M6bGw6oOy6b6m57m15pWJ4LqH54et6rOj54KHIiwibmJmIjoxNzA4MzQ0Njc0LCJub25jZSI6IllWZ2dHdWlTUTZlamhQNTNFX0tPS3ciLCJzdWIiOiJ3aXJlYXBwOi8vSWZ0VzBLeFVSb2F1QWVockRremJiQSFjYzZlNjQwZTI5NmU4YmJhQGV4YW1wbGUuY29tIiwidGVhbSI6ImMxNTE5NzVlLWIxOTMtNDAwOS1hM2QyLTc0N2M5NjFmMjMzMyJ9.SHxpMzOe2yC3y6DP7lEH0l7_eOKrUZZI0OjgtnCKjO4OBD0XqKOi0y_z07-7FWc-KtThlsaZatnBNTB67GhQBw" + uid = UserId "21fb56d0-ac54-4686-ae01-e86b0e4cdb6c" + nonce = Nonce "YVggGuiSQ6ejhP53E_KOKw" + expires = ExpiryEpoch 1739967074 + handle = Handle "ywfydnigbnwhuozetjagq" + displayName = DisplayName "\230\183\129\226\170\174\228\164\170\230\178\182\231\146\161\225\178\149\234\183\181\225\141\170\234\137\132\232\156\181\232\139\181\236\128\149\231\130\155\235\175\175\231\170\169\228\170\150\239\174\140\233\177\176\234\131\178\233\190\166\231\185\181\230\149\137\224\186\135\231\135\173\234\179\163\231\130\135" + tid = TeamId "c151975e-b193-4009-a3d2-747c961f2333" now = NowEpoch 1704982162 cid = ClientId 14730821443162901434 diff --git a/libs/metrics-wai/default.nix b/libs/metrics-wai/default.nix index 616c581b7fd..eb65cf447ae 100644 --- a/libs/metrics-wai/default.nix +++ b/libs/metrics-wai/default.nix @@ -16,6 +16,7 @@ , servant , servant-multipart , text +, utf8-string , wai , wai-middleware-prometheus , wai-route @@ -35,6 +36,7 @@ mkDerivation { servant servant-multipart text + utf8-string wai wai-middleware-prometheus wai-route diff --git a/libs/metrics-wai/metrics-wai.cabal b/libs/metrics-wai/metrics-wai.cabal index 5ea237e1964..3d9725348fe 100644 --- a/libs/metrics-wai/metrics-wai.cabal +++ b/libs/metrics-wai/metrics-wai.cabal @@ -79,6 +79,7 @@ library , servant , servant-multipart , text >=0.11 + , utf8-string , wai >=3 , wai-middleware-prometheus , wai-route >=0.3 diff --git a/libs/metrics-wai/src/Data/Metrics/Servant.hs b/libs/metrics-wai/src/Data/Metrics/Servant.hs index 372cdc95055..b8ec0984997 100644 --- a/libs/metrics-wai/src/Data/Metrics/Servant.hs +++ b/libs/metrics-wai/src/Data/Metrics/Servant.hs @@ -26,11 +26,14 @@ -- | Given a servant API type, this module gives you a 'Paths' for 'withPathTemplate'. module Data.Metrics.Servant where +import Data.ByteString.UTF8 qualified as UTF8 import Data.Metrics.Middleware.Prometheus (normalizeWaiRequestRoute) import Data.Metrics.Types import Data.Metrics.Types qualified as Metrics import Data.Metrics.WaiRoute (treeToPaths) import Data.Proxy +import Data.Text.Encoding +import Data.Text.Encoding.Error import Data.Tree import GHC.TypeLits import Imports @@ -48,8 +51,8 @@ servantPrometheusMiddleware _ = Promth.prometheus conf . instrument promthNormal promthNormalize :: Wai.Request -> Text promthNormalize req = pathInfo where - mPathInfo = Metrics.treeLookup (routesToPaths @api) $ cs <$> Wai.pathInfo req - pathInfo = cs $ fromMaybe "N/A" mPathInfo + mPathInfo = Metrics.treeLookup (routesToPaths @api) $ encodeUtf8 <$> Wai.pathInfo req + pathInfo = decodeUtf8With lenientDecode $ fromMaybe "N/A" mPathInfo -- See Note [Raw Response] instrument = Promth.instrumentHandlerValueWithFilter Promth.ignoreRawResponses @@ -85,14 +88,14 @@ instance (KnownSymbol seg, RoutesToPaths segs) => RoutesToPaths (seg :> segs) where - getRoutes = [Node (Right . cs $ symbolVal (Proxy @seg)) (getRoutes @segs)] + getRoutes = [Node (Right . UTF8.fromString $ symbolVal (Proxy @seg)) (getRoutes @segs)] -- :> routes instance (KnownSymbol capture, RoutesToPaths segs) => RoutesToPaths (Capture' mods capture a :> segs) where - getRoutes = [Node (Left (cs (":" <> symbolVal (Proxy @capture)))) (getRoutes @segs)] + getRoutes = [Node (Left (UTF8.fromString (":" <> symbolVal (Proxy @capture)))) (getRoutes @segs)] instance (RoutesToPaths rest) => diff --git a/libs/metrics-wai/src/Data/Metrics/Test.hs b/libs/metrics-wai/src/Data/Metrics/Test.hs index 308dc18193f..95016f23a5f 100644 --- a/libs/metrics-wai/src/Data/Metrics/Test.hs +++ b/libs/metrics-wai/src/Data/Metrics/Test.hs @@ -19,6 +19,8 @@ module Data.Metrics.Test where import Data.Metrics.Types import Data.Text qualified as Text +import Data.Text.Encoding +import Data.Text.Encoding.Error import Data.Tree qualified as Tree import Imports @@ -50,9 +52,12 @@ pathsConsistencyCheck (Paths forest) = mconcat $ go [] <$> forest findSiteConsistencyError prefix subtrees = case mapMaybe captureVars subtrees of [] -> Nothing [_] -> Nothing - bad@(_ : _ : _) -> Just $ SiteConsistencyError (either cs cs <$> prefix) bad + bad@(_ : _ : _) -> + Just $ + SiteConsistencyError (either decode decode <$> prefix) bad captureVars :: Tree.Tree (Either ByteString any) -> Maybe (Text, Int) - captureVars (Tree.Node (Left root) trees) = Just (cs root, weight trees) + captureVars (Tree.Node (Left root) trees) = Just (decode root, weight trees) captureVars (Tree.Node (Right _) _) = Nothing weight :: Tree.Forest a -> Int weight = sum . fmap (length . Tree.flatten) + decode = decodeUtf8With lenientDecode diff --git a/libs/polysemy-wire-zoo/default.nix b/libs/polysemy-wire-zoo/default.nix index e5a88e3be19..ebf7e8de8c5 100644 --- a/libs/polysemy-wire-zoo/default.nix +++ b/libs/polysemy-wire-zoo/default.nix @@ -8,6 +8,7 @@ , bytestring , cassandra-util , containers +, crypton , gitignoreSource , HsOpenSSL , hspec @@ -36,6 +37,7 @@ mkDerivation { base bytestring cassandra-util + crypton HsOpenSSL hspec imports diff --git a/libs/polysemy-wire-zoo/polysemy-wire-zoo.cabal b/libs/polysemy-wire-zoo/polysemy-wire-zoo.cabal index c6c363632e9..505874d7b6c 100644 --- a/libs/polysemy-wire-zoo/polysemy-wire-zoo.cabal +++ b/libs/polysemy-wire-zoo/polysemy-wire-zoo.cabal @@ -86,6 +86,7 @@ library , base >=4.6 && <5.0 , bytestring , cassandra-util + , crypton , HsOpenSSL , hspec , imports diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Jwk.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Jwk.hs index c0edb3d94c4..913e5cbf7b7 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Jwk.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Jwk.hs @@ -5,6 +5,7 @@ module Wire.Sem.Jwk where import Control.Exception import Crypto.JOSE.JWK import Data.Aeson +import Data.ByteString (fromStrict) import qualified Data.ByteString as BS import Imports import Polysemy @@ -18,4 +19,8 @@ interpretJwk :: Members '[Embed IO] r => Sem (Jwk ': r) a -> Sem r a interpretJwk = interpret $ \(Get fp) -> liftIO $ readJwk fp readJwk :: FilePath -> IO (Maybe JWK) -readJwk fp = try @IOException (BS.readFile fp) <&> either (const Nothing) (decode . cs) +readJwk fp = + try @IOException (BS.readFile fp) + <&> either + (const Nothing) + (decode . fromStrict) diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Paging/Cassandra.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Paging/Cassandra.hs index 7507d69c7d0..3856abcd9d0 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Paging/Cassandra.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Paging/Cassandra.hs @@ -36,6 +36,7 @@ import Data.Id import Data.Qualified import Data.Range import Imports +import Wire.API.Connection (UserConnection) import Wire.API.Team.Member (HardTruncationLimit, TeamMember) import qualified Wire.Sem.Paging as E @@ -97,6 +98,8 @@ type instance E.PagingBounds CassandraPaging TeamMember = Range 1 HardTruncation type instance E.PagingBounds InternalPaging TeamId = Range 1 100 Int32 +type instance E.PagingBounds InternalPaging (Remote UserConnection) = Range 1 1000 Int32 + instance E.Paging InternalPaging where pageItems (InternalPage (_, _, items)) = items pageHasMore (InternalPage (p, _, _)) = hasMore p diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Random.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Random.hs index aa58643eea1..da054b545ed 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Random.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Random.hs @@ -22,9 +22,11 @@ module Wire.Sem.Random bytes, uuid, scimTokenId, + liftRandom, ) where +import Crypto.Random.Types import Data.Id (ScimTokenId) import Data.UUID (UUID) import Imports @@ -34,5 +36,6 @@ data Random m a where Bytes :: Int -> Random m ByteString Uuid :: Random m UUID ScimTokenId :: Random m ScimTokenId + LiftRandom :: (forall mr. MonadRandom mr => mr a) -> Random m a makeSem ''Random diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Random/IO.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Random/IO.hs index 5fcf31709d8..e64815799f4 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Random/IO.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Random/IO.hs @@ -35,3 +35,4 @@ randomToIO = interpret $ \case Bytes i -> embed $ randBytes i Uuid -> embed $ UUID.nextRandom ScimTokenId -> embed $ randomId @IO + LiftRandom m -> embed @IO $ m diff --git a/libs/types-common/default.nix b/libs/types-common/default.nix index d13e256a89c..7421aae499c 100644 --- a/libs/types-common/default.nix +++ b/libs/types-common/default.nix @@ -23,6 +23,7 @@ , gitignoreSource , hashable , http-api-data +, http-types , imports , iproute , iso3166-country-codes @@ -40,6 +41,7 @@ , random , schema-profunctor , servant-server +, string-conversions , tagged , tasty , tasty-hunit @@ -51,6 +53,7 @@ , unix , unordered-containers , uri-bytestring +, utf8-string , uuid , yaml }: @@ -77,6 +80,7 @@ mkDerivation { generic-random hashable http-api-data + http-types imports iproute iso3166-country-codes @@ -103,6 +107,7 @@ mkDerivation { unix unordered-containers uri-bytestring + utf8-string uuid yaml ]; @@ -114,6 +119,7 @@ mkDerivation { cereal imports protobuf + string-conversions tasty tasty-hunit tasty-quickcheck diff --git a/libs/types-common/src/Data/Code.hs b/libs/types-common/src/Data/Code.hs index ba176629701..ef70a0aeb52 100644 --- a/libs/types-common/src/Data/Code.hs +++ b/libs/types-common/src/Data/Code.hs @@ -3,7 +3,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -- This file is part of the Wire Server implementation. -- @@ -27,10 +26,8 @@ module Data.Code where import Cassandra hiding (Value) import Data.Aeson qualified as A -import Data.Aeson.TH import Data.Bifunctor (Bifunctor (first)) import Data.ByteString.Conversion -import Data.Json.Util import Data.OpenApi qualified as S import Data.OpenApi.ParamSchema import Data.Proxy (Proxy (Proxy)) @@ -38,7 +35,8 @@ import Data.Range import Data.Schema import Data.Text (pack) import Data.Text.Ascii -import Data.Text.Encoding (encodeUtf8) +import Data.Text.Encoding +import Data.Text.Encoding.Error import Data.Time.Clock import Imports import Servant (FromHttpApiData (..), ToHttpApiData (..)) @@ -65,7 +63,7 @@ instance FromHttpApiData Key where first pack $ runParser parser (encodeUtf8 s) instance ToHttpApiData Key where - toQueryParam key = cs (toByteString' key) + toQueryParam key = decodeUtf8With lenientDecode (toByteString' key) -- | A secret value bound to a 'Key' and a 'Timeout'. newtype Value = Value {asciiValue :: Range 6 20 AsciiBase64Url} @@ -88,7 +86,7 @@ instance FromHttpApiData Value where first pack $ runParser parser (encodeUtf8 s) instance ToHttpApiData Value where - toQueryParam key = cs (toByteString' key) + toQueryParam key = decodeUtf8With lenientDecode (toByteString' key) -- | A 'Timeout' is rendered in/parsed from JSON as an integer representing the -- number of seconds remaining. @@ -123,5 +121,11 @@ data KeyValuePair = KeyValuePair code :: !Value } deriving (Eq, Generic, Show) - -deriveJSON toJSONFieldName ''KeyValuePair + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema KeyValuePair + +instance ToSchema KeyValuePair where + schema = + object "KeyValuePair" $ + KeyValuePair + <$> key .= field "key" schema + <*> code .= field "code" schema diff --git a/libs/types-common/src/Data/Credentials.hs b/libs/types-common/src/Data/Credentials.hs new file mode 100644 index 00000000000..52c632f9307 --- /dev/null +++ b/libs/types-common/src/Data/Credentials.hs @@ -0,0 +1,37 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2024 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 Data.Credentials where + +import Data.Aeson (FromJSON) +import Data.ByteString.Base64 qualified as B64 +import Data.Text +import Data.Text.Encoding qualified as TE +import Imports +import Network.HTTP.Types.Header + +-- | Generic credentials for authenticating a user. Usually used for deserializing from a secret yaml file. +data Credentials = Credentials + { username :: Text, + password :: Text + } + deriving stock (Generic) + +instance FromJSON Credentials + +mkBasicAuthHeader :: Credentials -> Header +mkBasicAuthHeader (Credentials u p) = (hAuthorization, "Basic " <> B64.encode (TE.encodeUtf8 (u <> ":" <> p))) diff --git a/libs/types-common/src/Data/Domain.hs b/libs/types-common/src/Data/Domain.hs index 6f9d0884405..ed74cd230a3 100644 --- a/libs/types-common/src/Data/Domain.hs +++ b/libs/types-common/src/Data/Domain.hs @@ -19,6 +19,7 @@ module Data.Domain where +import Cassandra import Control.Lens ((?~)) import Data.Aeson (FromJSON, FromJSONKey, FromJSONKeyFunction (FromJSONKeyTextParser), ToJSON, ToJSONKey (toJSONKey)) import Data.Aeson qualified as Aeson @@ -81,7 +82,7 @@ instance FromByteString Domain where parser = domainParser instance ToByteString Domain where - builder = Builder.lazyByteString . cs @Text @LByteString . _domainText + builder = Builder.lazyByteString . BS.Char8.fromStrict . Text.E.encodeUtf8 . _domainText instance FromHttpApiData Domain where parseUrlPiece = first Text.pack . mkDomain @@ -177,3 +178,9 @@ instance Arbitrary DomainText where [ (1, pure ""), (5, x) -- to get longer labels ] + +instance Cql Domain where + ctype = Tagged TextColumn + toCql = CqlText . domainText + fromCql (CqlText txt) = mkDomain txt + fromCql _ = Left "Domain: Text expected" diff --git a/libs/types-common/src/Data/Handle.hs b/libs/types-common/src/Data/Handle.hs index 29d1570cc32..59854e89ec8 100644 --- a/libs/types-common/src/Data/Handle.hs +++ b/libs/types-common/src/Data/Handle.hs @@ -25,6 +25,7 @@ module Data.Handle ) where +import Cassandra qualified as C import Data.Aeson (FromJSON (..), ToJSON (..)) import Data.Attoparsec.ByteString.Char8 qualified as Atto import Data.Bifunctor (Bifunctor (first)) @@ -50,6 +51,8 @@ newtype Handle = Handle deriving newtype (ToByteString, Hashable, S.ToParamSchema) deriving (FromJSON, ToJSON, S.ToSchema) via Schema Handle +deriving instance C.Cql Handle + instance ToSchema Handle where schema = fromHandle .= parsedText "Handle" p where diff --git a/libs/types-common/src/Data/Id.hs b/libs/types-common/src/Data/Id.hs index c707a4ea02d..2f57ba3d920 100644 --- a/libs/types-common/src/Data/Id.hs +++ b/libs/types-common/src/Data/Id.hs @@ -38,6 +38,7 @@ module Data.Id ScimTokenId, parseIdFromText, idToText, + idObjectSchema, IdObject (..), -- * Client IDs @@ -444,7 +445,7 @@ newtype IdObject a = IdObject {fromIdObject :: a} deriving (ToJSON, FromJSON, S.ToSchema) via Schema (IdObject a) instance ToSchema a => ToSchema (IdObject a) where - schema = - object "Id" $ - IdObject - <$> fromIdObject .= field "id" schema + schema = idObjectSchema (IdObject <$> fromIdObject .= schema) + +idObjectSchema :: ValueSchemaP NamedSwaggerDoc a b -> ValueSchemaP NamedSwaggerDoc a b +idObjectSchema sch = object "Id" (field "id" sch) diff --git a/libs/types-common/src/Data/Json/Util.hs b/libs/types-common/src/Data/Json/Util.hs index 2c898487f04..91f0e420fe6 100644 --- a/libs/types-common/src/Data/Json/Util.hs +++ b/libs/types-common/src/Data/Json/Util.hs @@ -61,6 +61,7 @@ import Data.ByteString.Base64.URL qualified as B64U import Data.ByteString.Builder qualified as BB import Data.ByteString.Conversion qualified as BS import Data.ByteString.Lazy qualified as L +import Data.ByteString.UTF8 qualified as UTF8 import Data.Fixed import Data.OpenApi qualified as S import Data.Schema @@ -101,17 +102,24 @@ newtype UTCTimeMillis = UTCTimeMillis {fromUTCTimeMillis :: UTCTime} deriving (FromJSON, ToJSON, S.ToSchema) via Schema UTCTimeMillis instance ToSchema UTCTimeMillis where - schema = UTCTimeMillis <$> showUTCTimeMillis .= utcTimeTextSchema - -utcTimeTextSchema :: ValueSchemaP NamedSwaggerDoc Text UTCTime -utcTimeTextSchema = - parsedText "UTCTime" (Atto.parseOnly (Atto.utcTime <* Atto.endOfInput)) + schema = + UTCTimeMillis + <$> showUTCTimeMillis + .= ( utcTimeTextSchema "UTCTimeMillis" + & doc . S.schema + %~ (S.format ?~ "yyyy-mm-ddThh:MM:ss.qqqZ") + . (S.example ?~ "2021-05-12T10:52:02.671Z") + ) + +utcTimeTextSchema :: Text -> ValueSchemaP NamedSwaggerDoc Text UTCTime +utcTimeTextSchema name = + parsedText name (Atto.parseOnly (Atto.utcTime <* Atto.endOfInput)) & doc . S.schema - %~ (S.format ?~ "yyyy-mm-ddThh:MM:ss.qqq") - . (S.example ?~ "2021-05-12T10:52:02.671Z") + %~ (S.format ?~ "yyyy-mm-ddThh:MM:ssZ") + . (S.example ?~ "2021-05-12T10:52:02Z") utcTimeSchema :: ValueSchema NamedSwaggerDoc UTCTime -utcTimeSchema = showUTCTime .= utcTimeTextSchema +utcTimeSchema = showUTCTime .= utcTimeTextSchema "UTCTime" {-# INLINE toUTCTimeMillis #-} toUTCTimeMillis :: UTCTime -> UTCTimeMillis @@ -134,7 +142,7 @@ instance Show UTCTimeMillis where showsPrec d = showParen (d > 10) . showString . Text.unpack . showUTCTimeMillis instance BS.ToByteString UTCTimeMillis where - builder = BB.byteString . cs . show + builder = BB.byteString . UTF8.fromString . show instance BS.FromByteString UTCTimeMillis where parser = maybe (fail "UTCTimeMillis") pure . readUTCTimeMillis =<< BS.parser diff --git a/libs/types-common/src/Data/Misc.hs b/libs/types-common/src/Data/Misc.hs index 23a404e2c02..837c24d18c2 100644 --- a/libs/types-common/src/Data/Misc.hs +++ b/libs/types-common/src/Data/Misc.hs @@ -79,7 +79,8 @@ import Data.OpenApi qualified as S import Data.Range import Data.Schema import Data.Text qualified as Text -import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Data.Text.Encoding +import Data.Text.Encoding.Error import GHC.TypeLits (Nat) import GHC.TypeNats (KnownNat) import Imports @@ -139,10 +140,13 @@ instance ToSchema IpAddr where schema = toText .= parsedText "IpAddr" fromText where toText :: IpAddr -> Text - toText = cs . toByteString + toText = decodeUtf8With lenientDecode . toStrict . toByteString fromText :: Text -> Either String IpAddr - fromText = maybe (Left "Failed parsing IP address.") Right . fromByteString . cs + fromText = + maybe (Left "Failed parsing IP address.") Right + . fromByteString + . encodeUtf8 instance ToSchema Port where schema = Port <$> portNumber .= schema diff --git a/libs/types-common/src/Data/Nonce.hs b/libs/types-common/src/Data/Nonce.hs index 1f094bab764..50d84f7c655 100644 --- a/libs/types-common/src/Data/Nonce.hs +++ b/libs/types-common/src/Data/Nonce.hs @@ -35,6 +35,8 @@ import Data.OpenApi qualified as S import Data.OpenApi.ParamSchema import Data.Proxy (Proxy (Proxy)) import Data.Schema +import Data.Text.Encoding +import Data.Text.Encoding.Error import Data.UUID as UUID (UUID, fromByteString, toByteString) import Data.UUID.V4 (nextRandom) import Imports @@ -48,10 +50,15 @@ newtype Nonce = Nonce {unNonce :: UUID} deriving (A.FromJSON, A.ToJSON, S.ToSchema) via (Schema Nonce) instance ToSchema Nonce where - schema = (cs . toByteString') .= parsedText "Nonce" p + schema = + (decodeUtf8With lenientDecode . toByteString') .= parsedText "Nonce" p where p :: Text -> Either String Nonce - p = maybe (Left "Invalid Nonce") Right . fromByteString' . cs + p = + maybe (Left "Invalid Nonce") Right + . fromByteString' + . fromStrict + . encodeUtf8 instance ToByteString Nonce where builder = builder . Base64.encodeUnpadded . toStrict . UUID.toByteString . unNonce @@ -68,16 +75,20 @@ instance ToParamSchema Nonce where toParamSchema _ = toParamSchema (Proxy @Text) instance ToHttpApiData Nonce where - toQueryParam = cs . toByteString' + toQueryParam = decodeUtf8With lenientDecode . toByteString' instance FromHttpApiData Nonce where - parseQueryParam = maybe (Left "Invalid Nonce") Right . fromByteString' . cs + parseQueryParam = + maybe (Left "Invalid Nonce") Right + . fromByteString' + . fromStrict + . encodeUtf8 randomNonce :: MonadIO m => m Nonce randomNonce = Nonce <$> liftIO nextRandom isValidBase64UrlEncodedUUID :: ByteString -> Bool -isValidBase64UrlEncodedUUID = isJust . fromByteString' @Nonce . cs +isValidBase64UrlEncodedUUID = isJust . fromByteString' @Nonce . fromStrict instance Cql Nonce where ctype = Tagged UuidColumn diff --git a/libs/types-common/src/Data/Range.hs b/libs/types-common/src/Data/Range.hs index 0ad0a3e2c14..d7a92f08d11 100644 --- a/libs/types-common/src/Data/Range.hs +++ b/libs/types-common/src/Data/Range.hs @@ -98,7 +98,7 @@ import Test.QuickCheck qualified as QC newtype Range (n :: Nat) (m :: Nat) a = Range { fromRange :: a } - deriving (Eq, Ord, Show) + deriving (Eq, Ord, Show, Functor) toRange :: (n <= x, x <= m, KnownNat x, Num a) => Proxy x -> Range n m a toRange = Range . fromIntegral . natVal diff --git a/libs/types-common/src/Util/Logging.hs b/libs/types-common/src/Util/Logging.hs index 0b4a3e7c5a2..318785c7578 100644 --- a/libs/types-common/src/Util/Logging.hs +++ b/libs/types-common/src/Util/Logging.hs @@ -29,7 +29,7 @@ import System.Logger.Message (Msg) sha256String :: Text -> Text sha256String t = let digest = hash @ByteString @SHA256 (encodeUtf8 t) - in cs . show $ digest + in T.pack . show $ digest logHandle :: Handle -> (Msg -> Msg) logHandle handl = @@ -44,7 +44,7 @@ logFunction fn = Log.field "fn" fn . Log.field "module" (getModule fn) x -> T.intercalate "." (init x) logUser :: UserId -> (Msg -> Msg) -logUser uid = Log.field "user" (cs @_ @Text . show $ uid) +logUser uid = Log.field "user" (T.pack . show $ uid) logTeam :: TeamId -> (Msg -> Msg) -logTeam tid = Log.field "team" (cs @_ @Text . show $ tid) +logTeam tid = Log.field "team" (T.pack . show $ tid) diff --git a/libs/types-common/src/Util/Options.hs b/libs/types-common/src/Util/Options.hs index 74437b78a27..f9beac14583 100644 --- a/libs/types-common/src/Util/Options.hs +++ b/libs/types-common/src/Util/Options.hs @@ -79,14 +79,19 @@ urlPort u = do makeLenses ''AWSEndpoint newtype FilePathSecrets = FilePathSecrets FilePath - deriving (Eq, Show, FromJSON) + deriving (Eq, Show, FromJSON, IsString) -loadSecret :: FromJSON a => FilePathSecrets -> IO (Either String a) +initCredentials :: (MonadIO m, FromJSON a) => FilePathSecrets -> m a +initCredentials secretFile = do + dat <- loadSecret secretFile + pure $ either (\e -> error $ "Could not load secrets from " ++ show secretFile ++ ": " ++ e) id dat + +loadSecret :: (MonadIO m, FromJSON a) => FilePathSecrets -> m (Either String a) loadSecret (FilePathSecrets p) = do path <- canonicalizePath p exists <- doesFileExist path if exists - then over _Left show . decodeEither' <$> BS.readFile path + then liftIO $ over _Left show . decodeEither' <$> BS.readFile path else pure (Left "File doesn't exist") -- | Get configuration options from the command line or configuration file. diff --git a/libs/types-common/test/Test/Data/PEMKeys.hs b/libs/types-common/test/Test/Data/PEMKeys.hs index 013688d7d70..c7a727f23d1 100644 --- a/libs/types-common/test/Test/Data/PEMKeys.hs +++ b/libs/types-common/test/Test/Data/PEMKeys.hs @@ -22,6 +22,7 @@ where import Data.ByteString.Conversion import Data.PEMKeys +import Data.String.Conversions import Imports import Test.Tasty import Test.Tasty.HUnit diff --git a/libs/types-common/test/Test/Properties.hs b/libs/types-common/test/Test/Properties.hs index 8e0556df41d..fbd1de60122 100644 --- a/libs/types-common/test/Test/Properties.hs +++ b/libs/types-common/test/Test/Properties.hs @@ -39,6 +39,7 @@ import Data.Json.Util qualified as Util import Data.Nonce (Nonce) import Data.ProtocolBuffers.Internal import Data.Serialize +import Data.String.Conversions import Data.Text.Ascii import Data.Text.Ascii qualified as Ascii import Data.Time diff --git a/libs/types-common/types-common.cabal b/libs/types-common/types-common.cabal index 0c13025aabb..5fb1c0ca72c 100644 --- a/libs/types-common/types-common.cabal +++ b/libs/types-common/types-common.cabal @@ -15,6 +15,7 @@ library exposed-modules: Data.Code Data.CommaSeparatedList + Data.Credentials Data.Domain Data.ETag Data.Handle @@ -108,6 +109,7 @@ library , generic-random >=1.4.0.0 , hashable >=1.2 , http-api-data + , http-types , imports , iproute >=1.5 , iso3166-country-codes >=0.20140203.8 @@ -134,6 +136,7 @@ library , unix , unordered-containers >=0.2 , uri-bytestring >=0.2 + , utf8-string , uuid >=1.3.11 , yaml >=0.8.22 @@ -207,6 +210,7 @@ test-suite tests , cereal , imports , protobuf + , string-conversions , tasty , tasty-hunit , tasty-quickcheck diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Headers.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Headers.hs index f1673e7de13..56049d0ecdf 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Headers.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Headers.hs @@ -17,9 +17,12 @@ module Network.Wai.Utilities.Headers where +import Data.ByteString import Data.ByteString.Conversion (FromByteString (..), ToByteString (..), fromByteString', toByteString') import Data.OpenApi.ParamSchema (ToParamSchema (..)) import Data.Text as T +import Data.Text.Encoding +import Data.Text.Encoding.Error import Imports import Servant (FromHttpApiData (..), Proxy (Proxy), ToHttpApiData (..)) @@ -37,10 +40,14 @@ instance FromByteString CacheControl where _ -> fail $ "Invalid CacheControl type: " ++ show t instance ToHttpApiData CacheControl where - toQueryParam = cs . toByteString' + toQueryParam = decodeUtf8With lenientDecode . toByteString' instance FromHttpApiData CacheControl where - parseQueryParam = maybe (Left "Invalid CacheControl") Right . fromByteString' . cs + parseQueryParam = + maybe (Left "Invalid CacheControl") Right + . fromByteString' + . fromStrict + . encodeUtf8 instance ToParamSchema CacheControl where toParamSchema _ = toParamSchema (Proxy @Text) diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/MockServer.hs b/libs/wai-utilities/src/Network/Wai/Utilities/MockServer.hs index d0072d6fbd9..407c0d47863 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/MockServer.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/MockServer.hs @@ -20,7 +20,7 @@ module Network.Wai.Utilities.MockServer where import Control.Concurrent.Async qualified as Async -import Control.Exception (throw) +import Control.Exception (throwIO) import Control.Exception qualified as E import Control.Monad.Catch import Control.Monad.Codensity @@ -83,10 +83,10 @@ startMockServer mtlsSettings app = do me <- Async.poll serverThread case me of Nothing -> Async.cancel serverThread - Just (Left e) -> throw e + Just (Left e) -> throwIO e Just (Right a) -> pure a case serverStartedSignal of Nothing -> do Async.cancel serverThread - throw (MockTimeout port) + throwIO (MockTimeout port) Just _ -> pure (closeMock, port) diff --git a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs index e611a3e34fd..80ee4329c13 100644 --- a/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs +++ b/libs/wai-utilities/src/Network/Wai/Utilities/Server.hs @@ -52,6 +52,7 @@ import Control.Error.Util ((?:)) import Control.Exception (throw) import Control.Monad.Catch hiding (onError, onException) import Data.Aeson (decode, encode) +import Data.ByteString (toStrict) import Data.ByteString qualified as BS import Data.ByteString.Builder import Data.ByteString.Char8 qualified as C @@ -61,6 +62,7 @@ import Data.Metrics.GC (spawnGCMetricsCollector) import Data.Metrics.Middleware import Data.Streaming.Zlib (ZlibException (..)) import Data.Text.Encoding.Error (lenientDecode) +import Data.Text.Lazy qualified as LT import Data.Text.Lazy.Encoding qualified as LT import Imports import Network.HTTP.Types.Status @@ -222,7 +224,7 @@ errorHandlers = Wai.mkError status500 "server-error" "Server Error", Handler $ \(e :: SomeException) -> pure . Left $ - Wai.mkError status500 "server-error" ("Server Error. " <> cs (displayException e)) + Wai.mkError status500 "server-error" ("Server Error. " <> LT.pack (displayException e)) ] {-# INLINE errorHandlers #-} @@ -290,7 +292,7 @@ heavyDebugLogging sanitizeReq lvl lgr app = \req cont -> do -- >>> pure $ fromMaybe "" nextChunk emitLByteString :: LByteString -> IO (IO ByteString) emitLByteString lbs = do - tvar <- newTVarIO (cs lbs) + tvar <- newTVarIO (toStrict lbs) -- Emit the bytestring on the first read, then always return "" on subsequent reads pure . atomically $ swapTVar tvar mempty @@ -323,7 +325,7 @@ rethrow5xx logger app req k = app req k' wrapError :: Status -> LByteString -> Wai.Error wrapError st body = decode body ?: - Wai.mkError st "server-error" (cs body) + Wai.mkError st "server-error" (LT.decodeUtf8With lenientDecode body) -- | This flushes the response! If you want to keep using the response, you need to construct -- a new one with a fresh body stream. diff --git a/libs/wire-api-federation/default.nix b/libs/wire-api-federation/default.nix index 9775b18ddb1..b287e8fdc21 100644 --- a/libs/wire-api-federation/default.nix +++ b/libs/wire-api-federation/default.nix @@ -11,6 +11,7 @@ , bytestring , bytestring-conversion , containers +, dns-util , exceptions , gitignoreSource , HsOpenSSL @@ -58,6 +59,7 @@ mkDerivation { bytestring bytestring-conversion containers + dns-util exceptions HsOpenSSL http-media diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API.hs b/libs/wire-api-federation/src/Wire/API/Federation/API.hs index 242991d2c41..053275577e3 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API.hs @@ -24,12 +24,14 @@ module Wire.API.Federation.API HasUnsafeFedEndpoint, fedClient, fedQueueClient, + sendBundle, fedClientIn, unsafeFedClientIn, module Wire.API.MakesFederatedCall, -- * Re-exports Component (..), + makeConversationUpdateBundle, ) where @@ -45,6 +47,7 @@ import Servant.Client.Core import Wire.API.Federation.API.Brig import Wire.API.Federation.API.Cargohold import Wire.API.Federation.API.Galley +import Wire.API.Federation.API.Util import Wire.API.Federation.BackendNotifications import Wire.API.Federation.Client import Wire.API.Federation.Component @@ -88,21 +91,21 @@ fedClient :: Client m api fedClient = clientIn (Proxy @api) (Proxy @m) -fedQueueClient :: - forall {k} (tag :: k). - ( HasNotificationEndpoint tag, - KnownSymbol (NotificationPath tag), - KnownComponent (NotificationComponent k), - ToJSON (Payload tag) - ) => - Payload tag -> - FedQueueClient (NotificationComponent k) () -fedQueueClient payload = do +fedClientIn :: + forall (comp :: Component) (name :: Symbol) m api. + (HasFedEndpoint comp api name, HasClient m api) => + Client m api +fedClientIn = clientIn (Proxy @api) (Proxy @m) + +sendBundle :: + KnownComponent c => + PayloadBundle c -> + FedQueueClient c () +sendBundle bundle = do env <- ask - let notif = fedNotifToBackendNotif @tag env.requestId env.originDomain payload - msg = + let msg = newMsg - { msgBody = encode notif, + { msgBody = encode bundle, msgDeliveryMode = Just (env.deliveryMode), msgContentType = Just "application/json" } @@ -112,11 +115,18 @@ fedQueueClient payload = do ensureQueue env.channel env.targetDomain._domainText void $ publishMsg env.channel exchange (routingKey env.targetDomain._domainText) msg -fedClientIn :: - forall (comp :: Component) (name :: Symbol) m api. - (HasFedEndpoint comp api name, HasClient m api) => - Client m api -fedClientIn = clientIn (Proxy @api) (Proxy @m) +fedQueueClient :: + forall {k} (tag :: k) c. + ( HasNotificationEndpoint tag, + HasVersionRange tag, + HasFedPath tag, + KnownComponent (NotificationComponent k), + ToJSON (Payload tag), + c ~ NotificationComponent k + ) => + Payload tag -> + FedQueueClient c () +fedQueueClient payload = sendBundle =<< makeBundle @tag payload -- | Like 'fedClientIn', but doesn't propagate a 'CallsFed' constraint. Intended -- to be used in test situations only. diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs index 9f9e1ee589e..0318e84d666 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs @@ -34,8 +34,10 @@ import Wire.API.Conversation.Action import Wire.API.Federation.Component import Wire.API.Federation.Endpoint import Wire.API.Federation.HasNotificationEndpoint +import Wire.API.Federation.Version import Wire.API.MLS.SubConversation import Wire.API.Message +import Wire.API.Routes.Version (From, Until) import Wire.API.Util.Aeson import Wire.Arbitrary @@ -43,6 +45,7 @@ data GalleyNotificationTag = OnClientRemovedTag | OnMessageSentTag | OnMLSMessageSentTag + | OnConversationUpdatedTagV0 | OnConversationUpdatedTag | OnUserDeletedConversationsTag deriving (Show, Eq, Generic, Bounded, Enum) @@ -66,9 +69,16 @@ instance HasNotificationEndpoint 'OnMLSMessageSentTag where -- used by the backend that owns a conversation to inform this backend of -- changes to the conversation +instance HasNotificationEndpoint 'OnConversationUpdatedTagV0 where + type Payload 'OnConversationUpdatedTagV0 = ConversationUpdateV0 + type NotificationPath 'OnConversationUpdatedTagV0 = "on-conversation-updated" + type NotificationVersionTag 'OnConversationUpdatedTagV0 = 'Just 'V0 + type NotificationMods 'OnConversationUpdatedTagV0 = '[Until 'V1] + instance HasNotificationEndpoint 'OnConversationUpdatedTag where type Payload 'OnConversationUpdatedTag = ConversationUpdate type NotificationPath 'OnConversationUpdatedTag = "on-conversation-updated" + type NotificationMods 'OnConversationUpdatedTag = '[From 'V1] instance HasNotificationEndpoint 'OnUserDeletedConversationsTag where type Payload 'OnUserDeletedConversationsTag = UserDeletedConversationsNotification @@ -79,6 +89,7 @@ type GalleyNotificationAPI = NotificationFedEndpoint 'OnClientRemovedTag :<|> NotificationFedEndpoint 'OnMessageSentTag :<|> NotificationFedEndpoint 'OnMLSMessageSentTag + :<|> NotificationFedEndpoint 'OnConversationUpdatedTagV0 :<|> NotificationFedEndpoint 'OnConversationUpdatedTag :<|> NotificationFedEndpoint 'OnUserDeletedConversationsTag @@ -129,7 +140,7 @@ data RemoteMLSMessage = RemoteMLSMessage instance ToSchema RemoteMLSMessage -data ConversationUpdate = ConversationUpdate +data ConversationUpdateV0 = ConversationUpdateV0 { cuTime :: UTCTime, cuOrigUserId :: Qualified UserId, -- | The unqualified ID of the conversation where the update is happening. @@ -147,12 +158,56 @@ data ConversationUpdate = ConversationUpdate } deriving (Eq, Show, Generic) +instance ToJSON ConversationUpdateV0 + +instance FromJSON ConversationUpdateV0 + +instance ToSchema ConversationUpdateV0 + +data ConversationUpdate = ConversationUpdate + { time :: UTCTime, + origUserId :: Qualified UserId, + -- | The unqualified ID of the conversation where the update is happening. + -- The ID is local to the sender to prevent putting arbitrary domain that + -- is different than that of the backend making a conversation membership + -- update request. + convId :: ConvId, + -- | A list of users from the receiving backend that need to be sent + -- notifications about this change. This is required as we do not expect a + -- non-conversation owning backend to have an indexed mapping of + -- conversation to users. + alreadyPresentUsers :: [UserId], + -- | Information on the specific action that caused the update. + action :: SomeConversationAction + } + deriving (Eq, Show, Generic) + instance ToJSON ConversationUpdate instance FromJSON ConversationUpdate instance ToSchema ConversationUpdate +conversationUpdateToV0 :: ConversationUpdate -> ConversationUpdateV0 +conversationUpdateToV0 cu = + ConversationUpdateV0 + { cuTime = cu.time, + cuOrigUserId = cu.origUserId, + cuConvId = cu.convId, + cuAlreadyPresentUsers = cu.alreadyPresentUsers, + cuAction = cu.action + } + +conversationUpdateFromV0 :: ConversationUpdateV0 -> ConversationUpdate +conversationUpdateFromV0 cu = + ConversationUpdate + { time = cu.cuTime, + origUserId = cu.cuOrigUserId, + convId = cu.cuConvId, + alreadyPresentUsers = cu.cuAlreadyPresentUsers, + action = cu.cuAction + } + type UserDeletedNotificationMaxConvs = 1000 data UserDeletedConversationsNotification = UserDeletedConversationsNotification diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Util.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Util.hs new file mode 100644 index 00000000000..d855c2abb01 --- /dev/null +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Util.hs @@ -0,0 +1,29 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2023 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Wire.API.Federation.API.Util where + +import Imports +import Wire.API.Federation.API.Galley.Notifications +import Wire.API.Federation.BackendNotifications +import Wire.API.Federation.Component + +makeConversationUpdateBundle :: + ConversationUpdate -> + FedQueueClient 'Galley (PayloadBundle 'Galley) +makeConversationUpdateBundle update = + (<>) <$> makeBundle update <*> makeBundle (conversationUpdateToV0 update) diff --git a/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs b/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs index b3cb2546ab4..43849c716da 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs @@ -4,11 +4,14 @@ module Wire.API.Federation.BackendNotifications where import Control.Exception +import Control.Monad.Codensity import Control.Monad.Except -import Data.Aeson +import Data.Aeson qualified as A import Data.Domain import Data.Id (RequestId) +import Data.List.NonEmpty qualified as NE import Data.Map qualified as Map +import Data.Schema import Data.Text qualified as Text import Data.Text.Lazy.Encoding qualified as TL import Imports @@ -20,6 +23,8 @@ import Wire.API.Federation.API.Common import Wire.API.Federation.Client import Wire.API.Federation.Component import Wire.API.Federation.Error +import Wire.API.Federation.HasNotificationEndpoint +import Wire.API.Federation.Version import Wire.API.RawJson -- | NOTE: Stored in RabbitMQ, any changes to serialization of this object could cause @@ -33,46 +38,115 @@ data BackendNotification = BackendNotification -- pusher. This also makes development less clunky as we don't have to -- create a sum type here for all types of notifications that could exist. body :: RawJson, + -- | The federation API versions that the 'body' corresponds to. The field + -- is optional so that messages already in the queue are not lost. + bodyVersions :: Maybe VersionRange, requestId :: Maybe RequestId } deriving (Show, Eq) - -instance ToJSON BackendNotification where - toJSON notif = - object - [ "ownDomain" .= notif.ownDomain, - "targetComponent" .= notif.targetComponent, - "path" .= notif.path, - "body" .= TL.decodeUtf8 notif.body.rawJsonBytes, - "requestId" .= notif.requestId - ] - -instance FromJSON BackendNotification where - parseJSON = withObject "BackendNotification" $ \o -> - BackendNotification - <$> o .: "ownDomain" - <*> o .: "targetComponent" - <*> o .: "path" - <*> (RawJson . TL.encodeUtf8 <$> o .: "body") - <*> o .:? "requestId" + deriving (A.ToJSON, A.FromJSON) via (Schema BackendNotification) + +instance ToSchema BackendNotification where + schema = + object "BackendNotification" $ + BackendNotification + <$> ownDomain .= field "ownDomain" schema + <*> targetComponent .= field "targetComponent" schema + <*> path .= field "path" schema + <*> (TL.decodeUtf8 . rawJsonBytes . body) + .= field "body" (RawJson . TL.encodeUtf8 <$> schema) + <*> bodyVersions .= maybe_ (optField "bodyVersions" schema) + <*> (.requestId) .= maybe_ (optField "requestId" schema) + +-- | Convert a federation endpoint to a backend notification to be enqueued to a +-- RabbitMQ queue. +fedNotifToBackendNotif :: + forall {k} (tag :: k). + ( HasFedPath tag, + HasVersionRange tag, + KnownComponent (NotificationComponent k), + A.ToJSON (Payload tag) + ) => + RequestId -> + Domain -> + Payload tag -> + BackendNotification +fedNotifToBackendNotif rid ownDomain payload = + let p = Text.pack $ fedPath @tag + b = RawJson . A.encode $ payload + in toNotif p b + where + toNotif :: Text -> RawJson -> BackendNotification + toNotif path body = + BackendNotification + { ownDomain = ownDomain, + targetComponent = componentVal @(NotificationComponent k), + path = path, + body = body, + bodyVersions = Just $ versionRange @tag, + requestId = Just rid + } + +newtype PayloadBundle (c :: Component) = PayloadBundle + { notifications :: NE.NonEmpty BackendNotification + } + deriving (A.ToJSON, A.FromJSON) via (Schema (PayloadBundle c)) + deriving newtype (Semigroup) + +instance ToSchema (PayloadBundle c) where + schema = + object "PayloadBundle" $ + PayloadBundle + <$> notifications .= field "notifications" (nonEmptyArray schema) + +toBundle :: + forall {k} (tag :: k). + ( HasFedPath tag, + HasVersionRange tag, + KnownComponent (NotificationComponent k), + A.ToJSON (Payload tag) + ) => + RequestId -> + -- | The origin domain + Domain -> + Payload tag -> + PayloadBundle (NotificationComponent k) +toBundle reqId originDomain payload = + let notif = fedNotifToBackendNotif @tag reqId originDomain payload + in PayloadBundle . pure $ notif + +makeBundle :: + forall {k} (tag :: k) c. + ( HasFedPath tag, + HasVersionRange tag, + KnownComponent (NotificationComponent k), + A.ToJSON (Payload tag), + c ~ NotificationComponent k + ) => + Payload tag -> + FedQueueClient c (PayloadBundle c) +makeBundle payload = do + reqId <- asks (.requestId) + origin <- asks (.originDomain) + pure $ toBundle @tag reqId origin payload type BackendNotificationAPI = Capture "name" Text :> ReqBody '[JSON] RawJson :> Post '[JSON] EmptyResponse -sendNotification :: FederatorClientEnv -> Component -> Text -> RawJson -> IO (Either FederatorClientError ()) -sendNotification env component path body = - case component of - Brig -> go @'Brig - Galley -> go @'Galley - Cargohold -> go @'Cargohold +sendNotification :: FederatorClientVersionedEnv -> Component -> Text -> RawJson -> IO (Either FederatorClientError ()) +sendNotification env component path body = case someComponent component of + SomeComponent p -> go p where withoutFirstSlash :: Text -> Text withoutFirstSlash (Text.stripPrefix "/" -> Just t) = t withoutFirstSlash t = t - go :: forall c. (KnownComponent c) => IO (Either FederatorClientError ()) - go = - runFederatorClient env . void $ - clientIn (Proxy @BackendNotificationAPI) (Proxy @(FederatorClient c)) (withoutFirstSlash path) body + go :: forall c. KnownComponent c => Proxy c -> IO (Either FederatorClientError ()) + go _ = + lowerCodensity + . runExceptT + . runVersionedFederatorClientToCodensity env + . void + $ clientIn (Proxy @BackendNotificationAPI) (Proxy @(FederatorClient c)) (withoutFirstSlash path) body enqueue :: Q.Channel -> RequestId -> Domain -> Domain -> Q.DeliveryMode -> FedQueueClient c a -> IO a enqueue channel requestId originDomain targetDomain deliveryMode (FedQueueClient action) = diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Client.hs b/libs/wire-api-federation/src/Wire/API/Federation/Client.hs index 648a4ee3ec6..37444a6a49e 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Client.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Client.hs @@ -21,8 +21,10 @@ module Wire.API.Federation.Client ( FederatorClientEnv (..), FederatorClientVersionedEnv (..), + unversionedEnv, FederatorClient, runFederatorClient, + runVersionedFederatorClient, runFederatorClientToCodensity, runVersionedFederatorClientToCodensity, performHTTP2Request, @@ -85,6 +87,9 @@ data FederatorClientVersionedEnv = FederatorClientVersionedEnv cveVersion :: Maybe Version } +unversionedEnv :: FederatorClientEnv -> FederatorClientVersionedEnv +unversionedEnv env = FederatorClientVersionedEnv env Nothing + -- | A request to a remote backend. The API version of the remote backend is in -- the environment. The 'MaybeT' layer is used to match endpoint versions (via -- the 'Alternative' and 'VersionedMonad' instances). @@ -171,7 +176,16 @@ instance KnownComponent c => RunClient (FederatorClient c) where expectedStatuses v <- asks cveVersion - let vreq = req {requestHeaders = (versionHeader, toByteString' (versionInt (fromMaybe V0 v))) :<| requestHeaders req} + let vreq = + req + { requestHeaders = + ( versionHeader, + toByteString' + ( versionInt (fromMaybe V0 v) + ) + ) + :<| requestHeaders req + } withHTTP2StreamingRequest successfulStatus vreq $ \resp -> do bdy <- @@ -297,6 +311,15 @@ runFederatorClient env = lowerCodensity . runFederatorClientToCodensity env +runVersionedFederatorClient :: + FederatorClientVersionedEnv -> + FederatorClient c a -> + IO (Either FederatorClientError a) +runVersionedFederatorClient venv = + lowerCodensity + . runExceptT + . runVersionedFederatorClientToCodensity venv + runFederatorClientToCodensity :: forall c a. FederatorClientEnv -> @@ -306,7 +329,7 @@ runFederatorClientToCodensity env action = runExceptT $ do v <- runVersionedFederatorClientToCodensity (FederatorClientVersionedEnv env Nothing) - versionNegotiation + (versionNegotiation supportedVersions) runVersionedFederatorClientToCodensity @c (FederatorClientVersionedEnv env (Just v)) action @@ -323,8 +346,8 @@ runVersionedFederatorClientToCodensity env = where unmaybe = (maybe (E.throw FederatorClientVersionMismatch) pure =<<) -versionNegotiation :: FederatorClient 'Brig Version -versionNegotiation = +versionNegotiation :: Set Version -> FederatorClient 'Brig Version +versionNegotiation localVersions = let req = defaultRequest { requestPath = "/api-version", @@ -334,13 +357,15 @@ versionNegotiation = } in withHTTP2StreamingRequest @'Brig HTTP.statusIsSuccessful req $ \resp -> do body <- toLazyByteString <$> streamingResponseStrictBody resp - remoteVersions <- case Aeson.decode body of + allRemoteVersions <- case Aeson.decode body of Nothing -> E.throw (FederatorClientVersionNegotiationError InvalidVersionInfo) - Just info -> pure (Set.fromList (vinfoSupported info)) - case Set.lookupMax (Set.intersection remoteVersions supportedVersions) of + Just info -> pure (vinfoSupported info) + -- ignore versions that don't even exist locally + let remoteVersions = Set.fromList $ Imports.mapMaybe intToVersion allRemoteVersions + case Set.lookupMax (Set.intersection remoteVersions localVersions) of Just v -> pure v Nothing -> E.throw . FederatorClientVersionNegotiationError $ - if Set.lookupMax supportedVersions > Set.lookupMax remoteVersions + if Set.lookupMax localVersions > Set.lookupMax remoteVersions then RemoteTooOld else RemoteTooNew diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Component.hs b/libs/wire-api-federation/src/Wire/API/Federation/Component.hs index 73595904f7c..1a5b91e6bd3 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Component.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Component.hs @@ -21,6 +21,7 @@ module Wire.API.Federation.Component ) where +import Data.Proxy import Imports import Wire.API.MakesFederatedCall (Component (..)) @@ -46,3 +47,11 @@ instance KnownComponent 'Galley where instance KnownComponent 'Cargohold where componentVal = Cargohold + +data SomeComponent where + SomeComponent :: KnownComponent c => Proxy c -> SomeComponent + +someComponent :: Component -> SomeComponent +someComponent Brig = SomeComponent (Proxy @'Brig) +someComponent Galley = SomeComponent (Proxy @'Galley) +someComponent Cargohold = SomeComponent (Proxy @'Cargohold) diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Endpoint.hs b/libs/wire-api-federation/src/Wire/API/Federation/Endpoint.hs index e656a3eda2f..f24085139cb 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Endpoint.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Endpoint.hs @@ -23,6 +23,7 @@ where import Data.Kind import GHC.TypeLits +import Imports import Servant.API import Wire.API.ApplyMods import Wire.API.Federation.API.Common @@ -41,21 +42,29 @@ type instance FedPath (name :: Symbol) = name type instance FedPath (Versioned v name) = name +type UnnamedFedEndpointWithMods (mods :: [Type]) path input output = + ( ApplyMods + mods + (path :> OriginDomainHeader :> ReqBody '[JSON] input :> Post '[JSON] output) + ) + type FedEndpointWithMods (mods :: [Type]) name input output = Named name - ( ApplyMods - mods - (FedPath name :> OriginDomainHeader :> ReqBody '[JSON] input :> Post '[JSON] output) + ( UnnamedFedEndpointWithMods mods (FedPath name) input output ) -type NotificationFedEndpointWithMods (mods :: [Type]) name input = - FedEndpointWithMods mods name input EmptyResponse - type FedEndpoint name input output = FedEndpointWithMods '[] name input output +type NotificationFedEndpointWithMods (mods :: [Type]) name path input = + Named name (UnnamedFedEndpointWithMods mods path input EmptyResponse) + type NotificationFedEndpoint tag = - FedEndpoint (NotificationPath tag) (Payload tag) EmptyResponse + MkNotificationFedEndpoint + (NotificationMods tag) + (NotificationPath tag) + (NotificationVersionTag tag) + (Payload tag) type StreamingFedEndpoint name input output = Named @@ -65,3 +74,18 @@ type StreamingFedEndpoint name input output = :> ReqBody '[JSON] input :> StreamPost NoFraming OctetStream output ) + +type family + MkNotificationFedEndpoint + (m :: [Type]) + (s :: Symbol) + (v :: Maybe k) + (p :: Type) + +type instance + MkNotificationFedEndpoint m s 'Nothing p = + NotificationFedEndpointWithMods m s s p + +type instance + MkNotificationFedEndpoint m s ('Just v) p = + NotificationFedEndpointWithMods m (Versioned v s) s p diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Error.hs b/libs/wire-api-federation/src/Wire/API/Federation/Error.hs index fcf3c9adce1..830a9f062fc 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Error.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Error.hs @@ -84,6 +84,7 @@ module Wire.API.Federation.Error where import Data.Aeson qualified as Aeson +import Data.Domain import Data.Text qualified as T import Data.Text.Encoding qualified as T import Data.Text.Encoding.Error qualified as T @@ -97,6 +98,7 @@ import Network.Wai.Utilities.Error qualified as Wai import OpenSSL.Session (SomeSSLException) import Servant.Client import Wire.API.Error +import Wire.Network.DNS.SRV -- | Transport-layer errors in federator client. data FederatorClientHTTP2Error @@ -209,27 +211,45 @@ federationClientErrorToWai FederatorClientVersionMismatch = "internal-error" "Endpoint version mismatch in federation client" -federationRemoteHTTP2Error :: FederatorClientHTTP2Error -> Wai.Error -federationRemoteHTTP2Error FederatorClientNoStatusCode = - Wai.mkError - unexpectedFederationResponseStatus - "federation-http2-error" - "No status code in HTTP2 response" -federationRemoteHTTP2Error (FederatorClientHTTP2Exception e) = - Wai.mkError - unexpectedFederationResponseStatus - "federation-http2-error" - (LT.pack (displayException e)) -federationRemoteHTTP2Error (FederatorClientTLSException e) = - Wai.mkError - (HTTP.mkStatus 525 "SSL Handshake Failure") - "federation-tls-error" - (LT.pack (displayException e)) -federationRemoteHTTP2Error (FederatorClientConnectionError e) = - Wai.mkError - federatorConnectionRefusedStatus - "federation-connection-refused" - (LT.pack (displayException e)) +federationRemoteHTTP2Error :: SrvTarget -> Text -> FederatorClientHTTP2Error -> Wai.Error +federationRemoteHTTP2Error target path = \case + FederatorClientNoStatusCode -> + ( Wai.mkError + unexpectedFederationResponseStatus + "federation-http2-error" + "No status code in HTTP2 response" + ) + & addErrData + (FederatorClientHTTP2Exception e) -> + ( Wai.mkError + unexpectedFederationResponseStatus + "federation-http2-error" + (LT.pack (displayException e)) + ) + & addErrData + (FederatorClientTLSException e) -> + ( Wai.mkError + (HTTP.mkStatus 525 "SSL Handshake Failure") + "federation-tls-error" + (LT.pack (displayException e)) + ) + & addErrData + (FederatorClientConnectionError e) -> + ( Wai.mkError + federatorConnectionRefusedStatus + "federation-connection-refused" + (LT.pack (displayException e)) + ) + & addErrData + where + addErrData err = + err + { Wai.errorData = + ( (mkDomain . T.decodeUtf8With T.lenientDecode . srvTargetDomain $ target) :: + Either String Domain + ) + & either (const Nothing) (\dom -> Just (Wai.FederationErrorData dom path)) + } federationClientHTTP2Error :: FederatorClientHTTP2Error -> Wai.Error federationClientHTTP2Error (FederatorClientConnectionError e) = @@ -243,8 +263,8 @@ federationClientHTTP2Error e = "federation-local-error" (LT.pack (displayException e)) -federationRemoteResponseError :: HTTP.Status -> LByteString -> Wai.Error -federationRemoteResponseError status body = +federationRemoteResponseError :: SrvTarget -> Text -> HTTP.Status -> LByteString -> Wai.Error +federationRemoteResponseError target path status body = ( Wai.mkError unexpectedFederationResponseStatus "federation-remote-error" @@ -252,7 +272,12 @@ federationRemoteResponseError status body = <> LT.pack (show (HTTP.statusCode status)) ) ) - { Wai.innerError = + { Wai.errorData = + ( (mkDomain . T.decodeUtf8With T.lenientDecode . srvTargetDomain $ target) :: + Either String Domain + ) + & either (const Nothing) (\dom -> Just (Wai.FederationErrorData dom path)), + Wai.innerError = Just $ fromMaybe ( Wai.mkError diff --git a/libs/wire-api-federation/src/Wire/API/Federation/HasNotificationEndpoint.hs b/libs/wire-api-federation/src/Wire/API/Federation/HasNotificationEndpoint.hs index c2f5772a255..7fba640ee90 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/HasNotificationEndpoint.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/HasNotificationEndpoint.hs @@ -15,53 +15,78 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Wire.API.Federation.HasNotificationEndpoint where +module Wire.API.Federation.HasNotificationEndpoint + ( IsNotificationTag (..), + HasNotificationEndpoint (..), + HasFedPath, + HasVersionRange, + fedPath, + versionRange, + ) +where -import Data.Aeson -import Data.Domain -import Data.Id import Data.Kind import Data.Proxy -import Data.Text qualified as T +import Data.Singletons import GHC.TypeLits import Imports -import Wire.API.Federation.BackendNotifications import Wire.API.Federation.Component -import Wire.API.RawJson +import Wire.API.Federation.Version +import Wire.API.Routes.Version (From, Until) class IsNotificationTag k where type NotificationComponent k = (c :: Component) | c -> k class HasNotificationEndpoint t where -- | The type of the payload for this endpoint - type Payload t :: Type + type Payload t = (p :: Type) | p -> t -- | The central path component of a notification endpoint, e.g., -- "on-conversation-updated". type NotificationPath t :: Symbol --- | Convert a federation endpoint to a backend notification to be enqueued to a --- RabbitMQ queue. -fedNotifToBackendNotif :: - forall {k} (tag :: k). - KnownSymbol (NotificationPath tag) => - KnownComponent (NotificationComponent k) => - ToJSON (Payload tag) => - RequestId -> - Domain -> - Payload tag -> - BackendNotification -fedNotifToBackendNotif rid ownDomain payload = - let p = T.pack . symbolVal $ Proxy @(NotificationPath tag) - b = RawJson . encode $ payload - in toNotif p b + -- | An optional version tag to distinguish different versions of the same + -- endpoint. + type NotificationVersionTag t :: Maybe Version + + type NotificationVersionTag t = 'Nothing + + type NotificationMods t :: [Type] + + type NotificationMods t = '[] + +type HasFedPath t = KnownSymbol (NotificationPath t) + +type HasVersionRange t = MkVersionRange (NotificationMods t) + +fedPath :: forall t. HasFedPath t => String +fedPath = symbolVal (Proxy @(NotificationPath t)) + +-- | Build a version range using any 'Until' and 'From' combinators present in +-- the endpoint modifiers. +class MkVersionRange mods where + mkVersionRange :: VersionRange + +instance MkVersionRange '[] where + mkVersionRange = allVersions + +instance + {-# OVERLAPPING #-} + (MkVersionRange mods, SingI v) => + MkVersionRange (From (v :: Version) ': mods) + where + mkVersionRange = mkVersionRange @mods <> rangeFromVersion (demote @v) + +instance + {-# OVERLAPPING #-} + (MkVersionRange mods, SingI v) => + MkVersionRange (Until (v :: Version) ': mods) where - toNotif :: Text -> RawJson -> BackendNotification - toNotif path body = - BackendNotification - { ownDomain = ownDomain, - targetComponent = componentVal @(NotificationComponent k), - path = path, - body = body, - requestId = Just rid - } + mkVersionRange = mkVersionRange @mods <> rangeUntilVersion (demote @v) + +instance {-# OVERLAPPABLE #-} MkVersionRange mods => MkVersionRange (m ': mods) where + mkVersionRange = mkVersionRange @mods + +-- | The federation API version range this endpoint is supported in. +versionRange :: forall t. HasVersionRange t => VersionRange +versionRange = mkVersionRange @(NotificationMods t) diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Version.hs b/libs/wire-api-federation/src/Wire/API/Federation/Version.hs index b1e29cf520e..a9055c7384b 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Version.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Version.hs @@ -17,16 +17,37 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Wire.API.Federation.Version where +module Wire.API.Federation.Version + ( -- * Version, VersionInfo + Version (..), + V0Sym0, + V1Sym0, + intToVersion, + versionInt, + supportedVersions, + VersionInfo (..), + versionInfo, -import Control.Lens ((?~)) + -- * VersionRange + VersionUpperBound (..), + VersionRange (..), + fromVersion, + toVersionExcl, + allVersions, + latestCommonVersion, + rangeFromVersion, + rangeUntilVersion, + enumVersionRange, + ) +where + +import Control.Lens (makeLenses, (?~)) import Data.Aeson (FromJSON (..), ToJSON (..)) import Data.OpenApi qualified as S import Data.Schema import Data.Set qualified as Set import Data.Singletons.Base.TH import Imports -import Wire.API.VersionInfo data Version = V0 | V1 deriving stock (Eq, Ord, Bounded, Enum, Show, Generic) @@ -36,6 +57,9 @@ versionInt :: Version -> Int versionInt V0 = 0 versionInt V1 = 1 +intToVersion :: Int -> Maybe Version +intToVersion intV = find (\v -> versionInt v == intV) [minBound ..] + instance ToSchema Version where schema = enum @Integer "Version" . mconcat $ @@ -47,7 +71,7 @@ supportedVersions :: Set Version supportedVersions = Set.fromList [minBound .. maxBound] data VersionInfo = VersionInfo - { vinfoSupported :: [Version] + { vinfoSupported :: [Int] } deriving (FromJSON, ToJSON, S.ToSchema) via (Schema VersionInfo) @@ -55,16 +79,108 @@ instance ToSchema VersionInfo where schema = objectWithDocModifier "VersionInfo" (S.schema . S.example ?~ toJSON example) $ VersionInfo - <$> vinfoSupported .= vinfoObjectSchema schema + -- if the supported_versions field does not exist, assume an old backend + -- that only supports V0 + <$> vinfoSupported + .= fmap + (fromMaybe [0]) + (optField "supported_versions" (array schema)) + -- legacy field to support older versions of the backend with broken + -- version negotiation + <* const [0 :: Int, 1] .= field "supported" (array schema) where example :: VersionInfo example = VersionInfo - { vinfoSupported = toList supportedVersions + { vinfoSupported = map versionInt (toList supportedVersions) } versionInfo :: VersionInfo -versionInfo = VersionInfo (toList supportedVersions) +versionInfo = VersionInfo (map versionInt (toList supportedVersions)) + +---------------------------------------------------------------------- + +-- | The upper bound of a version range. +-- +-- The order of constructors here makes the 'Unbounded' value maximum in the +-- generated lexicographic ordering. +data VersionUpperBound = VersionUpperBound Version | Unbounded + deriving (Eq, Ord, Show) + +versionFromUpperBound :: VersionUpperBound -> Maybe Version +versionFromUpperBound (VersionUpperBound v) = Just v +versionFromUpperBound Unbounded = Nothing + +versionToUpperBound :: Maybe Version -> VersionUpperBound +versionToUpperBound (Just v) = VersionUpperBound v +versionToUpperBound Nothing = Unbounded + +data VersionRange = VersionRange + { _fromVersion :: Version, + _toVersionExcl :: VersionUpperBound + } + +deriving instance Eq VersionRange + +deriving instance Show VersionRange + +deriving instance Ord VersionRange + +makeLenses ''VersionRange + +instance ToSchema VersionRange where + schema = + object "VersionRange" $ + VersionRange + <$> _fromVersion .= field "from" schema + <*> (versionFromUpperBound . _toVersionExcl) + .= maybe_ (versionToUpperBound <$> optFieldWithDocModifier "until_excl" desc schema) + where + desc = description ?~ "exlusive upper version bound" + +deriving via Schema VersionRange instance ToJSON VersionRange + +deriving via Schema VersionRange instance FromJSON VersionRange + +allVersions :: VersionRange +allVersions = VersionRange minBound Unbounded + +-- | The semigroup instance of VersionRange is intersection. +instance Semigroup VersionRange where + VersionRange from1 to1 <> VersionRange from2 to2 = + VersionRange (max from1 from2) (min to1 to2) + +inVersionRange :: VersionRange -> Version -> Bool +inVersionRange (VersionRange a b) v = + v >= a && VersionUpperBound v < b + +rangeFromVersion :: Version -> VersionRange +rangeFromVersion v = VersionRange v Unbounded + +rangeUntilVersion :: Version -> VersionRange +rangeUntilVersion v = VersionRange minBound (VersionUpperBound v) + +enumVersionRange :: VersionRange -> Set Version +enumVersionRange = + Set.fromList . \case + VersionRange l Unbounded -> [l ..] + VersionRange l (VersionUpperBound u) -> init [l .. u] + +-- | For a version range of a local backend and for a set of versions that a +-- remote backend supports, compute the newest version supported by both. The +-- remote versions are given as integers as the range of versions supported by +-- the remote backend can include a version unknown to the local backend. If +-- there is no version in common, the return value is 'Nothing'. +latestCommonVersion :: Foldable f => VersionRange -> f Int -> Maybe Version +latestCommonVersion localVersions = + safeMaximum + . filter (inVersionRange localVersions) + . mapMaybe intToVersion + . toList + +safeMaximum :: Ord a => [a] -> Maybe a +safeMaximum [] = Nothing +safeMaximum as = Just (maximum as) $(genSingletons [''Version]) diff --git a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs index 3e8635f9851..568e6533b67 100644 --- a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs @@ -16,7 +16,9 @@ -- with this program. If not, see . module Test.Wire.API.Federation.Golden.ConversationUpdate - ( testObject_ConversationUpdate1, + ( testObject_ConversationUpdate1V0, + testObject_ConversationUpdate2V0, + testObject_ConversationUpdate1, testObject_ConversationUpdate2, ) where @@ -31,7 +33,7 @@ import Imports import Wire.API.Conversation import Wire.API.Conversation.Action import Wire.API.Conversation.Role (roleNameWireAdmin) -import Wire.API.Federation.API.Galley (ConversationUpdate (..)) +import Wire.API.Federation.API.Galley qAlice, qBob :: Qualified UserId qAlice = @@ -47,9 +49,9 @@ chad, dee :: UserId chad = Id (fromJust (UUID.fromString "00000fff-0000-0000-0000-000100005007")) dee = Id (fromJust (UUID.fromString "00000fff-0000-aaaa-0000-000100005007")) -testObject_ConversationUpdate1 :: ConversationUpdate -testObject_ConversationUpdate1 = - ConversationUpdate +testObject_ConversationUpdate1V0 :: ConversationUpdateV0 +testObject_ConversationUpdate1V0 = + ConversationUpdateV0 { cuTime = read "1864-04-12 12:22:43.673 UTC", cuOrigUserId = Qualified @@ -61,9 +63,9 @@ testObject_ConversationUpdate1 = cuAction = SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (qAlice :| [qBob]) roleNameWireAdmin) } -testObject_ConversationUpdate2 :: ConversationUpdate -testObject_ConversationUpdate2 = - ConversationUpdate +testObject_ConversationUpdate2V0 :: ConversationUpdateV0 +testObject_ConversationUpdate2V0 = + ConversationUpdateV0 { cuTime = read "1864-04-12 12:22:43.673 UTC", cuOrigUserId = Qualified @@ -74,3 +76,31 @@ testObject_ConversationUpdate2 = cuAlreadyPresentUsers = [chad, dee], cuAction = SomeConversationAction (sing @'ConversationLeaveTag) () } + +testObject_ConversationUpdate1 :: ConversationUpdate +testObject_ConversationUpdate1 = + ConversationUpdate + { time = read "1864-04-12 12:22:43.673 UTC", + origUserId = + Qualified + (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000007"))) + (Domain "golden.example.com"), + convId = + Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000006")), + alreadyPresentUsers = [], + action = SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (qAlice :| [qBob]) roleNameWireAdmin) + } + +testObject_ConversationUpdate2 :: ConversationUpdate +testObject_ConversationUpdate2 = + ConversationUpdate + { time = read "1864-04-12 12:22:43.673 UTC", + origUserId = + Qualified + (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000007"))) + (Domain "golden.example.com"), + convId = + Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000006")), + alreadyPresentUsers = [chad, dee], + action = SomeConversationAction (sing @'ConversationLeaveTag) () + } diff --git a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GoldenSpec.hs b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GoldenSpec.hs index b436775494e..b691cd8e962 100644 --- a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GoldenSpec.hs +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GoldenSpec.hs @@ -46,6 +46,10 @@ spec = (MLSMessageSendingStatus.testObject_MLSMessageSendingStatus3, "testObject_MLSMessageSendingStatus3.json") ] testObjects [(LeaveConversationRequest.testObject_LeaveConversationRequest1, "testObject_LeaveConversationRequest1.json")] + testObjects + [ (ConversationUpdate.testObject_ConversationUpdate1V0, "testObject_ConversationUpdate1V0.json"), + (ConversationUpdate.testObject_ConversationUpdate2V0, "testObject_ConversationUpdate2V0.json") + ] testObjects [ (ConversationUpdate.testObject_ConversationUpdate1, "testObject_ConversationUpdate1.json"), (ConversationUpdate.testObject_ConversationUpdate2, "testObject_ConversationUpdate2.json") diff --git a/libs/wire-api-federation/test/golden/testObject_ConversationUpdate1.json b/libs/wire-api-federation/test/golden/testObject_ConversationUpdate1.json index 0c5ff9a27f2..a559d4197e5 100644 --- a/libs/wire-api-federation/test/golden/testObject_ConversationUpdate1.json +++ b/libs/wire-api-federation/test/golden/testObject_ConversationUpdate1.json @@ -1,5 +1,5 @@ { - "cuAction": { + "action": { "action": { "role": "wire_admin", "users": [ @@ -15,11 +15,11 @@ }, "tag": "ConversationJoinTag" }, - "cuAlreadyPresentUsers": [], - "cuConvId": "00000000-0000-0000-0000-000100000006", - "cuOrigUserId": { + "alreadyPresentUsers": [], + "convId": "00000000-0000-0000-0000-000100000006", + "origUserId": { "domain": "golden.example.com", "id": "00000000-0000-0000-0000-000100000007" }, - "cuTime": "1864-04-12T12:22:43.673Z" -} \ No newline at end of file + "time": "1864-04-12T12:22:43.673Z" +} diff --git a/libs/wire-api-federation/test/golden/testObject_ConversationUpdate1V0.json b/libs/wire-api-federation/test/golden/testObject_ConversationUpdate1V0.json new file mode 100644 index 00000000000..89e99c41c09 --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_ConversationUpdate1V0.json @@ -0,0 +1,26 @@ +{ + "cuAction": { + "action": { + "role": "wire_admin", + "users": [ + { + "domain": "golden.example.com", + "id": "00000000-0000-0000-0000-000100004007" + }, + { + "domain": "golden2.example.com", + "id": "00000000-0000-0000-0000-000100005007" + } + ] + }, + "tag": "ConversationJoinTag" + }, + "cuAlreadyPresentUsers": [], + "cuConvId": "00000000-0000-0000-0000-000100000006", + "cuOrigUserId": { + "domain": "golden.example.com", + "id": "00000000-0000-0000-0000-000100000007" + }, + "cuTime": "1864-04-12T12:22:43.673Z" +} + diff --git a/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2.json b/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2.json index 8b443934beb..fea5fc43ecb 100644 --- a/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2.json +++ b/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2.json @@ -1,16 +1,16 @@ { - "cuAction": { + "action": { "action": {}, "tag": "ConversationLeaveTag" }, - "cuAlreadyPresentUsers": [ + "alreadyPresentUsers": [ "00000fff-0000-0000-0000-000100005007", "00000fff-0000-aaaa-0000-000100005007" ], - "cuConvId": "00000000-0000-0000-0000-000100000006", - "cuOrigUserId": { + "convId": "00000000-0000-0000-0000-000100000006", + "origUserId": { "domain": "golden.example.com", "id": "00000000-0000-0000-0000-000100000007" }, - "cuTime": "1864-04-12T12:22:43.673Z" -} \ No newline at end of file + "time": "1864-04-12T12:22:43.673Z" +} diff --git a/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2V0.json b/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2V0.json new file mode 100644 index 00000000000..df533d7bad9 --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2V0.json @@ -0,0 +1,17 @@ +{ + "cuAction": { + "action": {}, + "tag": "ConversationLeaveTag" + }, + "cuAlreadyPresentUsers": [ + "00000fff-0000-0000-0000-000100005007", + "00000fff-0000-aaaa-0000-000100005007" + ], + "cuConvId": "00000000-0000-0000-0000-000100000006", + "cuOrigUserId": { + "domain": "golden.example.com", + "id": "00000000-0000-0000-0000-000100000007" + }, + "cuTime": "1864-04-12T12:22:43.673Z" +} + diff --git a/libs/wire-api-federation/wire-api-federation.cabal b/libs/wire-api-federation/wire-api-federation.cabal index d92f39c0792..e2490419ca0 100644 --- a/libs/wire-api-federation/wire-api-federation.cabal +++ b/libs/wire-api-federation/wire-api-federation.cabal @@ -23,6 +23,7 @@ library Wire.API.Federation.API.Common Wire.API.Federation.API.Galley Wire.API.Federation.API.Galley.Notifications + Wire.API.Federation.API.Util Wire.API.Federation.BackendNotifications Wire.API.Federation.Client Wire.API.Federation.Component @@ -90,6 +91,7 @@ library , bytestring , bytestring-conversion , containers + , dns-util , exceptions , HsOpenSSL , http-media diff --git a/libs/wire-api/default.nix b/libs/wire-api/default.nix index 87dc1bf9b84..c55239a351b 100644 --- a/libs/wire-api/default.nix +++ b/libs/wire-api/default.nix @@ -7,6 +7,7 @@ , aeson-diff , aeson-pretty , aeson-qq +, asn1-encoding , async , attoparsec , base @@ -86,6 +87,7 @@ , singletons-base , singletons-th , sop-core +, string-conversions , tagged , tasty , tasty-hspec @@ -93,6 +95,7 @@ , tasty-quickcheck , text , time +, tinylog , transitive-anns , types-common , unliftio @@ -115,6 +118,7 @@ mkDerivation { src = gitignoreSource ./.; libraryHaskellDepends = [ aeson + asn1-encoding async attoparsec base @@ -190,6 +194,7 @@ mkDerivation { tagged text time + tinylog transitive-anns types-common unordered-containers @@ -242,6 +247,7 @@ mkDerivation { schema-profunctor servant servant-server + string-conversions tasty tasty-hspec tasty-hunit diff --git a/libs/wire-api/src/Wire/API/Asset.hs b/libs/wire-api/src/Wire/API/Asset.hs index 200fcbe245c..4718fa66ad5 100644 --- a/libs/wire-api/src/Wire/API/Asset.hs +++ b/libs/wire-api/src/Wire/API/Asset.hs @@ -31,7 +31,6 @@ module Wire.API.Asset -- * AssetKey AssetKey (..), assetKeyToText, - nilAssetKey, -- * AssetToken AssetToken (..), @@ -63,6 +62,7 @@ module Wire.API.Asset ) where +import Cassandra qualified as C import Codec.MIME.Type qualified as MIME import Control.Lens (makeLenses, (?~)) import Data.Aeson (FromJSON (..), ToJSON (..)) @@ -186,8 +186,11 @@ instance S.ToParamSchema AssetKey where instance FromHttpApiData AssetKey where parseUrlPiece = first T.pack . runParser parser . T.encodeUtf8 -nilAssetKey :: AssetKey -nilAssetKey = AssetKeyV3 (Id UUID.nil) AssetVolatile +instance C.Cql AssetKey where + ctype = C.Tagged C.TextColumn + toCql = C.CqlText . assetKeyToText + fromCql (C.CqlText txt) = runParser parser . T.encodeUtf8 $ txt + fromCql _ = Left "AssetKey: Text expected" -------------------------------------------------------------------------------- -- AssetToken diff --git a/libs/wire-api/src/Wire/API/Call/Config.hs b/libs/wire-api/src/Wire/API/Call/Config.hs index 18289ca1706..a4eb530ae5c 100644 --- a/libs/wire-api/src/Wire/API/Call/Config.hs +++ b/libs/wire-api/src/Wire/API/Call/Config.hs @@ -27,6 +27,7 @@ module Wire.API.Call.Config rtcConfSftServers, rtcConfSftServersAll, rtcConfTTL, + rtcConfIsFederating, -- * RTCIceServer RTCIceServer, @@ -47,6 +48,15 @@ module Wire.API.Call.Config TurnHost (..), isHostName, + -- * SFTUsername + SFTUsername (SFTUsername), + mkSFTUsername, + suExpiresAt, + suVersion, + suKeyindex, + suShared, + suRandom, + -- * TurnUsername TurnUsername, turnUsername, @@ -61,6 +71,14 @@ module Wire.API.Call.Config sftServer, sftURL, + -- * AuthSFTServer + AuthSFTServer, + authSFTServer, + nauthSFTServer, + authURL, + authUsername, + authCredential, + -- * convenience isUdp, isTcp, @@ -75,6 +93,7 @@ import Data.Aeson qualified as A hiding (()) import Data.Aeson.Types qualified as A import Data.Attoparsec.Text hiding (Parser, parse) import Data.Attoparsec.Text qualified as Text +import Data.ByteString (toStrict) import Data.ByteString.Builder import Data.ByteString.Conversion (toByteString) import Data.ByteString.Conversion qualified as BC @@ -86,6 +105,7 @@ import Data.Schema import Data.Text qualified as Text import Data.Text.Ascii import Data.Text.Encoding qualified as TE +import Data.Text.Encoding.Error import Data.Text.Strict.Lens (utf8) import Data.Time.Clock.POSIX import Imports @@ -106,7 +126,8 @@ data RTCConfiguration = RTCConfiguration { _rtcConfIceServers :: NonEmpty RTCIceServer, _rtcConfSftServers :: Maybe (NonEmpty SFTServer), _rtcConfTTL :: Word32, - _rtcConfSftServersAll :: Maybe [SFTServer] + _rtcConfSftServersAll :: Maybe [AuthSFTServer], + _rtcConfIsFederating :: Maybe Bool } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform RTCConfiguration) @@ -116,7 +137,8 @@ rtcConfiguration :: NonEmpty RTCIceServer -> Maybe (NonEmpty SFTServer) -> Word32 -> - Maybe [SFTServer] -> + Maybe [AuthSFTServer] -> + Maybe Bool -> RTCConfiguration rtcConfiguration = RTCConfiguration @@ -132,6 +154,8 @@ instance ToSchema RTCConfiguration where .= fieldWithDocModifier "ttl" (description ?~ "Number of seconds after which the configuration should be refreshed (advisory)") schema <*> _rtcConfSftServersAll .= maybe_ (optFieldWithDocModifier "sft_servers_all" (description ?~ "Array of all SFT servers") (array schema)) + <*> _rtcConfIsFederating + .= maybe_ (optFieldWithDocModifier "is_federating" (description ?~ "True if the client should connect to an SFT in the sft_servers_all and request it to federate") schema) -------------------------------------------------------------------------------- -- SFTServer @@ -157,6 +181,39 @@ instance ToSchema SFTServer where sftServer :: HttpsUrl -> SFTServer sftServer = SFTServer +-------------------------------------------------------------------------------- +-- AuthSFTServer + +data AuthSFTServer = AuthSFTServer + { _authURL :: HttpsUrl, + _authUsername :: Maybe SFTUsername, + _authCredential :: Maybe AsciiBase64 + } + deriving stock (Eq, Show, Ord, Generic) + deriving (Arbitrary) via (GenericUniform AuthSFTServer) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema AuthSFTServer) + +instance ToSchema AuthSFTServer where + schema = + objectWithDocModifier "SftServer" (description ?~ "Inspired by WebRTC 'RTCIceServer' object, contains details of SFT servers") $ + AuthSFTServer + <$> (pure . _authURL) + .= fieldWithDocModifier "urls" (description ?~ "Array containing exactly one SFT server address of the form 'https://:'") (withParser (array schema) p) + <*> _authUsername + .= maybe_ (optFieldWithDocModifier "username" (description ?~ "String containing the SFT username") schema) + <*> _authCredential + .= maybe_ (optFieldWithDocModifier "credential" (description ?~ "String containing the SFT credential") schema) + where + p :: [HttpsUrl] -> A.Parser HttpsUrl + p [url] = pure url + p xs = fail $ "SFTServer can only have exactly one URL, found " <> show (length xs) + +nauthSFTServer :: SFTServer -> AuthSFTServer +nauthSFTServer = (\u -> AuthSFTServer u Nothing Nothing) . _sftURL + +authSFTServer :: SFTServer -> SFTUsername -> AsciiBase64 -> AuthSFTServer +authSFTServer svr u = AuthSFTServer (_sftURL svr) (Just u) . Just + -------------------------------------------------------------------------------- -- RTCIceServer @@ -209,7 +266,9 @@ data TurnURI = TurnURI deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema TurnURI) instance ToSchema TurnURI where - schema = (cs . toByteString) .= parsedText "TurnURI" parseTurnURI + schema = + (TE.decodeUtf8With lenientDecode . toStrict . toByteString) + .= parsedText "TurnURI" parseTurnURI turnURI :: Scheme -> TurnHost -> Port -> Maybe Transport -> TurnURI turnURI = TurnURI @@ -388,6 +447,83 @@ instance ToSchema Transport where element "tcp" TransportTCP ] +-------------------------------------------------------------------------------- +-- SFTUsername + +data SFTUsername = SFTUsername + { -- | must be positive, integral number of seconds + _suExpiresAt :: POSIXTime, + _suVersion :: Word, + -- | seems to large, but uint32_t is used in C + _suKeyindex :: Word32, + -- | whether the user is allowed to initialise an SFT conference + _suShared :: Bool, + -- | [a-z0-9]+ + _suRandom :: Text + } + deriving stock (Eq, Ord, Show, Generic) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema SFTUsername) + +-- note that the random value is not checked for well-formedness +mkSFTUsername :: POSIXTime -> Text -> SFTUsername +mkSFTUsername expires rnd = + SFTUsername + { _suExpiresAt = expires, + _suVersion = 1, + _suKeyindex = 0, + _suShared = True, + _suRandom = rnd + } + +instance ToSchema SFTUsername where + schema = toText .= parsedText "" fromText + where + fromText :: Text -> Either String SFTUsername + fromText = parseOnly (parseSFTUsername <* endOfInput) + + toText :: SFTUsername -> Text + toText = TE.decodeUtf8With lenientDecode . toStrict . toByteString + +instance BC.ToByteString SFTUsername where + builder su = + shortByteString "d=" + <> word64Dec (round (_suExpiresAt su)) + <> shortByteString ".v=" + <> wordDec (_suVersion su) + <> shortByteString ".k=" + <> word32Dec (_suKeyindex su) + <> shortByteString ".s=" + <> wordDec (boolToWord $ _suShared su) + <> shortByteString ".r=" + <> byteString (view (re utf8) (_suRandom su)) + where + boolToWord :: Num a => Bool -> a + boolToWord False = 0 + boolToWord True = 1 + +parseSFTUsername :: Text.Parser SFTUsername +parseSFTUsername = + SFTUsername + <$> (string "d=" *> fmap (fromIntegral :: Word64 -> POSIXTime) decimal) + <*> (string ".v=" *> decimal) + <*> (string ".k=" *> decimal) + <*> (string ".s=" *> (wordToBool <$> decimal)) + <*> (string ".r=" *> takeWhile1 (inClass "a-z0-9")) + where + wordToBool :: Word -> Bool + wordToBool = odd + +instance Arbitrary SFTUsername where + arbitrary = + SFTUsername + <$> (fromIntegral <$> arbitrary @Word64) + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> (Text.pack <$> QC.listOf1 genAlphaNum) + where + genAlphaNum = QC.elements $ ['a' .. 'z'] <> ['0' .. '9'] + -------------------------------------------------------------------------------- -- TurnUsername @@ -423,7 +559,7 @@ instance ToSchema TurnUsername where fromText = parseOnly (parseTurnUsername <* endOfInput) toText :: TurnUsername -> Text - toText = cs . toByteString + toText = TE.decodeUtf8With lenientDecode . toStrict . toByteString instance BC.ToByteString TurnUsername where builder tu = @@ -509,5 +645,7 @@ isTls uri = makeLenses ''RTCConfiguration makeLenses ''RTCIceServer makeLenses ''TurnURI +makeLenses ''SFTUsername makeLenses ''TurnUsername makeLenses ''SFTServer +makeLenses ''AuthSFTServer diff --git a/libs/wire-api/src/Wire/API/Connection.hs b/libs/wire-api/src/Wire/API/Connection.hs index 138b6c3eb4b..7c0fa5bbfdd 100644 --- a/libs/wire-api/src/Wire/API/Connection.hs +++ b/libs/wire-api/src/Wire/API/Connection.hs @@ -40,6 +40,7 @@ module Wire.API.Connection ) where +import Cassandra qualified as C import Control.Applicative (optional) import Control.Lens ((?~)) import Data.Aeson (FromJSON (..), ToJSON (..)) @@ -224,6 +225,38 @@ instance ToHttpApiData Relation where Cancelled -> "cancelled" MissingLegalholdConsent -> "missing-legalhold-consent" +instance C.Cql RelationWithHistory where + ctype = C.Tagged C.IntColumn + + fromCql (C.CqlInt i) = case i of + 0 -> pure AcceptedWithHistory + 1 -> pure BlockedWithHistory + 2 -> pure PendingWithHistory + 3 -> pure IgnoredWithHistory + 4 -> pure SentWithHistory + 5 -> pure CancelledWithHistory + 6 -> pure MissingLegalholdConsentFromAccepted + 7 -> pure MissingLegalholdConsentFromBlocked + 8 -> pure MissingLegalholdConsentFromPending + 9 -> pure MissingLegalholdConsentFromIgnored + 10 -> pure MissingLegalholdConsentFromSent + 11 -> pure MissingLegalholdConsentFromCancelled + n -> Left $ "unexpected RelationWithHistory: " ++ show n + fromCql _ = Left "RelationWithHistory: int expected" + + toCql AcceptedWithHistory = C.CqlInt 0 + toCql BlockedWithHistory = C.CqlInt 1 + toCql PendingWithHistory = C.CqlInt 2 + toCql IgnoredWithHistory = C.CqlInt 3 + toCql SentWithHistory = C.CqlInt 4 + toCql CancelledWithHistory = C.CqlInt 5 + toCql MissingLegalholdConsentFromAccepted = C.CqlInt 6 + toCql MissingLegalholdConsentFromBlocked = C.CqlInt 7 + toCql MissingLegalholdConsentFromPending = C.CqlInt 8 + toCql MissingLegalholdConsentFromIgnored = C.CqlInt 9 + toCql MissingLegalholdConsentFromSent = C.CqlInt 10 + toCql MissingLegalholdConsentFromCancelled = C.CqlInt 11 + ---------------- -- Requests diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index 84cd7d2390b..120ffe6a921 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -104,6 +104,7 @@ import Data.Range (Range, fromRange, rangedSchema) import Data.SOP import Data.Schema import Data.Set qualified as Set +import Data.Text qualified as Text import Data.UUID qualified as UUID import Data.UUID.V5 qualified as UUIDV5 import Imports @@ -724,7 +725,7 @@ newConvSchema sch = \to be part of this conversation" usersRoleDesc :: Text usersRoleDesc = - cs $ + Text.pack $ "The conversation permissions the users \ \added in this request should have. \ \Optional, defaults to '" diff --git a/libs/wire-api/src/Wire/API/Error/Galley.hs b/libs/wire-api/src/Wire/API/Error/Galley.hs index 57f76ef1d65..cf48534dff7 100644 --- a/libs/wire-api/src/Wire/API/Error/Galley.hs +++ b/libs/wire-api/src/Wire/API/Error/Galley.hs @@ -57,7 +57,7 @@ import Wire.API.Conversation.Role import Wire.API.Error import Wire.API.Error.Brig qualified as BrigError import Wire.API.Routes.API -import Wire.API.Team.Member +import Wire.API.Team.HardTruncationLimit import Wire.API.Team.Permission import Wire.API.Unreachable import Wire.API.Util.Aeson (CustomEncoded (..)) diff --git a/libs/wire-api/src/Wire/API/Internal/Notification.hs b/libs/wire-api/src/Wire/API/Internal/Notification.hs index 849c8125460..7d43ef30962 100644 --- a/libs/wire-api/src/Wire/API/Internal/Notification.hs +++ b/libs/wire-api/src/Wire/API/Internal/Notification.hs @@ -47,7 +47,7 @@ import Data.Id import Data.List1 import Data.OpenApi qualified as Swagger import Data.Schema qualified as S -import Imports hiding (cs) +import Imports import Wire.API.Notification ------------------------------------------------------------------------------- diff --git a/libs/wire-api/src/Wire/API/MLS/AuthenticatedContent.hs b/libs/wire-api/src/Wire/API/MLS/AuthenticatedContent.hs index 521217f7c53..17cc9ff1df4 100644 --- a/libs/wire-api/src/Wire/API/MLS/AuthenticatedContent.hs +++ b/libs/wire-api/src/Wire/API/MLS/AuthenticatedContent.hs @@ -24,8 +24,8 @@ module Wire.API.MLS.AuthenticatedContent ) where -import Crypto.PubKey.Ed25519 -import Imports hiding (cs) +import Crypto.Random.Types +import Imports import Wire.API.MLS.CipherSuite import Wire.API.MLS.Context import Wire.API.MLS.Epoch @@ -85,8 +85,15 @@ taggedSenderMembershipTag _ = Nothing -- | Craft a message with the backend itself as a sender. Return the message and its ref. mkSignedPublicMessage :: - SecretKey -> PublicKey -> GroupId -> Epoch -> TaggedSender -> FramedContentData -> PublicMessage -mkSignedPublicMessage priv pub gid epoch sender payload = + forall ss m. + (IsSignatureScheme ss, MonadRandom m) => + KeyPair ss -> + GroupId -> + Epoch -> + TaggedSender -> + FramedContentData -> + m PublicMessage +mkSignedPublicMessage kp gid epoch sender payload = do let framedContent = mkRawMLS FramedContent @@ -103,9 +110,10 @@ mkSignedPublicMessage priv pub gid epoch sender payload = content = framedContent, groupContext = Nothing } - sig = signWithLabel "FramedContentTBS" priv pub (mkRawMLS tbs) - in PublicMessage - { content = framedContent, - authData = mkRawMLS (FramedContentAuthData sig Nothing), - membershipTag = taggedSenderMembershipTag sender - } + sig <- signWithLabel @ss "FramedContentTBS" kp (mkRawMLS tbs) + pure + PublicMessage + { content = framedContent, + authData = mkRawMLS (FramedContentAuthData sig Nothing), + membershipTag = taggedSenderMembershipTag sender + } diff --git a/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs b/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs index fc06a3d708f..0a92ca9886e 100644 --- a/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs +++ b/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs @@ -27,12 +27,17 @@ module Wire.API.MLS.CipherSuite -- * MLS signature schemes SignatureScheme (..), + IsSignatureScheme, SignatureSchemeTag (..), + SignatureSchemeCurve, signatureScheme, signatureSchemeName, signatureSchemeTag, csSignatureScheme, + -- * Key pairs + KeyPair, + -- * Utilities csHash, csVerifySignatureWithLabel, @@ -41,14 +46,18 @@ module Wire.API.MLS.CipherSuite ) where +import Cassandra qualified as C import Cassandra.CQL import Control.Applicative import Control.Error (note) import Control.Lens ((?~)) +import Crypto.ECC hiding (KeyPair) import Crypto.Error import Crypto.Hash (hashWith) import Crypto.Hash.Algorithms +import Crypto.PubKey.ECDSA qualified as ECDSA import Crypto.PubKey.Ed25519 qualified as Ed25519 +import Crypto.Random.Types import Data.Aeson qualified as Aeson import Data.Aeson.Types (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..)) import Data.Aeson.Types qualified as Aeson @@ -67,8 +76,9 @@ import Data.Text.Lazy qualified as LT import Data.Text.Lazy.Builder qualified as LT import Data.Text.Lazy.Builder.Int qualified as LT import Data.Word -import Imports hiding (cs) +import Imports import Web.HttpApiData +import Wire.API.MLS.ECDSA qualified as ECDSA import Wire.API.MLS.Serialisation import Wire.Arbitrary @@ -106,6 +116,9 @@ instance FromByteString CipherSuite where data CipherSuiteTag = MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 + | MLS_128_DHKEMP256_AES128GCM_SHA256_P256 + | MLS_256_DHKEMP384_AES256GCM_SHA384_P384 + | MLS_256_DHKEMP521_AES256GCM_SHA512_P521 | MLS_128_X25519Kyber768Draft00_AES128GCM_SHA256_Ed25519 deriving stock (Bounded, Enum, Eq, Show, Generic, Ord) deriving (Arbitrary) via (GenericUniform CipherSuiteTag) @@ -134,6 +147,16 @@ instance ToSchema CipherSuiteTag where pure (cipherSuiteTag (CipherSuite index)) +instance C.Cql CipherSuiteTag where + ctype = Tagged IntColumn + toCql = CqlInt . fromIntegral . cipherSuiteNumber . tagCipherSuite + + fromCql (CqlInt index) = + case cipherSuiteTag (CipherSuite (fromIntegral index)) of + Just t -> Right t + Nothing -> Left "CipherSuiteTag: unexpected index" + fromCql _ = Left "CipherSuiteTag: int expected" + -- | See https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol.html#table-5. cipherSuiteTag :: CipherSuite -> Maybe CipherSuiteTag cipherSuiteTag cs = listToMaybe $ do @@ -143,18 +166,34 @@ cipherSuiteTag cs = listToMaybe $ do -- | Inverse of 'cipherSuiteTag' tagCipherSuite :: CipherSuiteTag -> CipherSuite -tagCipherSuite MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 = CipherSuite 1 +tagCipherSuite MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 = CipherSuite 0x1 +tagCipherSuite MLS_128_DHKEMP256_AES128GCM_SHA256_P256 = CipherSuite 0x2 +tagCipherSuite MLS_256_DHKEMP384_AES256GCM_SHA384_P384 = CipherSuite 0x7 +tagCipherSuite MLS_256_DHKEMP521_AES256GCM_SHA512_P521 = CipherSuite 0x5 tagCipherSuite MLS_128_X25519Kyber768Draft00_AES128GCM_SHA256_Ed25519 = CipherSuite 0xf031 -csHash :: CipherSuiteTag -> ByteString -> RawMLS a -> ByteString -csHash MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 = sha256Hash -csHash MLS_128_X25519Kyber768Draft00_AES128GCM_SHA256_Ed25519 = sha256Hash +data SomeHashAlgorithm where + SomeHashAlgorithm :: HashAlgorithm a => a -> SomeHashAlgorithm -sha256Hash :: ByteString -> RawMLS a -> ByteString -sha256Hash ctx value = convert . hashWith SHA256 . encodeMLS' $ RefHashInput ctx value +csHashAlgorithm :: CipherSuiteTag -> SomeHashAlgorithm +csHashAlgorithm MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 = SomeHashAlgorithm SHA256 +csHashAlgorithm MLS_128_DHKEMP256_AES128GCM_SHA256_P256 = SomeHashAlgorithm SHA256 +csHashAlgorithm MLS_256_DHKEMP384_AES256GCM_SHA384_P384 = SomeHashAlgorithm SHA384 +csHashAlgorithm MLS_256_DHKEMP521_AES256GCM_SHA512_P521 = SomeHashAlgorithm SHA512 +csHashAlgorithm MLS_128_X25519Kyber768Draft00_AES128GCM_SHA256_Ed25519 = SomeHashAlgorithm SHA256 + +csHash :: CipherSuiteTag -> ByteString -> RawMLS a -> ByteString +csHash cs ctx value = case csHashAlgorithm cs of + SomeHashAlgorithm a -> convert . hashWith a . encodeMLS' $ RefHashInput ctx value csVerifySignature :: CipherSuiteTag -> ByteString -> RawMLS a -> ByteString -> Bool csVerifySignature MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 = ed25519VerifySignature +csVerifySignature MLS_128_DHKEMP256_AES128GCM_SHA256_P256 = + ECDSA.verifySignature (Proxy @Curve_P256R1) SHA256 +csVerifySignature MLS_256_DHKEMP384_AES256GCM_SHA384_P384 = + ECDSA.verifySignature (Proxy @Curve_P384R1) SHA384 +csVerifySignature MLS_256_DHKEMP521_AES256GCM_SHA512_P521 = + ECDSA.verifySignature (Proxy @Curve_P521R1) SHA512 csVerifySignature MLS_128_X25519Kyber768Draft00_AES128GCM_SHA256_Ed25519 = ed25519VerifySignature ed25519VerifySignature :: ByteString -> RawMLS a -> ByteString -> Bool @@ -198,14 +237,44 @@ csVerifySignatureWithLabel :: csVerifySignatureWithLabel cs pub label x sig = csVerifySignature cs pub (mkRawMLS (mkSignContent label x)) sig --- FUTUREWORK: generalise to arbitrary ciphersuites -signWithLabel :: ByteString -> Ed25519.SecretKey -> Ed25519.PublicKey -> RawMLS a -> ByteString -signWithLabel sigLabel priv pub x = BA.convert $ Ed25519.sign priv pub (encodeMLS' (mkSignContent sigLabel x)) +signWithLabel :: + forall ss a m. + (IsSignatureScheme ss, MonadRandom m) => + ByteString -> + KeyPair ss -> + RawMLS a -> + m ByteString +signWithLabel sigLabel kp x = sign @ss kp (encodeMLS' (mkSignContent sigLabel x)) csSignatureScheme :: CipherSuiteTag -> SignatureSchemeTag csSignatureScheme MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 = Ed25519 +csSignatureScheme MLS_128_DHKEMP256_AES128GCM_SHA256_P256 = Ecdsa_secp256r1_sha256 +csSignatureScheme MLS_256_DHKEMP384_AES256GCM_SHA384_P384 = Ecdsa_secp384r1_sha384 +csSignatureScheme MLS_256_DHKEMP521_AES256GCM_SHA512_P521 = Ecdsa_secp521r1_sha512 csSignatureScheme MLS_128_X25519Kyber768Draft00_AES128GCM_SHA256_Ed25519 = Ed25519 +type family PrivateKey (ss :: SignatureSchemeTag) + +type instance PrivateKey Ed25519 = Ed25519.SecretKey + +type instance PrivateKey Ecdsa_secp256r1_sha256 = ECDSA.PrivateKey Curve_P256R1 + +type instance PrivateKey Ecdsa_secp384r1_sha384 = ECDSA.PrivateKey Curve_P384R1 + +type instance PrivateKey Ecdsa_secp521r1_sha512 = ECDSA.PrivateKey Curve_P521R1 + +type family PublicKey (ss :: SignatureSchemeTag) + +type instance PublicKey Ed25519 = Ed25519.PublicKey + +type instance PublicKey Ecdsa_secp256r1_sha256 = ECDSA.PublicKey Curve_P256R1 + +type instance PublicKey Ecdsa_secp384r1_sha384 = ECDSA.PublicKey Curve_P384R1 + +type instance PublicKey Ecdsa_secp521r1_sha512 = ECDSA.PublicKey Curve_P521R1 + +type KeyPair (ss :: SignatureSchemeTag) = (PrivateKey ss, PublicKey ss) + -- | A TLS signature scheme. -- -- See . @@ -216,10 +285,43 @@ newtype SignatureScheme = SignatureScheme {unSignatureScheme :: Word16} signatureScheme :: SignatureSchemeTag -> SignatureScheme signatureScheme = SignatureScheme . signatureSchemeNumber -data SignatureSchemeTag = Ed25519 +data SignatureSchemeTag + = Ed25519 + | Ecdsa_secp256r1_sha256 + | Ecdsa_secp384r1_sha384 + | Ecdsa_secp521r1_sha512 deriving stock (Bounded, Enum, Eq, Ord, Show, Generic) deriving (Arbitrary) via GenericUniform SignatureSchemeTag +class IsSignatureScheme (ss :: SignatureSchemeTag) where + sign :: MonadRandom m => KeyPair ss -> ByteString -> m ByteString + +instance IsSignatureScheme 'Ed25519 where + sign (priv, pub) = pure . BA.convert . Ed25519.sign priv pub + +instance IsSignatureScheme 'Ecdsa_secp256r1_sha256 where + sign (priv, _) = + fmap (ECDSA.encodeSignature (Proxy @Curve_P256R1)) + . ECDSA.sign (Proxy @Curve_P256R1) priv SHA256 + +instance IsSignatureScheme 'Ecdsa_secp384r1_sha384 where + sign (priv, _) = + fmap (ECDSA.encodeSignature (Proxy @Curve_P384R1)) + . ECDSA.sign (Proxy @Curve_P384R1) priv SHA384 + +instance IsSignatureScheme 'Ecdsa_secp521r1_sha512 where + sign (priv, _) = + fmap (ECDSA.encodeSignature (Proxy @Curve_P521R1)) + . ECDSA.sign (Proxy @Curve_P521R1) priv SHA512 + +type family SignatureSchemeCurve (ss :: SignatureSchemeTag) + +type instance SignatureSchemeCurve 'Ecdsa_secp256r1_sha256 = Curve_P256R1 + +type instance SignatureSchemeCurve 'Ecdsa_secp384r1_sha384 = Curve_P384R1 + +type instance SignatureSchemeCurve 'Ecdsa_secp521r1_sha512 = Curve_P521R1 + instance Cql SignatureSchemeTag where ctype = Tagged TextColumn toCql = CqlText . signatureSchemeName @@ -230,9 +332,15 @@ instance Cql SignatureSchemeTag where signatureSchemeNumber :: SignatureSchemeTag -> Word16 signatureSchemeNumber Ed25519 = 0x807 +signatureSchemeNumber Ecdsa_secp256r1_sha256 = 0x403 +signatureSchemeNumber Ecdsa_secp384r1_sha384 = 0x503 +signatureSchemeNumber Ecdsa_secp521r1_sha512 = 0x603 signatureSchemeName :: SignatureSchemeTag -> Text signatureSchemeName Ed25519 = "ed25519" +signatureSchemeName Ecdsa_secp256r1_sha256 = "ecdsa_secp256r1_sha256" +signatureSchemeName Ecdsa_secp384r1_sha384 = "ecdsa_secp384r1_sha384" +signatureSchemeName Ecdsa_secp521r1_sha512 = "ecdsa_secp521r1_sha512" signatureSchemeTag :: SignatureScheme -> Maybe SignatureSchemeTag signatureSchemeTag (SignatureScheme n) = getAlt $ diff --git a/libs/wire-api/src/Wire/API/MLS/Credential.hs b/libs/wire-api/src/Wire/API/MLS/Credential.hs index f4b74c6f1d3..d369727f3e1 100644 --- a/libs/wire-api/src/Wire/API/MLS/Credential.hs +++ b/libs/wire-api/src/Wire/API/MLS/Credential.hs @@ -17,12 +17,8 @@ module Wire.API.MLS.Credential where -import Control.Error.Util import Control.Lens ((?~)) -import Data.Aeson (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..)) -import Data.Aeson qualified as Aeson -import Data.Aeson.Types qualified as Aeson -import Data.Bifunctor +import Data.Aeson (FromJSON (..), ToJSON (..)) import Data.Binary import Data.Binary.Get import Data.Binary.Parser @@ -158,42 +154,3 @@ instance SerialiseMLS ClientIdentity where mkClientIdentity :: Qualified UserId -> ClientId -> ClientIdentity mkClientIdentity (Qualified uid domain) = ClientIdentity domain uid - --- | Possible uses of a private key in the context of MLS. -data SignaturePurpose - = -- | Creating external remove proposals. - RemovalPurpose - deriving (Eq, Ord, Show, Bounded, Enum) - -signaturePurposeName :: SignaturePurpose -> Text -signaturePurposeName RemovalPurpose = "removal" - -signaturePurposeFromName :: Text -> Either String SignaturePurpose -signaturePurposeFromName name = - note ("Unsupported signature purpose " <> T.unpack name) - . getAlt - $ flip foldMap [minBound .. maxBound] - $ \s -> - guard (signaturePurposeName s == name) $> s - -instance FromJSON SignaturePurpose where - parseJSON = - Aeson.withText "SignaturePurpose" $ - either fail pure . signaturePurposeFromName - -instance FromJSONKey SignaturePurpose where - fromJSONKey = - Aeson.FromJSONKeyTextParser $ - either fail pure . signaturePurposeFromName - -instance S.ToParamSchema SignaturePurpose where - toParamSchema _ = mempty & S.type_ ?~ S.OpenApiString - -instance FromHttpApiData SignaturePurpose where - parseQueryParam = first T.pack . signaturePurposeFromName - -instance ToJSON SignaturePurpose where - toJSON = Aeson.String . signaturePurposeName - -instance ToJSONKey SignaturePurpose where - toJSONKey = Aeson.toJSONKeyText signaturePurposeName diff --git a/libs/wire-api/src/Wire/API/MLS/ECDSA.hs b/libs/wire-api/src/Wire/API/MLS/ECDSA.hs new file mode 100644 index 00000000000..11d197c0369 --- /dev/null +++ b/libs/wire-api/src/Wire/API/MLS/ECDSA.hs @@ -0,0 +1,76 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2023 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Wire.API.MLS.ECDSA where + +import Crypto.Error +import Crypto.Hash hiding (hash) +import Crypto.PubKey.ECDSA +import Data.ASN1.BinaryEncoding +import Data.ASN1.Encoding +import Data.ASN1.Prim +import Data.Proxy +import Imports +import Wire.API.MLS.Serialisation + +-- | Decode an ECDSA signature. +decodeSignature :: + forall curve. + EllipticCurveECDSA curve => + Proxy curve -> + ByteString -> + Maybe (Signature curve) +decodeSignature curve bs = do + ints <- case decodeASN1' DER bs of + Right ([Start Sequence, IntVal r, IntVal s, End Sequence]) -> pure (r, s) + _ -> Nothing + maybeCryptoError $ signatureFromIntegers curve ints + +-- Encode an ECDSA signature. +encodeSignature :: + forall curve. + EllipticCurveECDSA curve => + Proxy curve -> + Signature curve -> + ByteString +encodeSignature curve sig = case signatureToIntegers curve sig of + (r, s) -> + encodeASN1' + DER + [ Start Sequence, + IntVal r, + IntVal s, + End Sequence + ] + +verifySignature :: + forall curve a hash. + ( EllipticCurveECDSA curve, + HashAlgorithm hash + ) => + Proxy curve -> + hash -> + ByteString -> + RawMLS a -> + ByteString -> + Bool +verifySignature curve hash pub x sig = + fromMaybe False $ do + sig' <- decodeSignature curve sig + pub' <- maybeCryptoError $ decodePublic curve pub + let valid = verify curve hash pub' sig' x.raw + pure valid diff --git a/libs/wire-api/src/Wire/API/MLS/Group/Serialisation.hs b/libs/wire-api/src/Wire/API/MLS/Group/Serialisation.hs index 9a52f1a0879..3250af2f81a 100644 --- a/libs/wire-api/src/Wire/API/MLS/Group/Serialisation.hs +++ b/libs/wire-api/src/Wire/API/MLS/Group/Serialisation.hs @@ -35,7 +35,7 @@ import Data.Qualified import Data.Text qualified as T import Data.Text.Encoding qualified as T import Data.UUID qualified as UUID -import Imports hiding (cs) +import Imports import Web.HttpApiData (FromHttpApiData (parseHeader)) import Wire.API.Conversation import Wire.API.MLS.Group diff --git a/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs b/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs index 906ec74fc58..eb736de6ea5 100644 --- a/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs +++ b/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs @@ -49,7 +49,7 @@ import Data.Text qualified as T import Data.Text.Encoding qualified as T import Data.X509 qualified as X509 import GHC.Records -import Imports hiding (cs) +import Imports import Test.QuickCheck import Web.HttpApiData import Wire.API.MLS.CipherSuite diff --git a/libs/wire-api/src/Wire/API/MLS/Keys.hs b/libs/wire-api/src/Wire/API/MLS/Keys.hs index 179ec9909cd..28a49047332 100644 --- a/libs/wire-api/src/Wire/API/MLS/Keys.hs +++ b/libs/wire-api/src/Wire/API/MLS/Keys.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -17,52 +15,69 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Wire.API.MLS.Keys - ( MLSKeys (..), - MLSPublicKeys (..), - mlsKeysToPublic, - ) -where +module Wire.API.MLS.Keys where -import Crypto.PubKey.Ed25519 +import Crypto.ECC (Curve_P256R1, Curve_P384R1, Curve_P521R1) +import Crypto.PubKey.ECDSA qualified as ECDSA import Data.Aeson (FromJSON (..), ToJSON (..)) import Data.ByteArray import Data.Json.Util -import Data.Map qualified as Map import Data.OpenApi qualified as S -import Data.Schema -import Imports +import Data.Proxy +import Data.Schema hiding (HasField) +import Imports hiding (First, getFirst) import Wire.API.MLS.CipherSuite -import Wire.API.MLS.Credential -data MLSKeys = MLSKeys - { mlsKeyPair_ed25519 :: Maybe (SecretKey, PublicKey) +data MLSKeysByPurpose a = MLSKeysByPurpose + { removal :: a } + deriving (Eq, Show, Functor, Foldable, Traversable) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema (MLSKeysByPurpose a) -instance Semigroup MLSKeys where - MLSKeys Nothing <> MLSKeys ed2 = MLSKeys ed2 - MLSKeys ed1 <> MLSKeys _ = MLSKeys ed1 - -instance Monoid MLSKeys where - mempty = MLSKeys Nothing +instance ToSchema a => ToSchema (MLSKeysByPurpose a) where + schema = + object "MLSKeysByPurpose" $ + MLSKeysByPurpose + <$> (.removal) .= field "removal" schema -newtype MLSPublicKeys = MLSPublicKeys - { unMLSPublicKeys :: Map SignaturePurpose (Map SignatureSchemeTag ByteString) +data MLSKeys a = MLSKeys + { ed25519 :: a, + ecdsa_secp256r1_sha256 :: a, + ecdsa_secp384r1_sha384 :: a, + ecdsa_secp521r1_sha512 :: a } - deriving (FromJSON, ToJSON, S.ToSchema) via Schema MLSPublicKeys - deriving newtype (Semigroup, Monoid) + deriving (Eq, Show) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema (MLSKeys a) -instance ToSchema MLSPublicKeys where +instance ToSchema a => ToSchema (MLSKeys a) where schema = - named "MLSKeys" $ - MLSPublicKeys - <$> unMLSPublicKeys - .= map_ (map_ base64Schema) + object "MLSKeys" $ + MLSKeys + <$> ed25519 .= field "ed25519" schema + <*> ecdsa_secp256r1_sha256 .= field "ecdsa_secp256r1_sha256" schema + <*> ecdsa_secp384r1_sha384 .= field "ecdsa_secp384r1_sha384" schema + <*> ecdsa_secp521r1_sha512 .= field "ecdsa_secp521r1_sha512" schema + +data MLSPrivateKeys = MLSPrivateKeys + { mlsKeyPair_ed25519 :: KeyPair Ed25519, + mlsKeyPair_ecdsa_secp256r1_sha256 :: KeyPair Ecdsa_secp256r1_sha256, + mlsKeyPair_ecdsa_secp384r1_sha384 :: KeyPair Ecdsa_secp384r1_sha384, + mlsKeyPair_ecdsa_secp521r1_sha512 :: KeyPair Ecdsa_secp521r1_sha512 + } + +type MLSPublicKeys = MLSKeys MLSPublicKey + +newtype MLSPublicKey = MLSPublicKey {unwrapMLSPublicKey :: ByteString} + deriving (Eq, Show) -mlsKeysToPublic1 :: MLSKeys -> Map SignatureSchemeTag ByteString -mlsKeysToPublic1 (MLSKeys mEd25519key) = - foldMap (Map.singleton Ed25519 . convert . snd) mEd25519key +instance ToSchema MLSPublicKey where + schema = named "MLSPublicKey" $ MLSPublicKey <$> unwrapMLSPublicKey .= base64Schema -mlsKeysToPublic :: (SignaturePurpose -> MLSKeys) -> MLSPublicKeys -mlsKeysToPublic f = flip foldMap [minBound .. maxBound] $ \purpose -> - MLSPublicKeys (Map.singleton purpose (mlsKeysToPublic1 (f purpose))) +mlsKeysToPublic :: MLSPrivateKeys -> MLSPublicKeys +mlsKeysToPublic (MLSPrivateKeys (_, ed) (_, ec256) (_, ec384) (_, ec521)) = + MLSKeys + { ed25519 = MLSPublicKey $ convert ed, + ecdsa_secp256r1_sha256 = MLSPublicKey $ ECDSA.encodePublic (Proxy @Curve_P256R1) ec256, + ecdsa_secp384r1_sha384 = MLSPublicKey $ ECDSA.encodePublic (Proxy @Curve_P384R1) ec384, + ecdsa_secp521r1_sha512 = MLSPublicKey $ ECDSA.encodePublic (Proxy @Curve_P521R1) ec521 + } diff --git a/libs/wire-api/src/Wire/API/MLS/Message.hs b/libs/wire-api/src/Wire/API/MLS/Message.hs index c13dcc0d96f..342bb739e23 100644 --- a/libs/wire-api/src/Wire/API/MLS/Message.hs +++ b/libs/wire-api/src/Wire/API/MLS/Message.hs @@ -45,7 +45,7 @@ import Data.Json.Util import Data.OpenApi qualified as S import Data.Schema hiding (HasField) import GHC.Records -import Imports hiding (cs) +import Imports import Test.QuickCheck hiding (label) import Wire.API.Event.Conversation import Wire.API.MLS.CipherSuite diff --git a/libs/wire-api/src/Wire/API/MLS/Proposal.hs b/libs/wire-api/src/Wire/API/MLS/Proposal.hs index 125364b8362..1ae2ef989ac 100644 --- a/libs/wire-api/src/Wire/API/MLS/Proposal.hs +++ b/libs/wire-api/src/Wire/API/MLS/Proposal.hs @@ -25,7 +25,7 @@ import Control.Lens (makePrisms) import Data.Binary import Data.ByteString as B import GHC.Records -import Imports hiding (cs) +import Imports import Test.QuickCheck import Wire.API.MLS.CipherSuite import Wire.API.MLS.Extension diff --git a/libs/wire-api/src/Wire/API/MLS/SubConversation.hs b/libs/wire-api/src/Wire/API/MLS/SubConversation.hs index c01aa3e2366..043984800ac 100644 --- a/libs/wire-api/src/Wire/API/MLS/SubConversation.hs +++ b/libs/wire-api/src/Wire/API/MLS/SubConversation.hs @@ -35,7 +35,7 @@ import Data.Schema hiding (HasField) import Data.Text qualified as T import Data.Time.Clock import GHC.Records -import Imports hiding (cs) +import Imports import Servant (FromHttpApiData (..), ToHttpApiData (toQueryParam)) import Test.QuickCheck import Wire.API.MLS.CipherSuite diff --git a/libs/wire-api/src/Wire/API/MLS/Validation.hs b/libs/wire-api/src/Wire/API/MLS/Validation.hs index 2f98d969426..c2e92203c2d 100644 --- a/libs/wire-api/src/Wire/API/MLS/Validation.hs +++ b/libs/wire-api/src/Wire/API/MLS/Validation.hs @@ -25,11 +25,12 @@ where import Control.Applicative import Control.Error.Util import Data.ByteArray qualified as BA +import Data.Text qualified as T import Data.Text.Lazy qualified as LT import Data.Text.Lazy.Builder qualified as LT import Data.Text.Lazy.Builder.Int qualified as LT import Data.X509 qualified as X509 -import Imports hiding (cs) +import Imports import Wire.API.MLS.Capabilities import Wire.API.MLS.CipherSuite import Wire.API.MLS.Credential @@ -119,9 +120,24 @@ validateCredential cs pkey mIdentity cred = do "Failed to parse identity: " <> e validateCredentialKey :: SignatureSchemeTag -> ByteString -> X509.PubKey -> Either Text () -validateCredentialKey Ed25519 pk1 (X509.PubKeyEd25519 pk2) = - note "Certificate public key does not match client's" $ guard (pk1 == BA.convert pk2) -validateCredentialKey _ _ _ = Left "Certificate signature scheme does not match client's public key" +validateCredentialKey Ed25519 pk1 (X509.PubKeyEd25519 pk2) = validateCredentialKeyBS pk1 (BA.convert pk2) +validateCredentialKey Ecdsa_secp256r1_sha256 pk1 (X509.PubKeyEC pk2) = + case pk2.pubkeyEC_pub of + X509.SerializedPoint bs -> validateCredentialKeyBS pk1 bs +validateCredentialKey Ecdsa_secp384r1_sha384 pk1 (X509.PubKeyEC pk2) = + case pk2.pubkeyEC_pub of + X509.SerializedPoint bs -> validateCredentialKeyBS pk1 bs +validateCredentialKey Ecdsa_secp521r1_sha512 pk1 (X509.PubKeyEC pk2) = + case pk2.pubkeyEC_pub of + X509.SerializedPoint bs -> validateCredentialKeyBS pk1 bs +validateCredentialKey ss _ _ = + Left $ + "Certificate signature scheme " <> T.pack (show ss) <> " does not match client's public key" + +validateCredentialKeyBS :: ByteString -> ByteString -> Either Text () +validateCredentialKeyBS pk1 pk2 = + note "Certificate public key does not match client's" $ + guard (pk1 == pk2) validateSource :: LeafNodeSourceTag -> LeafNodeSource -> Either Text () validateSource t s = do diff --git a/libs/wire-api/src/Wire/API/MLS/Welcome.hs b/libs/wire-api/src/Wire/API/MLS/Welcome.hs index 08028e31219..8cf1839e9d5 100644 --- a/libs/wire-api/src/Wire/API/MLS/Welcome.hs +++ b/libs/wire-api/src/Wire/API/MLS/Welcome.hs @@ -18,7 +18,7 @@ module Wire.API.MLS.Welcome where import Data.OpenApi qualified as S -import Imports hiding (cs) +import Imports import Wire.API.MLS.CipherSuite import Wire.API.MLS.Commit import Wire.API.MLS.KeyPackage diff --git a/libs/wire-api/src/Wire/API/Notification.hs b/libs/wire-api/src/Wire/API/Notification.hs index 1b7601bce10..83317eb5259 100644 --- a/libs/wire-api/src/Wire/API/Notification.hs +++ b/libs/wire-api/src/Wire/API/Notification.hs @@ -51,6 +51,7 @@ import Data.OpenApi (ToParamSchema (..)) import Data.OpenApi qualified as S import Data.SOP import Data.Schema +import Data.Text.Encoding import Data.Time.Clock (UTCTime) import Data.UUID qualified as UUID import Imports @@ -150,7 +151,7 @@ newtype RawNotificationId = RawNotificationId {unRawNotificationId :: ByteString deriving stock (Eq, Show, Generic) instance FromHttpApiData RawNotificationId where - parseUrlPiece = pure . RawNotificationId . cs + parseUrlPiece = pure . RawNotificationId . encodeUtf8 instance ToParamSchema RawNotificationId where toParamSchema _ = toParamSchema (Proxy @Text) diff --git a/libs/wire-api/src/Wire/API/OAuth.hs b/libs/wire-api/src/Wire/API/OAuth.hs index 8b0a8617ad3..dfbd5987201 100644 --- a/libs/wire-api/src/Wire/API/OAuth.hs +++ b/libs/wire-api/src/Wire/API/OAuth.hs @@ -26,7 +26,7 @@ import Data.Aeson.KeyMap qualified as M import Data.Aeson.Types qualified as A import Data.ByteArray (convert) import Data.ByteString.Conversion -import Data.ByteString.Lazy (toStrict) +import Data.ByteString.Lazy (fromStrict, toStrict) import Data.Either.Combinators (mapLeft) import Data.HashMap.Strict qualified as HM import Data.Id as Id @@ -115,8 +115,8 @@ instance ToSchema OAuthClientConfig where where applicationNameDescription = description ?~ "The name of the application. This will be shown to the user when they are asked to authorize the application. The name must be between " <> minL <> " and " <> maxL <> " characters long." redirectUrlDescription = description ?~ "The URL to redirect to after the user has authorized the application." - minL = cs @String @Text $ symbolVal $ Proxy @(Show_ OAuthApplicationNameMinLength) - maxL = cs @String @Text $ symbolVal $ Proxy @(Show_ OAuthApplicationNameMaxLength) + minL = T.pack $ symbolVal $ Proxy @(Show_ OAuthApplicationNameMinLength) + maxL = T.pack $ symbolVal $ Proxy @(Show_ OAuthApplicationNameMaxLength) newtype OAuthClientPlainTextSecret = OAuthClientPlainTextSecret {unOAuthClientPlainTextSecret :: AsciiBase16} deriving (Eq, Generic, Arbitrary) @@ -130,7 +130,7 @@ instance ToSchema OAuthClientPlainTextSecret where schema = (toText . unOAuthClientPlainTextSecret) .= parsedText "OAuthClientPlainTextSecret" (fmap OAuthClientPlainTextSecret . validateBase16) instance FromHttpApiData OAuthClientPlainTextSecret where - parseQueryParam = bimap cs OAuthClientPlainTextSecret . validateBase16 . cs + parseQueryParam = bimap T.pack OAuthClientPlainTextSecret . validateBase16 instance ToHttpApiData OAuthClientPlainTextSecret where toQueryParam = toText . unOAuthClientPlainTextSecret @@ -236,11 +236,17 @@ instance ToSchema OAuthScopes where schema = OAuthScopes <$> (oauthScopesToText . unOAuthScopes) .= withParser schema oauthScopeParser where oauthScopesToText :: Set OAuthScope -> Text - oauthScopesToText = T.intercalate " " . fmap (cs . toByteString') . Set.toList + oauthScopesToText = + T.intercalate " " + . fmap (TE.decodeUtf8With lenientDecode . toByteString') + . Set.toList oauthScopeParser :: Text -> A.Parser (Set OAuthScope) oauthScopeParser scope = - pure $ (not . T.null) `filter` T.splitOn " " scope & maybe Set.empty Set.fromList . mapM (fromByteString' . cs) + pure $ + (not . T.null) `filter` T.splitOn " " scope + & maybe Set.empty Set.fromList + . mapM (fromByteString' . fromStrict . TE.encodeUtf8) data CodeChallengeMethod = S256 deriving (Eq, Show, Generic) @@ -265,7 +271,7 @@ instance ToSchema OAuthCodeVerifier where schema = OAuthCodeVerifier <$> unOAuthCodeVerifier .= schema instance FromHttpApiData OAuthCodeVerifier where - parseQueryParam = fmap OAuthCodeVerifier . mapLeft cs . checkedEither + parseQueryParam = fmap OAuthCodeVerifier . mapLeft T.pack . checkedEither instance ToHttpApiData OAuthCodeVerifier where toQueryParam = fromRange . unOAuthCodeVerifier @@ -294,7 +300,7 @@ mkChallenge = . encodeBase64UrlUnpadded . convert . Crypto.hash @ByteString @Crypto.SHA256 - . cs + . TE.encodeUtf8 . fromRange . unOAuthCodeVerifier @@ -347,7 +353,7 @@ instance FromByteString OAuthAuthorizationCode where parser = OAuthAuthorizationCode <$> parser instance FromHttpApiData OAuthAuthorizationCode where - parseQueryParam = bimap cs OAuthAuthorizationCode . validateBase16 . cs + parseQueryParam = bimap T.pack OAuthAuthorizationCode . validateBase16 instance ToHttpApiData OAuthAuthorizationCode where toQueryParam = toText . unOAuthAuthorizationCode @@ -379,10 +385,10 @@ instance ToByteString OAuthGrantType where OAuthGrantTypeRefreshToken -> "refresh_token" instance FromHttpApiData OAuthGrantType where - parseQueryParam = maybe (Left "invalid OAuthGrantType") pure . fromByteString . cs + parseQueryParam = maybe (Left "invalid OAuthGrantType") pure . fromByteString . TE.encodeUtf8 instance ToHttpApiData OAuthGrantType where - toQueryParam = cs . toByteString + toQueryParam = TE.decodeUtf8With lenientDecode . toStrict . toByteString data OAuthAccessTokenRequest = OAuthAccessTokenRequest { grantType :: OAuthGrantType, @@ -454,20 +460,27 @@ instance ToByteString (OAuthToken a) where instance FromByteString (OAuthToken a) where parser = do t <- parser @Text - case decodeCompact (cs (TE.encodeUtf8 t)) of + case decodeCompact (fromStrict (TE.encodeUtf8 t)) of Left (err :: JWTError) -> fail $ show err Right jwt -> pure $ OAuthToken jwt instance ToHttpApiData (OAuthToken a) where toHeader = toByteString' - toUrlPiece = cs . toHeader + toUrlPiece = TE.decodeUtf8With lenientDecode . toHeader instance FromHttpApiData (OAuthToken a) where - parseHeader = either (Left . cs) pure . runParser parser . cs - parseUrlPiece = parseHeader . cs + parseHeader = either (Left . T.pack) pure . runParser parser + parseUrlPiece = parseHeader . TE.encodeUtf8 instance ToSchema (OAuthToken a) where - schema = (TE.decodeUtf8 . toByteString') .= withParser schema (either fail pure . runParser parser . cs) + schema = + (TE.decodeUtf8 . toByteString') + .= withParser + schema + ( either fail pure + . runParser parser + . TE.encodeUtf8 + ) type OAuthAccessToken = OAuthToken 'Access @@ -686,8 +699,11 @@ instance Cql OAuthAuthorizationCode where instance Cql OAuthScope where ctype = Tagged TextColumn - toCql = CqlText . cs . toByteString' - fromCql (CqlText t) = maybe (Left "invalid oauth scope") Right $ fromByteString' (cs t) + toCql = CqlText . TE.decodeUtf8With lenientDecode . toByteString' + fromCql (CqlText t) = + maybe (Left "invalid oauth scope") Right $ + fromByteString' . fromStrict . TE.encodeUtf8 $ + t fromCql _ = Left "OAuthScope: Text expected" instance Cql OAuthCodeChallenge where diff --git a/libs/wire-api/src/Wire/API/Properties.hs b/libs/wire-api/src/Wire/API/Properties.hs index debcf9016d7..83c8ee1aa50 100644 --- a/libs/wire-api/src/Wire/API/Properties.hs +++ b/libs/wire-api/src/Wire/API/Properties.hs @@ -25,6 +25,7 @@ module Wire.API.Properties ) where +import Cassandra qualified as C import Control.Lens ((?~)) import Data.Aeson (FromJSON (..), ToJSON (..), Value) import Data.Aeson qualified as A @@ -67,9 +68,17 @@ instance S.ToParamSchema PropertyKey where & S.type_ ?~ S.OpenApiString & S.format ?~ "printable" +deriving instance C.Cql PropertyKey + -- | A raw, unparsed property value. newtype RawPropertyValue = RawPropertyValue {rawPropertyBytes :: LByteString} +instance C.Cql RawPropertyValue where + ctype = C.Tagged C.BlobColumn + toCql = C.toCql . C.Blob . rawPropertyBytes + fromCql (C.CqlBlob v) = pure (RawPropertyValue v) + fromCql _ = Left "PropertyValue: Blob expected" + instance {-# OVERLAPPING #-} MimeUnrender JSON RawPropertyValue where mimeUnrender _ = pure . RawPropertyValue diff --git a/libs/wire-api/src/Wire/API/Push/V2/Token.hs b/libs/wire-api/src/Wire/API/Push/V2/Token.hs index 0cf7b292af4..79f282b4d0f 100644 --- a/libs/wire-api/src/Wire/API/Push/V2/Token.hs +++ b/libs/wire-api/src/Wire/API/Push/V2/Token.hs @@ -115,8 +115,6 @@ data Transport = GCM | APNS | APNSSandbox - | APNSVoIP - | APNSVoIPSandbox deriving stock (Eq, Ord, Show, Bounded, Enum, Generic) deriving (Arbitrary) via (GenericUniform Transport) deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema Transport) @@ -127,9 +125,7 @@ instance ToSchema Transport where mconcat [ element "GCM" GCM, element "APNS" APNS, - element "APNS_SANDBOX" APNSSandbox, - element "APNS_VOIP" APNSVoIP, - element "APNS_VOIP_SANDBOX" APNSVoIPSandbox + element "APNS_SANDBOX" APNSSandbox ] instance FromByteString Transport where @@ -138,8 +134,6 @@ instance FromByteString Transport where "GCM" -> pure GCM "APNS" -> pure APNS "APNS_SANDBOX" -> pure APNSSandbox - "APNS_VOIP" -> pure APNSVoIP - "APNS_VOIP_SANDBOX" -> pure APNSVoIPSandbox x -> fail $ "Invalid push transport: " <> show x newtype Token = Token diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index 4a52bf64aa7..43ca007abb1 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -21,7 +21,6 @@ module Wire.API.Routes.Internal.Brig brigInternalClient, runBrigInternalClient, IStatusAPI, - EJPD_API, AccountAPI, MLSAPI, TeamsAPI, @@ -31,6 +30,7 @@ module Wire.API.Routes.Internal.Brig FederationRemotesAPI, EJPDRequest, ISearchIndexAPI, + ProviderAPI, GetAccountConferenceCallingConfig, PutAccountConferenceCallingConfig, DeleteAccountConferenceCallingConfig, @@ -156,31 +156,29 @@ type GetAllConnections = :> ReqBody '[Servant.JSON] ConnectionsStatusRequestV2 :> Post '[Servant.JSON] [ConnectionStatusV2] -type EJPD_API = - ( EJPDRequest - :<|> Named "get-account-conference-calling-config" GetAccountConferenceCallingConfig - :<|> PutAccountConferenceCallingConfig - :<|> DeleteAccountConferenceCallingConfig - :<|> GetAllConnectionsUnqualified - :<|> GetAllConnections - ) - type AccountAPI = - -- This endpoint can lead to the following events being sent: - -- - UserActivated event to created user, if it is a team invitation or user has an SSO ID - -- - UserIdentityUpdated event to created user, if email or phone get activated - Named - "createUserNoVerify" - ( "users" - :> MakesFederatedCall 'Brig "on-user-deleted-connections" - :> ReqBody '[Servant.JSON] NewUser - :> MultiVerb 'POST '[Servant.JSON] RegisterInternalResponses (Either RegisterError SelfProfile) - ) + Named "get-account-conference-calling-config" GetAccountConferenceCallingConfig + :<|> PutAccountConferenceCallingConfig + :<|> DeleteAccountConferenceCallingConfig + :<|> GetAllConnectionsUnqualified + :<|> GetAllConnections + :<|> Named + "createUserNoVerify" + -- This endpoint can lead to the following events being sent: + -- - UserActivated event to created user, if it is a team invitation or user has an SSO ID + -- - UserIdentityUpdated event to created user, if email or phone get activated + ( "users" + :> MakesFederatedCall 'Brig "on-user-deleted-connections" + :> MakesFederatedCall 'Brig "send-connection-action" + :> ReqBody '[Servant.JSON] NewUser + :> MultiVerb 'POST '[Servant.JSON] RegisterInternalResponses (Either RegisterError SelfProfile) + ) :<|> Named "createUserNoVerifySpar" ( "users" :> "spar" :> MakesFederatedCall 'Brig "on-user-deleted-connections" + :> MakesFederatedCall 'Brig "send-connection-action" :> ReqBody '[Servant.JSON] NewUserSpar :> MultiVerb 'POST '[Servant.JSON] CreateUserSparInternalResponses (Either CreateUserSparError SelfProfile) ) @@ -530,7 +528,7 @@ type GetVerificationCode = type API = "i" :> ( IStatusAPI - :<|> EJPD_API + :<|> EJPDRequest :<|> AccountAPI :<|> MLSAPI :<|> GetVerificationCode @@ -541,6 +539,7 @@ type API = :<|> OAuthAPI :<|> ISearchIndexAPI :<|> FederationRemotesAPI + :<|> ProviderAPI ) type IStatusAPI = @@ -679,6 +678,7 @@ type AuthAPI = "legalhold-login" ( "legalhold-login" :> MakesFederatedCall 'Brig "on-user-deleted-connections" + :> MakesFederatedCall 'Brig "send-connection-action" :> ReqBody '[JSON] LegalHoldLogin :> MultiVerb1 'POST '[JSON] TokenResponse ) @@ -686,6 +686,7 @@ type AuthAPI = "sso-login" ( "sso-login" :> MakesFederatedCall 'Brig "on-user-deleted-connections" + :> MakesFederatedCall 'Brig "send-connection-action" :> ReqBody '[JSON] SsoLogin :> QueryParam' [Optional, Strict] "persist" Bool :> MultiVerb1 'POST '[JSON] TokenResponse @@ -767,6 +768,17 @@ type FederationRemotesAPI = :> Delete '[JSON] () ) +type ProviderAPI = + ( Named + "get-provider-activation-code" + ( Summary "Retrieve activation code via api instead of email (for testing only)" + :> "provider" + :> "activation-code" + :> QueryParam' '[Required, Strict] "email" Email + :> MultiVerb1 'GET '[JSON] (Respond 200 "" Code.KeyValuePair) + ) + ) + type FederationRemotesAPIDescription = "See https://docs.wire.com/understand/federation/backend-communication.html#configuring-remote-connections for background. " diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig/EJPD.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig/EJPD.hs index 93db38b2974..d34bd9fb78a 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig/EJPD.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig/EJPD.hs @@ -21,13 +21,26 @@ module Wire.API.Routes.Internal.Brig.EJPD ( EJPDRequestBody (EJPDRequestBody, ejpdRequestBody), EJPDResponseBody (EJPDResponseBody, ejpdResponseBody), - EJPDResponseItem (EJPDResponseItem, ejpdResponseHandle, ejpdResponsePushTokens, ejpdResponseContacts), + EJPDResponseItem + ( EJPDResponseItem, + ejpdResponseUserId, + ejpdResponseTeamId, + ejpdResponseName, + ejpdResponseHandle, + ejpdResponseEmail, + ejpdResponsePhone, + ejpdResponsePushTokens, + ejpdResponseContacts, + ejpdResponseTeamContacts, + ejpdResponseConversations, + ejpdResponseAssets + ), ) where import Data.Aeson hiding (json) import Data.Handle (Handle) -import Data.Id (TeamId, UserId) +import Data.Id (ConvId, TeamId, UserId) import Data.OpenApi (ToSchema) import Deriving.Swagger (CamelToSnake, CustomSwagger (..), FieldLabelModifier, StripSuffix) import Imports hiding (head) @@ -57,7 +70,9 @@ data EJPDResponseItem = EJPDResponseItem ejpdResponsePhone :: Maybe Phone, ejpdResponsePushTokens :: Set Text, -- 'Wire.API.Push.V2.Token.Token', but that would produce an orphan instance. ejpdResponseContacts :: Maybe (Set (Relation, EJPDResponseItem)), - ejpdResponseTeamContacts :: Maybe (Set EJPDResponseItem, NewListType) + ejpdResponseTeamContacts :: Maybe (Set EJPDResponseItem, NewListType), + ejpdResponseConversations :: Maybe (Set (Text, ConvId)), -- name, id + ejpdResponseAssets :: Maybe (Set Text) -- urls pointing to s3 resources } deriving stock (Eq, Ord, Show, Generic) deriving (Arbitrary) via (GenericUniform EJPDResponseItem) @@ -86,7 +101,9 @@ instance ToJSON EJPDResponseItem where "ejpd_response_phone" .= ejpdResponsePhone rspi, "ejpd_response_push_tokens" .= ejpdResponsePushTokens rspi, "ejpd_response_contacts" .= ejpdResponseContacts rspi, - "ejpd_response_team_contacts" .= ejpdResponseTeamContacts rspi + "ejpd_response_team_contacts" .= ejpdResponseTeamContacts rspi, + "ejpd_response_conversations" .= ejpdResponseConversations rspi, + "ejpd_response_assets" .= ejpdResponseAssets rspi ] instance FromJSON EJPDResponseItem where @@ -101,3 +118,5 @@ instance FromJSON EJPDResponseItem where <*> obj .: "ejpd_response_push_tokens" <*> obj .:? "ejpd_response_contacts" <*> obj .:? "ejpd_response_team_contacts" + <*> obj .:? "ejpd_response_conversations" + <*> obj .:? "ejpd_response_assets" diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Cargohold.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Cargohold.hs index cb9599b441e..592e72dc61a 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Cargohold.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Cargohold.hs @@ -22,12 +22,15 @@ import Data.OpenApi import Imports import Servant import Servant.OpenApi +import Wire.API.Asset import Wire.API.Routes.MultiVerb +import Wire.API.Routes.Named type InternalAPI = "i" - :> "status" - :> MultiVerb 'GET '() '[RespondEmpty 200 "OK"] () + :> ( "status" :> MultiVerb 'GET '() '[RespondEmpty 200 "OK"] () + :<|> Named "iGetAsset" ("assets" :> Capture "key" AssetKey :> Get '[Servant.JSON] Text) + ) swaggerDoc :: OpenApi swaggerDoc = diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs index d2f435e4a97..d07f48258dc 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs @@ -42,6 +42,7 @@ import Wire.API.Routes.Named import Wire.API.Routes.Public import Wire.API.Routes.Public.Galley.Conversation import Wire.API.Routes.Public.Galley.Feature +import Wire.API.Routes.QualifiedCapture import Wire.API.Team import Wire.API.Team.Feature import Wire.API.Team.Member @@ -256,7 +257,7 @@ type InternalAPIBase = :> "one2one" :> "upsert" :> ReqBody '[Servant.JSON] UpsertOne2OneConversationRequest - :> Post '[Servant.JSON] UpsertOne2OneConversationResponse + :> MultiVerb1 'POST '[Servant.JSON] (RespondEmpty 200 "Upsert One2One Policy") ) :<|> IFeatureAPI :<|> IFederationAPI @@ -492,7 +493,7 @@ type IConversationAPI = :> Put '[Servant.JSON] Conversation ) :<|> Named - "conversation-block" + "conversation-block-unqualified" ( CanThrow 'InvalidOperation :> CanThrow 'ConvNotFound :> ZUser @@ -501,12 +502,22 @@ type IConversationAPI = :> "block" :> Put '[Servant.JSON] () ) + :<|> Named + "conversation-block" + ( CanThrow 'InvalidOperation + :> CanThrow 'ConvNotFound + :> ZLocalUser + :> "conversations" + :> QualifiedCapture "cnv" ConvId + :> "block" + :> Put '[Servant.JSON] () + ) -- This endpoint can lead to the following events being sent: -- - MemberJoin event to you, if the conversation existed and had < 2 members before -- - MemberJoin event to other, if the conversation existed and only the other was member -- before :<|> Named - "conversation-unblock" + "conversation-unblock-unqualified" ( CanThrow 'InvalidOperation :> CanThrow 'ConvNotFound :> ZLocalUser @@ -516,6 +527,21 @@ type IConversationAPI = :> "unblock" :> Put '[Servant.JSON] Conversation ) + -- This endpoint can lead to the following events being sent: + -- - MemberJoin event to you, if the conversation existed and had < 2 members before + -- - MemberJoin event to other, if the conversation existed and only the other was member + -- before + :<|> Named + "conversation-unblock" + ( CanThrow 'InvalidOperation + :> CanThrow 'ConvNotFound + :> ZLocalUser + :> ZOptConn + :> "conversations" + :> QualifiedCapture "cnv" ConvId + :> "unblock" + :> Put '[Servant.JSON] () + ) :<|> Named "conversation-meta" ( CanThrow 'ConvNotFound @@ -524,6 +550,27 @@ type IConversationAPI = :> "meta" :> Get '[Servant.JSON] ConversationMetadata ) + :<|> Named + "conversation-mls-one-to-one" + ( CanThrow 'NotConnected + :> CanThrow 'MLSNotEnabled + :> "conversations" + :> "mls-one2one" + :> ZLocalUser + :> QualifiedCapture "user" UserId + :> Get '[Servant.JSON] Conversation + ) + :<|> Named + "conversation-mls-one-to-one-established" + ( CanThrow 'NotConnected + :> CanThrow 'MLSNotEnabled + :> ZLocalUser + :> "conversations" + :> "mls-one2one" + :> QualifiedCapture "user" UserId + :> "established" + :> Get '[Servant.JSON] Bool + ) swaggerDoc :: OpenApi swaggerDoc = diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Galley/ConversationsIntra.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Galley/ConversationsIntra.hs index b644906cd95..a25baa28b23 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley/ConversationsIntra.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Galley/ConversationsIntra.hs @@ -15,16 +15,9 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Wire.API.Routes.Internal.Galley.ConversationsIntra - ( DesiredMembership (..), - Actor (..), - UpsertOne2OneConversationRequest (..), - UpsertOne2OneConversationResponse (..), - ) -where +module Wire.API.Routes.Internal.Galley.ConversationsIntra where -import Data.Aeson qualified as A -import Data.Aeson.Types (FromJSON, ToJSON) +import Data.Aeson (FromJSON, ToJSON) import Data.Id (ConvId, UserId) import Data.OpenApi qualified as Swagger import Data.Qualified @@ -60,7 +53,7 @@ data UpsertOne2OneConversationRequest = UpsertOne2OneConversationRequest uooRemoteUser :: Remote UserId, uooActor :: Actor, uooActorDesiredMembership :: DesiredMembership, - uooConvId :: Maybe (Qualified ConvId) + uooConvId :: Qualified ConvId } deriving (Show, Generic) deriving (FromJSON, ToJSON, Swagger.ToSchema) via Schema UpsertOne2OneConversationRequest @@ -73,16 +66,4 @@ instance ToSchema UpsertOne2OneConversationRequest where <*> (tUntagged . uooRemoteUser) .= field "remote_user" (qTagUnsafe <$> schema) <*> uooActor .= field "actor" schema <*> uooActorDesiredMembership .= field "actor_desired_membership" schema - <*> uooConvId .= optField "conversation_id" (maybeWithDefault A.Null schema) - -newtype UpsertOne2OneConversationResponse = UpsertOne2OneConversationResponse - { uuorConvId :: Qualified ConvId - } - deriving (Show, Generic) - deriving (FromJSON, ToJSON, Swagger.ToSchema) via Schema UpsertOne2OneConversationResponse - -instance ToSchema UpsertOne2OneConversationResponse where - schema = - object "UpsertOne2OneConversationResponse" $ - UpsertOne2OneConversationResponse - <$> uuorConvId .= field "conversation_id" schema + <*> uooConvId .= field "conversation_id" schema diff --git a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging/State.hs b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging/State.hs index 7d43b3009be..1fae94b78b4 100644 --- a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging/State.hs +++ b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging/State.hs @@ -64,7 +64,9 @@ instance PagingTable tables => ToHttpApiData (MultiTablePagingState name tables) toQueryParam = (Text.decodeUtf8 . Base64Url.encode) . encodePagingState instance PagingTable tables => FromHttpApiData (MultiTablePagingState name tables) where - parseQueryParam = mapLeft cs . (parsePagingState <=< (Base64Url.decode . Text.encodeUtf8)) + parseQueryParam = + mapLeft Text.pack + . (parsePagingState <=< (Base64Url.decode . Text.encodeUtf8)) -- | A class for values that can be encoded with a single byte. Used to add a -- byte of extra information to the paging state in order to recover the table diff --git a/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs b/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs index ed24bbfdbe5..7c4e6dcd5ab 100644 --- a/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs +++ b/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs @@ -72,7 +72,7 @@ import Data.Text.Encoding qualified as Text import Data.Typeable import GHC.TypeLits import Generics.SOP as GSOP -import Imports hiding (cs) +import Imports import Network.HTTP.Media qualified as M import Network.HTTP.Types (hContentType) import Network.HTTP.Types qualified as HTTP diff --git a/libs/wire-api/src/Wire/API/Routes/Named.hs b/libs/wire-api/src/Wire/API/Routes/Named.hs index f76ada19664..5e8220818b5 100644 --- a/libs/wire-api/src/Wire/API/Routes/Named.hs +++ b/libs/wire-api/src/Wire/API/Routes/Named.hs @@ -25,6 +25,7 @@ import Data.Metrics.Servant import Data.OpenApi.Lens hiding (HasServer) import Data.OpenApi.Operation import Data.Proxy +import Data.Text qualified as T import GHC.TypeLits import Imports import Servant @@ -42,7 +43,7 @@ class RenderableSymbol a where renderSymbol :: Text instance {-# OVERLAPPABLE #-} KnownSymbol a => RenderableSymbol a where - renderSymbol = cs . show $ symbolVal (Proxy @a) + renderSymbol = T.pack . show $ symbolVal (Proxy @a) instance {-# OVERLAPPING #-} (RenderableSymbol a, RenderableSymbol b) => RenderableSymbol '(a, b) where renderSymbol = "(" <> (renderSymbol @a) <> ", " <> (renderSymbol @b) <> ")" @@ -55,7 +56,7 @@ instance (HasOpenApi api, RenderableSymbol name) => HasOpenApi (Named name api) dscr :: Text dscr = " [internal route ID: " - <> cs (renderSymbol @name) + <> renderSymbol @name <> "]" instance HasServer api ctx => HasServer (Named name api) ctx where diff --git a/libs/wire-api/src/Wire/API/Routes/Public.hs b/libs/wire-api/src/Wire/API/Routes/Public.hs index f5dd0fd40fa..73b6de1b3f6 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public.hs @@ -39,6 +39,7 @@ module Wire.API.Routes.Public where import Control.Lens ((%~), (<>~)) +import Data.ByteString (toStrict) import Data.ByteString.Conversion (toByteString) import Data.Domain import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap @@ -48,6 +49,8 @@ import Data.Metrics.Servant import Data.OpenApi hiding (HasServer, Header, Server) import Data.OpenApi qualified as S import Data.Qualified +import Data.Text.Encoding +import Data.Text.Encoding.Error import GHC.Base (Symbol) import GHC.TypeLits (KnownSymbol) import Imports hiding (All, head) @@ -339,7 +342,18 @@ instance toOpenApi _ = addScopeDescription @scope (toOpenApi (Proxy @api)) addScopeDescription :: forall scope. OAuth.IsOAuthScope scope => OpenApi -> OpenApi -addScopeDescription = allOperations . description %~ Just . (<> "\nOAuth scope: `" <> cs (toByteString (OAuth.toOAuthScope @scope)) <> "`") . fold +addScopeDescription = + allOperations + . description + %~ Just + . ( <> + "\nOAuth scope: `" + <> ( decodeUtf8With lenientDecode . toStrict . toByteString $ + OAuth.toOAuthScope @scope + ) + <> "`" + ) + . fold instance (HasServer api ctx) => HasServer (DescriptionOAuthScope scope :> api) ctx where type ServerT (DescriptionOAuthScope scope :> api) m = ServerT api m 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 ada615249cb..0cd23b3c3e3 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -65,6 +65,7 @@ import Wire.API.Routes.Public.Brig.Services (ServicesAPI) import Wire.API.Routes.Public.Util import Wire.API.Routes.QualifiedCapture import Wire.API.Routes.Version +import Wire.API.Routes.Versioned import Wire.API.SystemSettings import Wire.API.Team.Invitation import Wire.API.Team.Size @@ -126,8 +127,6 @@ type QualifiedCaptureUserId name = QualifiedCapture' '[Description "User Id"] na type CaptureClientId name = Capture' '[Description "ClientId"] name ClientId -type NewClientResponse = Headers '[Header "Location" ClientId] Client - type DeleteSelfResponses = '[ RespondEmpty 200 "Deletion is initiated.", RespondWithDeletionCodeTimeout @@ -316,6 +315,7 @@ type SelfAPI = \password, it must be provided. if password is correct, or if neither \ \a verified identity nor a password exists, account deletion \ \is scheduled immediately." + :> MakesFederatedCall 'Brig "send-connection-action" :> CanThrow 'InvalidUser :> CanThrow 'InvalidCode :> CanThrow 'BadCredentials @@ -333,6 +333,7 @@ type SelfAPI = Named "put-self" ( Summary "Update your profile." + :> MakesFederatedCall 'Brig "send-connection-action" :> ZUser :> ZConn :> "self" @@ -358,6 +359,7 @@ type SelfAPI = :> Description "Your phone number can only be removed if you also have an \ \email address and a password." + :> MakesFederatedCall 'Brig "send-connection-action" :> ZUser :> ZConn :> "self" @@ -373,6 +375,7 @@ type SelfAPI = :> Description "Your email address can only be removed if you also have a \ \phone number." + :> MakesFederatedCall 'Brig "send-connection-action" :> ZUser :> ZConn :> "self" @@ -405,6 +408,7 @@ type SelfAPI = :<|> Named "change-locale" ( Summary "Change your locale." + :> MakesFederatedCall 'Brig "send-connection-action" :> ZUser :> ZConn :> "self" @@ -415,6 +419,8 @@ type SelfAPI = :<|> Named "change-handle" ( Summary "Change your handle." + :> MakesFederatedCall 'Brig "send-connection-action" + :> MakesFederatedCall 'Brig "send-connection-action" :> ZUser :> ZConn :> "self" @@ -477,6 +483,7 @@ type AccountAPI = "If the environment where the registration takes \ \place is private and a registered email address or phone \ \number is not whitelisted, a 403 error is returned." + :> MakesFederatedCall 'Brig "send-connection-action" :> "register" :> ReqBody '[JSON] NewUserPublic :> MultiVerb 'POST '[JSON] RegisterResponses (Either RegisterError RegisterSuccess) @@ -487,6 +494,7 @@ type AccountAPI = :<|> Named "verify-delete" ( Summary "Verify account deletion with a code." + :> MakesFederatedCall 'Brig "send-connection-action" :> CanThrow 'InvalidCode :> "delete" :> ReqBody '[JSON] VerifyDeleteUser @@ -498,6 +506,7 @@ type AccountAPI = :<|> Named "get-activate" ( Summary "Activate (i.e. confirm) an email address or phone number." + :> MakesFederatedCall 'Brig "send-connection-action" :> Description "See also 'POST /activate' which has a larger feature set." :> CanThrow 'UserKeyExists :> CanThrow 'InvalidActivationCodeWrongUser @@ -524,6 +533,7 @@ type AccountAPI = :> Description "Activation only succeeds once and the number of \ \failed attempts for a valid key is limited." + :> MakesFederatedCall 'Brig "send-connection-action" :> CanThrow 'UserKeyExists :> CanThrow 'InvalidActivationCodeWrongUser :> CanThrow 'InvalidActivationCodeWrongCode @@ -719,15 +729,19 @@ type PrekeyAPI = :> Post '[JSON] QualifiedUserClientPrekeyMapV4 ) -type UserClientAPI = - -- User Client API ---------------------------------------------------- +-- User Client API ---------------------------------------------------- + +type ClientHeaders = '[DescHeader "Location" "Client ID" ClientId] +type UserClientAPI = -- This endpoint can lead to the following events being sent: -- - ClientAdded event to self -- - ClientRemoved event to self, if removing old clients due to max number Named - "add-client" + "add-client-v5" ( Summary "Register a new client" + :> Until 'V6 + :> MakesFederatedCall 'Brig "send-connection-action" :> CanThrow 'TooManyClients :> CanThrow 'MissingAuth :> CanThrow 'MalformedPrekeys @@ -737,8 +751,38 @@ type UserClientAPI = :> ZConn :> "clients" :> ReqBody '[JSON] NewClient - :> Verb 'POST 201 '[JSON] NewClientResponse + :> MultiVerb1 + 'POST + '[JSON] + ( WithHeaders + ClientHeaders + Client + (VersionedRespond 'V5 201 "Client registered" Client) + ) ) + :<|> Named + "add-client" + ( Summary "Register a new client" + :> From 'V6 + :> MakesFederatedCall 'Brig "send-connection-action" + :> CanThrow 'TooManyClients + :> CanThrow 'MissingAuth + :> CanThrow 'MalformedPrekeys + :> CanThrow 'CodeAuthenticationFailed + :> CanThrow 'CodeAuthenticationRequired + :> ZUser + :> ZConn + :> "clients" + :> ReqBody '[JSON] NewClient + :> MultiVerb1 + 'POST + '[JSON] + ( WithHeaders + ClientHeaders + Client + (Respond 201 "Client registered" Client) + ) + ) :<|> Named "update-client" ( Summary "Update a registered client" @@ -762,16 +806,49 @@ type UserClientAPI = :> ReqBody '[JSON] RmClient :> MultiVerb 'DELETE '[JSON] '[RespondEmpty 200 "Client deleted"] () ) + :<|> Named + "list-clients-v5" + ( Summary "List the registered clients" + :> Until 'V6 + :> ZUser + :> "clients" + :> MultiVerb1 + 'GET + '[JSON] + ( VersionedRespond 'V5 200 "List of clients" [Client] + ) + ) :<|> Named "list-clients" ( Summary "List the registered clients" + :> From 'V6 :> ZUser :> "clients" - :> Get '[JSON] [Client] + :> MultiVerb1 + 'GET + '[JSON] + ( Respond 200 "List of clients" [Client] + ) + ) + :<|> Named + "get-client-v5" + ( Summary "Get a registered client by ID" + :> Until 'V6 + :> ZUser + :> "clients" + :> CaptureClientId "client" + :> MultiVerb + 'GET + '[JSON] + '[ EmptyErrorForLegacyReasons 404 "Client not found", + VersionedRespond 'V5 200 "Client found" Client + ] + (Maybe Client) ) :<|> Named "get-client" ( Summary "Get a registered client by ID" + :> From 'V6 :> ZUser :> "clients" :> CaptureClientId "client" @@ -1334,6 +1411,7 @@ type AuthAPI = \ Every other combination is invalid.\ \ Access tokens can be given as query parameter or authorisation\ \ header, with the latter being preferred." + :> MakesFederatedCall 'Brig "send-connection-action" :> QueryParam "client_id" ClientId :> Cookies '["zuid" ::: SomeUserToken] :> Bearer SomeAccessToken @@ -1364,6 +1442,7 @@ type AuthAPI = ( "login" :> Summary "Authenticate a user to obtain a cookie and first access token" :> Description "Logins are throttled at the server's discretion" + :> MakesFederatedCall 'Brig "send-connection-action" :> ReqBody '[JSON] Login :> QueryParam' [ Optional, diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig/Bot.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig/Bot.hs index 4d544b64a53..635e6711c4a 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig/Bot.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig/Bot.hs @@ -30,6 +30,8 @@ import Wire.API.Provider.Bot (BotUserView) import Wire.API.Routes.MultiVerb import Wire.API.Routes.Named (Named) import Wire.API.Routes.Public +import Wire.API.Routes.Version +import Wire.API.Routes.Versioned import Wire.API.User import Wire.API.User.Client import Wire.API.User.Client.Prekey (PrekeyId) @@ -39,11 +41,6 @@ type DeleteResponses = Respond 200 "User found" RemoveBotResponse ] -type GetClientResponses = - '[ ErrorResponse 'ClientNotFound, - Respond 200 "Client found" Client - ] - type BotAPI = Named "add-bot" @@ -116,15 +113,39 @@ type BotAPI = :> ReqBody '[JSON] UpdateBotPrekeys :> MultiVerb1 'POST '[JSON] (RespondEmpty 200 "") ) + :<|> Named + "bot-get-client-v5" + ( Summary "Get client for bot" + :> Until 'V6 + :> CanThrow 'AccessDenied + :> CanThrow 'ClientNotFound + :> ZBot + :> "bot" + :> "client" + :> MultiVerb + 'GET + '[JSON] + '[ ErrorResponse 'ClientNotFound, + VersionedRespond 'V5 200 "Client found" Client + ] + (Maybe Client) + ) :<|> Named "bot-get-client" ( Summary "Get client for bot" + :> From 'V6 :> CanThrow 'AccessDenied :> CanThrow 'ClientNotFound :> ZBot :> "bot" :> "client" - :> MultiVerb 'GET '[JSON] GetClientResponses (Maybe Client) + :> MultiVerb + 'GET + '[JSON] + '[ ErrorResponse 'ClientNotFound, + Respond 200 "Client found" Client + ] + (Maybe Client) ) :<|> Named "bot-claim-users-prekeys" diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs index 6266979e8c3..1f4340bb372 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/MLS.hs @@ -116,7 +116,7 @@ type MLSMessagingAPI = :> CanThrow 'MLSNotEnabled :> "public-keys" :> ZLocalUser - :> MultiVerb1 'GET '[JSON] (Respond 200 "Public keys" MLSPublicKeys) + :> MultiVerb1 'GET '[JSON] (Respond 200 "Public keys" (MLSKeysByPurpose MLSPublicKeys)) ) type MLSAPI = LiftNamed ("mls" :> MLSMessagingAPI) diff --git a/libs/wire-api/src/Wire/API/Routes/Version/Wai.hs b/libs/wire-api/src/Wire/API/Routes/Version/Wai.hs index 939b91c5b75..cd797101f11 100644 --- a/libs/wire-api/src/Wire/API/Routes/Version/Wai.hs +++ b/libs/wire-api/src/Wire/API/Routes/Version/Wai.hs @@ -21,6 +21,7 @@ import Control.Monad.Except (throwError) import Data.ByteString.Conversion import Data.EitherR (fmapL) import Data.Text qualified as T +import Data.Text.Lazy (fromStrict) import Imports import Network.HTTP.Types qualified as HTTP import Network.Wai @@ -44,7 +45,7 @@ versionMiddleware disabledAPIVersions app req k = case parseVersion (removeVersi err :: Text -> IO ResponseReceived err v = k . errorRs' . mkError HTTP.status404 "unsupported-version" $ - "Version " <> cs v <> " is not supported" + "Version " <> fromStrict v <> " is not supported" errint :: IO ResponseReceived errint = diff --git a/libs/wire-api/src/Wire/API/Team/Export.hs b/libs/wire-api/src/Wire/API/Team/Export.hs index f5bfbbe08bb..1f1d4b1462a 100644 --- a/libs/wire-api/src/Wire/API/Team/Export.hs +++ b/libs/wire-api/src/Wire/API/Team/Export.hs @@ -67,7 +67,7 @@ instance ToNamedRecord TeamExportUser where ("managed_by", secureCsvFieldToByteString (tExportManagedBy row)), ("saml_name_id", secureCsvFieldToByteString (tExportSAMLNamedId row)), ("scim_external_id", secureCsvFieldToByteString (tExportSCIMExternalId row)), - ("scim_rich_info", maybe "" (cs . Aeson.encode) (tExportSCIMRichInfo row)), + ("scim_rich_info", maybe "" (C.toStrict . Aeson.encode) (tExportSCIMRichInfo row)), ("user_id", secureCsvFieldToByteString (tExportUserId row)), ("num_devices", secureCsvFieldToByteString (tExportNumDevices row)) ] @@ -100,7 +100,7 @@ allowEmpty p str = Just <$> p str parseByteString :: forall a. FromByteString a => ByteString -> Parser a parseByteString bstr = - case parseOnly (parser @a) (cs (unquoted bstr)) of + case parseOnly (parser @a) (C.fromStrict (unquoted bstr)) of Left err -> fail err Right thing -> pure thing @@ -117,7 +117,13 @@ instance FromNamedRecord TeamExportUser where <*> (nrec .: "managed_by" >>= parseByteString) <*> (nrec .: "saml_name_id" >>= parseByteString) <*> (nrec .: "scim_external_id" >>= parseByteString) - <*> (nrec .: "scim_rich_info" >>= allowEmpty (maybe (fail "failed to decode RichInfo") pure . Aeson.decode . cs)) + <*> ( nrec .: "scim_rich_info" + >>= allowEmpty + ( maybe (fail "failed to decode RichInfo") pure + . Aeson.decode + . C.fromStrict + ) + ) <*> (nrec .: "user_id" >>= parseByteString) <*> (nrec .: "num_devices" >>= parseByteString) diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 8dd48682f7a..55319e388d4 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -94,6 +94,7 @@ import Control.Lens (makeLenses, (?~)) import Data.Aeson qualified as A import Data.Aeson.Types qualified as A import Data.Attoparsec.ByteString qualified as Parser +import Data.ByteString (fromStrict) import Data.ByteString.Conversion import Data.ByteString.UTF8 qualified as UTF8 import Data.Domain (Domain) @@ -108,6 +109,7 @@ import Data.Schema import Data.Scientific (toBoundedInteger) import Data.Text qualified as T import Data.Text.Encoding qualified as T +import Data.Text.Encoding.Error import Data.Text.Lazy qualified as TL import Data.Time import Deriving.Aeson @@ -509,7 +511,7 @@ data LockStatus = LockStatusLocked | LockStatusUnlocked deriving (ToJSON, FromJSON, S.ToSchema) via (Schema LockStatus) instance FromHttpApiData LockStatus where - parseUrlPiece = maybeToEither "Invalid lock status" . fromByteString . cs + parseUrlPiece = maybeToEither "Invalid lock status" . fromByteString . T.encodeUtf8 instance ToSchema LockStatus where schema = @@ -1106,7 +1108,7 @@ instance RenderableSymbol EnforceFileDownloadLocationConfig where renderSymbol = "EnforceFileDownloadLocationConfig" instance Arbitrary EnforceFileDownloadLocationConfig where - arbitrary = EnforceFileDownloadLocationConfig . fmap (cs . getPrintableString) <$> arbitrary + arbitrary = EnforceFileDownloadLocationConfig . fmap (T.pack . getPrintableString) <$> arbitrary instance ToSchema EnforceFileDownloadLocationConfig where schema = @@ -1164,10 +1166,14 @@ instance S.ToParamSchema FeatureStatus where } instance FromHttpApiData FeatureStatus where - parseUrlPiece = maybe (Left "must be 'enabled' or 'disabled'") Right . fromByteString' . cs + parseUrlPiece = + maybe (Left "must be 'enabled' or 'disabled'") Right + . fromByteString' + . fromStrict + . T.encodeUtf8 instance ToHttpApiData FeatureStatus where - toUrlPiece = cs . toByteString' + toUrlPiece = T.decodeUtf8With lenientDecode . toByteString' instance ToSchema FeatureStatus where schema = diff --git a/libs/wire-api/src/Wire/API/Team/HardTruncationLimit.hs b/libs/wire-api/src/Wire/API/Team/HardTruncationLimit.hs new file mode 100644 index 00000000000..0ec378cc1bd --- /dev/null +++ b/libs/wire-api/src/Wire/API/Team/HardTruncationLimit.hs @@ -0,0 +1,10 @@ +module Wire.API.Team.HardTruncationLimit where + +import Data.Proxy +import GHC.TypeLits +import Imports + +type HardTruncationLimit = (2000 :: Nat) + +hardTruncationLimit :: Integral a => a +hardTruncationLimit = fromIntegral $ natVal (Proxy @HardTruncationLimit) diff --git a/libs/wire-api/src/Wire/API/Team/Member.hs b/libs/wire-api/src/Wire/API/Team/Member.hs index 91e790aa66e..28c72a3808b 100644 --- a/libs/wire-api/src/Wire/API/Team/Member.hs +++ b/libs/wire-api/src/Wire/API/Team/Member.hs @@ -61,12 +61,19 @@ module Wire.API.Team.Member TeamMemberDeleteData, newTeamMemberDeleteData, tmdAuthPassword, + + -- * Permissions + isAdminOrOwner, + permissionsRole, + rolePermissions, + IsPerm (..), + HiddenPerm (..), ) where import Cassandra (PageWithState (..)) import Cassandra qualified as C -import Control.Lens (Lens, Lens', makeLenses, (%~), (?~)) +import Control.Lens (Lens, Lens', makeLenses, (%~), (?~), (^.)) import Data.Aeson (FromJSON (..), ToJSON (..), Value (..)) import Data.ByteString.Lazy qualified as LBS import Data.Id (UserId) @@ -78,11 +85,14 @@ import Data.OpenApi (ToParamSchema (..)) import Data.OpenApi.Schema qualified as S import Data.Proxy import Data.Schema -import GHC.TypeLits +import Data.Set qualified as Set import Imports +import Wire.API.Error.Galley import Wire.API.Routes.MultiTablePaging (MultiTablePage (..)) import Wire.API.Routes.MultiTablePaging.State -import Wire.API.Team.Permission (Permissions) +import Wire.API.Team.HardTruncationLimit +import Wire.API.Team.Permission +import Wire.API.Team.Role import Wire.Arbitrary (Arbitrary, GenericUniform (..)) data PermissionTag = Required | Optional @@ -271,11 +281,6 @@ instance ToSchema (TeamMember' tag) => ToSchema (TeamMemberList' tag) where <*> _teamMemberListType .= fieldWithDocModifier "hasMore" (description ?~ "true if 'members' doesn't contain all team members") schema -type HardTruncationLimit = (2000 :: Nat) - -hardTruncationLimit :: Integral a => a -hardTruncationLimit = fromIntegral $ natVal (Proxy @HardTruncationLimit) - -- | Like 'ListType', but without backwards-compatible and boolean-blind json serialization. data NewListType = NewListComplete @@ -430,3 +435,167 @@ setOptionalPerms withPerms m = m & permissions %~ setPerm (withPerms m) setOptionalPermsMany :: (TeamMember -> Bool) -> TeamMemberList -> TeamMemberList' 'Optional setOptionalPermsMany withPerms l = l {_teamMembers = map (setOptionalPerms withPerms) (_teamMembers l)} + +-- Note [hidden team roles] +-- +-- The problem: the mapping between 'Role' and 'Permissions' is fixed by external contracts: +-- client apps treat permission bit matrices as opaque role identifiers, so if we add new +-- permission flags, things will break there. +-- +-- "Hidden" in "HiddenPerm", therefore, refers to a permission hidden from +-- clients, thereby making it internal to the backend. +-- +-- The solution: add new permission bits to 'HiddenPerm', 'HiddenPermissions', and make +-- 'hasPermission', 'mayGrantPermission' polymorphic. Now you can check both for the hidden +-- permission bits and the old ones that we share with the client apps. + +-- | See Note [hidden team roles] +data HiddenPerm + = ChangeLegalHoldTeamSettings + | ChangeLegalHoldUserSettings + | ViewLegalHoldUserSettings + | ChangeTeamFeature + | ChangeTeamSearchVisibility + | ViewTeamSearchVisibility + | ViewSameTeamEmails + | ReadIdp + | CreateUpdateDeleteIdp + | CreateReadDeleteScimToken + | -- | this has its own permission because we're not sure how + -- efficient this end-point is. better not let all team members + -- play with it unless we have to. + DownloadTeamMembersCsv + | ChangeTeamMemberProfiles + | SearchContacts + deriving (Eq, Ord, Show) + +-- | See Note [hidden team roles] +data HiddenPermissions = HiddenPermissions + { _hself :: Set HiddenPerm, + _hcopy :: Set HiddenPerm + } + deriving (Eq, Ord, Show) + +makeLenses ''HiddenPermissions + +rolePermissions :: Role -> Permissions +rolePermissions role = Permissions p p where p = rolePerms role + +permissionsRole :: Permissions -> Maybe Role +permissionsRole (Permissions p p') = + if p /= p' + then do + -- we never did use @p /= p'@ for anything, fingers crossed that it doesn't occur anywhere + -- in the wild. but if it does, this implementation prevents privilege escalation. + let p'' = Set.intersection p p' + in permissionsRole (Permissions p'' p'') + else permsRole p + where + permsRole :: Set Perm -> Maybe Role + permsRole perms = + listToMaybe + [ role + | role <- [minBound ..], + -- if a there is a role that is strictly less permissive than the perms set that + -- we encounter, we downgrade. this shouldn't happen in real life, but it has + -- happened to very old users on a staging environment, where a user (probably) + -- was create before the current publicly visible permissions had been stabilized. + rolePerms role `Set.isSubsetOf` perms + ] + +-- | Internal function for 'rolePermissions'. (It works iff the two sets in 'Permissions' are +-- identical for every 'Role', otherwise it'll need to be specialized for the resp. sides.) +rolePerms :: Role -> Set Perm +rolePerms RoleOwner = + rolePerms RoleAdmin + <> Set.fromList + [ GetBilling, + SetBilling, + DeleteTeam + ] +rolePerms RoleAdmin = + rolePerms RoleMember + <> Set.fromList + [ AddTeamMember, + RemoveTeamMember, + SetTeamData, + SetMemberPermissions + ] +rolePerms RoleMember = + rolePerms RoleExternalPartner + <> Set.fromList + [ DeleteConversation, + AddRemoveConvMember, + ModifyConvName, + GetMemberPermissions + ] +rolePerms RoleExternalPartner = + Set.fromList + [ CreateConversation, + GetTeamConversations + ] + +roleHiddenPermissions :: Role -> HiddenPermissions +roleHiddenPermissions role = HiddenPermissions p p + where + p = roleHiddenPerms role + roleHiddenPerms :: Role -> Set HiddenPerm + roleHiddenPerms RoleOwner = roleHiddenPerms RoleAdmin + roleHiddenPerms RoleAdmin = + (roleHiddenPerms RoleMember <>) $ + Set.fromList + [ ChangeLegalHoldTeamSettings, + ChangeLegalHoldUserSettings, + ChangeTeamSearchVisibility, + ChangeTeamFeature, + ChangeTeamMemberProfiles, + ReadIdp, + CreateUpdateDeleteIdp, + CreateReadDeleteScimToken, + DownloadTeamMembersCsv + ] + roleHiddenPerms RoleMember = + (roleHiddenPerms RoleExternalPartner <>) $ + Set.fromList + [ ViewSameTeamEmails, + SearchContacts + ] + roleHiddenPerms RoleExternalPartner = + Set.fromList + [ ViewLegalHoldUserSettings, + ViewTeamSearchVisibility + ] + +isAdminOrOwner :: Permissions -> Bool +isAdminOrOwner perms = + case permissionsRole perms of + Just RoleOwner -> True + Just RoleAdmin -> True + Just RoleMember -> False + Just RoleExternalPartner -> False + Nothing -> False + +-- | See Note [hidden team roles] +class IsPerm perm where + type PermError (e :: perm) :: GalleyError + + roleHasPerm :: Role -> perm -> Bool + roleGrantsPerm :: Role -> perm -> Bool + hasPermission :: TeamMember -> perm -> Bool + hasPermission tm perm = maybe False (`roleHasPerm` perm) . permissionsRole $ tm ^. permissions + mayGrantPermission :: TeamMember -> perm -> Bool + mayGrantPermission tm perm = maybe False (`roleGrantsPerm` perm) . permissionsRole $ tm ^. permissions + +instance IsPerm Perm where + type PermError p = 'MissingPermission ('Just p) + + roleHasPerm r p = p `Set.member` (rolePermissions r ^. self) + roleGrantsPerm r p = p `Set.member` (rolePermissions r ^. copy) + hasPermission tm p = p `Set.member` (tm ^. permissions . self) + mayGrantPermission tm p = p `Set.member` (tm ^. permissions . copy) + +instance IsPerm HiddenPerm where + type PermError p = OperationDenied + + roleHasPerm r p = p `Set.member` (roleHiddenPermissions r ^. hself) + roleGrantsPerm r p = p `Set.member` (roleHiddenPermissions r ^. hcopy) diff --git a/libs/wire-api/src/Wire/API/Team/Permission.hs b/libs/wire-api/src/Wire/API/Team/Permission.hs index 3b108391eda..b4ac0d90455 100644 --- a/libs/wire-api/src/Wire/API/Team/Permission.hs +++ b/libs/wire-api/src/Wire/API/Team/Permission.hs @@ -53,6 +53,7 @@ import Data.Schema import Data.Set qualified as Set import Data.Singletons.Base.TH import Imports +import Test.QuickCheck (oneof) import Wire.API.Util.Aeson (CustomEncoded (..)) import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..)) @@ -89,7 +90,7 @@ instance ToSchema Permissions where instance Arbitrary Permissions where arbitrary = maybe (error "instance Arbitrary Permissions") pure =<< do - selfperms <- arbitrary + selfperms <- oneof $ map (pure . intToPerms) [1025, 1587, 5951, 8191] copyperms <- Set.intersection selfperms <$> arbitrary pure $ newPermissions selfperms copyperms diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index c0095855963..e51b6949746 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -35,6 +35,7 @@ module Wire.API.User SelfProfile (..), -- User (should not be here) User (..), + userId, userEmail, userPhone, userSSOId, @@ -42,8 +43,7 @@ module Wire.API.User userSCIMExternalId, scimExternalId, ssoIssuerAndNameId, - connectedProfile, - publicProfile, + mkUserProfile, userObjectSchema, -- * NewUser @@ -59,6 +59,7 @@ module Wire.API.User CreateUserSparInternalResponses, newUserFromSpar, urefToExternalId, + urefToExternalIdUnsafe, urefToEmail, ExpiresIn, newUserInvitationCode, @@ -136,6 +137,9 @@ module Wire.API.User UpdateSSOIdResponse (..), CheckHandleResponse (..), UpdateConnectionsInternal (..), + EmailVisibility (..), + EmailVisibilityConfig, + EmailVisibilityConfigWithViewer, -- * re-exports module Wire.API.User.Identity, @@ -155,16 +159,18 @@ module Wire.API.User ) where +import Cassandra qualified as C import Control.Applicative import Control.Arrow ((&&&)) import Control.Error.Safe (rightMay) import Control.Lens (makePrisms, over, view, (.~), (?~), (^.)) -import Data.Aeson (FromJSON (..), ToJSON (..)) +import Data.Aeson (FromJSON (..), ToJSON (..), withText) import Data.Aeson.Types qualified as A import Data.Attoparsec.ByteString qualified as Parser import Data.Attoparsec.Text qualified as TParser import Data.Bifunctor qualified as Bifunctor import Data.Bits +import Data.ByteString (toStrict) import Data.ByteString.Builder (toLazyByteString) import Data.ByteString.Conversion import Data.CaseInsensitive qualified as CI @@ -189,6 +195,7 @@ import Data.Set qualified as Set import Data.Text qualified as T import Data.Text.Ascii import Data.Text.Encoding qualified as T +import Data.Text.Encoding.Error import Data.Time.Clock (NominalDiffTime) import Data.UUID (UUID, nil) import Data.UUID qualified as UUID @@ -209,6 +216,8 @@ import Wire.API.Error.Brig qualified as E import Wire.API.Provider.Service (ServiceRef) import Wire.API.Routes.MultiVerb import Wire.API.Team (BindingNewTeam, bindingNewTeamObjectSchema) +import Wire.API.Team.Member (TeamMember) +import Wire.API.Team.Member qualified as TeamMember import Wire.API.Team.Role import Wire.API.User.Activation (ActivationCode, ActivationKey) import Wire.API.User.Auth (CookieLabel) @@ -322,7 +331,7 @@ newtype PhonePrefix = PhonePrefix {fromPhonePrefix :: Text} instance Arbitrary PhonePrefix where arbitrary = do digits <- take 8 <$> QC.listOf1 (QC.elements ['0' .. '9']) - pure . PhonePrefix . cs $ "+" <> digits + pure . PhonePrefix . T.pack $ "+" <> digits instance ToSchema PhonePrefix where schema = fromPhonePrefix .= parsedText "PhonePrefix" phonePrefixParser @@ -337,7 +346,9 @@ instance ToByteString PhonePrefix where builder = builder . fromPhonePrefix instance FromHttpApiData PhonePrefix where - parseUrlPiece = Bifunctor.first cs . phonePrefixParser + parseUrlPiece = Bifunctor.first T.pack . phonePrefixParser + +deriving instance C.Cql PhonePrefix phonePrefixParser :: Text -> Either String PhonePrefix phonePrefixParser p = maybe err pure (parsePhonePrefix p) @@ -664,8 +675,7 @@ instance FromJSON SelfProfile where -- | The data of an existing user. data User = User - { userId :: UserId, - userQualifiedId :: Qualified UserId, + { userQualifiedId :: Qualified UserId, -- | User identity. For endpoints like @/self@, it will be present in the response iff -- the user is activated, and the email/phone contained in it will be guaranteedly -- verified. {#RefActivation} @@ -696,6 +706,9 @@ data User = User deriving (Arbitrary) via (GenericUniform User) deriving (ToJSON, FromJSON, S.ToSchema) via (Schema User) +userId :: User -> UserId +userId = qUnqualified . userQualifiedId + -- -- FUTUREWORK: -- -- disentangle json serializations for 'User', 'NewUser', 'UserIdentity', 'NewUserOrigin'. instance ToSchema User where @@ -704,10 +717,10 @@ instance ToSchema User where userObjectSchema :: ObjectSchema SwaggerDoc User userObjectSchema = User - <$> userId - .= field "id" schema - <*> userQualifiedId + <$> userQualifiedId .= field "qualified_id" schema + <* userId + .= optional (field "id" (deprecatedSchema "qualified_id" schema)) <*> userIdentity .= maybeUserIdentityObjectSchema <*> userDisplayName @@ -755,7 +768,11 @@ scimExternalId ManagedByWire (UserSSOId _) = Nothing ssoIssuerAndNameId :: UserSSOId -> Maybe (Text, Text) ssoIssuerAndNameId (UserSSOId (SAML.UserRef (SAML.Issuer uri) nameIdXML)) = Just (fromUri uri, fromNameId nameIdXML) where - fromUri = cs . toLazyByteString . serializeURIRef + fromUri = + T.decodeUtf8With lenientDecode + . toStrict + . toLazyByteString + . serializeURIRef fromNameId = CI.original . SAML.unsafeShowNameID ssoIssuerAndNameId (UserScimExternalId _) = Nothing @@ -766,60 +783,54 @@ userIssuer user = userSSOId user >>= fromSSOId fromSSOId (UserSSOId (SAML.UserRef issuer _)) = Just issuer fromSSOId _ = Nothing -connectedProfile :: User -> UserLegalHoldStatus -> UserProfile -connectedProfile u legalHoldStatus = - UserProfile - { profileQualifiedId = userQualifiedId u, - profileHandle = userHandle u, - profileName = userDisplayName u, - profilePict = userPict u, - profileAssets = userAssets u, - profileAccentId = userAccentId u, - profileService = userService u, - profileDeleted = userDeleted u, - profileExpire = userExpire u, - profileTeam = userTeam u, - -- We don't want to show the email by default; - -- However we do allow adding it back in intentionally later. - profileEmail = Nothing, - profileLegalholdStatus = legalHoldStatus, - profileSupportedProtocols = userSupportedProtocols u - } +-- | Configurations for whether to show a user's email to others. +data EmailVisibility a + = -- | Anyone can see the email of someone who is on ANY team. + -- This may sound strange; but certain on-premise hosters have many different teams + -- and still want them to see each-other's emails. + EmailVisibleIfOnTeam + | -- | Anyone on your team with at least 'Member' privileges can see your email address. + EmailVisibleIfOnSameTeam a + | -- | Show your email only to yourself + EmailVisibleToSelf + deriving (Eq, Show) --- FUTUREWORK: should public and conect profile be separate types? -publicProfile :: User -> UserLegalHoldStatus -> UserProfile -publicProfile u legalHoldStatus = - -- Note that we explicitly unpack and repack the types here rather than using - -- RecordWildCards or something similar because we want changes to the public profile - -- to be EXPLICIT and INTENTIONAL so we don't accidentally leak sensitive data. - let UserProfile - { profileQualifiedId, - profileHandle, - profileName, - profilePict, - profileAssets, - profileAccentId, - profileService, - profileDeleted, - profileExpire, - profileTeam, - profileLegalholdStatus, - profileSupportedProtocols - } = connectedProfile u legalHoldStatus - in UserProfile - { profileEmail = Nothing, - profileQualifiedId, - profileHandle, - profileName, - profilePict, - profileAssets, - profileAccentId, - profileService, - profileDeleted, - profileExpire, - profileTeam, - profileLegalholdStatus, - profileSupportedProtocols +type EmailVisibilityConfig = EmailVisibility () + +type EmailVisibilityConfigWithViewer = EmailVisibility (Maybe (TeamId, TeamMember)) + +instance FromJSON (EmailVisibility ()) where + parseJSON = withText "EmailVisibility" $ \case + "visible_if_on_team" -> pure EmailVisibleIfOnTeam + "visible_if_on_same_team" -> pure $ EmailVisibleIfOnSameTeam () + "visible_to_self" -> pure EmailVisibleToSelf + _ -> fail "unexpected value for EmailVisibility settings" + +mkUserProfile :: EmailVisibilityConfigWithViewer -> User -> UserLegalHoldStatus -> UserProfile +mkUserProfile emailVisibilityConfigAndViewer u legalHoldStatus = + let isEmailVisible = case emailVisibilityConfigAndViewer of + EmailVisibleToSelf -> False + EmailVisibleIfOnTeam -> isJust (userTeam u) + EmailVisibleIfOnSameTeam Nothing -> False + EmailVisibleIfOnSameTeam (Just (viewerTeamId, viewerMembership)) -> + Just viewerTeamId == userTeam u + && TeamMember.hasPermission viewerMembership TeamMember.ViewSameTeamEmails + in -- This profile would be visible to any other user. When a new field is + -- added, please make sure it is OK for other users to have access to it. + UserProfile + { profileQualifiedId = userQualifiedId u, + profileHandle = userHandle u, + profileName = userDisplayName u, + profilePict = userPict u, + profileAssets = userAssets u, + profileAccentId = userAccentId u, + profileService = userService u, + profileDeleted = userDeleted u, + profileExpire = userExpire u, + profileTeam = userTeam u, + profileEmail = if isEmailVisible then userEmail u else Nothing, + profileLegalholdStatus = legalHoldStatus, + profileSupportedProtocols = userSupportedProtocols u } -------------------------------------------------------------------------------- @@ -958,6 +969,9 @@ urefToEmail uref = case uref ^. SAML.uidSubject . SAML.nameID of SAML.UNameIDEmail email -> parseEmail . SAMLEmail.render . CI.original $ email _ -> Nothing +urefToExternalIdUnsafe :: SAML.UserRef -> Text +urefToExternalIdUnsafe = CI.original . SAML.unsafeShowNameID . view SAML.uidSubject + data CreateUserSparError = CreateUserSparHandleError ChangeHandleError | CreateUserSparRegistrationError RegisterError @@ -1352,10 +1366,16 @@ instance S.ToParamSchema InvitationCode where toParamSchema _ = S.toParamSchema (Proxy @Text) instance FromHttpApiData InvitationCode where - parseQueryParam = bimap cs InvitationCode . validateBase64Url + parseQueryParam = bimap T.pack InvitationCode . validateBase64Url instance ToHttpApiData InvitationCode where - toQueryParam = cs . toByteString . fromInvitationCode + toQueryParam = + T.decodeUtf8With lenientDecode + . toStrict + . toByteString + . fromInvitationCode + +deriving instance C.Cql InvitationCode -------------------------------------------------------------------------------- -- NewTeamUser @@ -1857,6 +1877,24 @@ instance Schema.ToSchema AccountStatus where Schema.element "pending-invitation" PendingInvitation ] +instance C.Cql AccountStatus where + ctype = C.Tagged C.IntColumn + + toCql Active = C.CqlInt 0 + toCql Suspended = C.CqlInt 1 + toCql Deleted = C.CqlInt 2 + toCql Ephemeral = C.CqlInt 3 + toCql PendingInvitation = C.CqlInt 4 + + fromCql (C.CqlInt i) = case i of + 0 -> pure Active + 1 -> pure Suspended + 2 -> pure Deleted + 3 -> pure Ephemeral + 4 -> pure PendingInvitation + n -> Left $ "unexpected account status: " ++ show n + fromCql _ = Left "account status: int expected" + data AccountStatusResp = AccountStatusResp {fromAccountStatusResp :: AccountStatus} deriving (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform AccountStatusResp) @@ -1904,6 +1942,7 @@ instance Schema.ToSchema UserAccount where data NewUserScimInvitation = NewUserScimInvitation -- FIXME: the TID should be captured in the route as usual { newUserScimInvTeamId :: TeamId, + newUserScimInvUserId :: UserId, newUserScimInvLocale :: Maybe Locale, newUserScimInvName :: Name, newUserScimInvEmail :: Email, @@ -1918,6 +1957,7 @@ instance Schema.ToSchema NewUserScimInvitation where Schema.object "NewUserScimInvitation" $ NewUserScimInvitation <$> newUserScimInvTeamId Schema..= Schema.field "team_id" Schema.schema + <*> newUserScimInvUserId Schema..= Schema.field "user_id" Schema.schema <*> newUserScimInvLocale Schema..= maybe_ (optField "locale" Schema.schema) <*> newUserScimInvName Schema..= Schema.field "name" Schema.schema <*> newUserScimInvEmail Schema..= Schema.field "email" Schema.schema @@ -1966,10 +2006,13 @@ instance S.ToParamSchema VerificationAction where } instance FromHttpApiData VerificationAction where - parseUrlPiece = maybeToEither "Invalid verification action" . fromByteString . cs + parseUrlPiece = + maybeToEither "Invalid verification action" + . fromByteString + . T.encodeUtf8 instance ToHttpApiData VerificationAction where - toQueryParam a = cs (toByteString' a) + toQueryParam a = T.decodeUtf8With lenientDecode (toByteString' a) data SendVerificationCode = SendVerificationCode { svcAction :: VerificationAction, @@ -2000,6 +2043,13 @@ data BaseProtocolTag = BaseProtocolProteusTag | BaseProtocolMLSTag deriving (Arbitrary) via (GenericUniform BaseProtocolTag) deriving (FromJSON, ToJSON, S.ToSchema) via (Schema BaseProtocolTag) +instance C.Cql (Imports.Set BaseProtocolTag) where + ctype = C.Tagged C.IntColumn + + toCql = C.CqlInt . fromIntegral . protocolSetBits + fromCql (C.CqlInt bits) = pure $ protocolSetFromBits (fromIntegral bits) + fromCql _ = Left "Protocol set: Int expected" + baseProtocolMask :: BaseProtocolTag -> Word32 baseProtocolMask BaseProtocolProteusTag = 1 baseProtocolMask BaseProtocolMLSTag = 2 diff --git a/libs/wire-api/src/Wire/API/User/Activation.hs b/libs/wire-api/src/Wire/API/User/Activation.hs index e14b30bc326..8998854b2e2 100644 --- a/libs/wire-api/src/Wire/API/User/Activation.hs +++ b/libs/wire-api/src/Wire/API/User/Activation.hs @@ -35,6 +35,7 @@ module Wire.API.User.Activation ) where +import Cassandra qualified as C import Control.Lens ((?~)) import Data.Aeson qualified as A import Data.Aeson.Types (Parser) @@ -82,6 +83,8 @@ instance ToParamSchema ActivationKey where instance FromHttpApiData ActivationKey where parseUrlPiece = fmap ActivationKey . parseUrlPiece +deriving instance C.Cql ActivationKey + -------------------------------------------------------------------------------- -- ActivationCode @@ -100,6 +103,8 @@ instance ToParamSchema ActivationCode where instance FromHttpApiData ActivationCode where parseQueryParam = fmap ActivationCode . parseUrlPiece +deriving instance C.Cql ActivationCode + -------------------------------------------------------------------------------- -- Activate diff --git a/libs/wire-api/src/Wire/API/User/Client.hs b/libs/wire-api/src/Wire/API/User/Client.hs index d900d8b830a..ecdc20531bd 100644 --- a/libs/wire-api/src/Wire/API/User/Client.hs +++ b/libs/wire-api/src/Wire/API/User/Client.hs @@ -46,6 +46,7 @@ module Wire.API.User.Client -- * Client Client (..), + clientSchema, PubClient (..), ClientType (..), ClientClass (..), @@ -67,7 +68,7 @@ module Wire.API.User.Client ) where -import Cassandra qualified as Cql +import Cassandra qualified as C import Control.Applicative import Control.Lens hiding (element, enum, set, (#), (.=)) import Data.Aeson (FromJSON (..), ToJSON (..)) @@ -85,9 +86,11 @@ import Data.Misc (Latitude (..), Longitude (..), PlainTextPassword6) import Data.OpenApi hiding (Schema, ToSchema, nullable, schema) import Data.OpenApi qualified as Swagger hiding (nullable) import Data.Qualified +import Data.SOP hiding (fn) import Data.Schema import Data.Set qualified as Set -import Data.Text.Encoding qualified as Text.E +import Data.Text qualified as T +import Data.Text.Encoding qualified as T import Data.Time.Clock import Data.UUID (toASCIIBytes) import Deriving.Swagger @@ -98,6 +101,9 @@ import Deriving.Swagger ) import Imports import Wire.API.MLS.CipherSuite +import Wire.API.Routes.MultiVerb +import Wire.API.Routes.Version +import Wire.API.Routes.Versioned import Wire.API.User.Auth import Wire.API.User.Client.Prekey as Prekey import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..), generateExample, mapOf', setOf') @@ -151,12 +157,12 @@ instance ToSchema ClientCapability where enum @Text "ClientCapability" $ element "legalhold-implicit-consent" ClientSupportsLegalholdImplicitConsent -instance Cql.Cql ClientCapability where - ctype = Cql.Tagged Cql.IntColumn +instance C.Cql ClientCapability where + ctype = C.Tagged C.IntColumn - toCql ClientSupportsLegalholdImplicitConsent = Cql.CqlInt 1 + toCql ClientSupportsLegalholdImplicitConsent = C.CqlInt 1 - fromCql (Cql.CqlInt i) = case i of + fromCql (C.CqlInt i) = case i of 1 -> pure ClientSupportsLegalholdImplicitConsent n -> Left $ "Unexpected ClientCapability value: " ++ show n fromCql _ = Left "ClientCapability value: int expected" @@ -376,7 +382,7 @@ instance ToJSON UserClientsFull where toJSON . Map.foldrWithKey' fn Map.empty . userClientsFull where fn u c m = - let k = Text.E.decodeLatin1 (toASCIIBytes (toUUID u)) + let k = T.decodeLatin1 (toASCIIBytes (toUUID u)) in Map.insert k c m instance FromJSON UserClientsFull where @@ -498,24 +504,46 @@ mlsPublicKeysSchema = mapSchema :: ValueSchema SwaggerDoc MLSPublicKeys mapSchema = map_ base64Schema +clientSchema :: Maybe Version -> ValueSchema NamedSwaggerDoc Client +clientSchema mv = + object ("Client" <> T.pack (foldMap show mv)) $ + Client + <$> clientId .= field "id" schema + <*> clientType .= field "type" schema + <*> clientTime .= field "time" schema + <*> clientClass .= maybe_ (optField "class" schema) + <*> clientLabel .= maybe_ (optField "label" schema) + <*> clientCookie .= maybe_ (optField "cookie" schema) + <*> clientModel .= maybe_ (optField "model" schema) + <*> clientCapabilities .= (fromMaybe mempty <$> caps) + <*> clientMLSPublicKeys .= mlsPublicKeysFieldSchema + <*> clientLastActive .= maybe_ (optField "last_active" utcTimeSchema) + where + caps :: ObjectSchemaP SwaggerDoc ClientCapabilityList (Maybe ClientCapabilityList) + caps = case mv of + -- broken capability serialisation for backwards compatibility + Just v | v <= V5 -> optField "capabilities" schema + _ -> fmap ClientCapabilityList <$> fromClientCapabilityList .= capabilitiesFieldSchema + instance ToSchema Client where + schema = clientSchema Nothing + +instance ToSchema (Versioned 'V5 Client) where + schema = Versioned <$> unVersioned .= clientSchema (Just V5) + +instance {-# OVERLAPPING #-} ToSchema (Versioned 'V5 [Client]) where schema = - object "Client" $ - Client - <$> clientId .= field "id" schema - <*> clientType .= field "type" schema - <*> clientTime .= field "time" schema - <*> clientClass .= maybe_ (optField "class" schema) - <*> clientLabel .= maybe_ (optField "label" schema) - <*> clientCookie .= maybe_ (optField "cookie" schema) - <*> clientModel .= maybe_ (optField "model" schema) - <*> clientCapabilities .= (fromMaybe mempty <$> optField "capabilities" schema) - <*> clientMLSPublicKeys .= mlsPublicKeysFieldSchema - <*> clientLastActive .= maybe_ (optField "last_active" utcTimeSchema) + Versioned + <$> unVersioned + .= named "ClientList" (array (clientSchema (Just V5))) mlsPublicKeysFieldSchema :: ObjectSchema SwaggerDoc MLSPublicKeys mlsPublicKeysFieldSchema = fromMaybe mempty <$> optField "mls_public_keys" mlsPublicKeysSchema +instance AsHeaders '[ClientId] Client Client where + toHeaders c = (I (clientId c) :* Nil, c) + fromHeaders = snd + -------------------------------------------------------------------------------- -- ClientList @@ -586,6 +614,17 @@ instance ToSchema ClientType where <> element "permanent" PermanentClientType <> element "legalhold" LegalHoldClientType +instance C.Cql ClientType where + ctype = C.Tagged C.IntColumn + toCql TemporaryClientType = C.CqlInt 0 + toCql PermanentClientType = C.CqlInt 1 + toCql LegalHoldClientType = C.CqlInt 2 + + fromCql (C.CqlInt 0) = pure TemporaryClientType + fromCql (C.CqlInt 1) = pure PermanentClientType + fromCql (C.CqlInt 2) = pure LegalHoldClientType + fromCql _ = Left "ClientType: Int [0, 2] expected" + data ClientClass = PhoneClient | TabletClient @@ -603,6 +642,19 @@ instance ToSchema ClientClass where <> element "desktop" DesktopClient <> element "legalhold" LegalHoldClient +instance C.Cql ClientClass where + ctype = C.Tagged C.IntColumn + toCql PhoneClient = C.CqlInt 0 + toCql TabletClient = C.CqlInt 1 + toCql DesktopClient = C.CqlInt 2 + toCql LegalHoldClient = C.CqlInt 3 + + fromCql (C.CqlInt 0) = pure PhoneClient + fromCql (C.CqlInt 1) = pure TabletClient + fromCql (C.CqlInt 2) = pure DesktopClient + fromCql (C.CqlInt 3) = pure LegalHoldClient + fromCql _ = Left "ClientClass: Int [0, 3] expected" + -------------------------------------------------------------------------------- -- NewClient diff --git a/libs/wire-api/src/Wire/API/User/Client/DPoPAccessToken.hs b/libs/wire-api/src/Wire/API/User/Client/DPoPAccessToken.hs index 99ed6e13d92..980e376e7fd 100644 --- a/libs/wire-api/src/Wire/API/User/Client/DPoPAccessToken.hs +++ b/libs/wire-api/src/Wire/API/User/Client/DPoPAccessToken.hs @@ -21,13 +21,15 @@ module Wire.API.User.Client.DPoPAccessToken where import Data.Aeson (FromJSON, ToJSON) +import Data.ByteString (fromStrict) import Data.ByteString.Conversion (FromByteString (..), ToByteString (..), fromByteString', toByteString') import Data.OpenApi qualified as S import Data.OpenApi.ParamSchema (ToParamSchema (..)) import Data.SOP import Data.Schema import Data.Text as T -import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Data.Text.Encoding +import Data.Text.Encoding.Error import Imports import Servant (FromHttpApiData (..), ToHttpApiData (..)) @@ -36,10 +38,14 @@ newtype Proof = Proof {unProof :: ByteString} deriving newtype (FromByteString, ToByteString) instance ToHttpApiData Proof where - toQueryParam = cs . toByteString' + toQueryParam = decodeUtf8With lenientDecode . toByteString' instance FromHttpApiData Proof where - parseQueryParam = maybe (Left "Invalid Proof") Right . fromByteString' . cs + parseQueryParam = + maybe (Left "Invalid Proof") Right + . fromByteString' + . fromStrict + . encodeUtf8 instance ToParamSchema Proof where toParamSchema _ = toParamSchema (Proxy @Text) @@ -56,10 +62,14 @@ instance ToParamSchema DPoPAccessToken where toParamSchema _ = toParamSchema (Proxy @Text) instance ToHttpApiData DPoPAccessToken where - toQueryParam = cs . toByteString' + toQueryParam = decodeUtf8With lenientDecode . toByteString' instance FromHttpApiData DPoPAccessToken where - parseQueryParam = maybe (Left "Invalid DPoPAccessToken") Right . fromByteString' . cs + parseQueryParam = + maybe (Left "Invalid DPoPAccessToken") Right + . fromByteString' + . fromStrict + . encodeUtf8 data AccessTokenType = DPoP deriving (Eq, Show, Generic) diff --git a/libs/wire-api/src/Wire/API/User/Identity.hs b/libs/wire-api/src/Wire/API/User/Identity.hs index 2b88c1d3bd8..88435e20602 100644 --- a/libs/wire-api/src/Wire/API/User/Identity.hs +++ b/libs/wire-api/src/Wire/API/User/Identity.hs @@ -52,6 +52,7 @@ module Wire.API.User.Identity ) where +import Cassandra qualified as C import Control.Applicative (optional) import Control.Lens (dimap, over, (.~), (?~), (^.)) import Data.Aeson (FromJSON (..), ToJSON (..)) @@ -59,13 +60,17 @@ import Data.Aeson qualified as A import Data.Aeson.Types qualified as A import Data.Attoparsec.Text import Data.Bifunctor (first) +import Data.ByteString (fromStrict, toStrict) import Data.ByteString.Conversion +import Data.ByteString.UTF8 qualified as UTF8 import Data.CaseInsensitive qualified as CI import Data.OpenApi (ToParamSchema (..)) import Data.OpenApi qualified as S import Data.Schema import Data.Text qualified as Text -import Data.Text.Encoding (decodeUtf8', encodeUtf8) +import Data.Text.Encoding +import Data.Text.Encoding.Error +import Data.Text.Lazy qualified as LT import Data.Time.Clock import Data.Tuple.Extra (fst3, snd3, thd3) import Imports @@ -188,10 +193,10 @@ instance FromByteString Email where parser = parser >>= maybe (fail "Invalid email") pure . parseEmail instance S.FromHttpApiData Email where - parseUrlPiece = maybe (Left "Invalid email") Right . fromByteString . cs + parseUrlPiece = maybe (Left "Invalid email") Right . fromByteString . encodeUtf8 instance S.ToHttpApiData Email where - toUrlPiece = cs . toByteString' + toUrlPiece = decodeUtf8With lenientDecode . toByteString' instance Arbitrary Email where arbitrary = do @@ -199,6 +204,16 @@ instance Arbitrary Email where domain <- Text.filter (/= '@') <$> arbitrary pure $ Email localPart domain +instance C.Cql Email where + ctype = C.Tagged C.TextColumn + + fromCql (C.CqlText t) = case parseEmail t of + Just e -> pure e + Nothing -> Left "fromCql: Invalid email" + fromCql _ = Left "fromCql: email: CqlText expected" + + toCql = C.toCql . fromEmail + fromEmail :: Email -> Text fromEmail (Email loc dom) = loc <> "@" <> dom @@ -270,10 +285,10 @@ instance FromByteString Phone where parser = parser >>= maybe (fail "Invalid phone") pure . parsePhone instance S.FromHttpApiData Phone where - parseUrlPiece = maybe (Left "Invalid phone") Right . fromByteString . cs + parseUrlPiece = maybe (Left "Invalid phone") Right . fromByteString . encodeUtf8 instance S.ToHttpApiData Phone where - toUrlPiece = cs . toByteString' + toUrlPiece = decodeUtf8With lenientDecode . toByteString' instance Arbitrary Phone where arbitrary = @@ -283,6 +298,8 @@ instance Arbitrary Phone where maxi <- mkdigits =<< QC.chooseInt (0, 7) pure $ '+' : mini <> maxi +deriving instance C.Cql Phone + -- | Parses a phone number in E.164 format with a mandatory leading '+'. parsePhone :: Text -> Maybe Phone parsePhone p @@ -315,6 +332,16 @@ data UserSSOId deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform UserSSOId) +instance C.Cql UserSSOId where + ctype = C.Tagged C.TextColumn + + fromCql (C.CqlText t) = case A.eitherDecode $ fromStrict (encodeUtf8 t) of + Right i -> pure i + Left msg -> Left $ "fromCql: Invalid UserSSOId: " ++ msg + fromCql _ = Left "fromCql: UserSSOId: CqlText expected" + + toCql = C.toCql . decodeUtf8With lenientDecode . toStrict . A.encode + -- | FUTUREWORK: This schema should ideally be a choice of either tenant+subject, or scim_external_id -- but this is currently not possible to derive in swagger2 -- Maybe this becomes possible with swagger 3? @@ -371,7 +398,7 @@ lenientlyParseSAMLIssuer mbtxt = forM mbtxt $ \txt -> do asurl :: Either String SAML.Issuer asurl = bimap show SAML.Issuer $ - URI.parseURI URI.laxURIParserOptions (cs txt) + URI.parseURI URI.laxURIParserOptions (encodeUtf8 . LT.toStrict $ txt) err :: String err = "lenientlyParseSAMLIssuer: " <> show (asxml, asurl, mbtxt) @@ -389,11 +416,11 @@ lenientlyParseSAMLNameID (Just txt) = do maybe (Left "not an email") (fmap emailToSAMLNameID . validateEmail) - (parseEmail (cs txt)) + (parseEmail . LT.toStrict $ txt) astxt :: Either String SAML.NameID astxt = do - nm <- mkName (cs txt) + nm <- mkName . LT.toStrict $ txt SAML.mkNameID (SAML.mkUNameIDUnspecified (fromName nm)) Nothing Nothing Nothing err :: String @@ -426,7 +453,12 @@ mkSampleUref :: Text -> Text -> SAML.UserRef mkSampleUref iseed nseed = SAML.UserRef issuer nameid where issuer :: SAML.Issuer - issuer = SAML.Issuer ([uri|http://example.com/|] & URI.pathL .~ cs ("/" cs iseed)) + issuer = + SAML.Issuer + ( [uri|http://example.com/|] + & URI.pathL + .~ UTF8.fromString ("/" Text.unpack iseed) + ) nameid :: SAML.NameID nameid = fromRight (error "impossible") $ do diff --git a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs index e954f15c2e6..544e8718685 100644 --- a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs +++ b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs @@ -28,11 +28,15 @@ import Data.Aeson.Types (parseMaybe) import Data.Attoparsec.ByteString qualified as AP import Data.Binary.Builder qualified as BSB import Data.ByteString.Conversion qualified as BSC +import Data.ByteString.Lazy (fromStrict, toStrict) import Data.HashMap.Strict.InsOrd (InsOrdHashMap) import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap import Data.Id (TeamId) import Data.OpenApi import Data.Proxy (Proxy (Proxy)) +import Data.Text.Encoding +import Data.Text.Encoding.Error +import Data.Text.Lazy qualified as LT import Imports import Network.HTTP.Media ((//)) import SAML2.WebSSO (IdPConfig) @@ -98,12 +102,14 @@ instance BSC.FromByteString WireIdPAPIVersion where <|> (AP.string "v2" >> pure WireIdPAPIV2) instance FromHttpApiData WireIdPAPIVersion where - parseQueryParam txt = maybe err Right $ BSC.fromByteString' (cs txt) + parseQueryParam txt = + maybe err Right $ + (BSC.fromByteString' . fromStrict . encodeUtf8) txt where err = Left $ "FromHttpApiData WireIdPAPIVersion: " <> txt instance ToHttpApiData WireIdPAPIVersion where - toQueryParam = cs . BSC.toByteString' + toQueryParam = decodeUtf8With lenientDecode . BSC.toByteString' instance ToParamSchema WireIdPAPIVersion where toParamSchema Proxy = @@ -153,10 +159,13 @@ instance Accept RawXML where contentType Proxy = "application" // "xml" instance MimeUnrender RawXML IdPMetadataInfo where - mimeUnrender Proxy raw = IdPMetadataValue (cs raw) <$> mimeUnrender (Proxy @SAML.XML) raw + mimeUnrender Proxy raw = + IdPMetadataValue + (decodeUtf8With lenientDecode . toStrict $ raw) + <$> mimeUnrender (Proxy @SAML.XML) raw instance MimeRender RawXML RawIdPMetadata where - mimeRender Proxy (RawIdPMetadata raw) = cs raw + mimeRender Proxy (RawIdPMetadata raw) = fromStrict . encodeUtf8 $ raw newtype RawIdPMetadata = RawIdPMetadata Text deriving (Eq, Show, Generic) @@ -164,7 +173,7 @@ newtype RawIdPMetadata = RawIdPMetadata Text instance FromJSON IdPMetadataInfo where parseJSON = withObject "IdPMetadataInfo" $ \obj -> do raw <- obj .: "value" - either fail (pure . IdPMetadataValue raw) (SAML.decode (cs raw)) + either fail (pure . IdPMetadataValue raw) (SAML.decode (LT.fromStrict raw)) instance ToJSON IdPMetadataInfo where toJSON (IdPMetadataValue _ x) = diff --git a/libs/wire-api/src/Wire/API/User/Password.hs b/libs/wire-api/src/Wire/API/User/Password.hs index 4f14e4ca7c6..a4c3f92c2ae 100644 --- a/libs/wire-api/src/Wire/API/User/Password.hs +++ b/libs/wire-api/src/Wire/API/User/Password.hs @@ -31,6 +31,7 @@ module Wire.API.User.Password ) where +import Cassandra qualified as C import Control.Lens ((?~)) import Data.Aeson qualified as A import Data.Aeson.Types (Parser) @@ -180,6 +181,8 @@ instance ToParamSchema PasswordResetKey where instance FromHttpApiData PasswordResetKey where parseQueryParam = fmap PasswordResetKey . parseQueryParam +deriving instance C.Cql PasswordResetKey + -------------------------------------------------------------------------------- -- PasswordResetCode @@ -190,6 +193,8 @@ newtype PasswordResetCode = PasswordResetCode deriving newtype (ToSchema, FromByteString, ToByteString, A.FromJSON, A.ToJSON) deriving (Arbitrary) via (Ranged 6 1024 AsciiBase64Url) +deriving instance C.Cql PasswordResetCode + -------------------------------------------------------------------------------- -- DEPRECATED diff --git a/libs/wire-api/src/Wire/API/User/Profile.hs b/libs/wire-api/src/Wire/API/User/Profile.hs index ae018f20b75..dafefa4b4a1 100644 --- a/libs/wire-api/src/Wire/API/User/Profile.hs +++ b/libs/wire-api/src/Wire/API/User/Profile.hs @@ -49,6 +49,7 @@ module Wire.API.User.Profile ) where +import Cassandra qualified as C import Control.Applicative (optional) import Control.Error (hush, note) import Data.Aeson (FromJSON (..), ToJSON (..)) @@ -85,6 +86,8 @@ mkName txt = Name . fromRange <$> checkedEitherMsg @_ @1 @128 "Name" txt instance ToSchema Name where schema = Name <$> fromName .= untypedRangedSchema 1 128 schema +deriving instance C.Cql Name + -------------------------------------------------------------------------------- -- Colour @@ -96,6 +99,8 @@ newtype ColourId = ColourId {fromColourId :: Int32} defaultAccentId :: ColourId defaultAccentId = ColourId 0 +deriving instance C.Cql ColourId + -------------------------------------------------------------------------------- -- Asset @@ -121,6 +126,45 @@ instance ToSchema Asset where enum @Text @NamedSwaggerDoc "AssetType" $ element "image" () +instance C.Cql Asset where + -- Note: Type name and column names and types must match up with the + -- Cassandra schema definition. New fields may only be added + -- (appended) but no fields may be removed. + ctype = + C.Tagged + ( C.UdtColumn + "asset" + [ ("typ", C.IntColumn), + ("key", C.TextColumn), + ("size", C.MaybeColumn C.IntColumn) + ] + ) + + fromCql (C.CqlUdt fs) = do + t <- required "typ" + k <- required "key" + s <- notrequired "size" + case (t :: Int32) of + 0 -> pure $! ImageAsset k s + _ -> Left $ "unexpected user asset type: " ++ show t + where + required :: C.Cql r => Text -> Either String r + required f = + maybe + (Left ("Asset: Missing required field '" ++ show f ++ "'")) + C.fromCql + (lookup f fs) + notrequired f = maybe (Right Nothing) C.fromCql (lookup f fs) + fromCql _ = Left "UserAsset: UDT expected" + + -- Note: Order must match up with the 'ctype' definition. + toCql (ImageAsset k s) = + C.CqlUdt + [ ("typ", C.CqlInt 0), + ("key", C.toCql k), + ("size", C.toCql s) + ] + data AssetSize = AssetComplete | AssetPreview deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform AssetSize) @@ -134,6 +178,16 @@ instance ToSchema AssetSize where element "complete" AssetComplete ] +instance C.Cql AssetSize where + ctype = C.Tagged C.IntColumn + + fromCql (C.CqlInt 0) = pure AssetPreview + fromCql (C.CqlInt 1) = pure AssetComplete + fromCql n = Left $ "Unexpected asset size: " ++ show n + + toCql AssetPreview = C.CqlInt 0 + toCql AssetComplete = C.CqlInt 1 + -------------------------------------------------------------------------------- -- Locale @@ -172,6 +226,15 @@ newtype Language = Language {fromLanguage :: ISO639_1} deriving stock (Eq, Ord, Show, Generic) deriving newtype (Arbitrary, S.ToSchema) +instance C.Cql Language where + ctype = C.Tagged C.AsciiColumn + toCql = C.toCql . lan2Text + + fromCql (C.CqlAscii l) = case parseLanguage l of + Just l' -> pure l' + Nothing -> Left "Language: ISO 639-1 expected." + fromCql _ = Left "Language: ASCII expected" + languageParser :: Parser Language languageParser = codeParser "language" $ fmap Language . checkAndConvert isLower @@ -188,6 +251,15 @@ newtype Country = Country {fromCountry :: CountryCode} deriving stock (Eq, Ord, Show, Generic) deriving newtype (Arbitrary, S.ToSchema) +instance C.Cql Country where + ctype = C.Tagged C.AsciiColumn + toCql = C.toCql . con2Text + + fromCql (C.CqlAscii c) = case parseCountry c of + Just c' -> pure c' + Nothing -> Left "Country: ISO 3166-1-alpha2 expected." + fromCql _ = Left "Country: ASCII expected" + countryParser :: Parser Country countryParser = codeParser "country" $ fmap Country . checkAndConvert isUpper @@ -243,6 +315,16 @@ instance FromByteString ManagedBy where "scim" -> pure ManagedByScim x -> fail $ "Invalid ManagedBy value: " <> show x +instance C.Cql ManagedBy where + ctype = C.Tagged C.IntColumn + + fromCql (C.CqlInt 0) = pure ManagedByWire + fromCql (C.CqlInt 1) = pure ManagedByScim + fromCql n = Left $ "Unexpected ManagedBy: " ++ show n + + toCql ManagedByWire = C.CqlInt 0 + toCql ManagedByScim = C.CqlInt 1 + defaultManagedBy :: ManagedBy defaultManagedBy = ManagedByWire @@ -262,6 +344,17 @@ instance ToSchema Pict where instance Arbitrary Pict where arbitrary = pure $ Pict [] +instance C.Cql Pict where + ctype = C.Tagged (C.ListColumn C.BlobColumn) + + fromCql (C.CqlList l) = do + vs <- map (\(C.Blob lbs) -> lbs) <$> mapM C.fromCql l + as <- mapM (note "Failed to read asset" . A.decode) vs + pure $ Pict as + fromCql _ = pure noPict + + toCql = C.toCql . map (C.Blob . A.encode) . fromPict + noPict :: Pict noPict = Pict [] diff --git a/libs/wire-api/src/Wire/API/User/RichInfo.hs b/libs/wire-api/src/Wire/API/User/RichInfo.hs index 32a3db8fa19..d84ba4f3c2f 100644 --- a/libs/wire-api/src/Wire/API/User/RichInfo.hs +++ b/libs/wire-api/src/Wire/API/User/RichInfo.hs @@ -43,6 +43,7 @@ module Wire.API.User.RichInfo ) where +import Cassandra qualified as C import Control.Lens ((%~), (?~), _1) import Data.Aeson qualified as A import Data.Aeson.Key qualified as A @@ -132,7 +133,7 @@ ciObject name sch = mkSchema s r w desc = S.description ?~ ("json object with case-insensitive fields." :: Text) r :: A.Value -> A.Parser b - r = A.withObject (cs name) f + r = A.withObject (Text.unpack name) f where f :: A.Object -> A.Parser b f = schemaIn sch . g @@ -319,6 +320,12 @@ instance Arbitrary RichInfoAssocList where arbitrary = mkRichInfoAssocList <$> arbitrary shrink (RichInfoAssocList things) = mkRichInfoAssocList <$> QC.shrink things +instance C.Cql RichInfoAssocList where + ctype = C.Tagged C.BlobColumn + toCql = C.toCql . C.Blob . A.encode + fromCql (C.CqlBlob v) = A.eitherDecode v + fromCql _ = Left "RichInfo: Blob expected" + -------------------------------------------------------------------------------- -- RichField @@ -343,8 +350,8 @@ instance ToSchema RichField where instance Arbitrary RichField where arbitrary = RichField - <$> (CI.mk . cs . QC.getPrintableString <$> arbitrary) - <*> (cs . QC.getPrintableString <$> arbitrary) + <$> (CI.mk . Text.pack . QC.getPrintableString <$> arbitrary) + <*> (Text.pack . QC.getPrintableString <$> arbitrary) shrink (RichField k v) = RichField <$> QC.shrink k <*> QC.shrink v -------------------------------------------------------------------------------- diff --git a/libs/wire-api/src/Wire/API/User/Saml.hs b/libs/wire-api/src/Wire/API/User/Saml.hs index 09ad0d24367..f165a17f76c 100644 --- a/libs/wire-api/src/Wire/API/User/Saml.hs +++ b/libs/wire-api/src/Wire/API/User/Saml.hs @@ -28,11 +28,14 @@ import Control.Lens (makeLenses) import Control.Monad.Except import Data.Aeson hiding (fieldLabelModifier) import Data.Aeson.TH hiding (fieldLabelModifier) +import Data.ByteString (toStrict) import Data.ByteString.Builder qualified as Builder import Data.Id (UserId) import Data.OpenApi import Data.Proxy (Proxy (Proxy)) import Data.Text qualified as T +import Data.Text.Encoding +import Data.Text.Encoding.Error import Data.Time import GHC.TypeLits (KnownSymbol, symbolVal) import GHC.Types (Symbol) @@ -66,8 +69,15 @@ deriveJSON deriveJSONOptions ''VerdictFormat mkVerdictGrantedFormatMobile :: MonadError String m => URI -> SetCookie -> UserId -> m URI mkVerdictGrantedFormatMobile before cky uid = parseURI' - . substituteVar "cookie" (cs . Builder.toLazyByteString . renderSetCookie $ cky) - . substituteVar "userid" (cs . show $ uid) + . substituteVar + "cookie" + ( decodeUtf8With lenientDecode + . toStrict + . Builder.toLazyByteString + . renderSetCookie + $ cky + ) + . substituteVar "userid" (T.pack . show $ uid) $ renderURI before mkVerdictDeniedFormatMobile :: MonadError String m => URI -> Text -> m URI diff --git a/libs/wire-api/src/Wire/API/User/Scim.hs b/libs/wire-api/src/Wire/API/User/Scim.hs index 752c608bd85..d8482447523 100644 --- a/libs/wire-api/src/Wire/API/User/Scim.hs +++ b/libs/wire-api/src/Wire/API/User/Scim.hs @@ -42,7 +42,7 @@ -- * Request and response types for SCIM-related endpoints. module Wire.API.User.Scim where -import Control.Lens (Prism', makeLenses, mapped, prism', (.~), (?~)) +import Control.Lens (Prism', makeLenses, mapped, prism', (.~), (?~), (^.)) import Control.Monad.Except (throwError) import Crypto.Hash (hash) import Crypto.Hash.Algorithms (SHA512) @@ -61,7 +61,8 @@ import Data.Map qualified as Map import Data.Misc (PlainTextPassword6) import Data.OpenApi hiding (Operation) import Data.Proxy -import Data.Text.Encoding (encodeUtf8) +import Data.Text qualified as T +import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Time.Clock (UTCTime) import Imports import SAML2.WebSSO qualified as SAML @@ -83,7 +84,8 @@ import Web.Scim.Schema.Schema qualified as Scim import Web.Scim.Schema.User qualified as Scim import Web.Scim.Schema.User qualified as Scim.User import Wire.API.Team.Role (Role) -import Wire.API.User.Identity (Email) +import Wire.API.User (emailFromSAMLNameID, urefToExternalIdUnsafe) +import Wire.API.User.Identity (Email, fromEmail) import Wire.API.User.Profile as BT import Wire.API.User.RichInfo qualified as RI import Wire.API.User.Saml () @@ -128,7 +130,7 @@ data ScimTokenLookupKey hashScimToken :: ScimToken -> ScimTokenHash hashScimToken token = let digest = hash @ByteString @SHA512 (encodeUtf8 (fromScimToken token)) - in ScimTokenHash (cs @ByteString @Text (convertToBase Base64 digest)) + in ScimTokenHash (decodeUtf8 (convertToBase Base64 digest)) -- | Metadata that we store about each token. data ScimTokenInfo = ScimTokenInfo @@ -251,8 +253,8 @@ instance QC.Arbitrary (Scim.User SparTag) where where addFields :: Scim.User.User tag -> QC.Gen (Scim.User.User tag) addFields usr = do - gexternalId <- cs . QC.getPrintableString <$$> QC.arbitrary - gdisplayName <- cs . QC.getPrintableString <$$> QC.arbitrary + gexternalId <- T.pack . QC.getPrintableString <$$> QC.arbitrary + gdisplayName <- T.pack . QC.getPrintableString <$$> QC.arbitrary gactive <- Just . Scim.ScimBool <$> QC.arbitrary -- (`Nothing` maps on `Just True` and was in the way of a unit test.) gemails <- catMaybes <$> (A.decode <$$> QC.listOf (QC.elements ["a@b.c", "x@y,z", "roland@st.uv"])) pure @@ -267,7 +269,7 @@ instance QC.Arbitrary (Scim.User SparTag) where genSchemas = QC.listOf1 $ QC.elements Scim.fakeEnumSchema genUserName :: QC.Gen Text - genUserName = cs . QC.getPrintableString <$> QC.arbitrary + genUserName = T.pack . QC.getPrintableString <$> QC.arbitrary genExtra :: QC.Gen ScimUserExtra genExtra = QC.arbitrary @@ -338,6 +340,15 @@ data ValidExternalId | EmailOnly Email deriving (Eq, Show, Generic) +instance Arbitrary ValidExternalId where + arbitrary = do + muref <- QC.arbitrary + case muref of + Just uref -> case emailFromSAMLNameID $ uref ^. SAML.uidSubject of + Just e -> pure $ EmailAndUref e uref + Nothing -> pure $ UrefOnly uref + Nothing -> EmailOnly <$> QC.arbitrary + -- | Take apart a 'ValidExternalId', using 'SAML.UserRef' if available, otherwise 'Email'. runValidExternalIdEither :: (SAML.UserRef -> a) -> (Email -> a) -> ValidExternalId -> a runValidExternalIdEither doUref doEmail = \case @@ -353,6 +364,11 @@ runValidExternalIdBoth merge doUref doEmail = \case UrefOnly uref -> doUref uref EmailOnly em -> doEmail em +-- | Returns either the extracted `UnqualifiedNameID` if present and not qualified, or the email address. +-- This throws an exception if there are any qualifiers. +runValidExternalIdUnsafe :: ValidExternalId -> Text +runValidExternalIdUnsafe = runValidExternalIdEither urefToExternalIdUnsafe fromEmail + veidUref :: Prism' ValidExternalId SAML.UserRef veidUref = prism' UrefOnly $ \case diff --git a/libs/wire-api/src/Wire/API/User/Search.hs b/libs/wire-api/src/Wire/API/User/Search.hs index 375e1f07dc2..435c7cf3998 100644 --- a/libs/wire-api/src/Wire/API/User/Search.hs +++ b/libs/wire-api/src/Wire/API/User/Search.hs @@ -33,6 +33,7 @@ module Wire.API.User.Search ) where +import Cassandra qualified as C import Control.Error import Control.Lens (makePrisms, (?~)) import Data.Aeson hiding (object, (.=)) @@ -72,7 +73,7 @@ instance ToParamSchema PagingState where toParamSchema _ = toParamSchema (Proxy @Text) instance FromHttpApiData PagingState where - parseQueryParam s = mapLeft cs $ PagingState <$> validateBase64Url s + parseQueryParam s = mapLeft T.pack $ PagingState <$> validateBase64Url s instance ToHttpApiData PagingState where toQueryParam = toText . unPagingState @@ -317,4 +318,16 @@ instance ToSchema FederatedUserSearchPolicy where <> element "exact_handle_search" ExactHandleSearch <> element "full_search" FullSearch +instance C.Cql FederatedUserSearchPolicy where + ctype = C.Tagged C.IntColumn + + toCql NoSearch = C.CqlInt 0 + toCql ExactHandleSearch = C.CqlInt 1 + toCql FullSearch = C.CqlInt 2 + + fromCql (C.CqlInt 0) = pure NoSearch + fromCql (C.CqlInt 1) = pure ExactHandleSearch + fromCql (C.CqlInt 2) = pure FullSearch + fromCql n = Left $ "Unexpected SearchVisibilityInbound: " ++ show n + makePrisms ''FederatedUserSearchPolicy diff --git a/libs/wire-api/src/Wire/API/UserEvent.hs b/libs/wire-api/src/Wire/API/UserEvent.hs new file mode 100644 index 00000000000..59e5ff91502 --- /dev/null +++ b/libs/wire-api/src/Wire/API/UserEvent.hs @@ -0,0 +1,452 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Wire.API.UserEvent where + +import Control.Lens.TH +import Data.Aeson qualified as A +import Data.Aeson.KeyMap qualified as KM +import Data.ByteString.Conversion +import Data.Handle (Handle) +import Data.Id +import Data.Json.Util +import Data.Qualified +import Data.Schema +import Imports +import System.Logger.Message hiding (field, (.=)) +import Wire.API.Connection +import Wire.API.Properties +import Wire.API.Routes.Version +import Wire.API.User +import Wire.API.User.Client +import Wire.API.User.Client.Prekey + +data Event + = UserEvent !UserEvent + | ConnectionEvent !ConnectionEvent + | PropertyEvent !PropertyEvent + | ClientEvent !ClientEvent + deriving stock (Eq, Show) + +eventType :: Event -> EventType +eventType (UserEvent (UserCreated _)) = EventTypeUserCreated +eventType (UserEvent (UserActivated _)) = EventTypeUserActivated +eventType (UserEvent (UserSuspended _)) = EventTypeUserSuspended +eventType (UserEvent (UserResumed _)) = EventTypeUserResumed +eventType (UserEvent (UserDeleted _)) = EventTypeUserDeleted +eventType (UserEvent (UserUpdated _)) = EventTypeUserUpdated +eventType (UserEvent (UserIdentityUpdated _)) = EventTypeUserUpdated +eventType (UserEvent (UserIdentityRemoved _)) = EventTypeUserIdentityRemoved +eventType (UserEvent (UserLegalHoldDisabled _)) = EventTypeUserLegalholdDisabled +eventType (UserEvent (UserLegalHoldEnabled _)) = EventTypeUserLegalholdEnabled +eventType (UserEvent (LegalHoldClientRequested _)) = EventTypeUserLegalholdRequested +eventType (ConnectionEvent _) = EventTypeConnection +eventType (PropertyEvent (PropertySet _ _)) = EventTypePropertiesSet +eventType (PropertyEvent (PropertyDeleted _)) = EventTypePropertiesDeleted +eventType (PropertyEvent PropertiesCleared) = EventTypePropertiesCleared +eventType (ClientEvent (ClientAdded _)) = EventTypeClientAdded +eventType (ClientEvent (ClientRemoved _)) = EventTypeClientRemoved + +data EventType + = EventTypeUserCreated + | EventTypeUserActivated + | EventTypeUserUpdated + | EventTypeUserIdentityRemoved + | EventTypeUserSuspended + | EventTypeUserResumed + | EventTypeUserDeleted + | EventTypeUserLegalholdEnabled + | EventTypeUserLegalholdDisabled + | EventTypeUserLegalholdRequested + | EventTypePropertiesSet + | EventTypePropertiesDeleted + | EventTypePropertiesCleared + | EventTypeClientAdded + | EventTypeClientRemoved + | EventTypeConnection + deriving stock (Eq, Enum, Bounded) + +instance ToSchema EventType where + schema = + enum @Text "EventType" $ + mconcat + [ element "user.new" EventTypeUserCreated, + element "user.activate" EventTypeUserActivated, + element "user.update" EventTypeUserUpdated, + element "user.identity-remove" EventTypeUserIdentityRemoved, + element "user.suspend" EventTypeUserSuspended, + element "user.resume" EventTypeUserResumed, + element "user.delete" EventTypeUserDeleted, + element "user.legalhold-enable" EventTypeUserLegalholdEnabled, + element "user.legalhold-disable" EventTypeUserLegalholdDisabled, + element "user.legalhold-request" EventTypeUserLegalholdRequested, + element "user.properties-set" EventTypePropertiesSet, + element "user.properties-delete" EventTypePropertiesDeleted, + element "user.properties-clear" EventTypePropertiesCleared, + element "user.client-add" EventTypeClientAdded, + element "user.client-remove" EventTypeClientRemoved, + element "user.connection" EventTypeConnection + ] + +data UserEvent + = UserCreated !User + | -- | A user is activated when the first user identity (email address or phone number) + -- is verified. {#RefActivationEvent} + UserActivated !User + | -- | Account & API access of a user has been suspended. + UserSuspended !UserId + | -- | Account & API access of a previously suspended user + -- has been restored. + UserResumed !UserId + | -- | The user account has been deleted. + UserDeleted !(Qualified UserId) + | UserUpdated !UserUpdatedData + | UserIdentityUpdated !UserIdentityUpdatedData + | UserIdentityRemoved !UserIdentityRemovedData + | UserLegalHoldDisabled !UserId + | UserLegalHoldEnabled !UserId + | LegalHoldClientRequested LegalHoldClientRequestedData + deriving stock (Eq, Show) + +data ConnectionEvent = ConnectionUpdated + { ucConn :: !UserConnection, + ucName :: !(Maybe Name) + } + deriving stock (Eq, Show) + +data PropertyEvent + = PropertySet !PropertyKey !A.Value + | PropertyDeleted !PropertyKey + | PropertiesCleared + deriving stock (Eq, Show) + +data ClientEvent + = ClientAdded !Client + | ClientRemoved !ClientId + deriving stock (Eq, Show) + +data UserUpdatedData = UserUpdatedData + { eupId :: !UserId, + eupName :: !(Maybe Name), + -- | DEPRECATED + eupPict :: !(Maybe Pict), + eupAccentId :: !(Maybe ColourId), + eupAssets :: !(Maybe [Asset]), + eupHandle :: !(Maybe Handle), + eupLocale :: !(Maybe Locale), + eupManagedBy :: !(Maybe ManagedBy), + eupSSOId :: !(Maybe UserSSOId), + eupSSOIdRemoved :: Bool, + eupSupportedProtocols :: !(Maybe (Set BaseProtocolTag)) + } + deriving stock (Eq, Show) + +data UserIdentityUpdatedData = UserIdentityUpdatedData + { eiuId :: !UserId, + eiuEmail :: !(Maybe Email), + eiuPhone :: !(Maybe Phone) + } + deriving stock (Eq, Show) + +data UserIdentityRemovedData = UserIdentityRemovedData + { eirId :: !UserId, + eirEmail :: !(Maybe Email), + eirPhone :: !(Maybe Phone) + } + deriving stock (Eq, Show) + +data LegalHoldClientRequestedData = LegalHoldClientRequestedData + { -- | the user that is under legalhold + lhcTargetUser :: !UserId, + -- | the last prekey of the user that is under legalhold + lhcLastPrekey :: !LastPrekey, + -- | the client id of the legalhold device + lhcClientId :: !ClientId + } + deriving stock (Eq, Show) + +emailRemoved :: UserId -> Email -> UserEvent +emailRemoved u e = + UserIdentityRemoved $ UserIdentityRemovedData u (Just e) Nothing + +phoneRemoved :: UserId -> Phone -> UserEvent +phoneRemoved u p = + UserIdentityRemoved $ UserIdentityRemovedData u Nothing (Just p) + +emailUpdated :: UserId -> Email -> UserEvent +emailUpdated u e = + UserIdentityUpdated $ UserIdentityUpdatedData u (Just e) Nothing + +phoneUpdated :: UserId -> Phone -> UserEvent +phoneUpdated u p = + UserIdentityUpdated $ UserIdentityUpdatedData u Nothing (Just p) + +handleUpdated :: UserId -> Handle -> UserEvent +handleUpdated u h = + UserUpdated $ (emptyUserUpdatedData u) {eupHandle = Just h} + +localeUpdate :: UserId -> Locale -> UserEvent +localeUpdate u loc = + UserUpdated $ (emptyUserUpdatedData u) {eupLocale = Just loc} + +managedByUpdate :: UserId -> ManagedBy -> UserEvent +managedByUpdate u mb = + UserUpdated $ (emptyUserUpdatedData u) {eupManagedBy = Just mb} + +supportedProtocolUpdate :: UserId -> Set BaseProtocolTag -> UserEvent +supportedProtocolUpdate u prots = + UserUpdated $ (emptyUserUpdatedData u) {eupSupportedProtocols = Just prots} + +profileUpdated :: UserId -> UserUpdate -> UserEvent +profileUpdated u UserUpdate {..} = + UserUpdated $ + (emptyUserUpdatedData u) + { eupName = uupName, + eupPict = uupPict, + eupAccentId = uupAccentId, + eupAssets = uupAssets + } + +emptyUpdate :: UserId -> UserEvent +emptyUpdate = UserUpdated . emptyUserUpdatedData + +emptyUserUpdatedData :: UserId -> UserUpdatedData +emptyUserUpdatedData u = + UserUpdatedData + { eupId = u, + eupName = Nothing, + eupPict = Nothing, + eupAccentId = Nothing, + eupAssets = Nothing, + eupHandle = Nothing, + eupLocale = Nothing, + eupManagedBy = Nothing, + eupSSOId = Nothing, + eupSSOIdRemoved = False, + eupSupportedProtocols = Nothing + } + +-- Event schema + +$(makePrisms ''Event) +$(makePrisms ''UserEvent) +$(makePrisms ''PropertyEvent) +$(makePrisms ''ClientEvent) + +eventObjectSchema :: ObjectSchema SwaggerDoc Event +eventObjectSchema = + snd + <$> bind + (eventType .= field "type" schema) + ( dispatch $ \case + EventTypeUserCreated -> + tag _UserEvent (tag _UserCreated (noId .= userSchema)) + EventTypeUserActivated -> + tag _UserEvent (tag _UserActivated userSchema) + EventTypeUserUpdated -> + tag + _UserEvent + ( tag + _UserUpdated + ( field + "user" + ( object + "UserUpdatedData" + ( UserUpdatedData + <$> eupId .= field "id" schema + <*> eupName .= maybe_ (optField "name" schema) + <*> eupPict .= maybe_ (optField "picture" schema) -- DEPRECATED + <*> eupAccentId .= maybe_ (optField "accent_id" schema) + <*> eupAssets .= maybe_ (optField "assets" (array schema)) + <*> eupHandle .= maybe_ (optField "handle" schema) + <*> eupLocale .= maybe_ (optField "locale" schema) + <*> eupManagedBy .= maybe_ (optField "managed_by" schema) + <*> eupSSOId .= maybe_ (optField "sso_id" genericToSchema) + <*> eupSSOIdRemoved .= field "sso_id_deleted" schema + <*> eupSupportedProtocols + .= maybe_ + ( optField + "supported_protocols" + (set schema) + ) + ) + ) + ) + <|> tag + _UserIdentityUpdated + ( field + "user" + ( object + "UserIdentityUpdatedData" + ( UserIdentityUpdatedData + <$> eiuId .= field "id" schema + <*> eiuEmail .= maybe_ (optField "email" schema) + <*> eiuPhone .= maybe_ (optField "phone" schema) + ) + ) + ) + ) + EventTypeUserIdentityRemoved -> + tag + _UserEvent + ( tag + _UserIdentityRemoved + ( field + "user" + ( object + "UserIdentityRemovedData" + ( UserIdentityRemovedData + <$> eirId .= field "id" schema + <*> eirEmail .= maybe_ (optField "email" schema) + <*> eirPhone .= maybe_ (optField "phone" schema) + ) + ) + ) + ) + EventTypeUserSuspended -> tag _UserEvent (tag _UserSuspended (field "id" schema)) + EventTypeUserResumed -> tag _UserEvent (tag _UserResumed (field "id" schema)) + EventTypeUserDeleted -> + tag + _UserEvent + ( tag + _UserDeleted + ( field "qualified_id" schema + <* qUnqualified .= field "id" schema + ) + ) + EventTypeUserLegalholdEnabled -> + tag + _UserEvent + ( tag _UserLegalHoldEnabled (field "id" schema) + ) + EventTypeUserLegalholdDisabled -> + tag + _UserEvent + ( tag _UserLegalHoldDisabled (field "id" schema) + ) + EventTypeUserLegalholdRequested -> + tag + _UserEvent + ( tag + _LegalHoldClientRequested + ( LegalHoldClientRequestedData + <$> lhcTargetUser .= field "id" schema + <*> lhcLastPrekey .= field "last_prekey" schema + <*> lhcClientId .= field "client" (idObjectSchema schema) + ) + ) + EventTypePropertiesSet -> + tag + _PropertyEvent + ( tag + _PropertySet + ( (,) + <$> fst .= field "key" genericToSchema + <*> snd .= field "value" jsonValue + ) + ) + EventTypePropertiesDeleted -> + tag + _PropertyEvent + ( tag + _PropertyDeleted + (field "key" genericToSchema) + ) + EventTypePropertiesCleared -> + tag + _PropertyEvent + ( tag + _PropertiesCleared + (pure ()) + ) + EventTypeClientAdded -> + tag + _ClientEvent + ( tag + _ClientAdded + (field "client" (clientSchema (Just V5))) + ) + EventTypeClientRemoved -> + tag + _ClientEvent + ( tag + _ClientRemoved + (field "client" (idObjectSchema schema)) + ) + EventTypeConnection -> + tag + _ConnectionEvent + ( ConnectionUpdated + <$> ucConn .= field "connection" schema + <*> ucName .= maybe_ (optField "user" (object "UserName" (field "name" schema))) + ) + ) + where + noId :: User -> User + noId u = u {userIdentity = Nothing} + + userSchema :: ObjectSchema SwaggerDoc User + userSchema = field "user" schema + +instance ToJSONObject Event where + toJSONObject = KM.fromList . fold . schemaOut eventObjectSchema + +instance ToSchema Event where + schema = object "UserEvent" eventObjectSchema + +deriving via (Schema Event) instance A.ToJSON Event + +deriving via (Schema Event) instance A.FromJSON Event + +-- Logging + +connEventUserId :: ConnectionEvent -> UserId +connEventUserId ConnectionUpdated {..} = ucFrom ucConn + +instance ToBytes Event where + bytes (UserEvent e) = bytes e + bytes (ConnectionEvent e) = bytes e + bytes (PropertyEvent e) = bytes e + bytes (ClientEvent e) = bytes e + +instance ToBytes UserEvent where + bytes (UserCreated u) = val "user.new: " +++ toByteString (userId u) + bytes (UserActivated u) = val "user.activate: " +++ toByteString (userId u) + bytes (UserUpdated u) = val "user.update: " +++ toByteString (eupId u) + bytes (UserIdentityUpdated u) = val "user.update: " +++ toByteString (eiuId u) + bytes (UserIdentityRemoved u) = val "user.identity-remove: " +++ toByteString (eirId u) + bytes (UserSuspended u) = val "user.suspend: " +++ toByteString u + bytes (UserResumed u) = val "user.resume: " +++ toByteString u + bytes (UserDeleted u) = val "user.delete: " +++ toByteString (qUnqualified u) +++ val "@" +++ toByteString (qDomain u) + bytes (UserLegalHoldDisabled u) = val "user.legalhold-disable: " +++ toByteString u + bytes (UserLegalHoldEnabled u) = val "user.legalhold-enable: " +++ toByteString u + bytes (LegalHoldClientRequested payload) = val "user.legalhold-request: " +++ show payload + +instance ToBytes ConnectionEvent where + bytes e@ConnectionUpdated {} = val "user.connection: " +++ toByteString (connEventUserId e) + +instance ToBytes PropertyEvent where + bytes PropertySet {} = val "user.properties-set" + bytes PropertyDeleted {} = val "user.properties-delete" + bytes PropertiesCleared {} = val "user.properties-clear" + +instance ToBytes ClientEvent where + bytes (ClientAdded _) = val "user.client-add" + bytes (ClientRemoved _) = val "user.client-remove" diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs index a6003b36d81..c530bf3234b 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated.hs @@ -350,7 +350,8 @@ tests = (Test.Wire.API.Golden.Generated.RTCConfiguration_user.testObject_RTCConfiguration_user_4, "testObject_RTCConfiguration_user_4.json"), (Test.Wire.API.Golden.Generated.RTCConfiguration_user.testObject_RTCConfiguration_user_5, "testObject_RTCConfiguration_user_5.json"), (Test.Wire.API.Golden.Generated.RTCConfiguration_user.testObject_RTCConfiguration_user_6, "testObject_RTCConfiguration_user_6.json"), - (Test.Wire.API.Golden.Generated.RTCConfiguration_user.testObject_RTCConfiguration_user_7, "testObject_RTCConfiguration_user_7.json") + (Test.Wire.API.Golden.Generated.RTCConfiguration_user.testObject_RTCConfiguration_user_7, "testObject_RTCConfiguration_user_7.json"), + (Test.Wire.API.Golden.Generated.RTCConfiguration_user.testObject_RTCConfiguration_user_8, "testObject_RTCConfiguration_user_8.json") ], testGroup "Golden: SFTServer_user" $ testObjects @@ -791,12 +792,6 @@ tests = ), ( Test.Wire.API.Golden.Generated.Push_2eToken_2eTransport_user.testObject_Push_2eToken_2eTransport_user_3, "testObject_Push_2eToken_2eTransport_user_3.json" - ), - ( Test.Wire.API.Golden.Generated.Push_2eToken_2eTransport_user.testObject_Push_2eToken_2eTransport_user_4, - "testObject_Push_2eToken_2eTransport_user_4.json" - ), - ( Test.Wire.API.Golden.Generated.Push_2eToken_2eTransport_user.testObject_Push_2eToken_2eTransport_user_5, - "testObject_Push_2eToken_2eTransport_user_5.json" ) ], testGroup "Golden: Token_user" $ @@ -1010,6 +1005,8 @@ tests = testObjects [(Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_1, "testObject_ClientClass_user_1.json"), (Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_2, "testObject_ClientClass_user_2.json"), (Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_3, "testObject_ClientClass_user_3.json"), (Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_4, "testObject_ClientClass_user_4.json"), (Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_5, "testObject_ClientClass_user_5.json"), (Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_6, "testObject_ClientClass_user_6.json"), (Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_7, "testObject_ClientClass_user_7.json"), (Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_8, "testObject_ClientClass_user_8.json"), (Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_9, "testObject_ClientClass_user_9.json"), (Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_10, "testObject_ClientClass_user_10.json"), (Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_11, "testObject_ClientClass_user_11.json"), (Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_12, "testObject_ClientClass_user_12.json"), (Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_13, "testObject_ClientClass_user_13.json"), (Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_14, "testObject_ClientClass_user_14.json"), (Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_15, "testObject_ClientClass_user_15.json"), (Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_16, "testObject_ClientClass_user_16.json"), (Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_17, "testObject_ClientClass_user_17.json"), (Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_18, "testObject_ClientClass_user_18.json"), (Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_19, "testObject_ClientClass_user_19.json"), (Test.Wire.API.Golden.Generated.ClientClass_user.testObject_ClientClass_user_20, "testObject_ClientClass_user_20.json")], testGroup "Golden: PubClient_user" $ testObjects [(Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_1, "testObject_PubClient_user_1.json"), (Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_2, "testObject_PubClient_user_2.json"), (Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_3, "testObject_PubClient_user_3.json"), (Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_4, "testObject_PubClient_user_4.json"), (Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_5, "testObject_PubClient_user_5.json"), (Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_6, "testObject_PubClient_user_6.json"), (Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_7, "testObject_PubClient_user_7.json"), (Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_8, "testObject_PubClient_user_8.json"), (Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_9, "testObject_PubClient_user_9.json"), (Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_10, "testObject_PubClient_user_10.json"), (Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_11, "testObject_PubClient_user_11.json"), (Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_12, "testObject_PubClient_user_12.json"), (Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_13, "testObject_PubClient_user_13.json"), (Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_14, "testObject_PubClient_user_14.json"), (Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_15, "testObject_PubClient_user_15.json"), (Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_16, "testObject_PubClient_user_16.json"), (Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_17, "testObject_PubClient_user_17.json"), (Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_18, "testObject_PubClient_user_18.json"), (Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_19, "testObject_PubClient_user_19.json"), (Test.Wire.API.Golden.Generated.PubClient_user.testObject_PubClient_user_20, "testObject_PubClient_user_20.json")], + testGroup "Golden: ClientV5_user" $ + testObjects [(Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_1, "testObject_ClientV5_user_1.json"), (Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_2, "testObject_ClientV5_user_2.json"), (Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_3, "testObject_ClientV5_user_3.json"), (Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_4, "testObject_ClientV5_user_4.json"), (Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_5, "testObject_ClientV5_user_5.json"), (Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_6, "testObject_ClientV5_user_6.json"), (Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_7, "testObject_ClientV5_user_7.json"), (Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_8, "testObject_ClientV5_user_8.json"), (Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_9, "testObject_ClientV5_user_9.json"), (Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_10, "testObject_ClientV5_user_10.json"), (Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_11, "testObject_ClientV5_user_11.json"), (Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_12, "testObject_ClientV5_user_12.json"), (Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_13, "testObject_ClientV5_user_13.json"), (Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_14, "testObject_ClientV5_user_14.json"), (Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_15, "testObject_ClientV5_user_15.json"), (Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_16, "testObject_ClientV5_user_16.json"), (Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_17, "testObject_ClientV5_user_17.json"), (Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_18, "testObject_ClientV5_user_18.json"), (Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_19, "testObject_ClientV5_user_19.json"), (Versioned @'V5 Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_20, "testObject_ClientV5_user_20.json")], testGroup "Golden: Client_user" $ testObjects [(Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_1, "testObject_Client_user_1.json"), (Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_2, "testObject_Client_user_2.json"), (Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_3, "testObject_Client_user_3.json"), (Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_4, "testObject_Client_user_4.json"), (Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_5, "testObject_Client_user_5.json"), (Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_6, "testObject_Client_user_6.json"), (Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_7, "testObject_Client_user_7.json"), (Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_8, "testObject_Client_user_8.json"), (Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_9, "testObject_Client_user_9.json"), (Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_10, "testObject_Client_user_10.json"), (Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_11, "testObject_Client_user_11.json"), (Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_12, "testObject_Client_user_12.json"), (Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_13, "testObject_Client_user_13.json"), (Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_14, "testObject_Client_user_14.json"), (Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_15, "testObject_Client_user_15.json"), (Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_16, "testObject_Client_user_16.json"), (Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_17, "testObject_Client_user_17.json"), (Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_18, "testObject_Client_user_18.json"), (Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_19, "testObject_Client_user_19.json"), (Test.Wire.API.Golden.Generated.Client_user.testObject_Client_user_20, "testObject_Client_user_20.json")], testGroup "Golden: NewClient_user" $ diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Push_2eToken_2eTransport_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Push_2eToken_2eTransport_user.hs index 96739ba620c..fc7c1ed7f14 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Push_2eToken_2eTransport_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Push_2eToken_2eTransport_user.hs @@ -17,7 +17,7 @@ module Test.Wire.API.Golden.Generated.Push_2eToken_2eTransport_user where -import Wire.API.Push.Token (Transport (APNS, APNSSandbox, APNSVoIP, APNSVoIPSandbox, GCM)) +import Wire.API.Push.Token (Transport (APNS, APNSSandbox, GCM)) import Wire.API.Push.Token qualified as Push.Token (Transport) testObject_Push_2eToken_2eTransport_user_1 :: Push.Token.Transport @@ -28,9 +28,3 @@ testObject_Push_2eToken_2eTransport_user_2 = APNS testObject_Push_2eToken_2eTransport_user_3 :: Push.Token.Transport testObject_Push_2eToken_2eTransport_user_3 = APNSSandbox - -testObject_Push_2eToken_2eTransport_user_4 :: Push.Token.Transport -testObject_Push_2eToken_2eTransport_user_4 = APNSVoIP - -testObject_Push_2eToken_2eTransport_user_5 :: Push.Token.Transport -testObject_Push_2eToken_2eTransport_user_5 = APNSVoIPSandbox diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/RTCConfiguration_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/RTCConfiguration_user.hs index 1a1414c6204..29c9555f4ba 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/RTCConfiguration_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/RTCConfiguration_user.hs @@ -19,46 +19,15 @@ module Test.Wire.API.Golden.Generated.RTCConfiguration_user where -import Control.Lens ((.~)) -import Data.Coerce (coerce) -import Data.List.NonEmpty (NonEmpty (..)) -import Data.Misc (HttpsUrl (HttpsUrl), IpAddr (IpAddr)) -import Data.Text.Ascii (AsciiChars (validate)) -import Data.Time (secondsToNominalDiffTime) -import Imports (Maybe (Just, Nothing), fromRight, read, undefined, (&)) +import Control.Lens +import Data.Coerce +import Data.List.NonEmpty +import Data.Misc +import Data.Text.Ascii +import Data.Time +import Imports import URI.ByteString - ( Authority - ( Authority, - authorityHost, - authorityPort, - authorityUserInfo - ), - Host (Host, hostBS), - Query (Query, queryPairs), - Scheme (Scheme, schemeBS), - URIRef - ( URI, - uriAuthority, - uriFragment, - uriPath, - uriQuery, - uriScheme - ), - ) import Wire.API.Call.Config - ( RTCConfiguration, - Scheme (SchemeTurn, SchemeTurns), - Transport (TransportTCP, TransportUDP), - TurnHost (TurnHostIp, TurnHostName), - rtcConfiguration, - rtcIceServer, - sftServer, - tuKeyindex, - tuT, - tuVersion, - turnURI, - turnUsername, - ) testObject_RTCConfiguration_user_1 :: RTCConfiguration testObject_RTCConfiguration_user_1 = @@ -154,6 +123,7 @@ testObject_RTCConfiguration_user_1 = Nothing 2 Nothing + Nothing testObject_RTCConfiguration_user_2 :: RTCConfiguration testObject_RTCConfiguration_user_2 = @@ -332,6 +302,7 @@ testObject_RTCConfiguration_user_2 = ) 4 Nothing + Nothing testObject_RTCConfiguration_user_3 :: RTCConfiguration testObject_RTCConfiguration_user_3 = @@ -477,6 +448,7 @@ testObject_RTCConfiguration_user_3 = ) 9 Nothing + Nothing testObject_RTCConfiguration_user_4 :: RTCConfiguration testObject_RTCConfiguration_user_4 = @@ -672,6 +644,7 @@ testObject_RTCConfiguration_user_4 = ) 2 Nothing + Nothing testObject_RTCConfiguration_user_5 :: RTCConfiguration testObject_RTCConfiguration_user_5 = @@ -714,6 +687,7 @@ testObject_RTCConfiguration_user_5 = ) 2 Nothing + Nothing testObject_RTCConfiguration_user_6 :: RTCConfiguration testObject_RTCConfiguration_user_6 = @@ -736,6 +710,7 @@ testObject_RTCConfiguration_user_6 = Nothing 2 Nothing + Nothing testObject_RTCConfiguration_user_7 :: RTCConfiguration testObject_RTCConfiguration_user_7 = @@ -758,22 +733,50 @@ testObject_RTCConfiguration_user_7 = Nothing 2 ( Just - [ sftServer - ( coerce - URI - { uriScheme = Scheme {schemeBS = "https"}, - uriAuthority = - Just - ( Authority - { authorityUserInfo = Nothing, - authorityHost = Host {hostBS = "example.com"}, - authorityPort = Nothing - } - ), - uriPath = "", - uriQuery = Query {queryPairs = []}, - uriFragment = Nothing - } + [ authSFTServer + ( sftServer + ( coerce + URI + { uriScheme = Scheme {schemeBS = "https"}, + uriAuthority = + Just + ( Authority + { authorityUserInfo = Nothing, + authorityHost = Host {hostBS = "example.com"}, + authorityPort = Nothing + } + ), + uriPath = "", + uriQuery = Query {queryPairs = []}, + uriFragment = Nothing + } + ) ) + (mkSFTUsername (secondsToNominalDiffTime 12) "username") + "credential" ] ) + Nothing + +testObject_RTCConfiguration_user_8 :: RTCConfiguration +testObject_RTCConfiguration_user_8 = + rtcConfiguration + ( rtcIceServer + ( turnURI SchemeTurns (TurnHostIp (IpAddr (read "248.187.155.126"))) (read "1") Nothing + :| [ turnURI SchemeTurn (TurnHostIp (IpAddr (read "166.155.90.230"))) (read "0") (Just TransportTCP), + turnURI SchemeTurns (TurnHostName "xn--mgbh0fb.xn--kgbechtv") (read "1") (Just TransportTCP), + turnURI SchemeTurn (TurnHostName "host.name") (read "1") (Just TransportTCP) + ] + ) + ( turnUsername (secondsToNominalDiffTime 2.000000000000) "tj" + & tuVersion .~ 0 + & tuKeyindex .~ 0 + & tuT .~ '\1011805' + ) + (fromRight undefined (validate "")) + :| [] + ) + Nothing + 2 + Nothing + (Just True) diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SFTServer_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SFTServer_user.hs index 535fd2683c5..b34fc94d32e 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SFTServer_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SFTServer_user.hs @@ -19,46 +19,33 @@ module Test.Wire.API.Golden.Generated.SFTServer_user where -import Data.Coerce (coerce) -import Data.Misc (HttpsUrl (HttpsUrl)) -import Imports (Maybe (Just, Nothing)) +import Data.Coerce +import Data.Misc +import Data.Time.Clock +import Imports import URI.ByteString - ( Authority - ( Authority, - authorityHost, - authorityPort, - authorityUserInfo - ), - Host (Host, hostBS), - Query (Query, queryPairs), - Scheme (Scheme, schemeBS), - URIRef - ( URI, - uriAuthority, - uriFragment, - uriPath, - uriQuery, - uriScheme - ), - ) -import Wire.API.Call.Config (SFTServer, sftServer) +import Wire.API.Call.Config -testObject_SFTServer_user_1 :: SFTServer +testObject_SFTServer_user_1 :: AuthSFTServer testObject_SFTServer_user_1 = - sftServer - ( coerce - URI - { uriScheme = Scheme {schemeBS = "https"}, - uriAuthority = - Just - ( Authority - { authorityUserInfo = Nothing, - authorityHost = Host {hostBS = "example.com"}, - authorityPort = Nothing - } - ), - uriPath = "", - uriQuery = Query {queryPairs = []}, - uriFragment = Nothing - } + authSFTServer + ( sftServer + ( coerce + URI + { uriScheme = Scheme {schemeBS = "https"}, + uriAuthority = + Just + ( Authority + { authorityUserInfo = Nothing, + authorityHost = Host {hostBS = "example.com"}, + authorityPort = Nothing + } + ), + uriPath = "", + uriQuery = Query {queryPairs = []}, + uriFragment = Nothing + } + ) ) + (mkSFTUsername (secondsToNominalDiffTime 12) "username") + "credential" diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SelfProfile_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SelfProfile_user.hs index 119b936cb89..8347f901b60 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SelfProfile_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SelfProfile_user.hs @@ -36,8 +36,7 @@ testObject_SelfProfile_user_1 = SelfProfile { selfUser = User - { userId = Id (fromJust (UUID.fromString "00000002-0000-0002-0000-000200000002")), - userQualifiedId = + { userQualifiedId = Qualified { qUnqualified = Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000002")), qDomain = Domain {_domainText = "n0-994.m-226.f91.vg9p-mj-j2"} diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/User_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/User_user.hs index 439e3c220d3..c744ea8f57a 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/User_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/User_user.hs @@ -49,8 +49,7 @@ import Wire.API.User testObject_User_user_1 :: User testObject_User_user_1 = User - { userId = Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000100000000")), - userQualifiedId = + { userQualifiedId = Qualified { qUnqualified = Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000200000002")), qDomain = Domain {_domainText = "s-f4.s"} @@ -73,8 +72,7 @@ testObject_User_user_1 = testObject_User_user_2 :: User testObject_User_user_2 = User - { userId = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000001")), - userQualifiedId = + { userQualifiedId = Qualified { qUnqualified = Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000200000001")), qDomain = Domain {_domainText = "k.vbg.p"} @@ -111,8 +109,7 @@ testObject_User_user_2 = testObject_User_user_3 :: User testObject_User_user_3 = User - { userId = Id (fromJust (UUID.fromString "00000002-0000-0000-0000-000100000000")), - userQualifiedId = + { userQualifiedId = Qualified { qUnqualified = Id (fromJust (UUID.fromString "00000002-0000-0000-0000-000100000002")), qDomain = Domain {_domainText = "dt.n"} @@ -142,8 +139,7 @@ testObject_User_user_3 = testObject_User_user_4 :: User testObject_User_user_4 = User - { userId = Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000100000002")), - userQualifiedId = + { userQualifiedId = Qualified { qUnqualified = Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000200000002")), qDomain = Domain {_domainText = "28b.cqb"} @@ -183,8 +179,7 @@ testObject_User_user_4 = testObject_User_user_5 :: User testObject_User_user_5 = User - { userId = Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000100000002")), - userQualifiedId = + { userQualifiedId = Qualified { qUnqualified = Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000200000002")), qDomain = Domain {_domainText = "28b.cqb"} diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs index ed40d1157bd..9e41b29bf3a 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs @@ -38,12 +38,13 @@ import Test.Wire.API.Golden.Manual.GetPaginatedConversationIds import Test.Wire.API.Golden.Manual.GroupId import Test.Wire.API.Golden.Manual.ListConversations import Test.Wire.API.Golden.Manual.ListUsersById +import Test.Wire.API.Golden.Manual.MLSKeys import Test.Wire.API.Golden.Manual.QualifiedUserClientPrekeyMap import Test.Wire.API.Golden.Manual.SearchResultContact import Test.Wire.API.Golden.Manual.SubConversation import Test.Wire.API.Golden.Manual.TeamSize -import Test.Wire.API.Golden.Manual.Token import Test.Wire.API.Golden.Manual.UserClientPrekeyMap +import Test.Wire.API.Golden.Manual.UserEvent import Test.Wire.API.Golden.Manual.UserIdList import Test.Wire.API.Golden.Runner import Wire.API.Routes.Version @@ -144,9 +145,6 @@ tests = testGroup "GroupId" $ testObjects [(testObject_GroupId_1, "testObject_GroupId_1.json")], - testGroup "PushToken" $ - testObjects - [(testObject_Token_1, "testObject_Token_1.json")], testGroup "TeamSize" $ testObjects [ (testObject_TeamSize_1, "testObject_TeamSize_1.json"), @@ -197,5 +195,33 @@ tests = [ (testObject_ConversationRemoveMembers_1, "testObject_ConversationRemoveMembers_1.json"), (testObject_ConversationRemoveMembers_2, "testObject_ConversationRemoveMembers_2.json"), (testObject_ConversationRemoveMembers_3, "testObject_ConversationRemoveMembers_3.json") + ], + testGroup "UserEvent" $ + testObjects + [ (testObject_UserEvent_1, "testObject_UserEvent_1.json"), + (testObject_UserEvent_2, "testObject_UserEvent_2.json"), + (testObject_UserEvent_3, "testObject_UserEvent_3.json"), + (testObject_UserEvent_4, "testObject_UserEvent_4.json"), + (testObject_UserEvent_5, "testObject_UserEvent_5.json"), + (testObject_UserEvent_6, "testObject_UserEvent_6.json"), + (testObject_UserEvent_7, "testObject_UserEvent_7.json"), + (testObject_UserEvent_8, "testObject_UserEvent_8.json"), + (testObject_UserEvent_9, "testObject_UserEvent_9.json"), + (testObject_UserEvent_10, "testObject_UserEvent_10.json"), + (testObject_UserEvent_11, "testObject_UserEvent_11.json"), + (testObject_UserEvent_12, "testObject_UserEvent_12.json"), + (testObject_UserEvent_13, "testObject_UserEvent_13.json"), + (testObject_UserEvent_14, "testObject_UserEvent_14.json"), + (testObject_UserEvent_15, "testObject_UserEvent_15.json"), + (testObject_UserEvent_16, "testObject_UserEvent_16.json"), + (testObject_UserEvent_17, "testObject_UserEvent_17.json") + ], + testGroup "MLSPublicKeys" $ + testObjects + [ (testObject_MLSPublicKeys1, "testObject_MLSPublicKeys_1.json") + ], + testGroup "MLSKeysByPurpose" $ + testObjects + [ (testObject_MLSKeysByPurpose1, "testObject_MLSKeysByPurpose_1.json") ] ] diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/MLSKeys.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/MLSKeys.hs new file mode 100644 index 00000000000..bd12d7f7af2 --- /dev/null +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/MLSKeys.hs @@ -0,0 +1,44 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2024 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 Test.Wire.API.Golden.Manual.MLSKeys where + +import Data.Json.Util +import Wire.API.MLS.Keys + +testObject_MLSPublicKeys1 :: MLSPublicKeys +testObject_MLSPublicKeys1 = + MLSKeys + { ed25519 = + MLSPublicKey + (fromBase64TextLenient "7C8PpP91rzMnD4VHuWTI3yNuInfbzIk937uF0Cg/Piw="), + ecdsa_secp256r1_sha256 = + MLSPublicKey + (fromBase64TextLenient "ArUTSywmqya1wAGwrK+pJuA7KSpKm06y3eZq8Py2NMM="), + ecdsa_secp384r1_sha384 = + MLSPublicKey + (fromBase64TextLenient "7pKiTLf72OfpQIeVeXF0mJKfWsBnhTtMUy0zuKasYjlTQUW5fGtcyAFXinM3FahV"), + ecdsa_secp521r1_sha512 = + MLSPublicKey + (fromBase64TextLenient "9twvhZ57ytiujWXFtSmxd8I5r9iZjgdCtGtReJT3yQL2BCGZ80Vzq/MrmV+O0i7lZEI1gqbr8vL1xKk+2h2LyQ==") + } + +testObject_MLSKeysByPurpose1 :: MLSKeysByPurpose MLSPublicKeys +testObject_MLSKeysByPurpose1 = + MLSKeysByPurpose + { removal = testObject_MLSPublicKeys1 + } diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/UserEvent.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/UserEvent.hs new file mode 100644 index 00000000000..7ae86628304 --- /dev/null +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/UserEvent.hs @@ -0,0 +1,247 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2024 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 Test.Wire.API.Golden.Manual.UserEvent + ( testObject_UserEvent_1, + testObject_UserEvent_2, + testObject_UserEvent_3, + testObject_UserEvent_4, + testObject_UserEvent_5, + testObject_UserEvent_6, + testObject_UserEvent_7, + testObject_UserEvent_8, + testObject_UserEvent_9, + testObject_UserEvent_10, + testObject_UserEvent_11, + testObject_UserEvent_12, + testObject_UserEvent_13, + testObject_UserEvent_14, + testObject_UserEvent_15, + testObject_UserEvent_16, + testObject_UserEvent_17, + ) +where + +import Data.Aeson (toJSON) +import Data.Domain +import Data.ISO3166_CountryCodes +import Data.Id +import Data.Json.Util +import Data.LanguageCodes as L +import Data.Qualified +import Data.UUID qualified as UUID (fromString) +import Imports +import Wire.API.Connection +import Wire.API.Properties +import Wire.API.User +import Wire.API.User.Client +import Wire.API.User.Client.Prekey +import Wire.API.UserEvent + +testObject_UserEvent_1 :: Event +testObject_UserEvent_1 = UserEvent (UserCreated alice) + +testObject_UserEvent_2 :: Event +testObject_UserEvent_2 = UserEvent (UserActivated alice) + +testObject_UserEvent_3 :: Event +testObject_UserEvent_3 = + UserEvent + ( UserSuspended + (Id (fromJust (UUID.fromString "dd56271c-181a-43f5-874b-1a8951f7fcc7"))) + ) + +testObject_UserEvent_4 :: Event +testObject_UserEvent_4 = + UserEvent + ( UserSuspended + (Id (fromJust (UUID.fromString "3ddb960e-8ea3-4d14-95bc-97f9da795ca6"))) + ) + +testObject_UserEvent_5 :: Event +testObject_UserEvent_5 = + UserEvent + ( UserDeleted + ( Qualified + (Id (fromJust (UUID.fromString "78f9ba2e-a6b0-48c6-a644-662617bb8bcc"))) + (Domain "bar.example.com") + ) + ) + +testObject_UserEvent_6 :: Event +testObject_UserEvent_6 = + UserEvent + ( UserUpdated + ( UserUpdatedData + (userId alice) + (Just alice.userDisplayName) + (Just alice.userPict) + (Just alice.userAccentId) + (Just alice.userAssets) + alice.userHandle + (Just alice.userLocale) + (Just alice.userManagedBy) + Nothing + False + (Just mempty) + ) + ) + +testObject_UserEvent_7 :: Event +testObject_UserEvent_7 = + UserEvent + ( UserIdentityUpdated + ( UserIdentityUpdatedData + (userId alice) + (Just (Email "alice" "foo.example.com")) + Nothing + ) + ) + +testObject_UserEvent_8 :: Event +testObject_UserEvent_8 = + UserEvent + ( UserIdentityRemoved + ( UserIdentityRemovedData + (userId alice) + (Just (Email "alice" "foo.example.com")) + Nothing + ) + ) + +testObject_UserEvent_9 :: Event +testObject_UserEvent_9 = UserEvent (UserLegalHoldDisabled (userId alice)) + +testObject_UserEvent_10 :: Event +testObject_UserEvent_10 = UserEvent (UserLegalHoldEnabled (userId alice)) + +testObject_UserEvent_11 :: Event +testObject_UserEvent_11 = + UserEvent + ( LegalHoldClientRequested + ( LegalHoldClientRequestedData + (userId alice) + (lastPrekey "foo") + (ClientId 3728) + ) + ) + +testObject_UserEvent_12 :: Event +testObject_UserEvent_12 = + ConnectionEvent + ( ConnectionUpdated + ( UserConnection + (userId bob) + bob.userQualifiedId + Accepted + (fromJust (readUTCTimeMillis "2007-02-03T10:51:17.329Z")) + Nothing + ) + (Just (Name "hi bob")) + ) + +testObject_UserEvent_13 :: Event +testObject_UserEvent_13 = + PropertyEvent + ( PropertySet (PropertyKey "a") (toJSON (39 :: Int)) + ) + +testObject_UserEvent_14 :: Event +testObject_UserEvent_14 = + PropertyEvent + ( PropertyDeleted (PropertyKey "a") + ) + +testObject_UserEvent_15 :: Event +testObject_UserEvent_15 = PropertyEvent PropertiesCleared + +testObject_UserEvent_16 :: Event +testObject_UserEvent_16 = + ClientEvent + ( ClientAdded + ( Client + (ClientId 2839) + PermanentClientType + (fromJust (readUTCTimeMillis "2007-02-03T10:51:17.329Z")) + (Just DesktopClient) + (Just "%*") + Nothing + (Just "bazz") + (ClientCapabilityList mempty) + mempty + Nothing + ) + ) + +testObject_UserEvent_17 :: Event +testObject_UserEvent_17 = ClientEvent (ClientRemoved (ClientId 2839)) + +-------------------------------------------------------------------------------- + +alice :: User +alice = + User + { userQualifiedId = + Qualified + { qUnqualified = Id (fromJust (UUID.fromString "539d9183-32a5-4fc4-ba5c-4634454e7585")), + qDomain = Domain {_domainText = "foo.example.com"} + }, + userIdentity = Nothing, + userDisplayName = Name "alice", + userPict = Pict {fromPict = []}, + userAssets = [], + userAccentId = ColourId {fromColourId = 1}, + userDeleted = True, + userLocale = + Locale + { lLanguage = Language L.TN, + lCountry = Just (Country {fromCountry = SB}) + }, + userService = Nothing, + userHandle = Nothing, + userExpire = Nothing, + userTeam = Nothing, + userManagedBy = ManagedByWire, + userSupportedProtocols = defSupportedProtocols + } + +bob :: User +bob = + User + { userQualifiedId = + Qualified + { qUnqualified = Id (fromJust (UUID.fromString "284d1c86-5117-4c58-aa18-c0068f3f7d8c")), + qDomain = Domain {_domainText = "baz.example.com"} + }, + userIdentity = Nothing, + userDisplayName = Name "bob", + userPict = Pict {fromPict = []}, + userAssets = [], + userAccentId = ColourId {fromColourId = 2}, + userDeleted = False, + userLocale = + Locale + { lLanguage = Language L.CA, + lCountry = Just (Country {fromCountry = JP}) + }, + userService = Nothing, + userHandle = Nothing, + userExpire = Nothing, + userTeam = Nothing, + userManagedBy = ManagedByWire, + userSupportedProtocols = defSupportedProtocols + } diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Runner.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Runner.hs index f4c9a736005..6a458413d84 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Runner.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Runner.hs @@ -33,6 +33,7 @@ import Data.ByteString.Lazy qualified as LBS import Data.ProtoLens.Encoding (decodeMessage, encodeMessage) import Data.ProtoLens.Message (Message) import Data.ProtoLens.TextFormat (readMessage, showMessage) +import Data.String.Conversions import Data.Text.Lazy.IO qualified as LText import Imports import Test.Tasty (TestTree) diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_1.json b/libs/wire-api/test/golden/testObject_ClientV5_user_1.json new file mode 100644 index 00000000000..9fc8b644e4a --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_1.json @@ -0,0 +1,12 @@ +{ + "capabilities": { + "capabilities": [] + }, + "class": "desktop", + "id": "2", + "label": "%*", + "mls_public_keys": {}, + "model": "󳇚;􇻫", + "time": "1864-05-06T19:39:12.770Z", + "type": "permanent" +} diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_10.json b/libs/wire-api/test/golden/testObject_ClientV5_user_10.json new file mode 100644 index 00000000000..1d08a33cfd0 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_10.json @@ -0,0 +1,13 @@ +{ + "capabilities": { + "capabilities": [] + }, + "cookie": "L", + "id": "0", + "mls_public_keys": { + "ed25519": "Wm1GclpTQndkV0pzYVdNZ2EyVjU=" + }, + "model": "\u0018", + "time": "1864-05-10T18:42:04.137Z", + "type": "permanent" +} diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_11.json b/libs/wire-api/test/golden/testObject_ClientV5_user_11.json new file mode 100644 index 00000000000..6e4c38b8dc9 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_11.json @@ -0,0 +1,13 @@ +{ + "capabilities": { + "capabilities": [] + }, + "class": "legalhold", + "cookie": "5", + "id": "3", + "label": "\u001fb", + "mls_public_keys": {}, + "model": "ML", + "time": "1864-05-08T11:57:08.087Z", + "type": "temporary" +} diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_12.json b/libs/wire-api/test/golden/testObject_ClientV5_user_12.json new file mode 100644 index 00000000000..644db85ecbf --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_12.json @@ -0,0 +1,12 @@ +{ + "capabilities": { + "capabilities": [] + }, + "cookie": "0", + "id": "2", + "label": "", + "mls_public_keys": {}, + "model": "", + "time": "1864-05-08T18:44:00.378Z", + "type": "permanent" +} diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_13.json b/libs/wire-api/test/golden/testObject_ClientV5_user_13.json new file mode 100644 index 00000000000..9034bcbc4ab --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_13.json @@ -0,0 +1,13 @@ +{ + "capabilities": { + "capabilities": [] + }, + "class": "phone", + "cookie": "\u000c^󷋏", + "id": "2", + "label": "􃱽", + "mls_public_keys": {}, + "model": "\u0017𐲤", + "time": "1864-05-07T01:09:04.597Z", + "type": "permanent" +} diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_14.json b/libs/wire-api/test/golden/testObject_ClientV5_user_14.json new file mode 100644 index 00000000000..a4d61fe168c --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_14.json @@ -0,0 +1,12 @@ +{ + "capabilities": { + "capabilities": [] + }, + "class": "tablet", + "id": "2", + "label": "x\u000e", + "mls_public_keys": {}, + "model": "􀸏\r󠁨", + "time": "1864-05-12T11:00:10.449Z", + "type": "temporary" +} diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_15.json b/libs/wire-api/test/golden/testObject_ClientV5_user_15.json new file mode 100644 index 00000000000..626f76201cd --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_15.json @@ -0,0 +1,12 @@ +{ + "capabilities": { + "capabilities": [] + }, + "cookie": "􌨷N", + "id": "3", + "label": "\u0004G", + "mls_public_keys": {}, + "model": "zAI", + "time": "1864-05-08T11:28:27.778Z", + "type": "temporary" +} diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_16.json b/libs/wire-api/test/golden/testObject_ClientV5_user_16.json new file mode 100644 index 00000000000..7216da58868 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_16.json @@ -0,0 +1,13 @@ +{ + "capabilities": { + "capabilities": [] + }, + "class": "legalhold", + "cookie": "U", + "id": "2", + "label": "=E", + "mls_public_keys": {}, + "model": "", + "time": "1864-05-12T11:31:10.072Z", + "type": "temporary" +} diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_17.json b/libs/wire-api/test/golden/testObject_ClientV5_user_17.json new file mode 100644 index 00000000000..9f0f36f96a3 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_17.json @@ -0,0 +1,12 @@ +{ + "capabilities": { + "capabilities": [] + }, + "class": "desktop", + "cookie": "", + "id": "4", + "mls_public_keys": {}, + "model": "", + "time": "1864-05-12T02:25:34.770Z", + "type": "temporary" +} diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_18.json b/libs/wire-api/test/golden/testObject_ClientV5_user_18.json new file mode 100644 index 00000000000..80dad343c4e --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_18.json @@ -0,0 +1,13 @@ +{ + "capabilities": { + "capabilities": [] + }, + "class": "legalhold", + "cookie": "PG:", + "id": "1", + "label": "󳔺", + "mls_public_keys": {}, + "model": "􅩹", + "time": "1864-05-07T17:21:05.930Z", + "type": "temporary" +} diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_19.json b/libs/wire-api/test/golden/testObject_ClientV5_user_19.json new file mode 100644 index 00000000000..db061827756 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_19.json @@ -0,0 +1,12 @@ +{ + "capabilities": { + "capabilities": [] + }, + "class": "desktop", + "id": "2", + "label": "􌇰l", + "mls_public_keys": {}, + "model": "", + "time": "1864-05-12T07:49:27.999Z", + "type": "permanent" +} diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_2.json b/libs/wire-api/test/golden/testObject_ClientV5_user_2.json new file mode 100644 index 00000000000..08dd2786531 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_2.json @@ -0,0 +1,10 @@ +{ + "capabilities": { + "capabilities": [] + }, + "cookie": "􏬺c􄂩", + "id": "1", + "mls_public_keys": {}, + "time": "1864-05-07T08:48:22.537Z", + "type": "legalhold" +} diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_20.json b/libs/wire-api/test/golden/testObject_ClientV5_user_20.json new file mode 100644 index 00000000000..253cd8c3952 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_20.json @@ -0,0 +1,14 @@ +{ + "capabilities": { + "capabilities": [ + "legalhold-implicit-consent" + ] + }, + "class": "phone", + "cookie": "", + "id": "1", + "label": "-󼊣v", + "mls_public_keys": {}, + "time": "1864-05-06T18:43:52.483Z", + "type": "legalhold" +} diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_3.json b/libs/wire-api/test/golden/testObject_ClientV5_user_3.json new file mode 100644 index 00000000000..8c5026d2cb7 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_3.json @@ -0,0 +1,13 @@ +{ + "capabilities": { + "capabilities": [] + }, + "class": "legalhold", + "cookie": "", + "id": "1", + "label": "pi", + "last_active": "2023-07-04T09:35:32Z", + "mls_public_keys": {}, + "time": "1864-05-07T00:38:22.384Z", + "type": "temporary" +} diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_4.json b/libs/wire-api/test/golden/testObject_ClientV5_user_4.json new file mode 100644 index 00000000000..25e8c8860bd --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_4.json @@ -0,0 +1,12 @@ +{ + "capabilities": { + "capabilities": [] + }, + "class": "legalhold", + "cookie": "j", + "id": "3", + "mls_public_keys": {}, + "model": "", + "time": "1864-05-06T09:13:45.902Z", + "type": "permanent" +} diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_5.json b/libs/wire-api/test/golden/testObject_ClientV5_user_5.json new file mode 100644 index 00000000000..0af93523dc2 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_5.json @@ -0,0 +1,12 @@ +{ + "capabilities": { + "capabilities": [] + }, + "class": "desktop", + "cookie": "", + "id": "0", + "mls_public_keys": {}, + "model": "⌷o", + "time": "1864-05-07T09:07:14.559Z", + "type": "temporary" +} diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_6.json b/libs/wire-api/test/golden/testObject_ClientV5_user_6.json new file mode 100644 index 00000000000..90a2b0ea16e --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_6.json @@ -0,0 +1,13 @@ +{ + "capabilities": { + "capabilities": [] + }, + "class": "tablet", + "cookie": "l\u0002", + "id": "4", + "last_active": "2021-09-15T22:00:21Z", + "mls_public_keys": {}, + "model": "", + "time": "1864-05-08T22:37:53.030Z", + "type": "permanent" +} diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_7.json b/libs/wire-api/test/golden/testObject_ClientV5_user_7.json new file mode 100644 index 00000000000..41253b1fb0a --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_7.json @@ -0,0 +1,12 @@ +{ + "capabilities": { + "capabilities": [] + }, + "class": "phone", + "id": "4", + "label": "", + "mls_public_keys": {}, + "model": "", + "time": "1864-05-07T04:35:34.201Z", + "type": "permanent" +} diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_8.json b/libs/wire-api/test/golden/testObject_ClientV5_user_8.json new file mode 100644 index 00000000000..fafbbc7e6e5 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_8.json @@ -0,0 +1,13 @@ +{ + "capabilities": { + "capabilities": [] + }, + "class": "phone", + "cookie": "\u0015p`", + "id": "4", + "label": "", + "mls_public_keys": {}, + "model": "􏽉", + "time": "1864-05-11T06:32:01.921Z", + "type": "legalhold" +} diff --git a/libs/wire-api/test/golden/testObject_ClientV5_user_9.json b/libs/wire-api/test/golden/testObject_ClientV5_user_9.json new file mode 100644 index 00000000000..ed4e67747ca --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ClientV5_user_9.json @@ -0,0 +1,13 @@ +{ + "capabilities": { + "capabilities": [] + }, + "class": "legalhold", + "cookie": "G", + "id": "1", + "label": "v", + "mls_public_keys": {}, + "model": "㌀m", + "time": "1864-05-08T03:54:56.526Z", + "type": "legalhold" +} diff --git a/libs/wire-api/test/golden/testObject_Client_user_1.json b/libs/wire-api/test/golden/testObject_Client_user_1.json index 9fc8b644e4a..3ae58f75402 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_1.json +++ b/libs/wire-api/test/golden/testObject_Client_user_1.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "desktop", "id": "2", "label": "%*", diff --git a/libs/wire-api/test/golden/testObject_Client_user_10.json b/libs/wire-api/test/golden/testObject_Client_user_10.json index 1d08a33cfd0..35ad363f074 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_10.json +++ b/libs/wire-api/test/golden/testObject_Client_user_10.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "cookie": "L", "id": "0", "mls_public_keys": { diff --git a/libs/wire-api/test/golden/testObject_Client_user_11.json b/libs/wire-api/test/golden/testObject_Client_user_11.json index 6e4c38b8dc9..8d6af47dc49 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_11.json +++ b/libs/wire-api/test/golden/testObject_Client_user_11.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "legalhold", "cookie": "5", "id": "3", diff --git a/libs/wire-api/test/golden/testObject_Client_user_12.json b/libs/wire-api/test/golden/testObject_Client_user_12.json index 644db85ecbf..63ca4553dee 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_12.json +++ b/libs/wire-api/test/golden/testObject_Client_user_12.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "cookie": "0", "id": "2", "label": "", diff --git a/libs/wire-api/test/golden/testObject_Client_user_13.json b/libs/wire-api/test/golden/testObject_Client_user_13.json index 9034bcbc4ab..9b2552d9086 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_13.json +++ b/libs/wire-api/test/golden/testObject_Client_user_13.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "phone", "cookie": "\u000c^󷋏", "id": "2", diff --git a/libs/wire-api/test/golden/testObject_Client_user_14.json b/libs/wire-api/test/golden/testObject_Client_user_14.json index a4d61fe168c..c95b927805a 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_14.json +++ b/libs/wire-api/test/golden/testObject_Client_user_14.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "tablet", "id": "2", "label": "x\u000e", diff --git a/libs/wire-api/test/golden/testObject_Client_user_15.json b/libs/wire-api/test/golden/testObject_Client_user_15.json index 626f76201cd..7050d356278 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_15.json +++ b/libs/wire-api/test/golden/testObject_Client_user_15.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "cookie": "􌨷N", "id": "3", "label": "\u0004G", diff --git a/libs/wire-api/test/golden/testObject_Client_user_16.json b/libs/wire-api/test/golden/testObject_Client_user_16.json index 7216da58868..e70257998b5 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_16.json +++ b/libs/wire-api/test/golden/testObject_Client_user_16.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "legalhold", "cookie": "U", "id": "2", diff --git a/libs/wire-api/test/golden/testObject_Client_user_17.json b/libs/wire-api/test/golden/testObject_Client_user_17.json index 9f0f36f96a3..485f822a3d2 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_17.json +++ b/libs/wire-api/test/golden/testObject_Client_user_17.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "desktop", "cookie": "", "id": "4", diff --git a/libs/wire-api/test/golden/testObject_Client_user_18.json b/libs/wire-api/test/golden/testObject_Client_user_18.json index 80dad343c4e..5f1ba1bf5b8 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_18.json +++ b/libs/wire-api/test/golden/testObject_Client_user_18.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "legalhold", "cookie": "PG:", "id": "1", diff --git a/libs/wire-api/test/golden/testObject_Client_user_19.json b/libs/wire-api/test/golden/testObject_Client_user_19.json index db061827756..f6263f00203 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_19.json +++ b/libs/wire-api/test/golden/testObject_Client_user_19.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "desktop", "id": "2", "label": "􌇰l", diff --git a/libs/wire-api/test/golden/testObject_Client_user_2.json b/libs/wire-api/test/golden/testObject_Client_user_2.json index 08dd2786531..802de9bd21f 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_2.json +++ b/libs/wire-api/test/golden/testObject_Client_user_2.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "cookie": "􏬺c􄂩", "id": "1", "mls_public_keys": {}, diff --git a/libs/wire-api/test/golden/testObject_Client_user_20.json b/libs/wire-api/test/golden/testObject_Client_user_20.json index 253cd8c3952..c9f3ae4459b 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_20.json +++ b/libs/wire-api/test/golden/testObject_Client_user_20.json @@ -1,9 +1,7 @@ { - "capabilities": { - "capabilities": [ - "legalhold-implicit-consent" - ] - }, + "capabilities": [ + "legalhold-implicit-consent" + ], "class": "phone", "cookie": "", "id": "1", diff --git a/libs/wire-api/test/golden/testObject_Client_user_3.json b/libs/wire-api/test/golden/testObject_Client_user_3.json index 8c5026d2cb7..b6cb51e0fbf 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_3.json +++ b/libs/wire-api/test/golden/testObject_Client_user_3.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "legalhold", "cookie": "", "id": "1", diff --git a/libs/wire-api/test/golden/testObject_Client_user_4.json b/libs/wire-api/test/golden/testObject_Client_user_4.json index 25e8c8860bd..4a8398a2e9b 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_4.json +++ b/libs/wire-api/test/golden/testObject_Client_user_4.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "legalhold", "cookie": "j", "id": "3", diff --git a/libs/wire-api/test/golden/testObject_Client_user_5.json b/libs/wire-api/test/golden/testObject_Client_user_5.json index 0af93523dc2..e1967bb1bcf 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_5.json +++ b/libs/wire-api/test/golden/testObject_Client_user_5.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "desktop", "cookie": "", "id": "0", diff --git a/libs/wire-api/test/golden/testObject_Client_user_6.json b/libs/wire-api/test/golden/testObject_Client_user_6.json index 90a2b0ea16e..929f3132496 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_6.json +++ b/libs/wire-api/test/golden/testObject_Client_user_6.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "tablet", "cookie": "l\u0002", "id": "4", diff --git a/libs/wire-api/test/golden/testObject_Client_user_7.json b/libs/wire-api/test/golden/testObject_Client_user_7.json index 41253b1fb0a..8ca4dc49b6a 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_7.json +++ b/libs/wire-api/test/golden/testObject_Client_user_7.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "phone", "id": "4", "label": "", diff --git a/libs/wire-api/test/golden/testObject_Client_user_8.json b/libs/wire-api/test/golden/testObject_Client_user_8.json index fafbbc7e6e5..35f568dd53c 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_8.json +++ b/libs/wire-api/test/golden/testObject_Client_user_8.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "phone", "cookie": "\u0015p`", "id": "4", diff --git a/libs/wire-api/test/golden/testObject_Client_user_9.json b/libs/wire-api/test/golden/testObject_Client_user_9.json index ed4e67747ca..cfda4f2768a 100644 --- a/libs/wire-api/test/golden/testObject_Client_user_9.json +++ b/libs/wire-api/test/golden/testObject_Client_user_9.json @@ -1,7 +1,5 @@ { - "capabilities": { - "capabilities": [] - }, + "capabilities": [], "class": "legalhold", "cookie": "G", "id": "1", diff --git a/libs/wire-api/test/golden/testObject_MLSKeysByPurpose_1.json b/libs/wire-api/test/golden/testObject_MLSKeysByPurpose_1.json new file mode 100644 index 00000000000..ec9dbea6c97 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_MLSKeysByPurpose_1.json @@ -0,0 +1,8 @@ +{ + "removal": { + "ecdsa_secp256r1_sha256": "ArUTSywmqya1wAGwrK+pJuA7KSpKm06y3eZq8Py2NMM=", + "ecdsa_secp384r1_sha384": "7pKiTLf72OfpQIeVeXF0mJKfWsBnhTtMUy0zuKasYjlTQUW5fGtcyAFXinM3FahV", + "ecdsa_secp521r1_sha512": "9twvhZ57ytiujWXFtSmxd8I5r9iZjgdCtGtReJT3yQL2BCGZ80Vzq/MrmV+O0i7lZEI1gqbr8vL1xKk+2h2LyQ==", + "ed25519": "7C8PpP91rzMnD4VHuWTI3yNuInfbzIk937uF0Cg/Piw=" + } +} diff --git a/libs/wire-api/test/golden/testObject_MLSPublicKeys_1.json b/libs/wire-api/test/golden/testObject_MLSPublicKeys_1.json new file mode 100644 index 00000000000..2ff1863226c --- /dev/null +++ b/libs/wire-api/test/golden/testObject_MLSPublicKeys_1.json @@ -0,0 +1,6 @@ +{ + "ecdsa_secp256r1_sha256": "ArUTSywmqya1wAGwrK+pJuA7KSpKm06y3eZq8Py2NMM=", + "ecdsa_secp384r1_sha384": "7pKiTLf72OfpQIeVeXF0mJKfWsBnhTtMUy0zuKasYjlTQUW5fGtcyAFXinM3FahV", + "ecdsa_secp521r1_sha512": "9twvhZ57ytiujWXFtSmxd8I5r9iZjgdCtGtReJT3yQL2BCGZ80Vzq/MrmV+O0i7lZEI1gqbr8vL1xKk+2h2LyQ==", + "ed25519": "7C8PpP91rzMnD4VHuWTI3yNuInfbzIk937uF0Cg/Piw=" +} diff --git a/libs/wire-api/test/golden/testObject_Push_2eToken_2eTransport_user_4.json b/libs/wire-api/test/golden/testObject_Push_2eToken_2eTransport_user_4.json deleted file mode 100644 index d177fe0e9d7..00000000000 --- a/libs/wire-api/test/golden/testObject_Push_2eToken_2eTransport_user_4.json +++ /dev/null @@ -1 +0,0 @@ -"APNS_VOIP" diff --git a/libs/wire-api/test/golden/testObject_Push_2eToken_2eTransport_user_5.json b/libs/wire-api/test/golden/testObject_Push_2eToken_2eTransport_user_5.json deleted file mode 100644 index fd689b4ac10..00000000000 --- a/libs/wire-api/test/golden/testObject_Push_2eToken_2eTransport_user_5.json +++ /dev/null @@ -1 +0,0 @@ -"APNS_VOIP_SANDBOX" diff --git a/libs/wire-api/test/golden/testObject_RTCConfiguration_user_7.json b/libs/wire-api/test/golden/testObject_RTCConfiguration_user_7.json index 8e9fa8b7808..bdd7b330834 100644 --- a/libs/wire-api/test/golden/testObject_RTCConfiguration_user_7.json +++ b/libs/wire-api/test/golden/testObject_RTCConfiguration_user_7.json @@ -13,9 +13,11 @@ ], "sft_servers_all": [ { + "credential": "credential", "urls": [ "https://example.com" - ] + ], + "username": "d=12.v=1.k=0.s=1.r=username" } ], "ttl": 2 diff --git a/libs/wire-api/test/golden/testObject_RTCConfiguration_user_8.json b/libs/wire-api/test/golden/testObject_RTCConfiguration_user_8.json new file mode 100644 index 00000000000..f3ffe63ade9 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_RTCConfiguration_user_8.json @@ -0,0 +1,16 @@ +{ + "ice_servers": [ + { + "credential": "", + "urls": [ + "turns:248.187.155.126:1", + "turn:166.155.90.230:0?transport=tcp", + "turns:xn--mgbh0fb.xn--kgbechtv:1?transport=tcp", + "turn:host.name:1?transport=tcp" + ], + "username": "d=2.v=0.k=0.t=󷁝.r=tj" + } + ], + "is_federating": true, + "ttl": 2 +} diff --git a/libs/wire-api/test/golden/testObject_SFTServer_user_1.json b/libs/wire-api/test/golden/testObject_SFTServer_user_1.json index 957a0ccbff7..1e2fbf7a23d 100644 --- a/libs/wire-api/test/golden/testObject_SFTServer_user_1.json +++ b/libs/wire-api/test/golden/testObject_SFTServer_user_1.json @@ -1,5 +1,7 @@ { + "credential": "credential", "urls": [ "https://example.com" - ] + ], + "username": "d=12.v=1.k=0.s=1.r=username" } diff --git a/libs/wire-api/test/golden/testObject_SelfProfile_user_1.json b/libs/wire-api/test/golden/testObject_SelfProfile_user_1.json index df030f6b257..111b4170f0e 100644 --- a/libs/wire-api/test/golden/testObject_SelfProfile_user_1.json +++ b/libs/wire-api/test/golden/testObject_SelfProfile_user_1.json @@ -4,7 +4,7 @@ "email": "\u0007@", "expires_at": "1864-05-07T21:09:29.342Z", "handle": "do9-5", - "id": "00000002-0000-0002-0000-000200000002", + "id": "00000001-0000-0000-0000-000000000002", "locale": "gl-PA", "managed_by": "scim", "name": "@ֱਦ𐋂\u001f􍱇l+𡡖6󳒏^𧦣Mu\t", diff --git a/libs/wire-api/test/golden/testObject_Token_1.json b/libs/wire-api/test/golden/testObject_Token_1.json deleted file mode 100644 index 36f8ff69bd8..00000000000 --- a/libs/wire-api/test/golden/testObject_Token_1.json +++ /dev/null @@ -1,6 +0,0 @@ -{ - "app": "j{𛂚\u0001_􈷉M", - "client": "6", - "token": "K", - "transport": "APNS_VOIP_SANDBOX" -} diff --git a/libs/wire-api/test/golden/testObject_UserEvent_1.json b/libs/wire-api/test/golden/testObject_UserEvent_1.json new file mode 100644 index 00000000000..09940cd4e9e --- /dev/null +++ b/libs/wire-api/test/golden/testObject_UserEvent_1.json @@ -0,0 +1,20 @@ +{ + "type": "user.new", + "user": { + "accent_id": 1, + "assets": [], + "deleted": true, + "id": "539d9183-32a5-4fc4-ba5c-4634454e7585", + "locale": "tn-SB", + "managed_by": "wire", + "name": "alice", + "picture": [], + "qualified_id": { + "domain": "foo.example.com", + "id": "539d9183-32a5-4fc4-ba5c-4634454e7585" + }, + "supported_protocols": [ + "proteus" + ] + } +} diff --git a/libs/wire-api/test/golden/testObject_UserEvent_10.json b/libs/wire-api/test/golden/testObject_UserEvent_10.json new file mode 100644 index 00000000000..c8aceb979de --- /dev/null +++ b/libs/wire-api/test/golden/testObject_UserEvent_10.json @@ -0,0 +1,4 @@ +{ + "id": "539d9183-32a5-4fc4-ba5c-4634454e7585", + "type": "user.legalhold-enable" +} diff --git a/libs/wire-api/test/golden/testObject_UserEvent_11.json b/libs/wire-api/test/golden/testObject_UserEvent_11.json new file mode 100644 index 00000000000..3a391a8781b --- /dev/null +++ b/libs/wire-api/test/golden/testObject_UserEvent_11.json @@ -0,0 +1,11 @@ +{ + "client": { + "id": "e90" + }, + "id": "539d9183-32a5-4fc4-ba5c-4634454e7585", + "last_prekey": { + "id": 65535, + "key": "foo" + }, + "type": "user.legalhold-request" +} diff --git a/libs/wire-api/test/golden/testObject_UserEvent_12.json b/libs/wire-api/test/golden/testObject_UserEvent_12.json new file mode 100644 index 00000000000..f342079b4ea --- /dev/null +++ b/libs/wire-api/test/golden/testObject_UserEvent_12.json @@ -0,0 +1,16 @@ +{ + "connection": { + "from": "284d1c86-5117-4c58-aa18-c0068f3f7d8c", + "last_update": "2007-02-03T10:51:17.329Z", + "qualified_to": { + "domain": "baz.example.com", + "id": "284d1c86-5117-4c58-aa18-c0068f3f7d8c" + }, + "status": "accepted", + "to": "284d1c86-5117-4c58-aa18-c0068f3f7d8c" + }, + "type": "user.connection", + "user": { + "name": "hi bob" + } +} diff --git a/libs/wire-api/test/golden/testObject_UserEvent_13.json b/libs/wire-api/test/golden/testObject_UserEvent_13.json new file mode 100644 index 00000000000..25a0a1dd05b --- /dev/null +++ b/libs/wire-api/test/golden/testObject_UserEvent_13.json @@ -0,0 +1,5 @@ +{ + "key": "a", + "type": "user.properties-set", + "value": 39 +} diff --git a/libs/wire-api/test/golden/testObject_UserEvent_14.json b/libs/wire-api/test/golden/testObject_UserEvent_14.json new file mode 100644 index 00000000000..0b359af6e4b --- /dev/null +++ b/libs/wire-api/test/golden/testObject_UserEvent_14.json @@ -0,0 +1,4 @@ +{ + "key": "a", + "type": "user.properties-delete" +} diff --git a/libs/wire-api/test/golden/testObject_UserEvent_15.json b/libs/wire-api/test/golden/testObject_UserEvent_15.json new file mode 100644 index 00000000000..529b84e9598 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_UserEvent_15.json @@ -0,0 +1,3 @@ +{ + "type": "user.properties-clear" +} diff --git a/libs/wire-api/test/golden/testObject_UserEvent_16.json b/libs/wire-api/test/golden/testObject_UserEvent_16.json new file mode 100644 index 00000000000..88168e5d582 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_UserEvent_16.json @@ -0,0 +1,15 @@ +{ + "client": { + "capabilities": { + "capabilities": [] + }, + "class": "desktop", + "id": "b17", + "label": "%*", + "mls_public_keys": {}, + "model": "bazz", + "time": "2007-02-03T10:51:17.329Z", + "type": "permanent" + }, + "type": "user.client-add" +} diff --git a/libs/wire-api/test/golden/testObject_UserEvent_17.json b/libs/wire-api/test/golden/testObject_UserEvent_17.json new file mode 100644 index 00000000000..9ddeee4ce50 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_UserEvent_17.json @@ -0,0 +1,6 @@ +{ + "client": { + "id": "b17" + }, + "type": "user.client-remove" +} diff --git a/libs/wire-api/test/golden/testObject_UserEvent_2.json b/libs/wire-api/test/golden/testObject_UserEvent_2.json new file mode 100644 index 00000000000..36ec06060ef --- /dev/null +++ b/libs/wire-api/test/golden/testObject_UserEvent_2.json @@ -0,0 +1,20 @@ +{ + "type": "user.activate", + "user": { + "accent_id": 1, + "assets": [], + "deleted": true, + "id": "539d9183-32a5-4fc4-ba5c-4634454e7585", + "locale": "tn-SB", + "managed_by": "wire", + "name": "alice", + "picture": [], + "qualified_id": { + "domain": "foo.example.com", + "id": "539d9183-32a5-4fc4-ba5c-4634454e7585" + }, + "supported_protocols": [ + "proteus" + ] + } +} diff --git a/libs/wire-api/test/golden/testObject_UserEvent_3.json b/libs/wire-api/test/golden/testObject_UserEvent_3.json new file mode 100644 index 00000000000..2dfeaa90444 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_UserEvent_3.json @@ -0,0 +1,4 @@ +{ + "id": "dd56271c-181a-43f5-874b-1a8951f7fcc7", + "type": "user.suspend" +} diff --git a/libs/wire-api/test/golden/testObject_UserEvent_4.json b/libs/wire-api/test/golden/testObject_UserEvent_4.json new file mode 100644 index 00000000000..ab6fc97882e --- /dev/null +++ b/libs/wire-api/test/golden/testObject_UserEvent_4.json @@ -0,0 +1,4 @@ +{ + "id": "3ddb960e-8ea3-4d14-95bc-97f9da795ca6", + "type": "user.suspend" +} diff --git a/libs/wire-api/test/golden/testObject_UserEvent_5.json b/libs/wire-api/test/golden/testObject_UserEvent_5.json new file mode 100644 index 00000000000..34d8c0d81a1 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_UserEvent_5.json @@ -0,0 +1,8 @@ +{ + "id": "78f9ba2e-a6b0-48c6-a644-662617bb8bcc", + "qualified_id": { + "domain": "bar.example.com", + "id": "78f9ba2e-a6b0-48c6-a644-662617bb8bcc" + }, + "type": "user.delete" +} diff --git a/libs/wire-api/test/golden/testObject_UserEvent_6.json b/libs/wire-api/test/golden/testObject_UserEvent_6.json new file mode 100644 index 00000000000..328b2cb2193 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_UserEvent_6.json @@ -0,0 +1,14 @@ +{ + "type": "user.update", + "user": { + "accent_id": 1, + "assets": [], + "id": "539d9183-32a5-4fc4-ba5c-4634454e7585", + "locale": "tn-SB", + "managed_by": "wire", + "name": "alice", + "picture": [], + "sso_id_deleted": false, + "supported_protocols": [] + } +} diff --git a/libs/wire-api/test/golden/testObject_UserEvent_7.json b/libs/wire-api/test/golden/testObject_UserEvent_7.json new file mode 100644 index 00000000000..71c1b5a163a --- /dev/null +++ b/libs/wire-api/test/golden/testObject_UserEvent_7.json @@ -0,0 +1,7 @@ +{ + "type": "user.update", + "user": { + "email": "alice@foo.example.com", + "id": "539d9183-32a5-4fc4-ba5c-4634454e7585" + } +} diff --git a/libs/wire-api/test/golden/testObject_UserEvent_8.json b/libs/wire-api/test/golden/testObject_UserEvent_8.json new file mode 100644 index 00000000000..9998a51fdbc --- /dev/null +++ b/libs/wire-api/test/golden/testObject_UserEvent_8.json @@ -0,0 +1,7 @@ +{ + "type": "user.identity-remove", + "user": { + "email": "alice@foo.example.com", + "id": "539d9183-32a5-4fc4-ba5c-4634454e7585" + } +} diff --git a/libs/wire-api/test/golden/testObject_UserEvent_9.json b/libs/wire-api/test/golden/testObject_UserEvent_9.json new file mode 100644 index 00000000000..fc025dd9ad6 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_UserEvent_9.json @@ -0,0 +1,4 @@ +{ + "id": "539d9183-32a5-4fc4-ba5c-4634454e7585", + "type": "user.legalhold-disable" +} diff --git a/libs/wire-api/test/golden/testObject_User_user_1.json b/libs/wire-api/test/golden/testObject_User_user_1.json index 0e06a5f2c45..b3fbc638960 100644 --- a/libs/wire-api/test/golden/testObject_User_user_1.json +++ b/libs/wire-api/test/golden/testObject_User_user_1.json @@ -2,7 +2,7 @@ "accent_id": 1, "assets": [], "deleted": true, - "id": "00000000-0000-0001-0000-000100000000", + "id": "00000002-0000-0001-0000-000200000002", "locale": "tn-SB", "managed_by": "wire", "name": "\u0000uv󳊼su渱lRi", diff --git a/libs/wire-api/test/golden/testObject_User_user_2.json b/libs/wire-api/test/golden/testObject_User_user_2.json index d34488ab3c2..1a9f918989f 100644 --- a/libs/wire-api/test/golden/testObject_User_user_2.json +++ b/libs/wire-api/test/golden/testObject_User_user_2.json @@ -18,7 +18,7 @@ ], "deleted": true, "expires_at": "1864-05-11T17:06:58.936Z", - "id": "00000000-0000-0000-0000-000100000001", + "id": "00000000-0000-0001-0000-000200000001", "locale": "da-TN", "managed_by": "wire", "name": "4􄢻7\u0006\u0012\u0012\u0017bp\u0001麙0Yr\\󰘣vKRg󿽓)󽼺S󰇌􂏦:3B\u0006\u0013\u0003T", diff --git a/libs/wire-api/test/golden/testObject_User_user_3.json b/libs/wire-api/test/golden/testObject_User_user_3.json index ba235a89721..fb25c3feb83 100644 --- a/libs/wire-api/test/golden/testObject_User_user_3.json +++ b/libs/wire-api/test/golden/testObject_User_user_3.json @@ -5,7 +5,7 @@ "email": "f@𔒫", "expires_at": "1864-05-09T20:12:05.821Z", "handle": "1c", - "id": "00000002-0000-0000-0000-000100000000", + "id": "00000002-0000-0000-0000-000100000002", "locale": "tg-UA", "managed_by": "wire", "name": ",r\u0019XEg0$𗾋\u001e\u000f'uS\u0003/󶙆`äV.J{\u000cgE(\rK!\u000ep8s9gXO唲Xj\u0002\u001e\u0012", diff --git a/libs/wire-api/test/golden/testObject_User_user_4.json b/libs/wire-api/test/golden/testObject_User_user_4.json index 612526358e8..9e5243bc311 100644 --- a/libs/wire-api/test/golden/testObject_User_user_4.json +++ b/libs/wire-api/test/golden/testObject_User_user_4.json @@ -4,7 +4,7 @@ "email": "@", "expires_at": "1864-05-09T14:25:26.089Z", "handle": "iw2-.udd2l7-7yg3dfg.wzn4vx3hjhch8.--5t6uyjqk93twv-a2pce8p1xjh7387nztzu.q", - "id": "00000002-0000-0001-0000-000100000002", + "id": "00000000-0000-0002-0000-000200000002", "locale": "bi-MQ", "managed_by": "scim", "name": "^󺝨F􈝼=&o>f<7\u000eq|6\u0011\u0019󳟧􁗄\u001bf󷯶𩣇\u0013bnVAj`^L\u000c󿮁\u001fLI\u0005!􃈈\u0017`󾒁\u0003e曉\u001aK|", diff --git a/libs/wire-api/test/golden/testObject_User_user_5.json b/libs/wire-api/test/golden/testObject_User_user_5.json index a11342eca05..2f9c0c23c40 100644 --- a/libs/wire-api/test/golden/testObject_User_user_5.json +++ b/libs/wire-api/test/golden/testObject_User_user_5.json @@ -4,7 +4,7 @@ "email": "@", "expires_at": "1864-05-09T14:25:26.089Z", "handle": "iw2-.udd2l7-7yg3dfg.wzn4vx3hjhch8.--5t6uyjqk93twv-a2pce8p1xjh7387nztzu.q", - "id": "00000002-0000-0001-0000-000100000002", + "id": "00000000-0000-0002-0000-000200000002", "locale": "bi-MQ", "managed_by": "scim", "name": "^󺝨F􈝼=&o>f<7\u000eq|6\u0011\u0019󳟧􁗄\u001bf󷯶𩣇\u0013bnVAj`^L\u000c󿮁\u001fLI\u0005!􃈈\u0017`󾒁\u0003e曉\u001aK|", diff --git a/libs/wire-api/test/unit/Test/Wire/API/MLS.hs b/libs/wire-api/test/unit/Test/Wire/API/MLS.hs index d0ff8a27a3b..e98ae87e01f 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/MLS.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/MLS.hs @@ -236,15 +236,15 @@ testRemoveProposalMessageSignature = withSystemTempDirectory "mls" $ \tmp -> do void $ spawn (cli qcid tmp ["member", "add", "--group", tmp groupFilename, "--in-place", tmp qcid2]) Nothing let proposal = mkRawMLS (RemoveProposal 1) - pmessage = - mkSignedPublicMessage - secretKey - publicKey - gid - (Epoch 1) - (TaggedSenderExternal 0) - (FramedContentProposal proposal) - message = mkMessage $ MessagePublic pmessage + pmessage <- + mkSignedPublicMessage + @Ed25519 + (secretKey, publicKey) + gid + (Epoch 1) + (TaggedSenderExternal 0) + (FramedContentProposal proposal) + let message = mkMessage $ MessagePublic pmessage messageFilename = "signed-message.mls" BS.writeFile (tmp messageFilename) (raw (mkRawMLS message)) @@ -308,7 +308,7 @@ spawn cp minput = do in snd <$> concurrently writeInput readOutput case (mout, ex) of (Just out, ExitSuccess) -> pure out - _ -> assertFailure "Failed spawning process" + _ -> assertFailure $ "Failed spawning process\n" <> show mout <> "\n" <> show ex cli :: String -> FilePath -> [String] -> CreateProcess cli store tmp args = diff --git a/libs/wire-api/test/unit/Test/Wire/API/Routes/Version.hs b/libs/wire-api/test/unit/Test/Wire/API/Routes/Version.hs index 603e14776af..b6224933398 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Routes/Version.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Routes/Version.hs @@ -4,6 +4,7 @@ import Data.Aeson as Aeson import Data.Binary.Builder import Data.ByteString.Conversion import Data.Set as Set +import Data.String.Conversions import Imports import Servant.API import Test.Tasty diff --git a/libs/wire-api/test/unit/Test/Wire/API/Routes/Version/Wai.hs b/libs/wire-api/test/unit/Test/Wire/API/Routes/Version/Wai.hs index 573904b8600..2e87537f60b 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Routes/Version/Wai.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Routes/Version/Wai.hs @@ -2,6 +2,7 @@ module Test.Wire.API.Routes.Version.Wai where import Data.Proxy import Data.Set qualified as Set +import Data.String.Conversions import Data.Text as T import Imports import Network.HTTP.Types.Status (status200, status400) diff --git a/libs/wire-api/test/unit/Test/Wire/API/Run.hs b/libs/wire-api/test/unit/Test/Wire/API/Run.hs index 5301f44cdc9..417d543e0e4 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Run.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Run.hs @@ -37,6 +37,7 @@ import Test.Wire.API.Routes.Version qualified as Routes.Version import Test.Wire.API.Routes.Version.Wai qualified as Routes.Version.Wai import Test.Wire.API.Swagger qualified as Swagger import Test.Wire.API.Team.Export qualified as Team.Export +import Test.Wire.API.Team.Feature qualified as Team.Feature import Test.Wire.API.Team.Member qualified as Team.Member import Test.Wire.API.User qualified as User import Test.Wire.API.User.Auth qualified as User.Auth @@ -69,5 +70,6 @@ main = unsafePerformIO Routes.Version.Wai.tests, RawJson.tests, OAuth.tests, - Password.tests + Password.tests, + Team.Feature.tests ] diff --git a/libs/wire-api/test/unit/Test/Wire/API/Team/Feature.hs b/libs/wire-api/test/unit/Test/Wire/API/Team/Feature.hs new file mode 100644 index 00000000000..60b634c9d17 --- /dev/null +++ b/libs/wire-api/test/unit/Test/Wire/API/Team/Feature.hs @@ -0,0 +1,92 @@ +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2024 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 Test.Wire.API.Team.Feature (tests) where + +import Imports +import Test.Tasty +import Test.Tasty.HUnit +import Wire.API.Team.Feature + +tests :: TestTree +tests = + testGroup + "Wire.API.Team.Feature" + [ testCase "no lock status in DB" testComputeFeatureConfigForTeamUserLsIsNothing, + testCase "feature is locked in DB" testComputeFeatureConfigForTeamUserLocked, + testCase "feature is unlocked in DB but has no feature status" testComputeFeatureConfigForTeamUserUnlocked, + testCase "feature is unlocked in DB and has feature status" testComputeFeatureConfigForTeamWithDbStatus + ] + +testComputeFeatureConfigForTeamUserLsIsNothing :: Assertion +testComputeFeatureConfigForTeamUserLsIsNothing = do + let mStatusDb = undefined + let mLockStatusDb = Nothing + let defStatus = + withStatus + FeatureStatusEnabled + LockStatusLocked + ExposeInvitationURLsToTeamAdminConfig + FeatureTTLUnlimited + let expected = defStatus + let actual = computeFeatureConfigForTeamUser @ExposeInvitationURLsToTeamAdminConfig mStatusDb mLockStatusDb defStatus + actual @?= expected + +testComputeFeatureConfigForTeamUserLocked :: Assertion +testComputeFeatureConfigForTeamUserLocked = do + let mStatusDb = undefined + let mLockStatusDb = Just LockStatusLocked + let defStatus = + withStatus + FeatureStatusEnabled + LockStatusLocked + ExposeInvitationURLsToTeamAdminConfig + FeatureTTLUnlimited + let expected = defStatus + let actual = computeFeatureConfigForTeamUser @ExposeInvitationURLsToTeamAdminConfig mStatusDb mLockStatusDb defStatus + actual @?= expected + +testComputeFeatureConfigForTeamUserUnlocked :: Assertion +testComputeFeatureConfigForTeamUserUnlocked = do + let mStatusDb = Nothing + let mLockStatusDb = Just LockStatusUnlocked + let defStatus = + withStatus + FeatureStatusEnabled + LockStatusLocked + ExposeInvitationURLsToTeamAdminConfig + FeatureTTLUnlimited + let expected = defStatus & setLockStatus LockStatusUnlocked + let actual = computeFeatureConfigForTeamUser @ExposeInvitationURLsToTeamAdminConfig mStatusDb mLockStatusDb defStatus + actual @?= expected + +testComputeFeatureConfigForTeamWithDbStatus :: Assertion +testComputeFeatureConfigForTeamWithDbStatus = do + let mStatusDb = + Just . forgetLock $ + withStatus + FeatureStatusDisabled + LockStatusUnlocked + ExposeInvitationURLsToTeamAdminConfig + FeatureTTLUnlimited + let mLockStatusDb = Just LockStatusUnlocked + let defStatus = undefined + let (Just expected) = withUnlocked <$> mStatusDb + let actual = computeFeatureConfigForTeamUser @ExposeInvitationURLsToTeamAdminConfig mStatusDb mLockStatusDb defStatus + actual @?= expected diff --git a/libs/wire-api/test/unit/Test/Wire/API/Team/Member.hs b/libs/wire-api/test/unit/Test/Wire/API/Team/Member.hs index a0d6404b1ac..8a44da25f23 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Team/Member.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Team/Member.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# OPTIONS_GHC -Wno-orphans #-} -- This file is part of the Wire Server implementation. @@ -18,20 +19,82 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Test.Wire.API.Team.Member where +module Test.Wire.API.Team.Member (tests) where +import Control.Lens ((^.)) import Data.Aeson +import Data.Set (isSubsetOf) +import Data.Set qualified as Set import Imports import Test.Tasty import Test.Tasty.HUnit -import Wire.API.Team.Member qualified as Team.Member +import Test.Tasty.QuickCheck +import Wire.API.Team.Member +import Wire.API.Team.Permission +import Wire.API.Team.Role -- NB: validateEveryToJSON from servant-swagger doesn't render these tests unnecessary! tests :: TestTree -tests = +tests = testGroup "Wire.API.Team.Member" [commonTests, permissionTests, permissionConversionTests] + +commonTests :: TestTree +commonTests = testGroup "Common (types vs. aeson)" [ testCase "{} is a valid TeamMemberDeleteData" $ do - assertBool "{}" (isRight (eitherDecode @Team.Member.TeamMemberDeleteData "{}")) + assertBool "{}" (isRight (eitherDecode @TeamMemberDeleteData "{}")) + ] + +permissionTests :: TestTree +permissionTests = + testGroup + "Permissions" + [ testCase "owner has all permissions" $ + rolePermissions RoleOwner @=? fullPermissions, + testCase "smaller roles (further to the left/top in the type def) are strictly more powerful" $ + -- we may not want to maintain this property in the future when adding more roles, but for + -- now it's true, and it's nice to have that written down somewhere. + forM_ [(r1, r2) | r1 <- [minBound ..], r2 <- drop 1 [r1 ..]] $ + \(r1, r2) -> do + assertBool "owner.self" ((rolePermissions r2 ^. self) `isSubsetOf` (rolePermissions r1 ^. self)) + assertBool "owner.copy" ((rolePermissions r2 ^. copy) `isSubsetOf` (rolePermissions r1 ^. copy)), + testGroup + "permissionsRole, rolePermissions" + [ testCase "'Role' maps to expected permissions" $ do + assertEqual "role type changed" [minBound ..] [RoleOwner, RoleAdmin, RoleMember, RoleExternalPartner] + assertEqual "owner" (permissionsRole =<< newPermissions (intToPerms 8191) (intToPerms 8191)) (Just RoleOwner) + assertEqual "admin" (permissionsRole =<< newPermissions (intToPerms 5951) (intToPerms 5951)) (Just RoleAdmin) + assertEqual "member" (permissionsRole =<< newPermissions (intToPerms 1587) (intToPerms 1587)) (Just RoleMember) + assertEqual "external partner" (permissionsRole =<< newPermissions (intToPerms 1025) (intToPerms 1025)) (Just RoleExternalPartner), + testCase "Role <-> Permissions roundtrip" $ do + assertEqual "admin" (permissionsRole . rolePermissions <$> [minBound ..]) (Just <$> [minBound ..]), + testProperty "Random, incoherent 'Permission' values gracefully translate to subsets." $ + let fakeSort (w, w') = (w `Set.union` w', w') + in \(fakeSort -> (w, w')) -> do + let Just perms = newPermissions w w' + case permissionsRole perms of + Just role -> do + let perms' = rolePermissions role + assertEqual "eq" (perms' ^. self) (perms' ^. copy) + assertBool "self" ((perms' ^. self) `Set.isSubsetOf` (perms ^. self)) + assertBool "copy" ((perms' ^. copy) `Set.isSubsetOf` (perms ^. copy)) + Nothing -> do + let leastPermissions = rolePermissions maxBound + assertBool "no role for perms, but strictly more perms than max role" $ + not + ( (leastPermissions ^. self) `Set.isSubsetOf` w + && (leastPermissions ^. copy) `Set.isSubsetOf` w' + ) + ] + ] + +permissionConversionTests :: TestTree +permissionConversionTests = + testGroup + "permsToInt / rolePermissions / serialization of `Role`s" + [ testCase "partner" $ assertEqual "" (permsToInt . _self $ rolePermissions RoleExternalPartner) 1025, + testCase "member" $ assertEqual "" (permsToInt . _self $ rolePermissions RoleMember) 1587, + testCase "admin" $ assertEqual "" (permsToInt . _self $ rolePermissions RoleAdmin) 5951, + testCase "owner" $ assertEqual "" (permsToInt . _self $ rolePermissions RoleOwner) 8191 ] diff --git a/libs/wire-api/test/unit/Test/Wire/API/User.hs b/libs/wire-api/test/unit/Test/Wire/API/User.hs index 98b7745b618..d8f9a115376 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/User.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/User.hs @@ -17,8 +17,9 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Test.Wire.API.User where +module Test.Wire.API.User (tests) where +import Control.Lens ((.~)) import Data.Aeson import Data.Aeson qualified as Aeson import Data.Aeson.Types as Aeson @@ -31,16 +32,85 @@ import Data.UUID.V4 qualified as UUID import Imports import Test.Tasty import Test.Tasty.HUnit +import Test.Tasty.QuickCheck +import Wire.API.Team.Member (TeamMember) +import Wire.API.Team.Member qualified as TeamMember +import Wire.API.Team.Role import Wire.API.User tests :: TestTree -tests = testGroup "User (types vs. aeson)" unitTests +tests = + testGroup + "User (types vs. aeson)" + [ parseIdentityTests, + jsonNullTests, + testMkUserProfile + ] -unitTests :: [TestTree] -unitTests = parseIdentityTests ++ jsonNullTests +jsonNullTests :: TestTree +jsonNullTests = testGroup "JSON null" [testCase "userProfile" testUserProfile] -jsonNullTests :: [TestTree] -jsonNullTests = [testGroup "JSON null" [testCase "userProfile" testUserProfile]] +testMkUserProfile :: TestTree +testMkUserProfile = + testGroup + "mkUserProfile" + [ testEmailVisibleToSelf, + testEmailVisibleIfOnTeam, + testEmailVisibleIfOnSameTeam + ] + +testEmailVisibleToSelf :: TestTree +testEmailVisibleToSelf = + testProperty "should not contain email when email visibility is EmailVisibleToSelf" $ + \user lhStatus -> + let profile = mkUserProfile EmailVisibleToSelf user lhStatus + in profileEmail profile === Nothing + .&&. profileLegalholdStatus profile === lhStatus + +testEmailVisibleIfOnTeam :: TestTree +testEmailVisibleIfOnTeam = + testProperty "should contain email only if the user has one and is part of a team when email visibility is EmailVisibleIfOnTeam" $ + \user lhStatus -> + let profile = mkUserProfile EmailVisibleIfOnTeam user lhStatus + in (profileEmail profile === (userTeam user *> userEmail user)) + .&&. profileLegalholdStatus profile === lhStatus + +testEmailVisibleIfOnSameTeam :: TestTree +testEmailVisibleIfOnSameTeam = + testGroup "when email visibility is EmailVisibleIfOnSameTeam" [testNoViewerTeam, testViewerDifferentTeam, testViewerSameTeamExternal, testViewerSameTeamNotExternal] + where + testNoViewerTeam = testProperty "should not contain email when viewer is not part of a team" $ + \user lhStatus -> + let profile = mkUserProfile (EmailVisibleIfOnSameTeam Nothing) user lhStatus + in (profileEmail profile === Nothing) + .&&. profileLegalholdStatus profile === lhStatus + + testViewerDifferentTeam = testProperty "should not contain email when viewer is not part of the same team" $ + \viewerTeamId viewerMembership user lhStatus -> + let profile = mkUserProfile (EmailVisibleIfOnSameTeam (Just (viewerTeamId, viewerMembership))) user lhStatus + in Just viewerTeamId /= userTeam user ==> + ( profileEmail profile === Nothing + .&&. profileLegalholdStatus profile === lhStatus + ) + + testViewerSameTeamExternal = testProperty "should not contain email when viewer is part of the same team and is an external member" $ + \viewerTeamId (viewerMembershipNoRole :: TeamMember) userNoTeam lhStatus -> + let user = userNoTeam {userTeam = Just viewerTeamId} + viewerMembership = viewerMembershipNoRole & TeamMember.permissions .~ TeamMember.rolePermissions RoleExternalPartner + profile = mkUserProfile (EmailVisibleIfOnSameTeam (Just (viewerTeamId, viewerMembership))) user lhStatus + in ( profileEmail profile === Nothing + .&&. profileLegalholdStatus profile === lhStatus + ) + + testViewerSameTeamNotExternal = testProperty "should contain email when viewer is part of the same team and is not an external member" $ + \viewerTeamId (viewerMembershipNoRole :: TeamMember) viewerRole userNoTeam lhStatus -> + let user = userNoTeam {userTeam = Just viewerTeamId} + viewerMembership = viewerMembershipNoRole & TeamMember.permissions .~ TeamMember.rolePermissions viewerRole + profile = mkUserProfile (EmailVisibleIfOnSameTeam (Just (viewerTeamId, viewerMembership))) user lhStatus + in viewerRole /= RoleExternalPartner ==> + ( profileEmail profile === userEmail user + .&&. profileLegalholdStatus profile === lhStatus + ) testUserProfile :: Assertion testUserProfile = do @@ -52,32 +122,31 @@ testUserProfile = do let msg = "toJSON encoding must not convert Nothing to null, but instead omit those json fields for backwards compatibility. UserProfileJSON:" <> profileJSONAsText assertBool msg (not $ "null" `isInfixOf` profileJSONAsText) -parseIdentityTests :: [TestTree] +parseIdentityTests :: TestTree parseIdentityTests = - [ let (=#=) :: Either String (Maybe UserIdentity) -> [Pair] -> Assertion - (=#=) uid (object -> Object obj) = assertEqual "=#=" uid (parseEither (schemaIn maybeUserIdentityObjectSchema) obj) - (=#=) _ bad = error $ "=#=: impossible: " <> show bad - in testGroup - "parseIdentity" - [ testCase "FullIdentity" $ - Right (Just (FullIdentity hemail hphone)) =#= [email, phone], - testCase "EmailIdentity" $ - Right (Just (EmailIdentity hemail)) =#= [email], - testCase "PhoneIdentity" $ - Right (Just (PhoneIdentity hphone)) =#= [phone], - testCase "SSOIdentity" $ do - Right (Just (SSOIdentity hssoid Nothing Nothing)) =#= [ssoid] - Right (Just (SSOIdentity hssoid Nothing (Just hphone))) =#= [ssoid, phone] - Right (Just (SSOIdentity hssoid (Just hemail) Nothing)) =#= [ssoid, email] - Right (Just (SSOIdentity hssoid (Just hemail) (Just hphone))) =#= [ssoid, email, phone], - testCase "Bad phone" $ - Left "Error in $.phone: Invalid phone number. Expected E.164 format." =#= [badphone], - testCase "Bad email" $ - Left "Error in $.email: Invalid email. Expected '@'." =#= [bademail], - testCase "Nothing" $ - Right Nothing =#= [("something_unrelated", "#")] - ] - ] + let (=#=) :: Either String (Maybe UserIdentity) -> [Pair] -> Assertion + (=#=) uid (object -> Object obj) = assertEqual "=#=" uid (parseEither (schemaIn maybeUserIdentityObjectSchema) obj) + (=#=) _ bad = error $ "=#=: impossible: " <> show bad + in testGroup + "parseIdentity" + [ testCase "FullIdentity" $ + Right (Just (FullIdentity hemail hphone)) =#= [email, phone], + testCase "EmailIdentity" $ + Right (Just (EmailIdentity hemail)) =#= [email], + testCase "PhoneIdentity" $ + Right (Just (PhoneIdentity hphone)) =#= [phone], + testCase "SSOIdentity" $ do + Right (Just (SSOIdentity hssoid Nothing Nothing)) =#= [ssoid] + Right (Just (SSOIdentity hssoid Nothing (Just hphone))) =#= [ssoid, phone] + Right (Just (SSOIdentity hssoid (Just hemail) Nothing)) =#= [ssoid, email] + Right (Just (SSOIdentity hssoid (Just hemail) (Just hphone))) =#= [ssoid, email, phone], + testCase "Bad phone" $ + Left "Error in $.phone: Invalid phone number. Expected E.164 format." =#= [badphone], + testCase "Bad email" $ + Left "Error in $.email: Invalid email. Expected '@'." =#= [bademail], + testCase "Nothing" $ + Right Nothing =#= [("something_unrelated", "#")] + ] where hemail = Email "me" "example.com" email = ("email", "me@example.com") diff --git a/libs/wire-api/test/unit/Test/Wire/API/User/Search.hs b/libs/wire-api/test/unit/Test/Wire/API/User/Search.hs index ad437d6d06f..a1fd13f4252 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/User/Search.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/User/Search.hs @@ -20,6 +20,7 @@ module Test.Wire.API.User.Search where import Data.Aeson (encode, toJSON) import Data.Aeson qualified as Aeson import Data.Aeson.KeyMap qualified as KeyMap +import Data.String.Conversions import Imports import Test.Tasty qualified as T import Test.Tasty.QuickCheck (counterexample, testProperty) diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index b191dbfbdec..b34eb3a5e22 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -109,6 +109,7 @@ library Wire.API.MLS.CommitBundle Wire.API.MLS.Context Wire.API.MLS.Credential + Wire.API.MLS.ECDSA Wire.API.MLS.Epoch Wire.API.MLS.Extension Wire.API.MLS.Group @@ -203,6 +204,7 @@ library Wire.API.Team.Conversation Wire.API.Team.Export Wire.API.Team.Feature + Wire.API.Team.HardTruncationLimit Wire.API.Team.Invitation Wire.API.Team.LegalHold Wire.API.Team.LegalHold.External @@ -232,6 +234,7 @@ library Wire.API.User.Saml Wire.API.User.Scim Wire.API.User.Search + Wire.API.UserEvent Wire.API.UserMap Wire.API.Util.Aeson Wire.API.VersionInfo @@ -241,6 +244,7 @@ library hs-source-dirs: src build-depends: , aeson >=2.0.1.0 + , asn1-encoding , async , attoparsec >=0.10 , base >=4 && <5 @@ -316,6 +320,7 @@ library , tagged , text >=0.11 , time >=1.4 + , tinylog , transitive-anns , types-common >=0.16 , unordered-containers >=0.2 @@ -581,12 +586,13 @@ test-suite wire-api-golden-tests Test.Wire.API.Golden.Manual.GroupId Test.Wire.API.Golden.Manual.ListConversations Test.Wire.API.Golden.Manual.ListUsersById + Test.Wire.API.Golden.Manual.MLSKeys Test.Wire.API.Golden.Manual.QualifiedUserClientPrekeyMap Test.Wire.API.Golden.Manual.SearchResultContact Test.Wire.API.Golden.Manual.SubConversation Test.Wire.API.Golden.Manual.TeamSize - Test.Wire.API.Golden.Manual.Token Test.Wire.API.Golden.Manual.UserClientPrekeyMap + Test.Wire.API.Golden.Manual.UserEvent Test.Wire.API.Golden.Manual.UserIdList Test.Wire.API.Golden.Protobuf Test.Wire.API.Golden.Run @@ -611,6 +617,7 @@ test-suite wire-api-golden-tests , lens , pem , proto-lens + , string-conversions , tasty , tasty-hunit , text @@ -649,6 +656,7 @@ test-suite wire-api-tests Test.Wire.API.Run Test.Wire.API.Swagger Test.Wire.API.Team.Export + Test.Wire.API.Team.Feature Test.Wire.API.Team.Member Test.Wire.API.User Test.Wire.API.User.Auth @@ -675,6 +683,7 @@ test-suite wire-api-tests , hspec-wai , http-types , imports + , lens , memory , metrics-wai , openapi3 @@ -685,6 +694,7 @@ test-suite wire-api-tests , schema-profunctor , servant , servant-server + , string-conversions , tasty , tasty-hspec , tasty-hunit diff --git a/libs/wire-subsystems/default.nix b/libs/wire-subsystems/default.nix index bd3ef35a59c..dc35149eb50 100644 --- a/libs/wire-subsystems/default.nix +++ b/libs/wire-subsystems/default.nix @@ -26,6 +26,7 @@ , QuickCheck , quickcheck-instances , retry +, string-conversions , text , tinylog , types-common @@ -73,6 +74,7 @@ mkDerivation { polysemy-wire-zoo QuickCheck quickcheck-instances + string-conversions types-common wire-api ]; diff --git a/libs/wire-subsystems/test/unit/Wire/NotificationSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/NotificationSubsystem/InterpreterSpec.hs index 4677a0d1bfd..1b5aee83b2b 100644 --- a/libs/wire-subsystems/test/unit/Wire/NotificationSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/NotificationSubsystem/InterpreterSpec.hs @@ -8,6 +8,7 @@ import Data.List.NonEmpty (NonEmpty ((:|)), fromList) import Data.List1 qualified as List1 import Data.Range (fromRange, toRange) import Data.Set qualified as Set +import Data.String.Conversions import Data.Time.Clock.DiffTime import Gundeck.Types.Push.V2 qualified as V2 import Imports diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index a631c0e2737..1c7676e7140 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -127,6 +127,7 @@ test-suite wire-subsystems-tests , polysemy-wire-zoo , QuickCheck , quickcheck-instances + , string-conversions , types-common , wire-api , wire-subsystems diff --git a/nix/all-toplevel-derivations.nix b/nix/all-toplevel-derivations.nix new file mode 100644 index 00000000000..4c7954352f4 --- /dev/null +++ b/nix/all-toplevel-derivations.nix @@ -0,0 +1,62 @@ +# this tries to recurse into pkgs to collect metadata about packages within nixpkgs +# it needs a recusionDepth, because pkgs is actually not a tree but a graph so you +# will go around in circles; also it helps bounding the memory needed to build this +# we also pass a keyFilter to ignore certain package names +# else, this just goes through the packages, tries to evaluate them, if that succeeds +# it goes on and remembers their metadata +# there's a lot of obfuscation caused by the fact that everything needs to be tryEval'd +# reason being that there's not a single thing in nixpkgs that is reliably evaluatable +{ lib +, pkgSet +, fn +, recursionDepth +, keyFilter +, ... +}: +let + go = depth: set': + let + evaluateableSet = builtins.tryEval set'; + in + if evaluateableSet.success && builtins.isAttrs evaluateableSet.value + then + let + set = evaluateableSet.value; + in + ( + if (builtins.tryEval (lib.isDerivation set)).value + then + let + meta = builtins.tryEval (fn set); + in + builtins.deepSeq meta ( + builtins.trace ("reached leaf: " + toString set) + ( + if meta.success + then [ meta.value ] + else builtins.trace "package didn't evaluate" [ ] + ) + ) + else if depth >= recursionDepth + then builtins.trace ("max depth of " + toString recursionDepth + " reached") [ ] + else + let + attrVals = builtins.tryEval (builtins.attrValues (lib.filterAttrs (k: _v: keyFilter k) set)); + go' = d: s: + let + gone' = builtins.tryEval (go d s); + in + if gone'.success + then gone'.value + else builtins.trace "could not recurse because of eval error" [ ]; + in + if attrVals.success + then + (builtins.concatMap + (go' (builtins.trace ("depth was: " + toString depth) (depth + 1))) + attrVals.value) + else builtins.trace "could not evaluate attr values because of eval error" [ ] + ) + else builtins.trace "could not evaluate package or package was not an attrset" [ ]; +in +go 0 pkgSet diff --git a/nix/default.nix b/nix/default.nix index f77d8de6fc1..02c0d9e01a7 100644 --- a/nix/default.nix +++ b/nix/default.nix @@ -7,7 +7,6 @@ let # All wire-server specific packages (import ./overlay.nix) (import ./overlay-docs.nix) - (self: super: { lib = super.lib // (import sources.bombon).lib.${super.system}; }) ]; }; @@ -79,7 +78,6 @@ let pkgs.entr ] ++ docsPkgs; }; - mls-test-cli = pkgs.mls-test-cli; - rusty-jwt-tools = pkgs.rusty-jwt-tools; + inherit (pkgs) mls-test-cli; in { inherit pkgs profileEnv wireServer docs docsEnv mls-test-cli nginz nginz-disco; } diff --git a/nix/haskell-pins.nix b/nix/haskell-pins.nix index 88be5c9094c..1b3c0b97ae5 100644 --- a/nix/haskell-pins.nix +++ b/nix/haskell-pins.nix @@ -82,8 +82,8 @@ let saml2-web-sso = { src = fetchgit { url = "https://github.com/wireapp/saml2-web-sso"; - rev = "d50bddadf9bd9a96dd6036dad0e2dda27567ec1a"; - sha256 = "sha256-IKovI1h2Wkm3Y7Sz6XsxLOv654SgUasaWsDX6gi9hZw="; + rev = "0cf23a87b140ba5b960a848ecad3976e6fdaac88"; + sha256 = "sha256-Gm58Yjt5ZGh74cfEjcZSx6jvwkpFC324xTPLhLS29r0="; }; }; @@ -110,9 +110,18 @@ let hsaml2 = { src = fetchgit { - url = "https://github.com/wireapp/hsaml2"; - rev = "723b377fcd759c8be9ad4b2e159a6a06df0d17c9"; - sha256 = "sha256-rPfztTu+NR/5FuoYWGMCfJFhrMn4o09bMcEKoerNX4A="; + url = "https://github.com/dylex/hsaml2"; + rev = "95d9dc7502c2533f7927de00cbc2bd20ad989ace"; + sha256 = "sha256-z3s/ZkkCd2ThVBsu72pS/+XygHImuffz/HVy3hkQ6eo="; + }; + }; + + # PR: https://github.com/informatikr/hedis/pull/224 + hedis = { + src = fetchgit { + url = "https://github.com/wireapp/hedis"; + rev = "81cdd8a2350b96168a06662c2601a41141a19f2d"; + sha256 = "sha256-0g6x9UOUq7s5ClnxMXvjYR2AsWNA6ymv1tYlQC44hGs="; }; }; @@ -261,7 +270,7 @@ let version = "5.0.18.4"; sha256 = "sha256-gIc4hpdUfTS33rZPfzwLfVcXkQaglmsljqViyYdihdk="; }; - # dependency of hoogle + # dependency of hoogle safe = { version = "0.3.20"; sha256 = "sha256-PGwjhrRnkH8cLhd7fHTZFd6ts9abp0w5sLlV8ke1yXU="; diff --git a/nix/manual-overrides.nix b/nix/manual-overrides.nix index 51d0f437aea..2a70e83728d 100644 --- a/nix/manual-overrides.nix +++ b/nix/manual-overrides.nix @@ -23,6 +23,9 @@ hself: hsuper: { transitive-anns = hlib.dontCheck hsuper.transitive-anns; warp = hlib.dontCheck hsuper.warp; + # Tests require a running redis + hedis = hlib.dontCheck hsuper.hedis; + # --------------------- # need to be jailbroken # (these need to be fixed upstream eventually) diff --git a/nix/overlay.nix b/nix/overlay.nix index 20aa6eb7995..08dd42c00d0 100644 --- a/nix/overlay.nix +++ b/nix/overlay.nix @@ -102,18 +102,7 @@ self: super: { inherit (super) stdenv fetchurl; }; - kind = staticBinary { - pname = "kind"; - version = "0.11.0"; - - darwinAmd64Url = "https://github.com/kubernetes-sigs/kind/releases/download/v0.11.1/kind-darwin-amd64"; - darwinAmd64Sha256 = "432bef555a70e9360b44661c759658265b9eaaf7f75f1beec4c4d1e6bbf97ce3"; - - linuxAmd64Url = "https://github.com/kubernetes-sigs/kind/releases/download/v0.11.1/kind-linux-amd64"; - linuxAmd64Sha256 = "949f81b3c30ca03a3d4effdecda04f100fa3edc07a28b19400f72ede7c5f0491"; - - inherit (super) stdenv fetchurl; - }; - rabbitmqadmin = super.callPackage ./pkgs/rabbitmqadmin { }; + + sbomqs = super.callPackage ./pkgs/sbomqs { }; } diff --git a/nix/pkg-info.nix b/nix/pkg-info.nix new file mode 100644 index 00000000000..9773bbaef9d --- /dev/null +++ b/nix/pkg-info.nix @@ -0,0 +1,60 @@ +# collects information about a single nixpkgs package +{ lib +, pkg +, ... +}: +with builtins; +assert lib.isDerivation pkg; let + # trace with reason + trc = info: pkg: trace (info + ": " + toString pkg); + + # if thing is a list, map the function, else apply f to thing and return a singleton of + # it + mapOrSingleton = f: x: + if isList x + then map f x + else [ (f x) ]; + + # things to save from the src attr (the derivation that was created by a fetcher) + srcInfo = { + urls = (pkg.src.urls or (trc "package didn't have src or url" pkg [ ])) ++ [ (pkg.src.url or null) ]; + }; + + dp = builtins.tryEval pkg.drvPath; + + # things to save from the meta attr + metaInfo = + let + m = pkg.meta or (trc "package didn't have meta" pkg { }); + in + { + homepage = m.homepage or (trc "package didn't have homepage" pkg null); + description = m.description or (trc "package didn't have description" pkg null); + licenseSpdxId = + mapOrSingleton + ( + l: { + id = l.spdxId or (trc "package license doesn't have a spdxId" pkg null); + name = l.fullName or (trc "package license doens't have a name" pkg null); + } + ) + (m.license or (trc "package does not have a license" pkg null)); + + # based on heuristics, figure out whether something is an application for now this only checks whether this + # componnent has a main program + type = + if m ? mainProgram + then "application" + else "library"; + + name = pkg.pname or pkg.name or (trc "name is missing" pkg null); + version = pkg.version or (trc "version is missing" pkg null); + }; +in +if dp.success +then + let + info = builtins.toJSON (srcInfo // metaInfo // { drvPath = builtins.unsafeDiscardStringContext dp.value; }); + in + info +else trc "drvPath of package could not be computed" pkg { } diff --git a/nix/pkgs/mls-test-cli/default.nix b/nix/pkgs/mls-test-cli/default.nix index ef5ef11ed3d..115f08511b5 100644 --- a/nix/pkgs/mls-test-cli/default.nix +++ b/nix/pkgs/mls-test-cli/default.nix @@ -7,18 +7,17 @@ rustPlatform.buildRustPackage rec { src = fetchFromGitHub { owner = "wireapp"; repo = "mls-test-cli"; - rev = "809925460222bac415a67461bfd134d22137f030"; - sha256 = "sha256-Tc1w8JPajvsiDJcjZPzd6r99U5eNsxtzkc+a77PuBwk="; + rev = "0b7bad3a5021d069bcf02aa0d0a3fe0a6fdabe72"; + sha256 = "sha256-bFNqDG2UhN8kOEdGFdhPHN/Wz1y67Wcp1c/z0f0vHfE="; }; pname = "mls-test-cli"; - version = "0.10.3"; + version = "0.11"; cargoLock = { lockFile = "${src}/Cargo.lock"; outputHashes = { "hpke-0.10.0" = "sha256-T1+BFwX6allljNZ/8T3mrWhOejnUU27BiWQetqU+0fY="; - "openmls-1.0.0" = "sha256-nyIMAlTy7CTV0bVQ0ytamKHpERgtsVKTX4zv7aHzemo="; + "openmls-1.0.0" = "sha256-MOf6F6jy2ofZ05leN9npDAlxYkn2S+hVOq/MSlKWBiU="; "safe_pqc_kyber-0.6.2" = "sha256-9t+IIohCJcMIWRtqLA0idyMmjev82BtpST15Tthlge4="; - "tls_codec-0.4.0" = "sha256-2wCreWSfduxjUyfkGkXWqawLxZ2yb167msjv5PdGEpw="; }; }; doCheck = false; diff --git a/nix/pkgs/rusty_jwt_tools_ffi/default.nix b/nix/pkgs/rusty_jwt_tools_ffi/default.nix index 71f25388d01..32e735bc849 100644 --- a/nix/pkgs/rusty_jwt_tools_ffi/default.nix +++ b/nix/pkgs/rusty_jwt_tools_ffi/default.nix @@ -10,12 +10,12 @@ # Cargo.lock file in its root (not at the ffi/ subpath). let - version = "0.8.5"; + version = "0.9.0"; src = fetchFromGitHub { owner = "wireapp"; repo = "rusty-jwt-tools"; - rev = "99acb427b2169d726f356d30dec55eae83dda6b6"; - sha256 = "sha256-x1W79spOZeFHabRbhMksz6gLtRIpl2E7WCiXuzIMoFM="; + rev = "60424bf7031e2fa535aac658d0b5643624d19537"; + sha256 = "sha256-kdubK9FruZT8pbIwCHyAkxYj9yVM0q7ivNhNUNtNQCY="; }; cargoLockFile = builtins.toFile "cargo.lock" (builtins.readFile "${src}/Cargo.lock"); @@ -29,9 +29,8 @@ rustPlatform.buildRustPackage { outputHashes = { # if any of these need updating, replace / create new key with # lib.fakeSha256, rebuild, and replace with actual hash. - "certval-0.1.4" = "sha256-mUg3Kx1I/r9zBoB7tDaZsykFkE+tsN+Rem6DjUOZbuU="; + "certval-0.1.4" = "sha256-gzkRC7/u/rARGPy3d37eBrAVml4XSDb6bRPpsESmttY="; "jwt-simple-0.12.1" = "sha256-5PAOwulL8j6f4Ycoa5Q+1dqEA24uN8rJt+i2RebL6eo="; - "x509-ocsp-0.2.1" = "sha256-o+r9h0CcexWqJIIoZdOgSd7hWIb91BheW6UZI98RpLA="; }; }; diff --git a/nix/pkgs/sbomqs/default.nix b/nix/pkgs/sbomqs/default.nix new file mode 100644 index 00000000000..d0e41ad5785 --- /dev/null +++ b/nix/pkgs/sbomqs/default.nix @@ -0,0 +1,21 @@ +{ buildGoModule, fetchFromGitHub, lib, ... }: +buildGoModule rec { + pname = "sbomqs"; + version = "0.0.30"; + + src = fetchFromGitHub { + owner = "interlynk-io"; + repo = "sbomqs"; + rev = "v${version}"; + hash = "sha256-+y7+xi+E8kjGUjhIRKNk6ogcQMP+Dp39LrL66B1XdrQ="; + }; + + vendorHash = "sha256-V6k7nF2ovyl4ELE8Cqe/xjpmPAKI0t5BNlssf41kd0Y="; + + meta = with lib; { + description = "SBOM quality score - Quality metrics for your sboms"; + homepage = "https://github.com/interlynk-io/sbomqs"; + license = licenses.asl20; + mainProgram = "sbomqs"; + }; +} diff --git a/nix/sources.json b/nix/sources.json index d885b9b44cc..207225e566b 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -24,15 +24,15 @@ "url_template": "https://github.com///archive/.tar.gz" }, "nixpkgs-cargo": { - "branch": "nixpkgs-unstable", + "branch": "master", "description": "Nix Packages collection", "homepage": "https://github.com/NixOS/nixpkgs", "owner": "NixOS", "repo": "nixpkgs", - "rev": "01441e14af5e29c9d27ace398e6dd0b293e25a54", - "sha256": "0yvkamjbk3aj4lvhm6vdgdk4b2j0xdv3gx9n4p7wfky52j2529dy", + "rev": "e236b838c71d2aff275356ade8104bbdef422117", + "sha256": "0zjf6b9pz3ljinwb2qxhmpix1mgiv4vakcqci7bcy5a6sv1sj1xs", "type": "tarball", - "url": "https://github.com/NixOS/nixpkgs/archive/01441e14af5e29c9d27ace398e6dd0b293e25a54.tar.gz", + "url": "https://github.com/NixOS/nixpkgs/archive/e236b838c71d2aff275356ade8104bbdef422117.tar.gz", "url_template": "https://github.com///archive/.tar.gz" } } diff --git a/nix/wire-server.nix b/nix/wire-server.nix index 8a7b85b5e91..9815de26869 100644 --- a/nix/wire-server.nix +++ b/nix/wire-server.nix @@ -462,9 +462,37 @@ let allLocalPackagesBom = lib.buildBom allLocalPackages { includeBuildtimeDependencies = true; }; + + haskellPackages = hPkgs localModsEnableAll; + haskellPackagesUnoptimizedNoDocs = hPkgs localModsOnlyTests; + + toplevel-derivations = + let + mk = pkg: + import ./pkg-info.nix { + inherit pkg; + inherit (pkgs) lib hostPlatform writeText; + }; + out = import ./all-toplevel-derivations.nix { + inherit (pkgs) lib; + fn = mk; + # more than two takes more than 32GB of RAM, so this is what + # we're limiting ourselves to + recursionDepth = 2; + keyFilter = k: k != "passthru"; + # only import the package sets we want; this makes the database + # less copmplete but makes it so that nix doesn't get OOMkilled + pkgSet = { + inherit pkgs; + inherit haskellPackages; + }; + }; + in + pkgs.writeText "all-toplevel.jsonl" (builtins.concatStringsSep "\n" out); in { - inherit ciImage hoogleImage allImages allLocalPackages allLocalPackagesBom; + inherit ciImage hoogleImage allImages allLocalPackages allLocalPackagesBom + toplevel-derivations haskellPackages haskellPackagesUnoptimizedNoDocs imagesList; images = images localModsEnableAll; imagesUnoptimizedNoDocs = images localModsOnlyTests; @@ -475,7 +503,6 @@ in enableTests = true; enableDocs = false; }; - inherit imagesList; devEnv = pkgs.buildEnv { name = "wire-server-dev-env"; @@ -508,6 +535,7 @@ in pkgs.yq pkgs.nginz pkgs.rabbitmqadmin + pkgs.sbomqs pkgs.cabal-install pkgs.nix-prefetch-git @@ -523,6 +551,4 @@ in }; inherit brig-templates; - haskellPackages = hPkgs localModsEnableAll; - haskellPackagesUnoptimizedNoDocs = hPkgs localModsOnlyTests; } // attrsets.genAttrs wireServerPackages (e: (hPkgs localModsEnableAll).${e}) diff --git a/services/background-worker/background-worker.cabal b/services/background-worker/background-worker.cabal index 1eb4df1229d..31657b00ca5 100644 --- a/services/background-worker/background-worker.cabal +++ b/services/background-worker/background-worker.cabal @@ -29,6 +29,7 @@ library build-depends: aeson , amqp + , base , containers , exceptions , extended @@ -48,7 +49,9 @@ library , transformers-base , types-common , unliftio + , utf8-string , wai-utilities + , wire-api , wire-api-federation default-extensions: @@ -176,6 +179,7 @@ test-suite background-worker-test , base , bytestring , containers + , data-default , extended , federator , hspec diff --git a/services/background-worker/default.nix b/services/background-worker/default.nix index 910b9a396dd..3698011087d 100644 --- a/services/background-worker/default.nix +++ b/services/background-worker/default.nix @@ -8,6 +8,7 @@ , base , bytestring , containers +, data-default , exceptions , extended , federator @@ -36,6 +37,7 @@ , transformers-base , types-common , unliftio +, utf8-string , wai , wai-utilities , wire-api @@ -50,6 +52,7 @@ mkDerivation { libraryHaskellDepends = [ aeson amqp + base containers exceptions extended @@ -69,7 +72,9 @@ mkDerivation { transformers-base types-common unliftio + utf8-string wai-utilities + wire-api wire-api-federation ]; executableHaskellDepends = [ HsOpenSSL imports types-common ]; @@ -79,6 +84,7 @@ mkDerivation { base bytestring containers + data-default extended federator hspec diff --git a/services/background-worker/src/Wire/BackendNotificationPusher.hs b/services/background-worker/src/Wire/BackendNotificationPusher.hs index 1fb6721eb58..7dfad1390f1 100644 --- a/services/background-worker/src/Wire/BackendNotificationPusher.hs +++ b/services/background-worker/src/Wire/BackendNotificationPusher.hs @@ -3,11 +3,13 @@ module Wire.BackendNotificationPusher where +import Control.Arrow import Control.Monad.Catch import Control.Retry import Data.Aeson qualified as A import Data.Domain import Data.Id +import Data.List.NonEmpty qualified as NE import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Data.Text qualified as Text @@ -19,8 +21,12 @@ import Network.RabbitMqAdmin import Prometheus import System.Logger.Class qualified as Log import UnliftIO +import Wire.API.Federation.API import Wire.API.Federation.BackendNotifications import Wire.API.Federation.Client +import Wire.API.Federation.Error +import Wire.API.Federation.Version +import Wire.API.RawJson import Wire.BackgroundWorker.Env import Wire.BackgroundWorker.Options import Wire.BackgroundWorker.Util @@ -78,32 +84,115 @@ pushNotification runningFlag targetDomain (msg, envelope) = do UnliftIO.bracket_ (takeMVar runningFlag) (putMVar runningFlag ()) go where go :: AppT IO () - go = case A.eitherDecode @BackendNotification (Q.msgBody msg) of + go = case A.eitherDecode @(PayloadBundle _) (Q.msgBody msg) of Left e -> do - Log.err $ - Log.msg (Log.val "Failed to parse notification, the notification will be ignored") - . Log.field "domain" (domainText targetDomain) - . Log.field "error" e + case A.eitherDecode @BackendNotification (Q.msgBody msg) of + Left eBN -> do + Log.err $ + Log.msg + ( Log.val "Cannot parse a queued message as s notification " + <> "nor as a bundle; the message will be ignored" + ) + . Log.field "domain" (domainText targetDomain) + . Log.field "error-notification" eBN + . Log.field + "error-bundle" + e + -- FUTUREWORK: This rejects the message without any requeueing. This is + -- dangerous as it could happen that a new type of notification is + -- introduced and an old instance of this worker is running, in which case + -- the notification will just get dropped. On the other hand not dropping + -- this message blocks the whole queue. Perhaps there is a better way to + -- deal with this. + lift $ reject envelope False + Right notif -> do + -- FUTUREWORK: Drop support for parsing it as a + -- single notification as soon as we can guarantee + -- that the message queue does not contain any + -- 'BackendNotification's anymore. + ceFederator <- asks (.federatorInternal) + ceHttp2Manager <- asks http2Manager + let ceOriginDomain = notif.ownDomain + ceTargetDomain = targetDomain + ceOriginRequestId = fromMaybe (RequestId "N/A") notif.requestId + cveEnv = FederatorClientEnv {..} + cveVersion = Just V0 -- V0 is assumed for non-versioned queue messages + fcEnv = FederatorClientVersionedEnv {..} + sendNotificationIgnoringVersionMismatch fcEnv notif.targetComponent notif.path notif.body + lift $ ack envelope + metrics <- asks backendNotificationMetrics + withLabel metrics.pushedCounter (domainText targetDomain) incCounter + withLabel metrics.stuckQueuesGauge (domainText targetDomain) (flip setGauge 0) + Right bundle -> do + federator <- asks (.federatorInternal) + manager <- asks http2Manager + let env = + FederatorClientEnv + { ceOriginDomain = ownDomain . NE.head $ bundle.notifications, + ceTargetDomain = targetDomain, + ceFederator = federator, + ceHttp2Manager = manager, + ceOriginRequestId = + fromMaybe (RequestId "N/A") . (.requestId) . NE.head $ bundle.notifications + } + remoteVersions :: Set Int <- + liftIO + -- use versioned client with no version set: since we are manually + -- performing version negotiation, we don't want the client to + -- negotiate a version for us + ( runVersionedFederatorClient @'Brig (unversionedEnv env) $ + fedClientIn @'Brig @"api-version" () + ) + >>= \case + Left e -> do + Log.err $ + Log.msg (Log.val "Failed to get supported API versions") + . Log.field "domain" (domainText targetDomain) + . Log.field "error" (displayException e) + throwM e + Right vi -> pure . Set.fromList . vinfoSupported $ vi - -- FUTUREWORK: This rejects the message without any requeueing. This is - -- dangerous as it could happen that a new type of notification is - -- introduced and an old instance of this worker is running, in which case - -- the notification will just get dropped. On the other hand not dropping - -- this message blocks the whole queue. Perhaps there is a better way to - -- deal with this. - lift $ reject envelope False - Right notif -> do - ceFederator <- asks (.federatorInternal) - ceHttp2Manager <- asks http2Manager - let ceOriginDomain = notif.ownDomain - ceTargetDomain = targetDomain - ceOriginRequestId = fromMaybe (RequestId "N/A") notif.requestId - fcEnv = FederatorClientEnv {..} - liftIO $ either throwM pure =<< sendNotification fcEnv notif.targetComponent notif.path notif.body - lift $ ack envelope - metrics <- asks backendNotificationMetrics - withLabel metrics.pushedCounter (domainText targetDomain) incCounter - withLabel metrics.stuckQueuesGauge (domainText targetDomain) (flip setGauge 0) + -- compute the best usable version in a notification + let bestVersion = bodyVersions >=> flip latestCommonVersion remoteVersions + case pairedMaximumOn bestVersion (toList (notifications bundle)) of + (_, Nothing) -> + Log.fatal $ + Log.msg (Log.val "No federation API version in common, the notification will be ignored") + . Log.field "domain" (domainText targetDomain) + (notif, cveVersion) -> do + ceFederator <- asks (.federatorInternal) + ceHttp2Manager <- asks http2Manager + let ceOriginDomain = notif.ownDomain + ceTargetDomain = targetDomain + ceOriginRequestId = fromMaybe (RequestId "N/A") notif.requestId + cveEnv = FederatorClientEnv {..} + fcEnv = FederatorClientVersionedEnv {..} + sendNotificationIgnoringVersionMismatch fcEnv notif.targetComponent notif.path notif.body + lift $ ack envelope + metrics <- asks backendNotificationMetrics + withLabel metrics.pushedCounter (domainText targetDomain) incCounter + withLabel metrics.stuckQueuesGauge (domainText targetDomain) (flip setGauge 0) + +sendNotificationIgnoringVersionMismatch :: + FederatorClientVersionedEnv -> + Component -> + Text -> + RawJson -> + AppT IO () +sendNotificationIgnoringVersionMismatch env comp path body = + liftIO (sendNotification env comp path body) >>= \case + Left (FederatorClientVersionNegotiationError v) -> do + Log.fatal $ + Log.msg (Log.val "Federator version negotiation error") + . Log.field "domain" (domainText env.cveEnv.ceTargetDomain) + . Log.field "error" (show v) + pure () + Left e -> throwM e + Right () -> pure () + +-- | Find the pair that maximises b. +pairedMaximumOn :: Ord b => (a -> b) -> [a] -> (a, b) +pairedMaximumOn f = maximumBy (compare `on` snd) . map (id &&& f) -- FUTUREWORK: Recosider using 1 channel for many consumers. It shouldn't matter -- for a handful of remote domains. diff --git a/services/background-worker/src/Wire/BackgroundWorker.hs b/services/background-worker/src/Wire/BackgroundWorker.hs index 31a9c769034..b5e745d6558 100644 --- a/services/background-worker/src/Wire/BackgroundWorker.hs +++ b/services/background-worker/src/Wire/BackgroundWorker.hs @@ -5,6 +5,7 @@ module Wire.BackgroundWorker where import Data.Domain import Data.Map.Strict qualified as Map import Data.Metrics.Servant qualified as Metrics +import Data.Text qualified as T import Imports import Network.AMQP qualified as Q import Network.Wai.Utilities.Server @@ -47,7 +48,7 @@ run opts = do -- Close the channel. `extended` will then close the connection, flushing messages to the server. Log.info l $ Log.msg $ Log.val "Closing RabbitMQ channel" Q.closeChannel chan - let server = defaultServer (cs $ opts.backgroundWorker._host) opts.backgroundWorker._port env.logger env.metrics + let server = defaultServer (T.unpack $ opts.backgroundWorker._host) opts.backgroundWorker._port env.logger env.metrics settings <- newSettings server -- Additional cleanup when shutting down via signals. runSettingsWithCleanup cleanup settings (servantApp env) Nothing diff --git a/services/background-worker/src/Wire/BackgroundWorker/Health.hs b/services/background-worker/src/Wire/BackgroundWorker/Health.hs index dc0cc0a97d7..f56c0404c4d 100644 --- a/services/background-worker/src/Wire/BackgroundWorker/Health.hs +++ b/services/background-worker/src/Wire/BackgroundWorker/Health.hs @@ -1,5 +1,6 @@ module Wire.BackgroundWorker.Health where +import Data.ByteString.Lazy.UTF8 qualified as UTF8 import Data.Map.Strict qualified as Map import Imports import Servant @@ -17,7 +18,7 @@ statusWorkersImpl = do notWorkingWorkers <- Map.keys . Map.filter not <$> (readIORef =<< asks statuses) if null notWorkingWorkers then pure NoContent - else lift $ throwError err500 {errBody = "These workers are not working: " <> cs (show notWorkingWorkers)} + else lift $ throwError err500 {errBody = "These workers are not working: " <> UTF8.fromString (show notWorkingWorkers)} api :: Env -> HealthAPI AsServer api env = fromServant $ hoistServer (Proxy @(ToServant HealthAPI AsApi)) (runAppT env) (toServant apiInAppT) diff --git a/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs b/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs index 2a458b6990e..472f02d1f2e 100644 --- a/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs +++ b/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs @@ -9,6 +9,7 @@ import Control.Monad.Trans.Except import Data.Aeson qualified as Aeson import Data.ByteString.Builder qualified as Builder import Data.ByteString.Lazy qualified as LBS +import Data.Default import Data.Domain import Data.Id import Data.Range @@ -37,9 +38,11 @@ import Test.QuickCheck import Test.Wire.Util import UnliftIO.Async import Util.Options +import Wire.API.Conversation.Action import Wire.API.Federation.API import Wire.API.Federation.API.Brig import Wire.API.Federation.API.Common +import Wire.API.Federation.API.Galley import Wire.API.Federation.BackendNotifications import Wire.API.RawJson import Wire.BackendNotificationPusher @@ -51,7 +54,6 @@ spec :: Spec spec = do describe "pushNotification" $ do it "should push notifications" $ do - let returnSuccess _ = pure ("application/json", Aeson.encode EmptyResponse) let origDomain = Domain "origin.example.com" targetDomain = Domain "target.example.com" -- Just using 'arbitrary' could generate a very big list, making tests very @@ -64,6 +66,7 @@ spec = do ownDomain = origDomain, path = "/on-user-deleted-connections", body = RawJson $ Aeson.encode notifContent, + bodyVersions = Nothing, requestId = Just $ RequestId "N/A" } envelope <- newMockEnvelope @@ -74,7 +77,7 @@ spec = do } runningFlag <- newMVar () (env, fedReqs) <- - withTempMockFederator [] returnSuccess . runTestAppT $ do + withTempMockFederator def . runTestAppT $ do wait =<< pushNotification runningFlag targetDomain (msg, envelope) ask @@ -92,8 +95,88 @@ spec = do getVectorWith env.backendNotificationMetrics.pushedCounter getCounter `shouldReturn` [(domainText targetDomain, 1)] + it "should push notification bundles" $ do + let origDomain = Domain "origin.example.com" + targetDomain = Domain "target.example.com" + -- Just using 'arbitrary' could generate a very big list, making tests very + -- slow. Make me wonder if notification pusher should even try to parse the + -- actual content, seems like wasted compute power. + notifContent <- + generate $ + ClientRemovedRequest <$> arbitrary <*> arbitrary <*> arbitrary + let bundle = toBundle @'OnClientRemovedTag (RequestId "N/A") origDomain notifContent + envelope <- newMockEnvelope + let msg = + Q.newMsg + { Q.msgBody = Aeson.encode bundle, + Q.msgContentType = Just "application/json" + } + runningFlag <- newMVar () + (env, fedReqs) <- + withTempMockFederator def . runTestAppT $ do + wait =<< pushNotification runningFlag targetDomain (msg, envelope) + ask + + readIORef envelope.acks `shouldReturn` 1 + readIORef envelope.rejections `shouldReturn` [] + fedReqs + `shouldBe` [ FederatedRequest + { frTargetDomain = targetDomain, + frOriginDomain = origDomain, + frComponent = Galley, + frRPC = "on-client-removed", + frBody = Aeson.encode notifContent + } + ] + getVectorWith env.backendNotificationMetrics.pushedCounter getCounter + `shouldReturn` [(domainText targetDomain, 1)] + + it "should negotiate the best version" $ do + let origDomain = Domain "origin.example.com" + targetDomain = Domain "target.example.com" + update <- generate $ do + now <- arbitrary + user <- arbitrary + convId <- arbitrary + pure + ConversationUpdate + { time = now, + origUserId = user, + convId = convId, + alreadyPresentUsers = [], + action = SomeConversationAction SConversationLeaveTag () + } + let update0 = conversationUpdateToV0 update + let bundle = + toBundle (RequestId "N/A") origDomain update + <> toBundle (RequestId "N/A") origDomain update0 + envelope <- newMockEnvelope + let msg = + Q.newMsg + { Q.msgBody = Aeson.encode bundle, + Q.msgContentType = Just "application/json" + } + runningFlag <- newMVar () + (env, fedReqs) <- + withTempMockFederator def {versions = [0, 2]} . runTestAppT $ do + wait =<< pushNotification runningFlag targetDomain (msg, envelope) + ask + + readIORef envelope.acks `shouldReturn` 1 + readIORef envelope.rejections `shouldReturn` [] + fedReqs + `shouldBe` [ FederatedRequest + { frTargetDomain = targetDomain, + frOriginDomain = origDomain, + frComponent = Galley, + frRPC = "on-conversation-updated", + frBody = Aeson.encode update0 + } + ] + getVectorWith env.backendNotificationMetrics.pushedCounter getCounter + `shouldReturn` [(domainText targetDomain, 1)] + it "should reject invalid notifications" $ do - let returnSuccess _ = pure ("application/json", Aeson.encode EmptyResponse) envelope <- newMockEnvelope let msg = Q.newMsg @@ -102,7 +185,7 @@ spec = do } runningFlag <- newMVar () (env, fedReqs) <- - withTempMockFederator [] returnSuccess . runTestAppT $ do + withTempMockFederator def . runTestAppT $ do wait =<< pushNotification runningFlag (Domain "target.example.com") (msg, envelope) ask @@ -131,6 +214,7 @@ spec = do ownDomain = origDomain, path = "/on-user-deleted-connections", body = RawJson $ Aeson.encode notifContent, + bodyVersions = Nothing, requestId = Just $ RequestId "N/A" } envelope <- newMockEnvelope @@ -142,7 +226,7 @@ spec = do runningFlag <- newMVar () env <- testEnv pushThread <- - async $ withTempMockFederator [] mockRemote . runTestAppTWithEnv env $ do + async $ withTempMockFederator def {handler = mockRemote} . runTestAppTWithEnv env $ do wait =<< pushNotification runningFlag targetDomain (msg, envelope) -- Wait for two calls, so we can be sure that the metric about stuck diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 5c86b737589..9ad17d98040 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -77,7 +77,6 @@ library -- cabal-fmt: expand src exposed-modules: Brig.Allowlists - Brig.API Brig.API.Auth Brig.API.Client Brig.API.Connection @@ -111,7 +110,6 @@ library Brig.Data.Activation Brig.Data.Client Brig.Data.Connection - Brig.Data.Instances Brig.Data.LoginCode Brig.Data.MLS.KeyPackage Brig.Data.Nonce @@ -125,6 +123,8 @@ library Brig.Effects.BlacklistStore.Cassandra Brig.Effects.CodeStore Brig.Effects.CodeStore.Cassandra + Brig.Effects.ConnectionStore + Brig.Effects.ConnectionStore.Cassandra Brig.Effects.FederationConfigStore Brig.Effects.FederationConfigStore.Cassandra Brig.Effects.GalleyProvider @@ -147,6 +147,7 @@ library Brig.InternalEvent.Types Brig.IO.Intra Brig.IO.Journal + Brig.IO.Logging Brig.Locale Brig.Options Brig.Phone @@ -350,13 +351,12 @@ library , unliftio >=0.2 , unordered-containers >=0.2 , uri-bytestring >=0.2 + , utf8-string , uuid >=1.3.5 , vector >=0.11 , wai >=3.0 , wai-extra >=3.0 , wai-middleware-gunzip >=0.0.2 - , wai-predicates >=0.8 - , wai-routing >=0.12 , wai-utilities >=0.16 , wire-api , wire-api-federation @@ -497,6 +497,7 @@ executable brig-integration , servant-client-core , spar , streaming-commons + , string-conversions , tasty >=1.0 , tasty-ant-xml , tasty-cannon >=0.3.4 diff --git a/services/brig/brig.integration.yaml b/services/brig/brig.integration.yaml index 71e83cf664c..38f0208b31c 100644 --- a/services/brig/brig.integration.yaml +++ b/services/brig/brig.integration.yaml @@ -10,8 +10,14 @@ cassandra: # filterNodesByDatacentre: datacenter1 elasticsearch: - url: http://127.0.0.1:9200 + url: https://localhost:9200 index: directory_test + credentials: test/resources/elasticsearch-credentials.yaml + caCert: test/resources/elasticsearch-ca.pem + insecureSkipVerifyTls: false + additionalCredentials: test/resources/elasticsearch-credentials.yaml + additionalCaCert: test/resources/elasticsearch-ca.pem + additionalInsecureSkipVerifyTls: false rabbitmq: host: 127.0.0.1 @@ -34,6 +40,8 @@ federatorInternal: host: 127.0.0.1 port: 8097 +multiSFT: false + # You can set up local SQS/Dynamo running e.g. `../../deploy/dockerephemeral/run.sh` aws: userJournalQueue: integration-user-events.fifo diff --git a/services/brig/default.nix b/services/brig/default.nix index 6c13f6194ea..fc3eff7812f 100644 --- a/services/brig/default.nix +++ b/services/brig/default.nix @@ -122,6 +122,7 @@ , statistics , stomp-queue , streaming-commons +, string-conversions , tasty , tasty-ant-xml , tasty-cannon @@ -144,14 +145,13 @@ , unliftio , unordered-containers , uri-bytestring +, utf8-string , uuid , vector , wai , wai-extra , wai-middleware-gunzip -, wai-predicates , wai-route -, wai-routing , wai-utilities , warp , warp-tls @@ -279,13 +279,12 @@ mkDerivation { unliftio unordered-containers uri-bytestring + utf8-string uuid vector wai wai-extra wai-middleware-gunzip - wai-predicates - wai-routing wai-utilities wire-api wire-api-federation @@ -356,6 +355,7 @@ mkDerivation { servant-client-core spar streaming-commons + string-conversions tasty tasty-ant-xml tasty-cannon diff --git a/services/brig/docs/swagger-v3.json b/services/brig/docs/swagger-v3.json index e252a739717..b844341e756 100644 --- a/services/brig/docs/swagger-v3.json +++ b/services/brig/docs/swagger-v3.json @@ -14,9 +14,7 @@ "enum": [ "GCM", "APNS", - "APNS_SANDBOX", - "APNS_VOIP", - "APNS_VOIP_SANDBOX" + "APNS_SANDBOX" ], "type": "string" }, diff --git a/services/brig/docs/swagger-v4.json b/services/brig/docs/swagger-v4.json index 937aafdefc9..7ff1394f344 100644 --- a/services/brig/docs/swagger-v4.json +++ b/services/brig/docs/swagger-v4.json @@ -4828,9 +4828,7 @@ "enum": [ "GCM", "APNS", - "APNS_SANDBOX", - "APNS_VOIP", - "APNS_VOIP_SANDBOX" + "APNS_SANDBOX" ], "type": "string" }, diff --git a/services/brig/src/Brig/API/Auth.hs b/services/brig/src/Brig/API/Auth.hs index 6b0d93aa56e..889a12d9b40 100644 --- a/services/brig/src/Brig/API/Auth.hs +++ b/services/brig/src/Brig/API/Auth.hs @@ -24,6 +24,7 @@ import Brig.API.User import Brig.App import Brig.Data.User qualified as User import Brig.Effects.BlacklistStore +import Brig.Effects.ConnectionStore (ConnectionStore) import Brig.Effects.GalleyProvider import Brig.Options import Brig.User.Auth qualified as Auth @@ -37,12 +38,14 @@ import Data.List1 (List1 (..)) import Data.Qualified import Data.Text qualified as T import Data.Text.Lazy qualified as LT +import Data.Time.Clock (UTCTime) import Data.ZAuth.Token qualified as ZAuth import Imports import Network.HTTP.Types import Network.Wai.Utilities ((!>>)) import Network.Wai.Utilities.Error qualified as Wai import Polysemy +import Polysemy.Input (Input) import Polysemy.TinyLog (TinyLog) import Wire.API.User import Wire.API.User.Auth hiding (access) @@ -50,11 +53,15 @@ import Wire.API.User.Auth.LegalHold import Wire.API.User.Auth.ReAuth import Wire.API.User.Auth.Sso import Wire.NotificationSubsystem +import Wire.Sem.Paging.Cassandra (InternalPaging) accessH :: ( Member TinyLog r, Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => Maybe ClientId -> [Either Text SomeUserToken] -> @@ -70,7 +77,10 @@ access :: ( TokenPair u a, Member TinyLog r, Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => Maybe ClientId -> NonEmpty (Token u) -> @@ -90,7 +100,10 @@ login :: ( Member GalleyProvider r, Member TinyLog r, Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => Login -> Maybe Bool -> @@ -150,7 +163,10 @@ legalHoldLogin :: ( Member GalleyProvider r, Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => LegalHoldLogin -> Handler r SomeAccess @@ -162,7 +178,10 @@ legalHoldLogin lhl = do ssoLogin :: ( Member TinyLog r, Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => SsoLogin -> Maybe Bool -> diff --git a/services/brig/src/Brig/API/Client.hs b/services/brig/src/Brig/API/Client.hs index 529b81ad0e9..2fbd3390af5 100644 --- a/services/brig/src/Brig/API/Client.hs +++ b/services/brig/src/Brig/API/Client.hs @@ -53,6 +53,7 @@ import Brig.App import Brig.Data.Client qualified as Data import Brig.Data.Nonce as Nonce import Brig.Data.User qualified as Data +import Brig.Effects.ConnectionStore (ConnectionStore) import Brig.Effects.GalleyProvider (GalleyProvider) import Brig.Effects.GalleyProvider qualified as GalleyProvider import Brig.Effects.JwtTools (JwtTools) @@ -68,7 +69,6 @@ import Brig.Options qualified as Opt import Brig.Queue qualified as Queue import Brig.Types.Intra import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) -import Brig.Types.User.Event import Brig.User.Auth qualified as UserAuth import Brig.User.Auth.Cookie qualified as Auth import Brig.User.Email @@ -76,6 +76,7 @@ import Cassandra (MonadClient) import Control.Error import Control.Lens (view) import Control.Monad.Trans.Except (except) +import Data.ByteString (toStrict) import Data.ByteString.Conversion import Data.Code as Code import Data.Domain @@ -86,10 +87,14 @@ import Data.Map.Strict qualified as Map import Data.Misc (PlainTextPassword6) import Data.Qualified import Data.Set qualified as Set +import Data.Text.Encoding qualified as T +import Data.Text.Encoding.Error +import Data.Time.Clock (UTCTime) import Imports import Network.HTTP.Types.Method (StdMethod) import Network.Wai.Utilities import Polysemy +import Polysemy.Input (Input) import Polysemy.TinyLog import Servant (Link, ToHttpApiData (toUrlPiece)) import System.Logger.Class (field, msg, val, (~~)) @@ -105,11 +110,13 @@ import Wire.API.User qualified as Code import Wire.API.User.Client import Wire.API.User.Client.DPoPAccessToken import Wire.API.User.Client.Prekey +import Wire.API.UserEvent import Wire.API.UserMap (QualifiedUserMap (QualifiedUserMap, qualifiedUserMap), UserMap (userMap)) import Wire.NotificationSubsystem import Wire.Sem.Concurrency import Wire.Sem.FromUTC (FromUTC (fromUTCTime)) import Wire.Sem.Now as Now +import Wire.Sem.Paging.Cassandra (InternalPaging) lookupLocalClient :: UserId -> ClientId -> (AppT r) (Maybe Client) lookupLocalClient uid = wrapClient . Data.lookupClient uid @@ -158,7 +165,10 @@ addClient :: ( Member GalleyProvider r, Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> Maybe ConnId -> @@ -173,7 +183,10 @@ addClientWithReAuthPolicy :: ( Member GalleyProvider r, Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => Data.ReAuthPolicy -> UserId -> @@ -201,7 +214,7 @@ addClientWithReAuthPolicy policy u con new = do lift $ do for_ old $ execDelete u con liftSem $ GalleyProvider.newClient u (clientId clt) - liftSem $ Intra.onClientEvent u con (ClientAdded u clt) + liftSem $ Intra.onClientEvent u con (ClientAdded clt) when (clientType clt == LegalHoldClientType) $ liftSem $ Intra.onUserEvent u con (UserLegalHoldEnabled u) when (count > 1) $ for_ (userEmail usr) $ @@ -215,10 +228,10 @@ addClientWithReAuthPolicy policy u con new = do Maybe Code.Value -> UserId -> ExceptT ClientError (AppT r) () - verifyCode mbCode userId = + verifyCode mbCode uid = -- this only happens inside the login flow (in particular, when logging in from a new device) -- the code obtained for logging in is used a second time for adding the device - UserAuth.verifyCode mbCode Code.Login userId `catchE` \case + UserAuth.verifyCode mbCode Code.Login uid `catchE` \case VerificationCodeRequired -> throwE ClientCodeAuthenticationRequired VerificationCodeNoPendingCode -> throwE ClientCodeAuthenticationFailed VerificationCodeNoEmail -> throwE ClientCodeAuthenticationFailed @@ -475,7 +488,10 @@ pubClient c = legalHoldClientRequested :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> LegalHoldClientRequest -> @@ -493,7 +509,10 @@ legalHoldClientRequested targetUser (LegalHoldClientRequest _requester lastPreke removeLegalHoldClient :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> AppT r () @@ -516,14 +535,26 @@ createAccessToken :: createAccessToken luid cid method link proof = do let domain = tDomain luid let uid = tUnqualified luid - (tid, handle) <- do + (tid, handle, displayName) <- do mUser <- lift $ wrapClient (Data.lookupUser NoPendingInvitations uid) except $ - (,) + (,,) <$> note NotATeamUser (userTeam =<< mUser) <*> note MissingHandle (userHandle =<< mUser) - nonce <- ExceptT $ note NonceNotFound <$> wrapClient (Nonce.lookupAndDeleteNonce uid (cs $ toByteString cid)) - httpsUrl <- except $ note MisconfiguredRequestUrl $ fromByteString $ "https://" <> toByteString' domain <> "/" <> cs (toUrlPiece link) + <*> note MissingName (userDisplayName <$> mUser) + nonce <- + ExceptT $ + note NonceNotFound + <$> wrapClient + ( Nonce.lookupAndDeleteNonce + uid + (T.decodeUtf8With lenientDecode . toStrict $ toByteString cid) + ) + httpsUrl <- + except $ + note MisconfiguredRequestUrl $ + fromByteString $ + "https://" <> toByteString' domain <> "/" <> T.encodeUtf8 (toUrlPiece link) maxSkewSeconds <- Opt.setDpopMaxSkewSecs <$> view settings expiresIn <- Opt.setDpopTokenExpirationTimeSecs <$> view settings now <- fromUTCTime <$> lift (liftSem Now.get) @@ -538,6 +569,7 @@ createAccessToken luid cid method link proof = do proof (ClientIdentity domain uid cid) handle + displayName tid nonce httpsUrl diff --git a/services/brig/src/Brig/API/Connection.hs b/services/brig/src/Brig/API/Connection.hs index 7debfb2ed6e..c5b8de1c4c2 100644 --- a/services/brig/src/Brig/API/Connection.hs +++ b/services/brig/src/Brig/API/Connection.hs @@ -42,12 +42,14 @@ import Brig.Data.Connection qualified as Data import Brig.Data.Types (resultHasMore, resultList) import Brig.Data.User qualified as Data import Brig.Effects.FederationConfigStore -import Brig.Effects.GalleyProvider (GalleyProvider) +import Brig.Effects.GalleyProvider import Brig.Effects.GalleyProvider qualified as GalleyProvider import Brig.IO.Intra qualified as Intra +import Brig.IO.Logging +import Brig.Options import Brig.Types.Connection -import Brig.Types.User.Event import Control.Error +import Control.Lens (view) import Control.Monad.Catch (throwM) import Data.Id as Id import Data.LegalHold qualified as LH @@ -55,6 +57,7 @@ import Data.Proxy (Proxy (Proxy)) import Data.Qualified import Data.Range import Data.UUID.V4 qualified as UUID +import Galley.Types.Conversations.One2One import Imports import Polysemy import Polysemy.TinyLog @@ -65,6 +68,8 @@ import Wire.API.Conversation hiding (Member) import Wire.API.Error import Wire.API.Error.Brig qualified as E import Wire.API.Routes.Public.Util (ResponseForExistedCreated (..)) +import Wire.API.User +import Wire.API.UserEvent import Wire.NotificationSubsystem ensureNotSameTeam :: Member GalleyProvider r => Local UserId -> Local UserId -> (ConnectionM r) () @@ -117,10 +122,10 @@ createConnectionToLocalUser self conn target = do Just rs -> rs Nothing -> do checkLimit self - Created <$> insert Nothing Nothing + Created <$> insert where - insert :: Maybe UserConnection -> Maybe UserConnection -> ExceptT ConnectionError (AppT r) UserConnection - insert s2o o2s = lift $ do + insert :: ExceptT ConnectionError (AppT r) UserConnection + insert = lift $ do Log.info $ logConnection (tUnqualified self) (tUntagged target) . msg (val "Creating connection") @@ -128,9 +133,8 @@ createConnectionToLocalUser self conn target = do s2o' <- wrapClient $ Data.insertConnection self (tUntagged target) SentWithHistory qcnv o2s' <- wrapClient $ Data.insertConnection target (tUntagged self) PendingWithHistory qcnv e2o <- - ConnectionUpdated o2s' (ucStatus <$> o2s) - <$> wrapClient (Data.lookupName (tUnqualified self)) - let e2s = ConnectionUpdated s2o' (ucStatus <$> s2o) Nothing + ConnectionUpdated o2s' <$> wrapClient (Data.lookupName (tUnqualified self)) + let e2s = ConnectionUpdated s2o' Nothing liftSem $ mapM_ (Intra.onConnectionEvent (tUnqualified self) (Just conn)) [e2o, e2s] pure s2o' @@ -145,9 +149,9 @@ createConnectionToLocalUser self conn target = do (_, Blocked) -> change s2o SentWithHistory (_, Sent) -> accept s2o o2s (_, Accepted) -> accept s2o o2s - (_, Ignored) -> resend s2o o2s - (_, Pending) -> resend s2o o2s - (_, Cancelled) -> resend s2o o2s + (_, Ignored) -> resend s2o + (_, Pending) -> resend s2o + (_, Cancelled) -> resend s2o accept :: UserConnection -> UserConnection -> ExceptT ConnectionError (AppT r) (ResponseForExistedCreated UserConnection) accept s2o o2s = do @@ -165,21 +169,19 @@ createConnectionToLocalUser self conn target = do else Data.updateConnection o2s AcceptedWithHistory e2o <- lift . wrapClient $ - ConnectionUpdated o2s' (Just $ ucStatus o2s) - <$> Data.lookupName (tUnqualified self) - let e2s = ConnectionUpdated s2o' (Just $ ucStatus s2o) Nothing + ConnectionUpdated o2s' <$> Data.lookupName (tUnqualified self) + let e2s = ConnectionUpdated s2o' Nothing lift $ liftSem $ mapM_ (Intra.onConnectionEvent (tUnqualified self) (Just conn)) [e2o, e2s] pure $ Existed s2o' - resend :: UserConnection -> UserConnection -> ExceptT ConnectionError (AppT r) (ResponseForExistedCreated UserConnection) - resend s2o o2s = do + resend :: UserConnection -> ExceptT ConnectionError (AppT r) (ResponseForExistedCreated UserConnection) + resend s2o = do unless (ucStatus s2o `elem` [Sent, Accepted]) $ checkLimit self lift . Log.info $ logLocalConnection (tUnqualified self) (qUnqualified (ucTo s2o)) . msg (val "Resending connection request") - s2o' <- insert (Just s2o) (Just o2s) - pure $ Existed s2o' + Existed <$> insert change :: UserConnection -> RelationWithHistory -> ExceptT ConnectionError (AppT r) (ResponseForExistedCreated UserConnection) change c s = Existed <$> lift (wrapClient $ Data.updateConnection c s) @@ -218,7 +220,8 @@ updateConnection :: ( Member FederationConfigStore r, Member NotificationSubsystem r, Member TinyLog r, - Member (Embed HttpClientIO) r + Member (Embed HttpClientIO) r, + Member GalleyProvider r ) => Local UserId -> Qualified UserId -> @@ -240,9 +243,10 @@ updateConnection self other newStatus conn = -- {#RefConnectionTeam} updateConnectionToLocalUser :: forall r. - ( Member NotificationSubsystem r, - Member TinyLog r, - Member (Embed HttpClientIO) r + ( Member (Embed HttpClientIO) r, + Member GalleyProvider r, + Member NotificationSubsystem r, + Member TinyLog r ) => -- | From Local UserId -> @@ -299,7 +303,7 @@ updateConnectionToLocalUser self other newStatus conn = do _ -> throwE $ InvalidTransition (tUnqualified self) let s2oUserConn = s2o' lift . liftSem . for_ s2oUserConn $ \c -> - let e2s = ConnectionUpdated c (Just $ ucStatus s2o) Nothing + let e2s = ConnectionUpdated c Nothing in Intra.onConnectionEvent (tUnqualified self) conn e2s pure s2oUserConn where @@ -321,7 +325,7 @@ updateConnectionToLocalUser self other newStatus conn = do then Data.updateConnection o2s AcceptedWithHistory else Data.updateConnection o2s BlockedWithHistory e2o <- - ConnectionUpdated o2s' (Just $ ucStatus o2s) + ConnectionUpdated o2s' <$> wrapClient (Data.lookupName (tUnqualified self)) liftSem $ Intra.onConnectionEvent (tUnqualified self) conn e2o lift . wrapClient $ Just <$> Data.updateConnection s2o AcceptedWithHistory @@ -331,7 +335,12 @@ updateConnectionToLocalUser self other newStatus conn = do Log.info $ logLocalConnection (tUnqualified self) (qUnqualified (ucTo s2o)) . msg (val "Blocking connection") - traverse_ (Intra.blockConv self conn) (ucConvId s2o) + traverse_ (liftSem . Intra.blockConv self) (ucConvId s2o) + mlsEnabled <- view (settings . enableMLS) + liftSem $ when (fromMaybe False mlsEnabled) $ do + let mlsConvId = one2OneConvId BaseProtocolMLSTag (tUntagged self) (tUntagged other) + isEstablished <- isMLSOne2OneEstablished self (tUntagged other) + when (isEstablished == Established) $ Intra.blockConv self mlsConvId wrapClient $ Just <$> Data.updateConnection s2o BlockedWithHistory unblock :: UserConnection -> UserConnection -> Relation -> ExceptT ConnectionError (AppT r) (Maybe UserConnection) @@ -342,7 +351,13 @@ updateConnectionToLocalUser self other newStatus conn = do lift . Log.info $ logLocalConnection (tUnqualified self) (qUnqualified (ucTo s2o)) . msg (val "Unblocking connection") - cnv <- lift $ traverse (Intra.unblockConv self conn) (ucConvId s2o) + cnv <- lift . liftSem $ traverse (unblockConversation self conn) (ucConvId s2o) + mlsEnabled <- view (settings . enableMLS) + lift . liftSem $ when (fromMaybe False mlsEnabled) $ do + let mlsConvId = one2OneConvId BaseProtocolMLSTag (tUntagged self) (tUntagged other) + isEstablished <- isMLSOne2OneEstablished self (tUntagged other) + when (isEstablished == NotAMember || isEstablished == Established) . void $ + unblockConversation self conn mlsConvId when (ucStatus o2s == Sent && new == Accepted) . lift $ do o2s' <- wrapClient $ @@ -351,7 +366,7 @@ updateConnectionToLocalUser self other newStatus conn = do else Data.updateConnection o2s BlockedWithHistory e2o :: ConnectionEvent <- wrapClient $ - ConnectionUpdated o2s' (Just $ ucStatus o2s) + ConnectionUpdated o2s' <$> Data.lookupName (tUnqualified self) -- TODO: is this correct? shouldnt o2s be sent to other? liftSem $ Intra.onConnectionEvent (tUnqualified self) conn e2o @@ -363,9 +378,9 @@ updateConnectionToLocalUser self other newStatus conn = do logLocalConnection (tUnqualified self) (qUnqualified (ucTo s2o)) . msg (val "Cancelling connection") lfrom <- qualifyLocal (ucFrom s2o) - lift $ traverse_ (Intra.blockConv lfrom conn) (ucConvId s2o) + lift $ traverse_ (liftSem . Intra.blockConv lfrom) (ucConvId s2o) o2s' <- lift . wrapClient $ Data.updateConnection o2s CancelledWithHistory - let e2o = ConnectionUpdated o2s' (Just $ ucStatus o2s) Nothing + let e2o = ConnectionUpdated o2s' Nothing lift $ liftSem $ Intra.onConnectionEvent (tUnqualified self) conn e2o change s2o Cancelled @@ -402,7 +417,8 @@ mkRelationWithHistory oldRel = \case updateConnectionInternal :: forall r. - ( Member NotificationSubsystem r, + ( Member GalleyProvider r, + Member NotificationSubsystem r, Member TinyLog r, Member (Embed HttpClientIO) r ) => @@ -434,9 +450,9 @@ updateConnectionInternal = \case o2s <- localConnection other self for_ [s2o, o2s] $ \(uconn :: UserConnection) -> lift $ do lfrom <- qualifyLocal (ucFrom uconn) - traverse_ (Intra.blockConv lfrom Nothing) (ucConvId uconn) + traverse_ (liftSem . Intra.blockConv lfrom) (ucConvId uconn) uconn' <- wrapClient $ Data.updateConnection uconn (mkRelationWithHistory (ucStatus uconn) MissingLegalholdConsent) - let ev = ConnectionUpdated uconn' (Just $ ucStatus uconn) Nothing + let ev = ConnectionUpdated uconn' Nothing liftSem $ Intra.onConnectionEvent (tUnqualified self) Nothing ev removeLHBlocksInvolving :: Local UserId -> ExceptT ConnectionError (AppT r) () @@ -469,14 +485,13 @@ updateConnectionInternal = \case unblockDirected :: UserConnection -> UserConnection -> ExceptT ConnectionError (AppT r) () unblockDirected uconn uconnRev = do lfrom <- qualifyLocal (ucFrom uconnRev) - void . lift . for (ucConvId uconn) $ Intra.unblockConv lfrom Nothing + void . lift . liftSem . for (ucConvId uconn) $ unblockConversation lfrom Nothing uconnRevRel :: RelationWithHistory <- relationWithHistory lfrom (ucTo uconnRev) uconnRev' <- lift . wrapClient $ Data.updateConnection uconnRev (undoRelationHistory uconnRevRel) connName <- lift . wrapClient $ Data.lookupName (tUnqualified lfrom) let connEvent = ConnectionUpdated { ucConn = uconnRev', - ucPrev = Just $ ucStatus uconnRev, ucName = connName } lift $ liftSem $ Intra.onConnectionEvent (ucFrom uconn) Nothing connEvent diff --git a/services/brig/src/Brig/API/Connection/Remote.hs b/services/brig/src/Brig/API/Connection/Remote.hs index 96c446d603a..c96ecd24a5b 100644 --- a/services/brig/src/Brig/API/Connection/Remote.hs +++ b/services/brig/src/Brig/API/Connection/Remote.hs @@ -29,14 +29,17 @@ import Brig.App import Brig.Data.Connection qualified as Data import Brig.Data.User qualified as Data import Brig.Effects.FederationConfigStore -import Brig.Federation.Client +import Brig.Effects.GalleyProvider +import Brig.Federation.Client as Federation import Brig.IO.Intra qualified as Intra -import Brig.Types.User.Event +import Brig.Options import Control.Comonad import Control.Error.Util ((??)) +import Control.Lens (view) import Control.Monad.Trans.Except import Data.Id as Id import Data.Qualified +import Galley.Types.Conversations.One2One (one2OneConvId) import Imports import Network.Wai.Utilities.Error import Polysemy @@ -45,9 +48,10 @@ import Wire.API.Federation.API.Brig ( NewConnectionResponse (..), RemoteConnectionAction (..), ) -import Wire.API.Routes.Internal.Galley.ConversationsIntra (Actor (..), DesiredMembership (..), UpsertOne2OneConversationRequest (..), UpsertOne2OneConversationResponse (uuorConvId)) +import Wire.API.Routes.Internal.Galley.ConversationsIntra import Wire.API.Routes.Public.Util (ResponseForExistedCreated (..)) import Wire.API.User +import Wire.API.UserEvent import Wire.NotificationSubsystem data LocalConnectionAction @@ -104,39 +108,41 @@ transition (RCA RemoteRescind) Pending = Just Cancelled transition (RCA RemoteRescind) Accepted = Just Sent transition (RCA RemoteRescind) _ = Nothing --- When user A has made a request -> Only user A's membership in conv is affected -> User A wants to be in one2one conv with B, or User A doesn't want to be in one2one conv with B +-- When user A has made a request -> Only user A's membership in conv is +-- affected -> User A wants to be in one2one conv with B, or User A doesn't want +-- to be in one2one conv with B updateOne2OneConv :: Local UserId -> Maybe ConnId -> Remote UserId -> - Maybe (Qualified ConvId) -> - Relation -> + Qualified ConvId -> + DesiredMembership -> Actor -> - (AppT r) (Qualified ConvId) -updateOne2OneConv lUsr _mbConn remoteUser mbConvId rel actor = do + (AppT r) () +updateOne2OneConv lUsr _mbConn remoteUser convId desiredMem actor = do let request = UpsertOne2OneConversationRequest { uooLocalUser = lUsr, uooRemoteUser = remoteUser, uooActor = actor, - uooActorDesiredMembership = desiredMembership actor rel, - uooConvId = mbConvId + uooActorDesiredMembership = desiredMem, + uooConvId = convId } - uuorConvId <$> wrapHttp (Intra.upsertOne2OneConversation request) - where - desiredMembership :: Actor -> Relation -> DesiredMembership - desiredMembership a r = - let isIncluded = - a - `elem` case r of - Accepted -> [LocalActor, RemoteActor] - Blocked -> [] - Pending -> [RemoteActor] - Ignored -> [RemoteActor] - Sent -> [LocalActor] - Cancelled -> [] - MissingLegalholdConsent -> [] - in if isIncluded then Included else Excluded + void $ wrapHttp (Intra.upsertOne2OneConversation request) + +desiredMembership :: Actor -> Relation -> DesiredMembership +desiredMembership a r = + let isIncluded = + a + `elem` case r of + Accepted -> [LocalActor, RemoteActor] + Blocked -> [] + Pending -> [RemoteActor] + Ignored -> [RemoteActor] + Sent -> [LocalActor] + Cancelled -> [] + MissingLegalholdConsent -> [] + in if isIncluded then Included else Excluded -- | Perform a state transition on a connection, handle conversation updates and -- push events. @@ -146,7 +152,7 @@ updateOne2OneConv lUsr _mbConn remoteUser mbConvId rel actor = do -- -- Returns the connection, and whether it was updated or not. transitionTo :: - (Member NotificationSubsystem r) => + (Member GalleyProvider r, Member NotificationSubsystem r) => Local UserId -> Maybe ConnId -> Remote UserId -> @@ -159,8 +165,13 @@ transitionTo self _ _ Nothing Nothing _ = -- connection. This shouldn't be possible. throwE (InvalidTransition (tUnqualified self)) transitionTo self mzcon other Nothing (Just rel) actor = lift $ do - -- update 1-1 connection - qcnv <- updateOne2OneConv self mzcon other Nothing rel actor + -- Create 1-1 proteus conversation. + -- + -- We do nothing here for MLS as haveing no pre-existing connection implies + -- there was no conversation. Creating an MLS converstaion is special due to + -- key packages, etc. so the clients have to make another call for this. + let proteusConv = one2OneConvId BaseProtocolProteusTag (tUntagged self) (tUntagged other) + updateOne2OneConv self mzcon other proteusConv (desiredMembership actor rel) actor -- create connection connection <- @@ -169,21 +180,36 @@ transitionTo self mzcon other Nothing (Just rel) actor = lift $ do self (tUntagged other) (relationWithHistory rel) - qcnv + proteusConv -- send event pushEvent self mzcon connection pure (Created connection, True) transitionTo _self _zcon _other (Just connection) Nothing _actor = pure (Existed connection, False) -transitionTo self mzcon other (Just connection) (Just rel) actor = lift $ do +transitionTo self mzcon other (Just connection) (Just rel) actor = do -- update 1-1 conversation - void $ updateOne2OneConv self Nothing other (ucConvId connection) rel actor + let proteusConvId = + fromMaybe + (one2OneConvId BaseProtocolProteusTag (tUntagged self) (tUntagged other)) + $ ucConvId connection + desiredMem = desiredMembership actor rel + lift $ updateOne2OneConv self Nothing other proteusConvId desiredMem actor + mlsEnabled <- view (settings . enableMLS) + when (fromMaybe False mlsEnabled) $ do + let mlsConvId = one2OneConvId BaseProtocolMLSTag (tUntagged self) (tUntagged other) + isEstablished <- lift . liftSem $ isMLSOne2OneEstablished self (tUntagged other) + lift + . when + ( isEstablished == Established + || (isEstablished == NotAMember && ucStatus connection == Blocked && rel == Accepted) + ) + $ updateOne2OneConv self Nothing other mlsConvId desiredMem actor -- update connection - connection' <- wrapClient $ Data.updateConnection connection (relationWithHistory rel) + connection' <- lift $ wrapClient $ Data.updateConnection connection (relationWithHistory rel) -- send event - pushEvent self mzcon connection' + lift $ pushEvent self mzcon connection' pure (Existed connection', True) -- | Send an event to the local user when the state of a connection changes. @@ -194,11 +220,11 @@ pushEvent :: UserConnection -> AppT r () pushEvent self mzcon connection = do - let event = ConnectionUpdated connection Nothing Nothing + let event = ConnectionUpdated connection Nothing liftSem $ Intra.onConnectionEvent (tUnqualified self) mzcon event performLocalAction :: - (Member NotificationSubsystem r) => + (Member GalleyProvider r, Member NotificationSubsystem r) => Local UserId -> Maybe ConnId -> Remote UserId -> @@ -254,7 +280,7 @@ performLocalAction self mzcon other mconnection action = do -- B connects & A reacts: Accepted Accepted -- @ performRemoteAction :: - (Member NotificationSubsystem r) => + (Member GalleyProvider r, Member NotificationSubsystem r) => Local UserId -> Remote UserId -> Maybe UserConnection -> @@ -272,7 +298,8 @@ performRemoteAction self other mconnection action = do reaction _ = Nothing createConnectionToRemoteUser :: - ( Member FederationConfigStore r, + ( Member GalleyProvider r, + Member FederationConfigStore r, Member NotificationSubsystem r ) => Local UserId -> @@ -286,7 +313,8 @@ createConnectionToRemoteUser self zcon other = do fst <$> performLocalAction self (Just zcon) other mconnection LocalConnect updateConnectionToRemoteUser :: - ( Member NotificationSubsystem r, + ( Member GalleyProvider r, + Member NotificationSubsystem r, Member FederationConfigStore r ) => Local UserId -> diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index d1758a3dd09..23a24bad4e2 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -25,6 +25,7 @@ import Data.Aeson.KeyMap qualified as KeyMap import Data.ByteString.Conversion import Data.Domain (Domain) import Data.Jwt.Tools (DPoPTokenGenerationError (..)) +import Data.Text.Lazy as LT import Data.ZAuth.Validation qualified as ZAuth import Imports import Network.HTTP.Types.Header @@ -220,12 +221,14 @@ certEnrollmentError (RustError UnsupportedApiVersion) = StdError $ Wai.mkError s certEnrollmentError (RustError UnsupportedScope) = StdError $ Wai.mkError status400 "unsupported-scope" "Bubbling up errors" certEnrollmentError (RustError DpopHandleMismatch) = StdError $ Wai.mkError status400 "dpop-handle-mismatch" "Bubbling up errors" certEnrollmentError (RustError DpopTeamMismatch) = StdError $ Wai.mkError status400 "dpop-team-mismatch" "Bubbling up errors" +certEnrollmentError (RustError DpopDisplayNameMismatch) = StdError $ Wai.mkError status400 "dpop-display-name-mismatch" "Bubbling up errors" certEnrollmentError NonceNotFound = StdError $ Wai.mkError status400 "client-token-bad-nonce" "The client sent an unacceptable anti-replay nonce" certEnrollmentError MisconfiguredRequestUrl = StdError $ Wai.mkError status500 "misconfigured-request-url" "The request url cannot be derived from optSettings.setFederationDomain in brig.yaml" certEnrollmentError KeyBundleError = StdError $ Wai.mkError status404 "no-server-key-bundle" "The key bundle required for the certificate enrollment process could not be found" certEnrollmentError ClientIdSyntaxError = StdError $ Wai.mkError status400 "client-token-id-parse-error" "The client id could not be parsed" certEnrollmentError NotATeamUser = StdError $ Wai.mkError status400 "not-a-team-user" "The user is not a team user" certEnrollmentError MissingHandle = StdError $ Wai.mkError status400 "missing-handle" "The user has no handle" +certEnrollmentError MissingName = StdError $ Wai.mkError status400 "missing-name" "The user has no name" fedError :: FederationError -> Error fedError = StdError . federationErrorToWai @@ -445,7 +448,7 @@ customerExtensionBlockedDomain domain = Wai.mkError (mkStatus 451 "Unavailable F where msg = "[Customer extension] the email domain " - <> cs (show domain) + <> LT.pack (show domain) <> " that you are attempting to register a user with has been \ \blocked for creating wire users. Please contact your IT department." diff --git a/services/brig/src/Brig/API/Federation.hs b/services/brig/src/Brig/API/Federation.hs index 7515577d073..9a6559663c6 100644 --- a/services/brig/src/Brig/API/Federation.hs +++ b/services/brig/src/Brig/API/Federation.hs @@ -36,7 +36,6 @@ import Brig.Effects.FederationConfigStore qualified as E import Brig.Effects.GalleyProvider (GalleyProvider) import Brig.IO.Intra (notify) import Brig.Options -import Brig.Types.User.Event import Brig.User.API.Handle import Brig.User.Search.SearchIndex qualified as Q import Control.Error.Util @@ -69,6 +68,7 @@ import Wire.API.User (UserProfile) import Wire.API.User.Client import Wire.API.User.Client.Prekey import Wire.API.User.Search hiding (searchPolicy) +import Wire.API.UserEvent import Wire.API.UserMap (UserMap) import Wire.NotificationSubsystem import Wire.Sem.Concurrency @@ -111,6 +111,7 @@ getFederationStatus _ request = do sendConnectionAction :: ( Member FederationConfigStore r, + Member GalleyProvider r, Member NotificationSubsystem r ) => Domain -> diff --git a/services/brig/src/Brig/API/Handler.hs b/services/brig/src/Brig/API/Handler.hs index bbea923f517..4c6e92e341a 100644 --- a/services/brig/src/Brig/API/Handler.hs +++ b/services/brig/src/Brig/API/Handler.hs @@ -18,11 +18,9 @@ module Brig.API.Handler ( -- * Handler Monad Handler, - runHandler, toServantHandler, -- * Utilities - JSON, parseJsonBody, checkAllowlist, checkAllowlistWithError, @@ -53,13 +51,9 @@ import Data.Text.Encoding qualified as Text import Data.ZAuth.Validation qualified as ZV import Imports import Network.HTTP.Types (Status (statusCode, statusMessage)) -import Network.Wai (Request, ResponseReceived) -import Network.Wai.Predicate (Media) -import Network.Wai.Routing (Continue) import Network.Wai.Utilities.Error ((!>>)) import Network.Wai.Utilities.Error qualified as WaiError import Network.Wai.Utilities.Request (JsonRequest, parseBody) -import Network.Wai.Utilities.Response (addHeader, json, setStatus) import Network.Wai.Utilities.Server qualified as Server import Servant qualified import System.Logger qualified as Log @@ -72,18 +66,6 @@ import Wire.API.Error.Brig type Handler r = ExceptT Error (AppT r) -runHandler :: - Env -> - Request -> - (Handler BrigCanonicalEffects) ResponseReceived -> - Continue IO -> - IO ResponseReceived -runHandler e r h k = do - a <- - runBrigToIO e (runExceptT h) - `catches` brigErrorHandlers (view applog e) (unRequestId (view requestId e)) - either (onError (view applog e) r k) pure a - toServantHandler :: Env -> (Handler BrigCanonicalEffects) a -> Servant.Handler a toServantHandler env action = do let logger = view applog env @@ -135,33 +117,12 @@ brigErrorHandlers logger reqId = throwIO e ] -onError :: Logger -> Request -> Continue IO -> Error -> IO ResponseReceived -onError g r k e = do - Server.logError g (Just r) we - -- This function exists to workaround a problem that existed in nginx 5 years - -- ago. Context here: - -- https://github.com/zinfra/wai-utilities/commit/3d7e8349d3463e5ee2c3ebe89c717baeef1a8241 - -- So, this can probably be deleted and is not part of the new servant - -- handler. - Server.flushRequestBody r - k - $ setStatus (WaiError.code we) - . appEndo (foldMap (Endo . uncurry addHeader) hs) - $ json e - where - (we, hs) = case e of - StdError x -> (x, []) - RichError x _ h -> (x, h) - ------------------------------------------------------------------------------- -- Utilities --- TODO: move to libs/wai-utilities? -type JSON = Media "application" "json" - --- TODO: move to libs/wai-utilities? there is a parseJson' in "Network.Wai.Utilities.Request", --- but adjusting its signature to this here would require to move more code out of brig (at least --- badRequest and probably all the other errors). +-- This could go to libs/wai-utilities. There is a `parseJson'` in +-- "Network.Wai.Utilities.Request", but adding `parseJsonBody` there would require to move +-- more code out of brig. parseJsonBody :: (FromJSON a, MonadIO m) => JsonRequest a -> ExceptT Error m a parseJsonBody req = parseBody req !>> StdError . badRequest diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index f811894c335..12e529d9886 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -15,9 +15,7 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . module Brig.API.Internal - ( sitemap, - servantSitemap, - BrigIRoutes.API, + ( servantSitemap, getMLSClients, ) where @@ -42,6 +40,7 @@ import Brig.Data.User qualified as Data import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) import Brig.Effects.BlacklistStore (BlacklistStore) import Brig.Effects.CodeStore (CodeStore) +import Brig.Effects.ConnectionStore (ConnectionStore) import Brig.Effects.FederationConfigStore (AddFederationRemoteResult (..), AddFederationRemoteTeamResult (..), FederationConfigStore, UpdateFederationResult (..)) import Brig.Effects.FederationConfigStore qualified as E import Brig.Effects.GalleyProvider (GalleyProvider) @@ -57,7 +56,6 @@ import Brig.Types.Connection import Brig.Types.Intra import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) import Brig.Types.User -import Brig.Types.User.Event (UserEvent (UserUpdated), UserUpdatedData (eupSSOId, eupSSOIdRemoved), emptyUserUpdatedData) import Brig.User.API.Search qualified as Search import Brig.User.EJPD qualified import Brig.User.Search.Index qualified as Index @@ -71,11 +69,14 @@ import Data.Id as Id import Data.Map.Strict qualified as Map import Data.Qualified import Data.Set qualified as Set +import Data.Text qualified as T +import Data.Text.Lazy qualified as LT +import Data.Time.Clock (UTCTime) import Data.Time.Clock.System import Imports hiding (head) -import Network.Wai.Routing hiding (toList) import Network.Wai.Utilities as Utilities import Polysemy +import Polysemy.Input (Input) import Polysemy.TinyLog (TinyLog) import Servant hiding (Handler, JSON, addHeader, respond) import Servant.OpenApi.Internal.Orphans () @@ -96,25 +97,29 @@ import Wire.API.User import Wire.API.User.Activation import Wire.API.User.Client import Wire.API.User.RichInfo +import Wire.API.UserEvent import Wire.NotificationSubsystem +import Wire.Rpc import Wire.Sem.Concurrency - ---------------------------------------------------------------------------- --- Sitemap (servant) +import Wire.Sem.Paging.Cassandra (InternalPaging) servantSitemap :: forall r p. - ( Member BlacklistStore r, + ( Member BlacklistPhonePrefixStore r, + Member BlacklistStore r, Member CodeStore r, - Member BlacklistPhonePrefixStore r, - Member PasswordResetStore r, - Member GalleyProvider r, - Member (UserPendingActivationStore p) r, - Member FederationConfigStore r, + Member (Concurrency 'Unsafe) r, + Member (ConnectionStore InternalPaging) r, Member (Embed HttpClientIO) r, + Member FederationConfigStore r, + Member GalleyProvider r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, Member NotificationSubsystem r, + Member PasswordResetStore r, + Member Rpc r, Member TinyLog r, - Member (Concurrency 'Unsafe) r + Member (UserPendingActivationStore p) r ) => ServerT BrigIRoutes.API (Handler r) servantSitemap = @@ -130,20 +135,19 @@ servantSitemap = :<|> internalOauthAPI :<|> internalSearchIndexAPI :<|> federationRemotesAPI + :<|> Provider.internalProviderAPI istatusAPI :: forall r. ServerT BrigIRoutes.IStatusAPI (Handler r) istatusAPI = Named @"get-status" (pure NoContent) ejpdAPI :: - (Member GalleyProvider r, Member NotificationSubsystem r) => - ServerT BrigIRoutes.EJPD_API (Handler r) + ( Member GalleyProvider r, + Member NotificationSubsystem r, + Member Rpc r + ) => + ServerT BrigIRoutes.EJPDRequest (Handler r) ejpdAPI = Brig.User.EJPD.ejpdRequest - :<|> Named @"get-account-conference-calling-config" getAccountConferenceCallingConfig - :<|> putAccountConferenceCallingConfig - :<|> deleteAccountConferenceCallingConfig - :<|> getConnectionsStatusUnqualified - :<|> getConnectionsStatus mlsAPI :: ServerT BrigIRoutes.MLSAPI (Handler r) mlsAPI = getMLSClients @@ -157,11 +161,19 @@ accountAPI :: Member (UserPendingActivationStore p) r, Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => ServerT BrigIRoutes.AccountAPI (Handler r) accountAPI = - Named @"createUserNoVerify" (callsFed (exposeAnnotations createUserNoVerify)) + Named @"get-account-conference-calling-config" getAccountConferenceCallingConfig + :<|> putAccountConferenceCallingConfig + :<|> deleteAccountConferenceCallingConfig + :<|> getConnectionsStatusUnqualified + :<|> getConnectionsStatus + :<|> Named @"createUserNoVerify" (callsFed (exposeAnnotations createUserNoVerify)) :<|> Named @"createUserNoVerifySpar" (callsFed (exposeAnnotations createUserNoVerifySpar)) :<|> Named @"putSelfEmail" changeSelfEmailMaybeSendH :<|> Named @"iDeleteUser" deleteUserNoAuthH @@ -201,7 +213,10 @@ teamsAPI :: Member (Embed HttpClientIO) r, Member NotificationSubsystem r, Member (Concurrency 'Unsafe) r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => ServerT BrigIRoutes.TeamsAPI (Handler r) teamsAPI = @@ -226,7 +241,10 @@ authAPI :: ( Member GalleyProvider r, Member TinyLog r, Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => ServerT BrigIRoutes.AuthAPI (Handler r) authAPI = @@ -280,24 +298,24 @@ addFederationRemote fedDomConf = do "keeping track of remote domains in the brig config file is deprecated, but as long as we \ \do that, adding a domain with different settings than in the config file is not allowed. want " <> ( "Just " - <> cs (show fedDomConf) + <> T.pack (show fedDomConf) <> "or Nothing, " ) <> ( "got " - <> cs (show (Map.lookup (domain fedDomConf) cfg)) + <> T.pack (show (Map.lookup (domain fedDomConf) cfg)) ) updateFederationRemote :: (Member FederationConfigStore r) => Domain -> FederationDomainConfig -> (Handler r) () updateFederationRemote dom fedcfg = do if (dom /= fedcfg.domain) then - throwError . fedError . FederationUnexpectedError . cs $ + throwError . fedError . FederationUnexpectedError . T.pack $ "federation domain of a given peer cannot be changed from " <> show (domain fedcfg) <> " to " <> show dom <> "." else lift (liftSem (E.updateFederationConfig fedcfg)) >>= \case UpdateFederationSuccess -> pure () UpdateFederationRemoteNotFound -> - throwError . fedError . FederationUnexpectedError . cs $ + throwError . fedError . FederationUnexpectedError . T.pack $ "federation domain does not exist and cannot be updated: " <> show (dom, fedcfg) UpdateFederationRemoteDivergingConfig -> throwError . fedError . FederationUnexpectedError $ @@ -352,16 +370,6 @@ internalSearchIndexAPI = :<|> Named @"indexReindex" (NoContent <$ lift (wrapClient Search.reindexAll)) :<|> Named @"indexReindexIfSameOrNewer" (NoContent <$ lift (wrapClient Search.reindexAllIfSameOrNewer)) ---------------------------------------------------------------------------- --- Sitemap (wai-route) - -sitemap :: - ( Member GalleyProvider r - ) => - Routes a (Handler r) () -sitemap = unsafeCallsFed @'Brig @"on-user-deleted-connections" $ do - Provider.routesInternal - --------------------------------------------------------------------------- -- Handlers @@ -370,7 +378,10 @@ addClientInternalH :: ( Member GalleyProvider r, Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> Maybe Bool -> @@ -386,7 +397,10 @@ addClientInternalH usr mSkipReAuth new connId = do legalHoldClientRequestedH :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> LegalHoldClientRequest -> @@ -397,7 +411,10 @@ legalHoldClientRequestedH targetUser clientRequest = do removeLegalHoldClientH :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> (Handler r) NoContent @@ -419,7 +436,10 @@ createUserNoVerify :: Member (UserPendingActivationStore p) r, Member TinyLog r, Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => NewUser -> (Handler r) (Either RegisterError SelfProfile) @@ -440,7 +460,10 @@ createUserNoVerifySpar :: ( Member GalleyProvider r, Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => NewUserSpar -> (Handler r) (Either CreateUserSparError SelfProfile) @@ -461,7 +484,10 @@ createUserNoVerifySpar uData = deleteUserNoAuthH :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> (Handler r) DeleteUserResponse @@ -547,7 +573,13 @@ listActivatedAccounts elh includePendingInvitations = do getActivationCodeH :: Maybe Email -> Maybe Phone -> (Handler r) GetActivationCodeResp getActivationCodeH (Just email) Nothing = getActivationCode (Left email) getActivationCodeH Nothing (Just phone) = getActivationCode (Right phone) -getActivationCodeH bade badp = throwStd (badRequest ("need exactly one of email, phone: " <> Imports.cs (show (bade, badp)))) +getActivationCodeH bade badp = + throwStd + ( badRequest + ( "need exactly one of email, phone: " + <> LT.pack (show (bade, badp)) + ) + ) getActivationCode :: Either Email Phone -> (Handler r) GetActivationCodeResp getActivationCode emailOrPhone = do @@ -563,7 +595,11 @@ getPasswordResetCodeH :: (Handler r) GetPasswordResetCodeResp getPasswordResetCodeH (Just email) Nothing = getPasswordResetCode (Left email) getPasswordResetCodeH Nothing (Just phone) = getPasswordResetCode (Right phone) -getPasswordResetCodeH bade badp = throwStd (badRequest ("need exactly one of email, phone: " <> Imports.cs (show (bade, badp)))) +getPasswordResetCodeH bade badp = + throwStd + ( badRequest + ("need exactly one of email, phone: " <> LT.pack (show (bade, badp))) + ) getPasswordResetCode :: ( Member CodeStore r, @@ -577,7 +613,10 @@ getPasswordResetCode emailOrPhone = changeAccountStatusH :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> AccountStatusUpdate -> @@ -622,17 +661,25 @@ getConnectionsStatus (ConnectionsStatusRequestV2 froms mtos mrel) = do revokeIdentityH :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => Maybe Email -> Maybe Phone -> (Handler r) NoContent revokeIdentityH (Just email) Nothing = lift $ NoContent <$ API.revokeIdentity (Left email) revokeIdentityH Nothing (Just phone) = lift $ NoContent <$ API.revokeIdentity (Right phone) -revokeIdentityH bade badp = throwStd (badRequest ("need exactly one of email, phone: " <> Imports.cs (show (bade, badp)))) +revokeIdentityH bade badp = + throwStd + ( badRequest + ("need exactly one of email, phone: " <> LT.pack (show (bade, badp))) + ) updateConnectionInternalH :: - ( Member NotificationSubsystem r, + ( Member GalleyProvider r, + Member NotificationSubsystem r, Member TinyLog r, Member (Embed HttpClientIO) r ) => @@ -645,7 +692,11 @@ updateConnectionInternalH updateConn = do checkBlacklistH :: Member BlacklistStore r => Maybe Email -> Maybe Phone -> (Handler r) CheckBlacklistResponse checkBlacklistH (Just email) Nothing = checkBlacklist (Left email) checkBlacklistH Nothing (Just phone) = checkBlacklist (Right phone) -checkBlacklistH bade badp = throwStd (badRequest ("need exactly one of email, phone: " <> Imports.cs (show (bade, badp)))) +checkBlacklistH bade badp = + throwStd + ( badRequest + ("need exactly one of email, phone: " <> LT.pack (show (bade, badp))) + ) checkBlacklist :: Member BlacklistStore r => Either Email Phone -> (Handler r) CheckBlacklistResponse checkBlacklist emailOrPhone = lift $ bool NotBlacklisted YesBlacklisted <$> API.isBlacklisted emailOrPhone @@ -653,7 +704,11 @@ checkBlacklist emailOrPhone = lift $ bool NotBlacklisted YesBlacklisted <$> API. deleteFromBlacklistH :: Member BlacklistStore r => Maybe Email -> Maybe Phone -> (Handler r) NoContent deleteFromBlacklistH (Just email) Nothing = deleteFromBlacklist (Left email) deleteFromBlacklistH Nothing (Just phone) = deleteFromBlacklist (Right phone) -deleteFromBlacklistH bade badp = throwStd (badRequest ("need exactly one of email, phone: " <> Imports.cs (show (bade, badp)))) +deleteFromBlacklistH bade badp = + throwStd + ( badRequest + ("need exactly one of email, phone: " <> LT.pack (show (bade, badp))) + ) deleteFromBlacklist :: Member BlacklistStore r => Either Email Phone -> (Handler r) NoContent deleteFromBlacklist emailOrPhone = lift $ NoContent <$ API.blacklistDelete emailOrPhone @@ -661,7 +716,11 @@ deleteFromBlacklist emailOrPhone = lift $ NoContent <$ API.blacklistDelete email addBlacklistH :: Member BlacklistStore r => Maybe Email -> Maybe Phone -> (Handler r) NoContent addBlacklistH (Just email) Nothing = addBlacklist (Left email) addBlacklistH Nothing (Just phone) = addBlacklist (Right phone) -addBlacklistH bade badp = throwStd (badRequest ("need exactly one of email, phone: " <> Imports.cs (show (bade, badp)))) +addBlacklistH bade badp = + throwStd + ( badRequest + ("need exactly one of email, phone: " <> LT.pack (show (bade, badp))) + ) addBlacklist :: Member BlacklistStore r => Either Email Phone -> (Handler r) NoContent addBlacklist emailOrPhone = lift $ NoContent <$ API.blacklistInsert emailOrPhone @@ -685,7 +744,10 @@ addPhonePrefixH prefix = lift $ NoContent <$ API.phonePrefixInsert prefix updateSSOIdH :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> UserSSOId -> @@ -701,7 +763,10 @@ updateSSOIdH uid ssoid = do deleteSSOIdH :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> (Handler r) UpdateSSOIdResponse @@ -766,7 +831,10 @@ updateHandleH :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, Member GalleyProvider r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> HandleUpdate -> @@ -780,7 +848,10 @@ updateUserNameH :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, Member GalleyProvider r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> NameUpdate -> diff --git a/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs b/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs index 0783663e807..16707b15ff4 100644 --- a/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs +++ b/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs @@ -34,7 +34,7 @@ import Data.ByteString qualified as LBS import Data.Qualified import Data.Time.Clock import Data.Time.Clock.POSIX -import Imports hiding (cs) +import Imports import Wire.API.Error import Wire.API.Error.Brig import Wire.API.MLS.CipherSuite diff --git a/services/brig/src/Brig/API/OAuth.hs b/services/brig/src/Brig/API/OAuth.hs index 43453f45548..8643e8eff6d 100644 --- a/services/brig/src/Brig/API/OAuth.hs +++ b/services/brig/src/Brig/API/OAuth.hs @@ -39,6 +39,7 @@ import Data.Id import Data.Misc import Data.Set qualified as Set import Data.Text.Ascii +import Data.Text.Encoding qualified as T import Data.Time import Imports hiding (exp) import OpenSSL.Random (randBytes) @@ -125,13 +126,40 @@ createNewOAuthAuthorizationCode :: UserId -> CreateOAuthAuthorizationCodeRequest createNewOAuthAuthorizationCode uid code = do runExceptT (validateAndCreateAuthorizationCode uid code) >>= \case Right oauthCode -> - pure $ CreateOAuthCodeSuccess $ code.redirectUri & addParams [("code", toByteString' oauthCode), ("state", cs code.state)] + pure $ + CreateOAuthCodeSuccess $ + code.redirectUri + & addParams + [ ("code", toByteString' oauthCode), + ("state", T.encodeUtf8 code.state) + ] Left CreateNewOAuthCodeErrorFeatureDisabled -> - pure $ CreateOAuthCodeFeatureDisabled $ code.redirectUri & addParams [("error", "access_denied"), ("error_description", "OAuth is not enabled"), ("state", cs code.state)] + pure $ + CreateOAuthCodeFeatureDisabled $ + code.redirectUri + & addParams + [ ("error", "access_denied"), + ("error_description", "OAuth is not enabled"), + ("state", T.encodeUtf8 code.state) + ] Left CreateNewOAuthCodeErrorClientNotFound -> - pure $ CreateOAuthCodeClientNotFound $ code.redirectUri & addParams [("error", "access_denied"), ("error_description", "The client ID was not found"), ("state", cs code.state)] + pure $ + CreateOAuthCodeClientNotFound $ + code.redirectUri + & addParams + [ ("error", "access_denied"), + ("error_description", "The client ID was not found"), + ("state", T.encodeUtf8 code.state) + ] Left CreateNewOAuthCodeErrorUnsupportedResponseType -> - pure $ CreateOAuthCodeUnsupportedResponseType $ code.redirectUri & addParams [("error", "access_denied"), ("error_description", "The client ID was not found"), ("state", cs code.state)] + pure $ + CreateOAuthCodeUnsupportedResponseType $ + code.redirectUri + & addParams + [ ("error", "access_denied"), + ("error_description", "The client ID was not found"), + ("state", T.encodeUtf8 code.state) + ] Left CreateNewOAuthCodeErrorRedirectUrlMissMatch -> pure CreateOAuthCodeRedirectUrlMissMatch diff --git a/services/brig/src/Brig/API/Properties.hs b/services/brig/src/Brig/API/Properties.hs index 3443ace2956..814b899962a 100644 --- a/services/brig/src/Brig/API/Properties.hs +++ b/services/brig/src/Brig/API/Properties.hs @@ -30,25 +30,25 @@ import Brig.App import Brig.Data.Properties (PropertiesDataError) import Brig.Data.Properties qualified as Data import Brig.IO.Intra qualified as Intra -import Brig.Types.User.Event import Control.Error import Data.Id import Imports import Polysemy import Wire.API.Properties +import Wire.API.UserEvent import Wire.NotificationSubsystem setProperty :: (Member NotificationSubsystem r) => UserId -> ConnId -> PropertyKey -> PropertyValue -> ExceptT PropertiesDataError (AppT r) () setProperty u c k v = do wrapClientE $ Data.insertProperty u k (propertyRaw v) - lift $ liftSem $ Intra.onPropertyEvent u c (PropertySet u k v) + lift $ liftSem $ Intra.onPropertyEvent u c (PropertySet k (propertyValue v)) deleteProperty :: (Member NotificationSubsystem r) => UserId -> ConnId -> PropertyKey -> AppT r () deleteProperty u c k = do wrapClient $ Data.deleteProperty u k - liftSem $ Intra.onPropertyEvent u c (PropertyDeleted u k) + liftSem $ Intra.onPropertyEvent u c (PropertyDeleted k) clearProperties :: (Member NotificationSubsystem r) => UserId -> ConnId -> AppT r () clearProperties u c = do wrapClient $ Data.clearProperties u - liftSem $ Intra.onPropertyEvent u c (PropertiesCleared u) + liftSem $ Intra.onPropertyEvent u c PropertiesCleared diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 8beab24c7d3..f4d77b27a52 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -48,12 +48,14 @@ import Brig.Data.UserKey qualified as UserKey import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) import Brig.Effects.BlacklistStore (BlacklistStore) import Brig.Effects.CodeStore (CodeStore) +import Brig.Effects.ConnectionStore (ConnectionStore) import Brig.Effects.FederationConfigStore (FederationConfigStore) import Brig.Effects.GalleyProvider (GalleyProvider) import Brig.Effects.GalleyProvider qualified as GalleyProvider import Brig.Effects.JwtTools (JwtTools) import Brig.Effects.PasswordResetStore (PasswordResetStore) import Brig.Effects.PublicKeyBundle (PublicKeyBundle) +import Brig.Effects.SFT import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import Brig.Options hiding (internalEvents, sesQueue) import Brig.Provider.API @@ -76,8 +78,10 @@ import Control.Monad.Catch (throwM) import Control.Monad.Except import Data.Aeson hiding (json) import Data.Bifunctor +import Data.ByteString (fromStrict, toStrict) import Data.ByteString.Lazy qualified as Lazy import Data.ByteString.Lazy.Char8 qualified as LBS +import Data.ByteString.UTF8 qualified as UTF8 import Data.CommaSeparatedList import Data.Domain import Data.FileEmbed @@ -93,14 +97,16 @@ import Data.Range import Data.Schema () import Data.Text qualified as Text import Data.Text.Ascii qualified as Ascii +import Data.Text.Encoding qualified as Text import Data.Text.Lazy (pack) +import Data.Time.Clock (UTCTime) import Data.ZAuth.Token qualified as ZAuth import FileEmbedLzma -import Galley.Types.Teams (HiddenPerm (..), hasPermission) import Imports hiding (head) import Network.Socket (PortNumber) import Network.Wai.Utilities as Utilities import Polysemy +import Polysemy.Input (Input) import Polysemy.TinyLog (TinyLog) import Servant hiding (Handler, JSON, addHeader, respond) import Servant qualified @@ -139,6 +145,7 @@ import Wire.API.SwaggerHelper (cleanupSwagger) import Wire.API.SystemSettings import Wire.API.Team qualified as Public import Wire.API.Team.LegalHold (LegalholdProtectee (..)) +import Wire.API.Team.Member (HiddenPerm (..), hasPermission) import Wire.API.User (RegisterError (RegisterErrorAllowlistError)) import Wire.API.User qualified as Public import Wire.API.User.Activation qualified as Public @@ -155,6 +162,7 @@ import Wire.NotificationSubsystem import Wire.Sem.Concurrency import Wire.Sem.Jwk (Jwk) import Wire.Sem.Now (Now) +import Wire.Sem.Paging.Cassandra (InternalPaging) -- User API ----------------------------------------------------------- @@ -212,7 +220,7 @@ versionedSwaggerDocsAPI Nothing = allroutes (throwError listAllVersionsResp) Servant.Server (SwaggerSchemaUI "swagger-ui" "swagger.json") allroutes action = -- why? see 'SwaggerSchemaUI' type. - action :<|> action :<|> action :<|> error (cs listAllVersionsHTML) + action :<|> action :<|> action :<|> error (UTF8.toString . toStrict $ listAllVersionsHTML) listAllVersionsResp :: ServerError listAllVersionsResp = ServerError 200 mempty listAllVersionsHTML [("Content-Type", "text/html;charset=utf-8")] @@ -222,7 +230,11 @@ versionedSwaggerDocsAPI Nothing = allroutes (throwError listAllVersionsResp) "

please pick an api version

" <> mconcat [ let url = "/" <> toQueryParam v <> "/api/swagger-ui/" - in " cs url <> "\">" <> cs url <> "
" + in " (fromStrict . Text.encodeUtf8 $ url) + <> "\">" + <> (fromStrict . Text.encodeUtf8 $ url) + <> "
" | v <- [minBound :: Version ..] ] <> "" @@ -266,17 +278,22 @@ servantSitemap :: Member BlacklistStore r, Member CodeStore r, Member (Concurrency 'Unsafe) r, + Member (ConnectionStore InternalPaging) r, + Member (Embed HttpClientIO) r, + Member (Embed IO) r, + Member FederationConfigStore r, Member GalleyProvider r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member Jwk r, Member JwtTools r, + Member NotificationSubsystem r, Member Now r, Member PasswordResetStore r, Member PublicKeyBundle r, - Member (UserPendingActivationStore p) r, - Member Jwk r, - Member FederationConfigStore r, - Member (Embed HttpClientIO) r, - Member NotificationSubsystem r, - Member TinyLog r + Member SFT r, + Member TinyLog r, + Member (UserPendingActivationStore p) r ) => ServerT BrigAPI (Handler r) servantSitemap = @@ -362,10 +379,13 @@ servantSitemap = userClientAPI :: ServerT UserClientAPI (Handler r) userClientAPI = - Named @"add-client" (callsFed (exposeAnnotations addClient)) + Named @"add-client-v5" (callsFed (exposeAnnotations addClient)) + :<|> Named @"add-client" (callsFed (exposeAnnotations addClient)) :<|> Named @"update-client" updateClient :<|> Named @"delete-client" deleteClient + :<|> Named @"list-clients-v5" listClients :<|> Named @"list-clients" listClients + :<|> Named @"get-client-v5" getClient :<|> Named @"get-client" getClient :<|> Named @"get-client-capabilities" getClientCapabilities :<|> Named @"get-client-prekeys" getClientPrekeys @@ -563,22 +583,21 @@ addClient :: ( Member GalleyProvider r, Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> ConnId -> Public.NewClient -> - (Handler r) NewClientResponse + Handler r Public.Client addClient usr con new = do -- Users can't add legal hold clients when (Public.newClientType new == Public.LegalHoldClientType) $ throwE (clientError ClientLegalHoldCannotBeAdded) - clientResponse - <$> API.addClient usr (Just con) new - !>> clientError - where - clientResponse :: Public.Client -> NewClientResponse - clientResponse client = Servant.addHeader (Public.clientId client) client + API.addClient usr (Just con) new + !>> clientError deleteClient :: UserId -> ConnId -> ClientId -> Public.RmClient -> (Handler r) () deleteClient usr con clt body = @@ -686,7 +705,10 @@ createUser :: Member (UserPendingActivationStore p) r, Member TinyLog r, Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => Public.NewUserPublic -> (Handler r) (Either Public.RegisterError Public.RegisterSuccess) @@ -718,9 +740,10 @@ createUser (Public.NewUserPublic new) = lift . runExceptT $ do ) lift . Log.info $ context . Log.msg @Text "Sucessfully created user" - let Public.User {userLocale, userDisplayName, userId} = usr - let userEmail = Public.userEmail usr - let userPhone = Public.userPhone usr + let Public.User {userLocale, userDisplayName} = usr + userEmail = Public.userEmail usr + userPhone = Public.userPhone usr + userId = Public.userId usr lift $ do for_ (liftM2 (,) userEmail epair) $ \(e, p) -> sendActivationEmail e userDisplayName p (Just userLocale) newUserTeam @@ -878,7 +901,10 @@ updateUser :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, Member GalleyProvider r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> ConnId -> @@ -905,7 +931,10 @@ changePhone u _ (Public.puPhone -> phone) = lift . exceptTToMaybe $ do removePhone :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> ConnId -> @@ -916,7 +945,10 @@ removePhone self conn = removeEmail :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> ConnId -> @@ -933,7 +965,10 @@ changePassword u cp = lift . exceptTToMaybe $ API.changePassword u cp changeLocale :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> ConnId -> @@ -944,7 +979,10 @@ changeLocale u conn l = lift $ API.changeLocale u conn l changeSupportedProtocols :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => Local UserId -> ConnId -> @@ -988,7 +1026,10 @@ changeHandle :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, Member GalleyProvider r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> ConnId -> @@ -1081,7 +1122,8 @@ createConnection self conn target = do API.createConnection lself conn target !>> connError updateLocalConnection :: - ( Member NotificationSubsystem r, + ( Member GalleyProvider r, + Member NotificationSubsystem r, Member TinyLog r, Member (Embed HttpClientIO) r ) => @@ -1100,7 +1142,8 @@ updateConnection :: ( Member FederationConfigStore r, Member NotificationSubsystem r, Member TinyLog r, - Member (Embed HttpClientIO) r + Member (Embed HttpClientIO) r, + Member GalleyProvider r ) => UserId -> ConnId -> @@ -1174,7 +1217,10 @@ deleteSelfUser :: ( Member GalleyProvider r, Member TinyLog r, Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> Public.DeleteUser -> @@ -1185,7 +1231,10 @@ deleteSelfUser u body = do verifyDeleteUser :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => Public.VerifyDeleteUser -> Handler r () @@ -1226,7 +1275,10 @@ activate :: ( Member GalleyProvider r, Member TinyLog r, Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => Public.ActivationKey -> Public.ActivationCode -> @@ -1240,7 +1292,10 @@ activateKey :: ( Member GalleyProvider r, Member TinyLog r, Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => Public.Activate -> (Handler r) ActivationRespWithStatus diff --git a/services/brig/src/Brig/API/Types.hs b/services/brig/src/Brig/API/Types.hs index bdc0a3548e7..721ec2cde36 100644 --- a/services/brig/src/Brig/API/Types.hs +++ b/services/brig/src/Brig/API/Types.hs @@ -214,6 +214,7 @@ data CertEnrollmentError | ClientIdSyntaxError | NotATeamUser | MissingHandle + | MissingName ------------------------------------------------------------------------------- -- Exceptions diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index bd5c84d555c..05e4a2b43aa 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -115,6 +115,7 @@ import Brig.Effects.BlacklistStore (BlacklistStore) import Brig.Effects.BlacklistStore qualified as BlacklistStore import Brig.Effects.CodeStore (CodeStore) import Brig.Effects.CodeStore qualified as E +import Brig.Effects.ConnectionStore (ConnectionStore) import Brig.Effects.GalleyProvider import Brig.Effects.GalleyProvider qualified as GalleyProvider import Brig.Effects.PasswordResetStore (PasswordResetStore) @@ -131,7 +132,6 @@ import Brig.Team.Types (ShowOrHideInvitationUrl (..)) import Brig.Types.Activation (ActivationPair) import Brig.Types.Connection import Brig.Types.Intra -import Brig.Types.User.Event import Brig.User.Auth.Cookie (listCookies, revokeAllCookies) import Brig.User.Email import Brig.User.Handle @@ -140,7 +140,6 @@ import Brig.User.Phone import Brig.User.Search.Index (reindex) import Brig.User.Search.TeamSize qualified as TeamSize import Cassandra hiding (Set) -import Control.Arrow ((&&&)) import Control.Error import Control.Lens (view, (^.)) import Control.Monad.Catch @@ -153,16 +152,15 @@ import Data.Json.Util import Data.LegalHold (UserLegalHoldStatus (..), defUserLegalHoldStatus) import Data.List.Extra import Data.List1 as List1 (List1, singleton) -import Data.Map.Strict qualified as Map import Data.Metrics qualified as Metrics import Data.Misc import Data.Qualified -import Data.Time.Clock (addUTCTime, diffUTCTime) +import Data.Time.Clock (UTCTime, addUTCTime, diffUTCTime) import Data.UUID.V4 (nextRandom) -import Galley.Types.Teams qualified as Team -import Imports hiding (cs) +import Imports import Network.Wai.Utilities import Polysemy +import Polysemy.Input (Input) import Polysemy.TinyLog (TinyLog) import Polysemy.TinyLog qualified as Log import System.Logger.Class (MonadLogger) @@ -173,7 +171,6 @@ import Wire.API.Error import Wire.API.Error.Brig qualified as E import Wire.API.Federation.Error import Wire.API.Password -import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.Internal.Galley.TeamsIntra qualified as Team import Wire.API.Team hiding (newTeam) import Wire.API.Team.Feature @@ -187,8 +184,10 @@ import Wire.API.User.Activation import Wire.API.User.Client import Wire.API.User.Password import Wire.API.User.RichInfo +import Wire.API.UserEvent import Wire.NotificationSubsystem import Wire.Sem.Concurrency +import Wire.Sem.Paging.Cassandra (InternalPaging) data AllowSCIMUpdates = AllowSCIMUpdates @@ -232,7 +231,10 @@ createUserSpar :: ( Member GalleyProvider r, Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => NewUserSpar -> ExceptT CreateUserSparError (AppT r) CreateUserResult @@ -302,7 +304,10 @@ createUser :: Member (UserPendingActivationStore p) r, Member TinyLog r, Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => NewUser -> ExceptT RegisterError (AppT r) CreateUserResult @@ -548,10 +553,9 @@ createUserInviteViaScim :: Member (UserPendingActivationStore p) r, Member TinyLog r ) => - UserId -> NewUserScimInvitation -> ExceptT Error.Error (AppT r) UserAccount -createUserInviteViaScim uid (NewUserScimInvitation tid loc name rawEmail _) = do +createUserInviteViaScim (NewUserScimInvitation tid uid loc name rawEmail _) = do email <- either (const . throwE . Error.StdError $ errorToWai @'E.InvalidEmail) pure (validateEmail rawEmail) let emKey = userEmailKey email verifyUniquenessAndCheckBlacklist emKey !>> identityErrorToBrigError @@ -592,7 +596,10 @@ updateUser :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, Member GalleyProvider r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> Maybe ConnId -> @@ -623,7 +630,10 @@ updateUser uid mconn uu allowScim = do changeLocale :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> ConnId -> @@ -639,7 +649,10 @@ changeLocale uid conn (LocaleUpdate loc) = do changeManagedBy :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> ConnId -> @@ -655,7 +668,10 @@ changeManagedBy uid conn (ManagedByUpdate mb) = do changeSupportedProtocols :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> ConnId -> @@ -672,7 +688,10 @@ changeHandle :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, Member GalleyProvider r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> Maybe ConnId -> @@ -840,7 +859,10 @@ changePhone u phone = do removeEmail :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> ConnId -> @@ -861,7 +883,10 @@ removeEmail uid conn = do removePhone :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> ConnId -> @@ -887,7 +912,10 @@ revokeIdentity :: forall r. ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => Either Email Phone -> AppT r () @@ -930,7 +958,10 @@ changeAccountStatus :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, Member (Concurrency 'Unsafe) r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => List1 UserId -> AccountStatus -> @@ -950,7 +981,10 @@ changeAccountStatus usrs status = do changeSingleAccountStatus :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> AccountStatus -> @@ -980,7 +1014,10 @@ activate :: ( Member GalleyProvider r, Member TinyLog r, Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => ActivationTarget -> ActivationCode -> @@ -993,7 +1030,10 @@ activateWithCurrency :: ( Member GalleyProvider r, Member TinyLog r, Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => ActivationTarget -> ActivationCode -> @@ -1037,7 +1077,10 @@ preverify tgt code = do onActivated :: ( Member TinyLog r, Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => ActivationEvent -> (AppT r) (UserId, Maybe UserIdentity, Bool) @@ -1265,7 +1308,10 @@ deleteSelfUser :: ( Member GalleyProvider r, Member TinyLog r, Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> Maybe PlainTextPassword6 -> @@ -1346,7 +1392,10 @@ deleteSelfUser uid pwd = do verifyDeleteUser :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => VerifyDeleteUser -> ExceptT DeleteUserError (AppT r) () @@ -1364,7 +1413,10 @@ verifyDeleteUser d = do ensureAccountDeleted :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> AppT r DeleteUserResult @@ -1404,7 +1456,10 @@ ensureAccountDeleted uid = do deleteAccount :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserAccount -> Sem r () @@ -1601,22 +1656,17 @@ lookupLocalProfiles :: AppT r [UserProfile] lookupLocalProfiles requestingUser others = do users <- wrapHttpClient $ Data.lookupUsers NoPendingInvitations others >>= mapM userGC - css <- case requestingUser of - Just localReqUser -> toMap <$> wrapHttpClient (Data.lookupConnectionStatus (map userId users) [localReqUser]) - Nothing -> pure mempty - emailVisibility' <- view (settings . emailVisibility) - emailVisibility'' <- case emailVisibility' of - EmailVisibleIfOnTeam -> pure EmailVisibleIfOnTeam' - EmailVisibleIfOnSameTeam -> case requestingUser of - Just localReqUser -> EmailVisibleIfOnSameTeam' <$> getSelfInfo localReqUser - Nothing -> pure EmailVisibleToSelf' - EmailVisibleToSelf -> pure EmailVisibleToSelf' + emailVisibilityConfig <- view (settings . emailVisibility) + emailVisibilityConfigWithViewer <- + case emailVisibilityConfig of + EmailVisibleIfOnTeam -> pure EmailVisibleIfOnTeam + EmailVisibleToSelf -> pure EmailVisibleToSelf + EmailVisibleIfOnSameTeam () -> + EmailVisibleIfOnSameTeam . join @Maybe + <$> traverse getSelfInfo requestingUser usersAndStatus <- liftSem $ for users $ \u -> (u,) <$> getLegalHoldStatus' u - pure $ map (toProfile emailVisibility'' css) usersAndStatus + pure $ map (uncurry $ mkUserProfile emailVisibilityConfigWithViewer) usersAndStatus where - toMap :: [ConnectionStatus] -> Map UserId Relation - toMap = Map.fromList . map (csFrom &&& csStatus) - getSelfInfo :: UserId -> AppT r (Maybe (TeamId, TeamMember)) getSelfInfo selfId = do -- FUTUREWORK: it is an internal error for the two lookups (for 'User' and 'TeamMember') @@ -1627,16 +1677,6 @@ lookupLocalProfiles requestingUser others = do Nothing -> pure Nothing Just tid -> (tid,) <$$> liftSem (GalleyProvider.getTeamMember selfId tid) - toProfile :: EmailVisibility' -> Map UserId Relation -> (User, UserLegalHoldStatus) -> UserProfile - toProfile emailVisibility'' css (u, userLegalHold) = - let cs = Map.lookup (userId u) css - profileEmail' = getEmailForProfile u emailVisibility'' - baseProfile = - if Just (userId u) == requestingUser || cs == Just Accepted || cs == Just Sent - then connectedProfile u userLegalHold - else publicProfile u userLegalHold - in baseProfile {profileEmail = profileEmail'} - getLegalHoldStatus :: Member GalleyProvider r => UserId -> @@ -1654,28 +1694,6 @@ getLegalHoldStatus' user = teamMember <- GalleyProvider.getTeamMember (userId user) tid pure $ maybe defUserLegalHoldStatus (^. legalHoldStatus) teamMember -data EmailVisibility' - = EmailVisibleIfOnTeam' - | EmailVisibleIfOnSameTeam' (Maybe (TeamId, TeamMember)) - | EmailVisibleToSelf' - --- | Gets the email if it's visible to the requester according to configured settings -getEmailForProfile :: - User -> - EmailVisibility' -> - Maybe Email -getEmailForProfile profileOwner EmailVisibleIfOnTeam' = - if isJust (userTeam profileOwner) - then userEmail profileOwner - else Nothing -getEmailForProfile profileOwner (EmailVisibleIfOnSameTeam' (Just (viewerTeamId, viewerTeamMember))) = - if Just viewerTeamId == userTeam profileOwner - && Team.hasPermission viewerTeamMember Team.ViewSameTeamEmails - then userEmail profileOwner - else Nothing -getEmailForProfile _ (EmailVisibleIfOnSameTeam' Nothing) = Nothing -getEmailForProfile _ EmailVisibleToSelf' = Nothing - -- | Find user accounts for a given identity, both activated and those -- currently pending activation. lookupAccountsByIdentity :: Either Email Phone -> Bool -> (AppT r) [UserAccount] diff --git a/services/brig/src/Brig/API/Util.hs b/services/brig/src/Brig/API/Util.hs index 67693d37300..54f04975a51 100644 --- a/services/brig/src/Brig/API/Util.hs +++ b/services/brig/src/Brig/API/Util.hs @@ -48,6 +48,7 @@ import Data.Handle (Handle, parseHandle) import Data.Id import Data.Maybe import Data.Qualified +import Data.Text qualified as T import Data.Text.Ascii (AsciiText (toText)) import Imports import Polysemy @@ -88,7 +89,7 @@ validateHandle = maybe (throwStd (errorToWai @'InvalidHandle)) pure . parseHandl logEmail :: Email -> (Msg -> Msg) logEmail email = - Log.field "email_sha256" (sha256String . cs . show $ email) + Log.field "email_sha256" (sha256String . T.pack . show $ email) logInvitationCode :: InvitationCode -> (Msg -> Msg) logInvitationCode code = Log.field "invitation_code" (toText $ fromInvitationCode code) diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index 80c938c5d06..4a25928751a 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -37,6 +37,7 @@ module Brig.App galley, galleyEndpoint, gundeckEndpoint, + cargoholdEndpoint, federator, casClient, userTemplates, @@ -65,15 +66,16 @@ module Brig.App rabbitmqChannel, fsWatcher, disabledVersions, + enableSFTFederation, + mkIndexEnv, -- * App Monad AppT (..), viewFederationDomain, qualifyLocal, + qualifyLocal', - -- * Crutches that should be removed once Brig has been completely - - -- * transitioned to Polysemy + -- * Crutches that should be removed once Brig has been completely transitioned to Polysemy wrapClient, wrapClientE, wrapClientM, @@ -85,6 +87,7 @@ module Brig.App liftSem, lowerAppT, temporaryGetEnv, + initHttpManagerWithTLSConfig, ) where @@ -94,7 +97,7 @@ import Bilge.IO import Bilge.RPC (HasRequestId (..)) import Brig.AWS qualified as AWS import Brig.Calling qualified as Calling -import Brig.Options (Opts, Settings) +import Brig.Options (ElasticSearchOpts, Opts, Settings (..)) import Brig.Options qualified as Opt import Brig.Provider.Template import Brig.Queue.Stomp qualified as Stomp @@ -116,6 +119,7 @@ import Control.Lens hiding (index, (.=)) import Control.Monad.Catch import Control.Monad.Trans.Resource import Data.ByteString.Conversion +import Data.Credentials (Credentials (..)) import Data.Domain import Data.Metrics (Metrics) import Data.Metrics.Middleware qualified as Metrics @@ -126,7 +130,6 @@ import Data.Text.Encoding (encodeUtf8) import Data.Text.Encoding qualified as Text import Data.Text.IO qualified as Text import Data.Time.Clock -import Data.Yaml (FromJSON) import Database.Bloodhound qualified as ES import HTTP2.Client.Manager (Http2Manager, http2ManagerWithSSLCtx) import Imports @@ -139,6 +142,7 @@ import OpenSSL.Session (SSLOption (..)) import OpenSSL.Session qualified as SSL import Polysemy import Polysemy.Final +import Polysemy.Input (Input, input) import Ropes.Nexmo qualified as Nexmo import Ropes.Twilio qualified as Twilio import Ssl.Util @@ -162,6 +166,7 @@ data Env = Env _galley :: RPC.Request, _galleyEndpoint :: 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? _casClient :: Cas.ClientState, _smtpEnv :: Maybe SMTP.SMTP, @@ -193,7 +198,8 @@ data Env = Env _randomPrekeyLocalLock :: Maybe (MVar ()), _keyPackageLocalLock :: MVar (), _rabbitmqChannel :: Maybe (MVar Q.Channel), - _disabledVersions :: Set Version + _disabledVersions :: Set Version, + _enableSFTFederation :: Maybe Bool } makeLenses ''Env @@ -244,7 +250,7 @@ newEnv o = do eventsQueue <- case Opt.internalEventsQueue (Opt.internalEvents o) of StompQueue q -> pure (StompQueue q) SqsQueue q -> SqsQueue <$> AWS.getQueueUrl (aws ^. AWS.amazonkaEnv) q - mSFTEnv <- mapM Calling.mkSFTEnv $ Opt.sft o + mSFTEnv <- mapM (Calling.mkSFTEnv sha512) $ Opt.sft o prekeyLocalLock <- case Opt.randomPrekeys o of Just True -> do Log.info lgr $ Log.msg (Log.val "randomPrekeys: active") @@ -255,13 +261,14 @@ newEnv o = do kpLock <- newMVar () rabbitChan <- traverse (Q.mkRabbitMqChannelMVar lgr) o.rabbitmq let allDisabledVersions = foldMap expandVersionExp (Opt.setDisabledAPIVersions sett) - + idxEnv <- mkIndexEnv o.elasticsearch lgr mtr (Opt.galley o) mgr pure $! Env { _cargohold = mkEndpoint $ Opt.cargohold o, _galley = mkEndpoint $ Opt.galley o, _galleyEndpoint = Opt.galley o, _gundeckEndpoint = Opt.gundeck o, + _cargoholdEndpoint = Opt.cargohold o, _federator = Opt.federatorInternal o, _casClient = cas, _smtpEnv = emailSMTP, @@ -289,11 +296,12 @@ newEnv o = do _zauthEnv = zau, _digestMD5 = md5, _digestSHA256 = sha256, - _indexEnv = mkIndexEnv o lgr mgr mtr (Opt.galley o), + _indexEnv = idxEnv, _randomPrekeyLocalLock = prekeyLocalLock, _keyPackageLocalLock = kpLock, _rabbitmqChannel = rabbitChan, - _disabledVersions = allDisabledVersions + _disabledVersions = allDisabledVersions, + _enableSFTFederation = Opt.multiSFT o } where emailConn _ (Opt.EmailAWS aws) = pure (Just aws, Nothing) @@ -308,14 +316,33 @@ newEnv o = do pure (Nothing, Just smtp) mkEndpoint service = RPC.host (encodeUtf8 (service ^. host)) . RPC.port (service ^. port) $ RPC.empty -mkIndexEnv :: Opts -> Logger -> Manager -> Metrics -> Endpoint -> IndexEnv -mkIndexEnv o lgr mgr mtr galleyEp = - let bhe = ES.mkBHEnv (ES.Server (Opt.url (Opt.elasticsearch o))) mgr - lgr' = Log.clone (Just "index.brig") lgr - mainIndex = ES.IndexName $ Opt.index (Opt.elasticsearch o) - additionalIndex = ES.IndexName <$> Opt.additionalWriteIndex (Opt.elasticsearch o) - additionalBhe = flip ES.mkBHEnv mgr . ES.Server <$> Opt.additionalWriteIndexUrl (Opt.elasticsearch o) - in IndexEnv mtr lgr' bhe Nothing mainIndex additionalIndex additionalBhe galleyEp mgr +mkIndexEnv :: ElasticSearchOpts -> Logger -> Metrics -> Endpoint -> Manager -> IO IndexEnv +mkIndexEnv esOpts logger metricsStorage galleyEp rpcHttpManager = do + mEsCreds :: Maybe Credentials <- for esOpts.credentials initCredentials + mEsAddCreds :: Maybe Credentials <- for esOpts.additionalCredentials initCredentials + + let mkBhEnv skipVerifyTls mCustomCa mCreds url = do + mgr <- initHttpManagerWithTLSConfig skipVerifyTls mCustomCa + let bhe = ES.mkBHEnv url mgr + pure $ maybe bhe (\creds -> bhe {ES.bhRequestHook = ES.basicAuthHook (ES.EsUsername creds.username) (ES.EsPassword creds.password)}) mCreds + esLogger = Log.clone (Just "index.brig") logger + bhEnv <- mkBhEnv esOpts.insecureSkipVerifyTls esOpts.caCert mEsCreds esOpts.url + additionalBhEnv <- + for esOpts.additionalWriteIndexUrl $ + mkBhEnv esOpts.additionalInsecureSkipVerifyTls esOpts.additionalCaCert mEsAddCreds + pure $ + IndexEnv + { idxMetrics = metricsStorage, + idxLogger = esLogger, + idxElastic = bhEnv, + idxRequest = Nothing, + idxName = esOpts.index, + idxAdditionalName = esOpts.additionalWriteIndex, + idxAdditionalElastic = additionalBhEnv, + idxGalley = galleyEp, + idxRpcHttpManager = rpcHttpManager, + idxCredentials = mEsCreds + } initZAuth :: Opts -> IO ZAuth.Env initZAuth o = do @@ -331,14 +358,25 @@ initZAuth o = do initHttpManager :: IO Manager initHttpManager = do + initHttpManagerWithTLSConfig False Nothing + +initHttpManagerWithTLSConfig :: Bool -> Maybe FilePath -> IO Manager +initHttpManagerWithTLSConfig skipTlsVerify mCustomCa = do -- See Note [SSL context] ctx <- SSL.context SSL.contextAddOption ctx SSL_OP_NO_SSLv2 SSL.contextAddOption ctx SSL_OP_NO_SSLv3 SSL.contextSetCiphers ctx "HIGH" - SSL.contextSetVerificationMode ctx $ - SSL.VerifyPeer True True Nothing - SSL.contextSetDefaultVerifyPaths ctx + if skipTlsVerify + then SSL.contextSetVerificationMode ctx SSL.VerifyNone + else + SSL.contextSetVerificationMode ctx $ + SSL.VerifyPeer True True Nothing + case mCustomCa of + Nothing -> SSL.contextSetDefaultVerifyPaths ctx + Just customCa -> do + filePath <- canonicalizePath customCa + SSL.contextSetCAFile ctx filePath -- Unfortunately, there are quite some AWS services we talk to -- (e.g. SES, Dynamo) that still only support TLSv1. -- Ideally: SSL.contextAddOption ctx SSL_OP_NO_TLSv1 @@ -404,11 +442,6 @@ initCassandra o g = (Just schemaVersion) g -initCredentials :: (FromJSON a) => FilePathSecrets -> IO a -initCredentials secretFile = do - dat <- loadSecret secretFile - pure $ either (\e -> error $ "Could not load secrets from " ++ show secretFile ++ ": " ++ e) id dat - userTemplates :: (MonadReader Env m) => Maybe Locale -> m (Locale, UserTemplates) userTemplates l = forLocale l <$> view usrTemplates @@ -599,3 +632,6 @@ viewFederationDomain = view (settings . Opt.federationDomain) qualifyLocal :: (MonadReader Env m) => a -> m (Local a) qualifyLocal a = toLocalUnsafe <$> viewFederationDomain <*> pure a + +qualifyLocal' :: (Member (Input (Local ()))) r => a -> Sem r (Local a) +qualifyLocal' a = flip toLocalUnsafe a . tDomain <$> input diff --git a/services/brig/src/Brig/Calling.hs b/services/brig/src/Brig/Calling.hs index 890531bd63a..c9501b3fcad 100644 --- a/services/brig/src/Brig/Calling.hs +++ b/services/brig/src/Brig/Calling.hs @@ -25,6 +25,7 @@ module Brig.Calling unSFTServers, mkSFTServers, SFTEnv (..), + SFTTokenEnv (..), Discovery (..), TurnEnv, TurnServers (..), @@ -62,6 +63,7 @@ import Data.Misc import Data.Range import Data.Text qualified as Text import Data.Text.Encoding qualified as Text +import Data.Text.Encoding.Error import Data.Text.IO qualified as Text import Data.Time.Clock (DiffTime, diffTimeToPicoseconds) import Imports @@ -133,7 +135,9 @@ data SFTEnv = SFTEnv sftDiscoveryInterval :: Int, -- | maximum amount of servers to give out, -- even if more are in the SRV record - sftListLength :: Range 1 100 Int + sftListLength :: Range 1 100 Int, + -- | token parameters + sftToken :: Maybe SFTTokenEnv } data Discovery a @@ -182,6 +186,13 @@ srvDiscoveryLoop domain discoveryInterval saveAction = forever $ do forM_ servers saveAction delay discoveryInterval +data SFTTokenEnv = SFTTokenEnv + { sftTokenTTL :: Word32, + sftTokenSecret :: ByteString, + sftTokenPRNG :: GenIO, + sftTokenSHA :: Digest + } + mkSFTDomain :: SFTOptions -> DNS.Domain mkSFTDomain SFTOptions {..} = DNS.normalize $ maybe defSftServiceName ("_" <>) sftSRVServiceName <> "._tcp." <> sftBaseDomain @@ -190,13 +201,21 @@ sftDiscoveryLoop SFTEnv {..} = srvDiscoveryLoop sftDomain sftDiscoveryInterval $ atomicWriteIORef sftServers . Discovered . SFTServers -mkSFTEnv :: SFTOptions -> IO SFTEnv -mkSFTEnv opts = +mkSFTEnv :: Digest -> SFTOptions -> IO SFTEnv +mkSFTEnv digest opts = SFTEnv <$> newIORef NotDiscoveredYet <*> pure (mkSFTDomain opts) <*> pure (diffTimeToMicroseconds (fromMaybe defSrvDiscoveryIntervalSeconds (Opts.sftDiscoveryIntervalSeconds opts))) <*> pure (fromMaybe defSftListLength (Opts.sftListLength opts)) + <*> forM (Opts.sftTokenOptions opts) (mkSFTTokenEnv digest) + +mkSFTTokenEnv :: Digest -> Opts.SFTTokenOptions -> IO SFTTokenEnv +mkSFTTokenEnv digest opts = + SFTTokenEnv (Opts.sttTTL opts) + <$> BS.readFile (Opts.sttSecret opts) + <*> createSystemRandom + <*> pure digest -- | Start SFT service discovery synchronously startSFTServiceDiscovery :: Log.Logger -> SFTEnv -> IO () @@ -325,7 +344,15 @@ startDNSBasedTurnDiscovery logger opts deprecatedUdpRef udpRef tcpRef tlsRef = d turnURIFromSRV :: Scheme -> Maybe Transport -> SrvEntry -> TurnURI turnURIFromSRV sch mtr SrvEntry {..} = - turnURI sch (TurnHostName . cs . stripDot $ srvTargetDomain srvTarget) (Port $ srvTargetPort srvTarget) mtr + turnURI + sch + ( TurnHostName + . Text.decodeUtf8With lenientDecode + . stripDot + $ srvTargetDomain srvTarget + ) + (Port $ srvTargetPort srvTarget) + mtr where stripDot h | "." `BS.isSuffixOf` h = BS.take (BS.length h - 1) h diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs index 90998b1fb3a..998b92ee874 100644 --- a/services/brig/src/Brig/Calling/API.hs +++ b/services/brig/src/Brig/Calling/API.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE RecordWildCards #-} -- This file is part of the Wire Server implementation. -- @@ -48,35 +49,37 @@ import Data.Misc (HttpsUrl) import Data.Range import Data.Text.Ascii (AsciiBase64, encodeBase64) import Data.Text.Strict.Lens -import Data.Time.Clock.POSIX (getPOSIXTime) +import Data.Time.Clock.POSIX import Imports hiding (head) import OpenSSL.EVP.Digest (Digest, hmacBS) import Polysemy import Polysemy.Error qualified as Polysemy import System.Logger.Class qualified as Log import System.Random.MWC qualified as MWC -import Wire.API.Call.Config (SFTServer) import Wire.API.Call.Config qualified as Public import Wire.Network.DNS.SRV (srvTarget) -import Wire.Sem.Logger.TinyLog (loggerToTinyLog) -- | ('UserId', 'ConnId' are required as args here to make sure this is an authenticated end-point.) -getCallsConfigV2 :: UserId -> ConnId -> Maybe (Range 1 10 Int) -> (Handler r) Public.RTCConfiguration +getCallsConfigV2 :: + ( Member (Embed IO) r, + Member SFT r + ) => + UserId -> + ConnId -> + Maybe (Range 1 10 Int) -> + (Handler r) Public.RTCConfiguration getCallsConfigV2 _ _ limit = do env <- view turnEnv staticUrl <- view $ settings . Opt.sftStaticUrl sftListAllServers <- fromMaybe Opt.HideAllSFTServers <$> view (settings . Opt.sftListAllServers) sftEnv' <- view sftEnv - logger <- view applog - manager <- view httpManager + sftFederation <- view enableSFTFederation discoveredServers <- turnServersV2 (env ^. turnServers) eitherConfig <- - liftIO - . runM @IO - . loggerToTinyLog logger - . interpretSFT manager + lift + . liftSem . Polysemy.runError - $ newConfig env discoveredServers staticUrl sftEnv' limit sftListAllServers CallsConfigV2 + $ newConfig env discoveredServers staticUrl sftEnv' limit sftListAllServers (CallsConfigV2 sftFederation) handleNoTurnServers eitherConfig -- | Throws '500 Internal Server Error' when no turn servers are found. This is @@ -91,18 +94,20 @@ handleNoTurnServers (Left NoTurnServers) = do Log.err $ Log.msg (Log.val "Call config requested before TURN URIs could be discovered.") throwE $ StdError internalServerError -getCallsConfig :: UserId -> ConnId -> (Handler r) Public.RTCConfiguration +getCallsConfig :: + ( Member (Embed IO) r, + Member SFT r + ) => + UserId -> + ConnId -> + (Handler r) Public.RTCConfiguration getCallsConfig _ _ = do env <- view turnEnv - logger <- view applog - manager <- view httpManager discoveredServers <- turnServersV1 (env ^. turnServers) eitherConfig <- (dropTransport <$$>) - . liftIO - . runM @IO - . loggerToTinyLog logger - . interpretSFT manager + . lift + . liftSem . Polysemy.runError $ newConfig env discoveredServers Nothing Nothing Nothing HideAllSFTServers CallsConfigDeprecated handleNoTurnServers eitherConfig @@ -116,7 +121,7 @@ getCallsConfig _ _ = do data CallsConfigVersion = CallsConfigDeprecated - | CallsConfigV2 + | CallsConfigV2 (Maybe Bool) data NoTurnServers = NoTurnServers deriving (Show) @@ -129,7 +134,10 @@ instance Exception NoTurnServers -- to be set or only one of them (perhaps Data.These combined with error -- handling). newConfig :: - Members [Embed IO, SFT, Polysemy.Error NoTurnServers] r => + ( Member (Embed IO) r, + Member SFT r, + Member (Polysemy.Error NoTurnServers) r + ) => Calling.TurnEnv -> Discovery (NonEmpty Public.TurnURI) -> Maybe HttpsUrl -> @@ -139,7 +147,6 @@ newConfig :: CallsConfigVersion -> Sem r Public.RTCConfiguration newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers version = do - let (sha, secret, tTTL, cTTL, prng) = (env ^. turnSHA512, env ^. turnSecret, env ^. turnTokenTTL, env ^. turnConfigTTL, env ^. turnPrng) -- randomize list of servers (before limiting the list, to ensure not always the same servers are chosen if limit is set) randomizedUris <- liftIO . randomize @@ -150,8 +157,8 @@ newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers versio -- randomize again (as limitedList partially re-orders uris) finalUris <- liftIO $ randomize limitedUris srvs <- for finalUris $ \uri -> do - u <- liftIO $ genUsername tTTL prng - pure $ Public.rtcIceServer (pure uri) u (computeCred sha secret u) + u <- liftIO $ genTurnUsername (env ^. turnTokenTTL) (env ^. turnPrng) + pure . Public.rtcIceServer (pure uri) u $ computeCred (env ^. turnSHA512) (env ^. turnSecret) u let staticSft = pure . Public.sftServer <$> sftStaticUrl allSrvEntries <- @@ -163,16 +170,21 @@ newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers versio let subsetLength = Calling.sftListLength actualSftEnv mapM (getRandomElements subsetLength) allSrvEntries - mSftServersAll :: Maybe [SFTServer] <- case version of - CallsConfigDeprecated -> pure Nothing - CallsConfigV2 -> - case (listAllServers, sftStaticUrl) of - (HideAllSFTServers, _) -> pure Nothing - (ListAllSFTServers, Nothing) -> pure . Just $ sftServerFromSrvTarget . srvTarget <$> maybe [] toList allSrvEntries - (ListAllSFTServers, Just url) -> hush . unSFTGetResponse <$> sftGetAllServers url + let sftFederation' = case version of + CallsConfigDeprecated -> Nothing + CallsConfigV2 fed -> fed + + mSftServersAll <- + case version of + CallsConfigDeprecated -> pure Nothing + CallsConfigV2 _ -> + case (listAllServers, sftStaticUrl) of + (HideAllSFTServers, _) -> pure Nothing + (ListAllSFTServers, Nothing) -> mapM (mapM authenticate) . pure $ sftServerFromSrvTarget . srvTarget <$> maybe [] toList allSrvEntries + (ListAllSFTServers, Just url) -> mapM (mapM authenticate) . hush . unSFTGetResponse =<< sftGetAllServers url let mSftServers = staticSft <|> sftServerFromSrvTarget . srvTarget <$$> srvEntries - pure $ Public.rtcConfiguration srvs mSftServers cTTL mSftServersAll + pure $ Public.rtcConfiguration srvs mSftServers (env ^. turnConfigTTL) mSftServersAll sftFederation' where limitedList :: NonEmpty Public.TurnURI -> Range 1 10 Int -> NonEmpty Public.TurnURI limitedList uris lim = @@ -182,10 +194,27 @@ newConfig env discoveredServers sftStaticUrl mSftEnv limit listAllServers versio -- it should also be safe to assume the returning list has length >= 1 NonEmpty.nonEmpty (Public.limitServers (NonEmpty.toList uris) (fromRange lim)) & fromMaybe (error "newConfig:limitedList: empty list of servers") - genUsername :: Word32 -> MWC.GenIO -> IO Public.TurnUsername + genUsername :: Word32 -> MWC.GenIO -> IO (POSIXTime, Text) genUsername ttl prng = do rnd <- view (packedBytes . utf8) <$> replicateM 16 (MWC.uniformR (97, 122) prng) t <- fromIntegral . (+ ttl) . round <$> getPOSIXTime - pure $ Public.turnUsername t rnd - computeCred :: Digest -> ByteString -> Public.TurnUsername -> AsciiBase64 + pure $ (t, rnd) + genTurnUsername :: Word32 -> MWC.GenIO -> IO Public.TurnUsername + genTurnUsername = (fmap (uncurry Public.turnUsername) .) . genUsername + genSFTUsername :: Word32 -> MWC.GenIO -> IO Public.SFTUsername + genSFTUsername = (fmap (uncurry Public.mkSFTUsername) .) . genUsername + computeCred :: ToByteString a => Digest -> ByteString -> a -> AsciiBase64 computeCred dig secret = encodeBase64 . hmacBS dig secret . toByteString' + authenticate :: + Member (Embed IO) r => + Public.SFTServer -> + Sem r Public.AuthSFTServer + authenticate = + maybe + (pure . Public.nauthSFTServer) + ( \SFTTokenEnv {..} sftsvr -> do + username <- liftIO $ genSFTUsername sftTokenTTL sftTokenPRNG + let credential = computeCred sftTokenSHA sftTokenSecret username + pure $ Public.authSFTServer sftsvr username credential + ) + (sftToken =<< mSftEnv) diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index c76802a40ae..b23a8c2a6dc 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -7,6 +7,8 @@ import Brig.Effects.BlacklistStore (BlacklistStore) import Brig.Effects.BlacklistStore.Cassandra (interpretBlacklistStoreToCassandra) import Brig.Effects.CodeStore (CodeStore) import Brig.Effects.CodeStore.Cassandra (codeStoreToCassandra, interpretClientToIO) +import Brig.Effects.ConnectionStore (ConnectionStore) +import Brig.Effects.ConnectionStore.Cassandra (connectionStoreToCassandra) import Brig.Effects.FederationConfigStore (FederationConfigStore) import Brig.Effects.FederationConfigStore.Cassandra (interpretFederationDomainConfig, remotesMapFromCfgFile) import Brig.Effects.GalleyProvider (GalleyProvider) @@ -15,19 +17,24 @@ import Brig.Effects.JwtTools import Brig.Effects.PasswordResetStore (PasswordResetStore) import Brig.Effects.PasswordResetStore.CodeStore (passwordResetStoreToCodeStore) import Brig.Effects.PublicKeyBundle +import Brig.Effects.SFT (SFT, interpretSFT) import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import Brig.Effects.UserPendingActivationStore.Cassandra (userPendingActivationStoreToCassandra) import Brig.Options (ImplicitNoFederationRestriction (federationDomainConfig), federationDomainConfigs, federationStrategy) +import Brig.Options qualified as Opt import Brig.RPC (ParseException) import Cassandra qualified as Cas import Control.Lens ((^.)) import Control.Monad.Catch (throwM) +import Data.Qualified (Local, toLocalUnsafe) +import Data.Time.Clock (UTCTime, getCurrentTime) import Imports -import Polysemy (Embed, Final, embedToFinal, runFinal) +import Polysemy (Embed, Final, embed, embedToFinal, runFinal) import Polysemy.Async import Polysemy.Conc import Polysemy.Embed (runEmbedded) import Polysemy.Error (Error, mapError, runError) +import Polysemy.Input (Input, runInputConst, runInputSem) import Polysemy.TinyLog (TinyLog) import Wire.GundeckAPIAccess import Wire.NotificationSubsystem @@ -43,7 +50,11 @@ import Wire.Sem.Now.IO (nowToIOAction) import Wire.Sem.Paging.Cassandra (InternalPaging) type BrigCanonicalEffects = - '[ NotificationSubsystem, + '[ SFT, + ConnectionStore InternalPaging, + Input UTCTime, + Input (Local ()), + NotificationSubsystem, GundeckAPIAccess, FederationConfigStore, Jwk, @@ -98,6 +109,10 @@ runBrigToIO e (AppT ma) = do . interpretFederationDomainConfig (e ^. settings . federationStrategy) (foldMap (remotesMapFromCfgFile . fmap (.federationDomainConfig)) (e ^. settings . federationDomainConfigs)) . runGundeckAPIAccess (e ^. gundeckEndpoint) . runNotificationSubsystemGundeck (defaultNotificationSubsystemConfig (e ^. requestId)) + . runInputConst (toLocalUnsafe (e ^. settings . Opt.federationDomain) ()) + . runInputSem (embed getCurrentTime) + . connectionStoreToCassandra + . interpretSFT (e ^. httpManager) ) ) $ runReaderT ma e diff --git a/services/brig/src/Brig/Code.hs b/services/brig/src/Brig/Code.hs index 2d0fc50485c..2ea506aa5e7 100644 --- a/services/brig/src/Brig/Code.hs +++ b/services/brig/src/Brig/Code.hs @@ -40,6 +40,7 @@ module Brig.Code codeForPhone, codeKey, codeValue, + codeToKeyValuePair, codeTTL, codeAccount, scopeFromAction, @@ -59,7 +60,6 @@ module Brig.Code ) where -import Brig.Data.Instances () import Brig.Email (emailKeyUniq, mkEmailKey) import Brig.Phone (mkPhoneKey, phoneKeyUniq) import Cassandra hiding (Value) @@ -114,6 +114,9 @@ scopeFromAction = \case User.Login -> AccountLogin User.DeleteTeam -> DeleteTeam +codeToKeyValuePair :: Code -> KeyValuePair +codeToKeyValuePair code = KeyValuePair code.codeKey code.codeValue + -- | The same 'Key' can exist with different 'Value's in different -- 'Scope's at the same time. data Scope diff --git a/services/brig/src/Brig/Data/Client.hs b/services/brig/src/Brig/Data/Client.hs index 9b864391503..69e9ac0b829 100644 --- a/services/brig/src/Brig/Data/Client.hs +++ b/services/brig/src/Brig/Data/Client.hs @@ -56,7 +56,6 @@ import Amazonka.DynamoDB.Lens qualified as AWS import Bilge.Retry (httpHandlers) import Brig.AWS import Brig.App -import Brig.Data.Instances () import Brig.Data.User (AuthError (..), ReAuthError (..)) import Brig.Data.User qualified as User import Brig.Types.Instances () diff --git a/services/brig/src/Brig/Data/Connection.hs b/services/brig/src/Brig/Data/Connection.hs index 16031d654eb..ec46f3fe406 100644 --- a/services/brig/src/Brig/Data/Connection.hs +++ b/services/brig/src/Brig/Data/Connection.hs @@ -34,6 +34,7 @@ module Brig.Data.Connection lookupRemoteConnectionStatuses, lookupAllStatuses, lookupRemoteConnectedUsersC, + lookupRemoteConnectedUsersPaginated, countConnections, deleteConnections, deleteRemoteConnections, @@ -44,7 +45,6 @@ module Brig.Data.Connection remoteConnectionDelete, remoteConnectionSelectFromDomain, remoteConnectionClear, - remoteConnectionsSelectUsers, -- * Re-exports module T, @@ -52,7 +52,6 @@ module Brig.Data.Connection where import Brig.App -import Brig.Data.Instances () import Brig.Data.Types as T import Cassandra import Control.Monad.Morph @@ -268,10 +267,14 @@ lookupAllStatuses lfroms = do map (\(d, u, r) -> toConnectionStatusV2 from d u r) <$> retry x1 (query remoteRelationsSelectAll (params LocalQuorum (Identity from))) -lookupRemoteConnectedUsersC :: forall m. (MonadClient m) => UserId -> Int32 -> ConduitT () [Remote UserId] m () +lookupRemoteConnectedUsersC :: forall m. (MonadClient m) => Local UserId -> Int32 -> ConduitT () [Remote UserConnection] m () lookupRemoteConnectedUsersC u maxResults = - paginateC remoteConnectionsSelectUsers (paramsP LocalQuorum (Identity u) maxResults) x1 - .| C.map (map (uncurry toRemoteUnsafe)) + paginateC remoteConnectionSelect (paramsP LocalQuorum (Identity (tUnqualified u)) maxResults) x1 + .| C.map (\xs -> map (\x@(d, _, _, _, _, _) -> toRemoteUnsafe d (toRemoteUserConnection u x)) xs) + +lookupRemoteConnectedUsersPaginated :: MonadClient m => Local UserId -> Int32 -> m (Page (Remote UserConnection)) +lookupRemoteConnectedUsersPaginated u maxResults = do + (\x@(d, _, _, _, _, _) -> toRemoteUnsafe d (toRemoteUserConnection u x)) <$$> retry x1 (paginate remoteConnectionSelect (paramsP LocalQuorum (Identity (tUnqualified u)) maxResults)) -- | See 'lookupContactListWithRelation'. lookupContactList :: (MonadClient m) => UserId -> m [UserId] @@ -411,9 +414,6 @@ remoteRelationsSelect = "SELECT right_user, status FROM connection_remote WHERE remoteRelationsSelectAll :: PrepQuery R (Identity UserId) (Domain, UserId, RelationWithHistory) remoteRelationsSelectAll = "SELECT right_domain, right_user, status FROM connection_remote WHERE left = ?" -remoteConnectionsSelectUsers :: PrepQuery R (Identity UserId) (Domain, UserId) -remoteConnectionsSelectUsers = "SELECT right_domain, right_user FROM connection_remote WHERE left = ?" - -- Conversions toLocalUserConnection :: diff --git a/services/brig/src/Brig/Data/Instances.hs b/services/brig/src/Brig/Data/Instances.hs deleted file mode 100644 index 34309315771..00000000000 --- a/services/brig/src/Brig/Data/Instances.hs +++ /dev/null @@ -1,319 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Brig.Data.Instances - ( - ) -where - -import Brig.Types.Common -import Brig.Types.Search -import Cassandra.CQL -import Control.Error (note) -import Data.Aeson (eitherDecode, encode) -import Data.Aeson qualified as JSON -import Data.ByteString.Conversion -import Data.Domain (Domain, domainText, mkDomain) -import Data.Handle (Handle (..)) -import Data.Id () -import Data.Range () -import Data.Text.Ascii () -import Data.Text.Encoding (encodeUtf8) -import Imports -import Wire.API.Asset (AssetKey, assetKeyToText, nilAssetKey) -import Wire.API.Connection (RelationWithHistory (..)) -import Wire.API.MLS.CipherSuite -import Wire.API.Properties -import Wire.API.User -import Wire.API.User.Activation -import Wire.API.User.Client -import Wire.API.User.Password -import Wire.API.User.RichInfo -import Wire.API.User.Search - -deriving instance Cql Name - -deriving instance Cql Handle - -deriving instance Cql ColourId - -deriving instance Cql Phone - -deriving instance Cql InvitationCode - -deriving instance Cql PasswordResetKey - -deriving instance Cql PasswordResetCode - -deriving instance Cql ActivationKey - -deriving instance Cql ActivationCode - -deriving instance Cql PropertyKey - -deriving instance Cql PhonePrefix - -instance Cql Email where - ctype = Tagged TextColumn - - fromCql (CqlText t) = case parseEmail t of - Just e -> pure e - Nothing -> Left "fromCql: Invalid email" - fromCql _ = Left "fromCql: email: CqlText expected" - - toCql = toCql . fromEmail - -instance Cql UserSSOId where - ctype = Tagged TextColumn - - fromCql (CqlText t) = case eitherDecode $ cs t of - Right i -> pure i - Left msg -> Left $ "fromCql: Invalid UserSSOId: " ++ msg - fromCql _ = Left "fromCql: UserSSOId: CqlText expected" - - toCql = toCql . cs @LByteString @Text . encode - -instance Cql RelationWithHistory where - ctype = Tagged IntColumn - - fromCql (CqlInt i) = case i of - 0 -> pure AcceptedWithHistory - 1 -> pure BlockedWithHistory - 2 -> pure PendingWithHistory - 3 -> pure IgnoredWithHistory - 4 -> pure SentWithHistory - 5 -> pure CancelledWithHistory - 6 -> pure MissingLegalholdConsentFromAccepted - 7 -> pure MissingLegalholdConsentFromBlocked - 8 -> pure MissingLegalholdConsentFromPending - 9 -> pure MissingLegalholdConsentFromIgnored - 10 -> pure MissingLegalholdConsentFromSent - 11 -> pure MissingLegalholdConsentFromCancelled - n -> Left $ "unexpected RelationWithHistory: " ++ show n - fromCql _ = Left "RelationWithHistory: int expected" - - toCql AcceptedWithHistory = CqlInt 0 - toCql BlockedWithHistory = CqlInt 1 - toCql PendingWithHistory = CqlInt 2 - toCql IgnoredWithHistory = CqlInt 3 - toCql SentWithHistory = CqlInt 4 - toCql CancelledWithHistory = CqlInt 5 - toCql MissingLegalholdConsentFromAccepted = CqlInt 6 - toCql MissingLegalholdConsentFromBlocked = CqlInt 7 - toCql MissingLegalholdConsentFromPending = CqlInt 8 - toCql MissingLegalholdConsentFromIgnored = CqlInt 9 - toCql MissingLegalholdConsentFromSent = CqlInt 10 - toCql MissingLegalholdConsentFromCancelled = CqlInt 11 - --- DEPRECATED -instance Cql Pict where - ctype = Tagged (ListColumn BlobColumn) - - fromCql (CqlList l) = do - vs <- map (\(Blob lbs) -> lbs) <$> mapM fromCql l - as <- mapM (note "Failed to read asset" . JSON.decode) vs - pure $ Pict as - fromCql _ = pure noPict - - toCql = toCql . map (Blob . JSON.encode) . fromPict - -instance Cql AssetKey where - ctype = Tagged TextColumn - toCql = CqlText . assetKeyToText - - -- if the asset key is invalid we will return the nil asset key (`3-1-00000000-0000-0000-0000-000000000000`) - fromCql (CqlText txt) = pure $ fromRight nilAssetKey $ runParser parser $ encodeUtf8 txt - fromCql _ = Left "AssetKey: Expected CqlText" - -instance Cql AssetSize where - ctype = Tagged IntColumn - - fromCql (CqlInt 0) = pure AssetPreview - fromCql (CqlInt 1) = pure AssetComplete - fromCql n = Left $ "Unexpected asset size: " ++ show n - - toCql AssetPreview = CqlInt 0 - toCql AssetComplete = CqlInt 1 - -instance Cql Asset where - -- Note: Type name and column names and types must match up with the - -- Cassandra schema definition. New fields may only be added - -- (appended) but no fields may be removed. - ctype = - Tagged - ( UdtColumn - "asset" - [ ("typ", IntColumn), - ("key", TextColumn), - ("size", MaybeColumn IntColumn) - ] - ) - - fromCql (CqlUdt fs) = do - t <- required "typ" - k <- required "key" - s <- optional "size" - case (t :: Int32) of - 0 -> pure $! ImageAsset k s - _ -> Left $ "unexpected user asset type: " ++ show t - where - required :: Cql r => Text -> Either String r - required f = - maybe - (Left ("Asset: Missing required field '" ++ show f ++ "'")) - fromCql - (lookup f fs) - optional f = maybe (Right Nothing) fromCql (lookup f fs) - fromCql _ = Left "UserAsset: UDT expected" - - -- Note: Order must match up with the 'ctype' definition. - toCql (ImageAsset k s) = - CqlUdt - [ ("typ", CqlInt 0), - ("key", toCql k), - ("size", toCql s) - ] - -instance Cql AccountStatus where - ctype = Tagged IntColumn - - toCql Active = CqlInt 0 - toCql Suspended = CqlInt 1 - toCql Deleted = CqlInt 2 - toCql Ephemeral = CqlInt 3 - toCql PendingInvitation = CqlInt 4 - - fromCql (CqlInt i) = case i of - 0 -> pure Active - 1 -> pure Suspended - 2 -> pure Deleted - 3 -> pure Ephemeral - 4 -> pure PendingInvitation - n -> Left $ "unexpected account status: " ++ show n - fromCql _ = Left "account status: int expected" - -instance Cql ClientType where - ctype = Tagged IntColumn - toCql TemporaryClientType = CqlInt 0 - toCql PermanentClientType = CqlInt 1 - toCql LegalHoldClientType = CqlInt 2 - - fromCql (CqlInt 0) = pure TemporaryClientType - fromCql (CqlInt 1) = pure PermanentClientType - fromCql (CqlInt 2) = pure LegalHoldClientType - fromCql _ = Left "ClientType: Int [0, 2] expected" - -instance Cql ClientClass where - ctype = Tagged IntColumn - toCql PhoneClient = CqlInt 0 - toCql TabletClient = CqlInt 1 - toCql DesktopClient = CqlInt 2 - toCql LegalHoldClient = CqlInt 3 - - fromCql (CqlInt 0) = pure PhoneClient - fromCql (CqlInt 1) = pure TabletClient - fromCql (CqlInt 2) = pure DesktopClient - fromCql (CqlInt 3) = pure LegalHoldClient - fromCql _ = Left "ClientClass: Int [0, 3] expected" - -instance Cql RawPropertyValue where - ctype = Tagged BlobColumn - toCql = toCql . Blob . rawPropertyBytes - fromCql (CqlBlob v) = pure (RawPropertyValue v) - fromCql _ = Left "PropertyValue: Blob expected" - -instance Cql Country where - ctype = Tagged AsciiColumn - toCql = toCql . con2Text - - fromCql (CqlAscii c) = case parseCountry c of - Just c' -> pure c' - Nothing -> Left "Country: ISO 3166-1-alpha2 expected." - fromCql _ = Left "Country: ASCII expected" - -instance Cql Language where - ctype = Tagged AsciiColumn - toCql = toCql . lan2Text - - fromCql (CqlAscii l) = case parseLanguage l of - Just l' -> pure l' - Nothing -> Left "Language: ISO 639-1 expected." - fromCql _ = Left "Language: ASCII expected" - -instance Cql ManagedBy where - ctype = Tagged IntColumn - - fromCql (CqlInt 0) = pure ManagedByWire - fromCql (CqlInt 1) = pure ManagedByScim - fromCql n = Left $ "Unexpected ManagedBy: " ++ show n - - toCql ManagedByWire = CqlInt 0 - toCql ManagedByScim = CqlInt 1 - -instance Cql RichInfoAssocList where - ctype = Tagged BlobColumn - toCql = toCql . Blob . JSON.encode - fromCql (CqlBlob v) = JSON.eitherDecode v - fromCql _ = Left "RichInfo: Blob expected" - -instance Cql Domain where - ctype = Tagged TextColumn - toCql = CqlText . domainText - fromCql (CqlText txt) = mkDomain txt - fromCql _ = Left "Domain: Text expected" - -instance Cql SearchVisibilityInbound where - ctype = Tagged IntColumn - - toCql SearchableByOwnTeam = CqlInt 0 - toCql SearchableByAllTeams = CqlInt 1 - - fromCql (CqlInt 0) = pure SearchableByOwnTeam - fromCql (CqlInt 1) = pure SearchableByAllTeams - fromCql n = Left $ "Unexpected SearchVisibilityInbound: " ++ show n - -instance Cql FederatedUserSearchPolicy where - ctype = Tagged IntColumn - - toCql NoSearch = CqlInt 0 - toCql ExactHandleSearch = CqlInt 1 - toCql FullSearch = CqlInt 2 - - fromCql (CqlInt 0) = pure NoSearch - fromCql (CqlInt 1) = pure ExactHandleSearch - fromCql (CqlInt 2) = pure FullSearch - fromCql n = Left $ "Unexpected SearchVisibilityInbound: " ++ show n - -instance Cql (Imports.Set BaseProtocolTag) where - ctype = Tagged IntColumn - - toCql = CqlInt . fromIntegral . protocolSetBits - fromCql (CqlInt bits) = pure $ protocolSetFromBits (fromIntegral bits) - fromCql _ = Left "Protocol set: Int expected" - -instance Cql CipherSuiteTag where - ctype = Tagged IntColumn - toCql = CqlInt . fromIntegral . cipherSuiteNumber . tagCipherSuite - - fromCql (CqlInt index) = - case cipherSuiteTag (CipherSuite (fromIntegral index)) of - Just tag -> Right tag - Nothing -> Left "CipherSuiteTag: unexpected index" - fromCql _ = Left "CipherSuiteTag: int expected" diff --git a/services/brig/src/Brig/Data/LoginCode.hs b/services/brig/src/Brig/Data/LoginCode.hs index 197d28aa8d8..1f58dba7cc7 100644 --- a/services/brig/src/Brig/Data/LoginCode.hs +++ b/services/brig/src/Brig/Data/LoginCode.hs @@ -27,7 +27,6 @@ module Brig.Data.LoginCode where import Brig.App (Env, currentTime) -import Brig.Data.Instances () import Brig.User.Auth.DB.Instances () import Cassandra import Control.Lens (view) diff --git a/services/brig/src/Brig/Data/Nonce.hs b/services/brig/src/Brig/Data/Nonce.hs index 83f11d1b78f..8ca18fd1a53 100644 --- a/services/brig/src/Brig/Data/Nonce.hs +++ b/services/brig/src/Brig/Data/Nonce.hs @@ -21,7 +21,6 @@ module Brig.Data.Nonce ) where -import Brig.Data.Instances () import Cassandra import Control.Lens hiding (from) import Data.Id (UserId) diff --git a/services/brig/src/Brig/Data/Properties.hs b/services/brig/src/Brig/Data/Properties.hs index 4519fe9d3ad..b073394584f 100644 --- a/services/brig/src/Brig/Data/Properties.hs +++ b/services/brig/src/Brig/Data/Properties.hs @@ -26,7 +26,6 @@ module Brig.Data.Properties ) where -import Brig.Data.Instances () import Cassandra import Control.Error import Data.Id diff --git a/services/brig/src/Brig/Data/User.hs b/services/brig/src/Brig/Data/User.hs index 64638d9af57..5eb86970276 100644 --- a/services/brig/src/Brig/Data/User.hs +++ b/services/brig/src/Brig/Data/User.hs @@ -76,7 +76,6 @@ module Brig.Data.User where import Brig.App (Env, currentTime, settings, viewFederationDomain, zauthEnv) -import Brig.Data.Instances () import Brig.Options import Brig.Types.Intra import Brig.ZAuth qualified as ZAuth @@ -159,7 +158,7 @@ newAccount u inv tid mbHandle = do locale defLoc = fromMaybe defLoc (newUserLocale u) managedBy = fromMaybe defaultManagedBy (newUserManagedBy u) prots = fromMaybe defSupportedProtocols (newUserSupportedProtocols u) - user uid domain l e = User uid (Qualified uid domain) ident name pict assets colour False l Nothing mbHandle e tid managedBy prots + user uid domain l e = User (Qualified uid domain) ident name pict assets colour False l Nothing mbHandle e tid managedBy prots newAccountInviteViaScim :: MonadReader Env m => UserId -> TeamId -> Maybe Locale -> Name -> Email -> m UserAccount newAccountInviteViaScim uid tid locale name email = do @@ -170,7 +169,6 @@ newAccountInviteViaScim uid tid locale name email = do where user domain loc = User - uid (Qualified uid domain) (Just $ EmailIdentity email) name @@ -721,7 +719,6 @@ toUserAccount svc = newServiceRef <$> sid <*> pid in UserAccount ( User - uid (Qualified uid domain) ident name @@ -797,7 +794,6 @@ toUsers domain defaultLocale havePendingInvitations = fmap mk . filter fp loc = toLocale defaultLocale (lan, con) svc = newServiceRef <$> sid <*> pid in User - uid (Qualified uid domain) ident name diff --git a/services/brig/src/Brig/Data/UserKey.hs b/services/brig/src/Brig/Data/UserKey.hs index 6487a77e730..11128014a24 100644 --- a/services/brig/src/Brig/Data/UserKey.hs +++ b/services/brig/src/Brig/Data/UserKey.hs @@ -33,7 +33,6 @@ module Brig.Data.UserKey ) where -import Brig.Data.Instances () import Brig.Data.User qualified as User import Brig.Email import Brig.Phone diff --git a/services/brig/src/Brig/Effects/CodeStore/Cassandra.hs b/services/brig/src/Brig/Effects/CodeStore/Cassandra.hs index e6cae090996..26d4d2c7f32 100644 --- a/services/brig/src/Brig/Effects/CodeStore/Cassandra.hs +++ b/services/brig/src/Brig/Effects/CodeStore/Cassandra.hs @@ -22,7 +22,6 @@ module Brig.Effects.CodeStore.Cassandra ) where -import Brig.Data.Instances () import Brig.Effects.CodeStore import Cassandra import Data.ByteString.Conversion (toByteString') diff --git a/services/brig/src/Brig/Effects/ConnectionStore.hs b/services/brig/src/Brig/Effects/ConnectionStore.hs new file mode 100644 index 00000000000..013232d2686 --- /dev/null +++ b/services/brig/src/Brig/Effects/ConnectionStore.hs @@ -0,0 +1,35 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2024 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 Brig.Effects.ConnectionStore where + +import Data.Id +import Data.Qualified (Local, Remote) +import Imports +import Polysemy +import Wire.API.Connection (UserConnection) +import Wire.Sem.Paging (Page, PagingBounds, PagingState) + +data ConnectionStore p m a where + RemoteConnectedUsersPaginated :: + Local UserId -> + Maybe (PagingState p (Remote UserConnection)) -> + PagingBounds p (Remote UserConnection) -> + ConnectionStore p m (Page p (Remote UserConnection)) + +makeSem ''ConnectionStore diff --git a/services/brig/src/Brig/Effects/ConnectionStore/Cassandra.hs b/services/brig/src/Brig/Effects/ConnectionStore/Cassandra.hs new file mode 100644 index 00000000000..35f2444ab88 --- /dev/null +++ b/services/brig/src/Brig/Effects/ConnectionStore/Cassandra.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE DeepSubsumption #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2024 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Brig.Effects.ConnectionStore.Cassandra where + +import Brig.Data.Connection +import Brig.Effects.ConnectionStore +import Cassandra +import Data.Range +import Imports +import Polysemy +import Polysemy.Internal.Tactics +import Wire.Sem.Paging.Cassandra + +connectionStoreToCassandra :: + forall r a. + (Member (Embed Client) r) => + Sem (ConnectionStore InternalPaging ': r) a -> + Sem r a +connectionStoreToCassandra = + interpretH $ + liftT . embed @Client . \case + RemoteConnectedUsersPaginated uid mps bounds -> case mps of + Nothing -> flip mkInternalPage pure =<< lookupRemoteConnectedUsersPaginated uid (fromRange bounds) + Just ps -> ipNext ps diff --git a/services/brig/src/Brig/Effects/FederationConfigStore/Cassandra.hs b/services/brig/src/Brig/Effects/FederationConfigStore/Cassandra.hs index 0d348dd4e3b..bc9fcd8f7b6 100644 --- a/services/brig/src/Brig/Effects/FederationConfigStore/Cassandra.hs +++ b/services/brig/src/Brig/Effects/FederationConfigStore/Cassandra.hs @@ -22,7 +22,6 @@ module Brig.Effects.FederationConfigStore.Cassandra ) where -import Brig.Data.Instances () import Brig.Effects.FederationConfigStore import Cassandra import Control.Exception (ErrorCall (ErrorCall)) diff --git a/services/brig/src/Brig/Effects/GalleyProvider.hs b/services/brig/src/Brig/Effects/GalleyProvider.hs index b73fd919ed2..24843dbaa0b 100644 --- a/services/brig/src/Brig/Effects/GalleyProvider.hs +++ b/services/brig/src/Brig/Effects/GalleyProvider.hs @@ -36,6 +36,12 @@ import Wire.API.Team.Member qualified as Team import Wire.API.Team.Role import Wire.API.Team.SearchVisibility +data MLSOneToOneEstablished + = Established + | NotEstablished + | NotAMember + deriving (Eq, Show) + data GalleyProvider m a where CreateSelfConv :: UserId -> @@ -106,5 +112,14 @@ data GalleyProvider m a where GetExposeInvitationURLsToTeamAdmin :: TeamId -> GalleyProvider m ShowOrHideInvitationUrl + IsMLSOne2OneEstablished :: + Local UserId -> + Qualified UserId -> + GalleyProvider m MLSOneToOneEstablished + UnblockConversation :: + Local UserId -> + Maybe ConnId -> + Qualified ConvId -> + GalleyProvider m Conversation makeSem ''GalleyProvider diff --git a/services/brig/src/Brig/Effects/GalleyProvider/RPC.hs b/services/brig/src/Brig/Effects/GalleyProvider/RPC.hs index 481b4d28c09..08759ee2b06 100644 --- a/services/brig/src/Brig/Effects/GalleyProvider/RPC.hs +++ b/services/brig/src/Brig/Effects/GalleyProvider/RPC.hs @@ -19,7 +19,7 @@ module Brig.Effects.GalleyProvider.RPC where import Bilge hiding (head, options, requestId) import Brig.API.Types -import Brig.Effects.GalleyProvider (GalleyProvider (..)) +import Brig.Effects.GalleyProvider (GalleyProvider (..), MLSOneToOneEstablished (..)) import Brig.RPC hiding (galleyRequest) import Brig.Team.Types (ShowOrHideInvitationUrl (..)) import Control.Error (hush) @@ -33,8 +33,9 @@ import Data.Id import Data.Json.Util (UTCTimeMillis) import Data.Qualified import Data.Range -import Galley.Types.Teams qualified as Team import Imports +import Network.HTTP.Client qualified as HTTP +import Network.HTTP.Types qualified as HTTP import Network.HTTP.Types.Method import Network.HTTP.Types.Status import Network.Wai.Utilities.Error qualified as Wai @@ -51,8 +52,7 @@ import Wire.API.Routes.Version import Wire.API.Team import Wire.API.Team.Conversation qualified as Conv import Wire.API.Team.Feature -import Wire.API.Team.Member qualified as Member -import Wire.API.Team.Member qualified as Team +import Wire.API.Team.Member as Member import Wire.API.Team.Role import Wire.API.Team.SearchVisibility import Wire.Rpc @@ -89,6 +89,8 @@ interpretGalleyProviderToRpc disabledVersions galleyEndpoint = GetAllFeatureConfigsForUser m_id' -> getAllFeatureConfigsForUser m_id' GetVerificationCodeEnabled id' -> getVerificationCodeEnabled id' GetExposeInvitationURLsToTeamAdmin id' -> getTeamExposeInvitationURLsToTeamAdmin id' + IsMLSOne2OneEstablished lusr qother -> checkMLSOne2OneEstablished lusr qother + UnblockConversation lusr mconn qcnv -> unblockConversation v lusr mconn qcnv galleyRequest :: (Member Rpc r, Member (Input Endpoint) r) => (Request -> Request) -> Sem r (Response (Maybe LByteString)) galleyRequest req = do @@ -246,7 +248,7 @@ addTeamMember u tid (minvmeta, role) = do 200 -> True _ -> False where - prm = Team.rolePermissions role + prm = Member.rolePermissions role bdy = Member.mkNewTeamMember u prm minvmeta req = method POST @@ -294,7 +296,7 @@ getTeamMember :: ) => UserId -> TeamId -> - Sem r (Maybe Team.TeamMember) + Sem r (Maybe TeamMember) getTeamMember u tid = do debug $ remote "galley" @@ -322,7 +324,7 @@ getTeamMembers :: Member TinyLog r ) => TeamId -> - Sem r Team.TeamMemberList + Sem r TeamMemberList getTeamMembers tid = do debug $ remote "galley" . msg (val "Get team members") galleyRequest req >>= decodeBodyOrThrow "galley" @@ -524,3 +526,67 @@ getTeamExposeInvitationURLsToTeamAdmin tid = do method GET . paths ["i", "teams", toByteString' tid, "features", featureNameBS @ExposeInvitationURLsToTeamAdminConfig] . expect2xx + +checkMLSOne2OneEstablished :: + ( Member (Error ParseException) r, + Member (Input Endpoint) r, + Member Rpc r, + Member TinyLog r + ) => + Local UserId -> + Qualified UserId -> + Sem r MLSOneToOneEstablished +checkMLSOne2OneEstablished self (Qualified other otherDomain) = do + debug $ remote "galley" . msg (val "Get the MLS one-to-one conversation") + responseSelf <- galleyRequest req + case HTTP.statusCode (HTTP.responseStatus responseSelf) of + 200 -> do + established <- decodeBodyOrThrow @Bool "galley" responseSelf + pure $ if established then Established else NotEstablished + 403 -> pure NotAMember + 400 -> pure NotEstablished + _ -> pure NotEstablished + where + req = + method GET + . paths + [ "i", + "conversations", + "mls-one2one", + toByteString' otherDomain, + toByteString' other, + "established" + ] + . zUser (tUnqualified self) + +unblockConversation :: + ( Member (Error ParseException) r, + Member (Input Endpoint) r, + Member Rpc r, + Member TinyLog r + ) => + Version -> + Local UserId -> + Maybe ConnId -> + Qualified ConvId -> + Sem r Conversation +unblockConversation v lusr mconn (Qualified cnv cdom) = do + debug $ + remote "galley" + . field "conv" (toByteString cnv) + . field "domain" (toByteString cdom) + . msg (val "Unblocking conversation") + void $ galleyRequest putReq + galleyRequest getReq >>= decodeBodyOrThrow @Conversation "galley" + where + putReq = + method PUT + . paths ["i", "conversations", toByteString' cdom, toByteString' cnv, "unblock"] + . zUser (tUnqualified lusr) + . maybe id (header "Z-Connection" . fromConnId) mconn + . expect2xx + getReq = + method GET + . paths [toHeader v, "conversations", toByteString' cdom, toByteString' cnv] + . zUser (tUnqualified lusr) + . expect2xx diff --git a/services/brig/src/Brig/Effects/JwtTools.hs b/services/brig/src/Brig/Effects/JwtTools.hs index f31329c5aa1..1b9a1773413 100644 --- a/services/brig/src/Brig/Effects/JwtTools.hs +++ b/services/brig/src/Brig/Effects/JwtTools.hs @@ -12,6 +12,8 @@ import Data.Jwt.Tools qualified as Jwt import Data.Misc (HttpsUrl) import Data.Nonce (Nonce) import Data.PEMKeys +import Data.Text.Encoding +import Data.Text.Encoding.Error import Imports import Network.HTTP.Types (StdMethod (..)) import Network.HTTP.Types qualified as HTTP @@ -19,6 +21,7 @@ import Polysemy import Wire.API.MLS.Credential (ClientIdentity (..)) import Wire.API.MLS.Epoch (Epoch (..)) import Wire.API.User.Client.DPoPAccessToken (DPoPAccessToken (..), Proof (..)) +import Wire.API.User.Profile (Name (..)) data JwtTools m a where GenerateDPoPAccessToken :: @@ -30,6 +33,8 @@ data JwtTools m a where ClientIdentity -> -- | The user's handle Handle -> + -- The user's display name + Name -> -- | The user's team ID TeamId -> -- | The most recent DPoP nonce provided by the backend to the current client @@ -52,7 +57,7 @@ makeSem ''JwtTools interpretJwtTools :: Member (Embed IO) r => Sem (JwtTools ': r) a -> Sem r a interpretJwtTools = interpret $ \case - GenerateDPoPAccessToken proof cid handle tid nonce uri method skew ex now pem -> + GenerateDPoPAccessToken proof cid handle displayName tid nonce uri method skew ex now pem -> mapLeft RustError <$> runExceptT ( DPoPAccessToken @@ -61,6 +66,7 @@ interpretJwtTools = interpret $ \case (Jwt.UserId (toByteString' (ciUser cid))) (Jwt.ClientId (clientToWord64 (ciClient cid))) (Jwt.Handle (toByteString' (urlEncode (fromHandle (handle))))) + (Jwt.DisplayName (toByteString' (fromName displayName))) (Jwt.TeamId (toByteString' tid)) (Jwt.Domain (toByteString' (ciDomain cid))) (Jwt.Nonce (toByteString' nonce)) @@ -73,4 +79,4 @@ interpretJwtTools = interpret $ \case ) where urlEncode :: Text -> Text - urlEncode = cs . HTTP.urlEncode False . cs + urlEncode = decodeUtf8With lenientDecode . HTTP.urlEncode False . encodeUtf8 diff --git a/services/brig/src/Brig/Effects/SFT.hs b/services/brig/src/Brig/Effects/SFT.hs index 24fe09bfa7d..d1cdd9d2cde 100644 --- a/services/brig/src/Brig/Effects/SFT.hs +++ b/services/brig/src/Brig/Effects/SFT.hs @@ -29,6 +29,7 @@ where import Data.Aeson qualified as Aeson import Data.ByteString.Conversion +import Data.ByteString.UTF8 qualified as UTF8 import Data.Map qualified as Map import Data.Misc import Data.Schema @@ -58,7 +59,7 @@ interpretSFT :: Members [Embed IO, TinyLog] r => Manager -> Sem (SFT ': r) a -> interpretSFT httpManager = interpret $ \(SFTGetAllServers url) -> do let urlWithPath = ensureHttpsUrl $ (httpsUrl url) {uriPath = "/sft_servers_all.json"} fmap SFTGetResponse . runSftError urlWithPath $ do - let req = parseRequest_ . cs . toByteString' $ urlWithPath + let req = parseRequest_ . UTF8.toString . toByteString' $ urlWithPath response <- fromExceptionVia @HttpException (SFTError . show) (responseBody <$> httpLbs req httpManager) let eList = Aeson.eitherDecode @AllURLs response res <- fromEither $ bimap SFTError (fmap sftServer . unAllURLs) eList @@ -92,6 +93,6 @@ interpretSFTInMemory m = interpret $ \(SFTGetAllServers url) -> case Map.lookup url m of Nothing -> do let msg = "No value in the lookup map" - err $ Log.field "url" (show url) . Log.msg (cs msg :: ByteString) + err $ Log.field "url" (show url) . Log.msg (UTF8.fromString msg :: ByteString) pure . SFTGetResponse . Left . SFTError $ msg Just ss -> pure ss diff --git a/services/brig/src/Brig/Federation/Client.hs b/services/brig/src/Brig/Federation/Client.hs index ad697843719..d86f706169f 100644 --- a/services/brig/src/Brig/Federation/Client.hs +++ b/services/brig/src/Brig/Federation/Client.hs @@ -157,8 +157,7 @@ notifyUserDeleted self remotes = do view rabbitmqChannel >>= \case Just chanVar -> do enqueueNotification (tDomain self) remoteDomain Q.Persistent chanVar $ - void $ - fedQueueClient @'OnUserDeletedConnectionsTag notif + fedQueueClient @'OnUserDeletedConnectionsTag notif Nothing -> Log.err $ Log.msg ("Federation error while notifying remote backends of a user deletion." :: ByteString) diff --git a/services/brig/src/Brig/IO/Intra.hs b/services/brig/src/Brig/IO/Intra.hs index 61dc0c3e272..c8e82c586d0 100644 --- a/services/brig/src/Brig/IO/Intra.hs +++ b/services/brig/src/Brig/IO/Intra.hs @@ -29,7 +29,6 @@ module Brig.IO.Intra createConnectConv, acceptConnectConv, blockConv, - unblockConv, upsertOne2OneConversation, -- * Clients @@ -52,57 +51,57 @@ import Brig.API.Error (internalServerError) import Brig.API.Types import Brig.API.Util import Brig.App -import Brig.Data.Connection (lookupContactList) +import Brig.Data.Connection import Brig.Data.Connection qualified as Data -import Brig.Federation.Client (notifyUserDeleted) +import Brig.Effects.ConnectionStore (ConnectionStore) +import Brig.Effects.ConnectionStore qualified as E +import Brig.Federation.Client (notifyUserDeleted, sendConnectionAction) import Brig.IO.Journal qualified as Journal +import Brig.IO.Logging import Brig.RPC -import Brig.Types.User.Event import Brig.User.Search.Index qualified as Search -import Cassandra (MonadClient) -import Conduit (runConduit, (.|)) -import Control.Error (ExceptT) +import Control.Error (ExceptT, runExceptT) import Control.Lens (view, (.~), (?~), (^.), (^?)) import Control.Monad.Catch import Control.Monad.Trans.Except (throwE) import Data.Aeson hiding (json) -import Data.Aeson.KeyMap qualified as KeyMap import Data.Aeson.Lens import Data.ByteString.Conversion import Data.ByteString.Lazy qualified as BL -import Data.Conduit.List qualified as C import Data.Id -import Data.Json.Util ((#)) +import Data.Json.Util import Data.List.NonEmpty (NonEmpty (..)) import Data.List1 (List1, singleton) import Data.Proxy import Data.Qualified import Data.Range -import GHC.TypeLits +import Data.Time.Clock (UTCTime) import Gundeck.Types.Push.V2 (RecipientClients (RecipientClientsAll)) import Gundeck.Types.Push.V2 qualified as V2 import Imports import Network.HTTP.Types.Method import Network.HTTP.Types.Status import Polysemy +import Polysemy.Input (Input, input) import Polysemy.TinyLog (TinyLog) -import System.Logger.Class (MonadLogger) import System.Logger.Message hiding ((.=)) import Wire.API.Connection import Wire.API.Conversation hiding (Member) import Wire.API.Event.Conversation (Connect (Connect)) import Wire.API.Federation.API.Brig import Wire.API.Federation.Error -import Wire.API.Properties -import Wire.API.Routes.Internal.Galley.ConversationsIntra (UpsertOne2OneConversationRequest, UpsertOne2OneConversationResponse) +import Wire.API.Routes.Internal.Galley.ConversationsIntra import Wire.API.Routes.Internal.Galley.TeamsIntra (GuardLegalholdPolicyConflicts (GuardLegalholdPolicyConflicts)) import Wire.API.Team.LegalHold (LegalholdProtectee) import Wire.API.Team.Member qualified as Team import Wire.API.User import Wire.API.User.Client +import Wire.API.UserEvent import Wire.NotificationSubsystem import Wire.Rpc import Wire.Sem.Logger qualified as Log +import Wire.Sem.Paging qualified as P +import Wire.Sem.Paging.Cassandra (InternalPaging) ----------------------------------------------------------------------------- -- Event Handlers @@ -110,7 +109,10 @@ import Wire.Sem.Logger qualified as Log onUserEvent :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> Maybe ConnId -> @@ -168,7 +170,7 @@ onClientEvent orig conn e = do let event = ClientEvent e let rcps = Recipient orig V2.RecipientClientsAll :| [] pushNotifications - [ newPush1 (Just orig) (toPushFormat event) rcps + [ newPush1 (Just orig) (toJSONObject event) rcps & pushConn .~ conn & pushApsData .~ toApsData event ] @@ -228,7 +230,10 @@ journalEvent orig e = case e of dispatchNotifications :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> Maybe ConnId -> @@ -252,49 +257,103 @@ dispatchNotifications orig conn e = case e of -- n.b. Synchronously fetch the contact list on the current thread. -- If done asynchronously, the connections may already have been deleted. notifyUserDeletionLocals orig conn event - embed $ notifyUserDeletionRemotes orig + notifyUserDeletionRemotes orig where event = singleton $ UserEvent e notifyUserDeletionLocals :: + forall r. ( Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r ) => UserId -> Maybe ConnId -> List1 Event -> Sem r () notifyUserDeletionLocals deleted conn event = do - recipients <- (:|) deleted <$> embed (lookupContactList deleted) - notify event deleted V2.RouteDirect conn (pure recipients) + luid <- qualifyLocal' deleted + -- first we send a notification to the deleted user's devices + notify event deleted V2.RouteDirect conn (pure (deleted :| [])) + -- then to all their connections + connectionPages Nothing luid (toRange (Proxy @500)) + where + handler :: [UserConnection] -> Sem r () + handler connections = do + -- sent event to connections that are accepted + case qUnqualified . ucTo <$> filter ((==) Accepted . ucStatus) connections of + x : xs -> notify event deleted V2.RouteDirect conn (pure (x :| xs)) + [] -> pure () + -- also send a connection cancelled event to connections that are pending + d <- tDomain <$> input + forM_ + (filter ((==) Sent . ucStatus) connections) + ( \uc -> do + now <- toUTCTimeMillis <$> input + -- because the connections are going to be removed from the database anyway when a user gets deleted + -- we don't need to save the updated connection state in the database + -- note that we switch from and to users so that the "other" user becomes the recipient of the event + let ucCancelled = + UserConnection + (qUnqualified (ucTo uc)) + (Qualified (ucFrom uc) d) + Cancelled + now + (ucConvId uc) + let e = ConnectionUpdated ucCancelled Nothing + onConnectionEvent deleted conn e + ) + + connectionPages :: Maybe UserId -> Local UserId -> Range 1 500 Int32 -> Sem r () + connectionPages mbStart user pageSize = do + page <- embed $ Data.lookupLocalConnections user mbStart pageSize + case resultList page of + [] -> pure () + xs -> do + handler xs + when (Data.resultHasMore page) $ + connectionPages (Just (maximum (qUnqualified . ucTo <$> xs))) user pageSize notifyUserDeletionRemotes :: - forall m. - ( MonadReader Env m, - MonadClient m, - MonadLogger m, - MonadMask m + forall r. + ( Member (Embed HttpClientIO) r, + Member TinyLog r, + Member (Input (Local ())) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> - m () + Sem r () notifyUserDeletionRemotes deleted = do - runConduit $ - Data.lookupRemoteConnectedUsersC deleted (fromInteger (natVal (Proxy @UserDeletedNotificationMaxConnections))) - .| C.mapM_ fanoutNotifications + luid <- qualifyLocal' deleted + P.withChunks (\mps -> E.remoteConnectedUsersPaginated luid mps maxBound) fanoutNotifications where - fanoutNotifications :: [Remote UserId] -> m () + fanoutNotifications :: [Remote UserConnection] -> Sem r () fanoutNotifications = mapM_ notifyBackend . bucketRemote - notifyBackend :: Remote [UserId] -> m () - notifyBackend uids = do - case tUnqualified (checked <$> uids) of + notifyBackend :: Remote [UserConnection] -> Sem r () + notifyBackend ucs = do + case tUnqualified (checked <$> ucs) of Nothing -> -- The user IDs cannot be more than 1000, so we can assume the range -- check will only fail because there are 0 User Ids. pure () - Just rangedUids -> do - luidDeleted <- qualifyLocal deleted - notifyUserDeleted luidDeleted (qualifyAs uids rangedUids) + Just rangedUcs -> do + luidDeleted <- qualifyLocal' deleted + embed $ notifyUserDeleted luidDeleted (qualifyAs ucs ((fmap (fmap (qUnqualified . ucTo))) rangedUcs)) + -- also sent connection cancelled events to the connections that are pending + let remotePendingConnections = qualifyAs ucs <$> filter ((==) Sent . ucStatus) (fromRange rangedUcs) + forM_ remotePendingConnections $ sendCancelledEvent luidDeleted + + sendCancelledEvent :: Local UserId -> Remote UserConnection -> Sem r () + sendCancelledEvent luidDeleted ruc = do + embed (runExceptT (sendConnectionAction luidDeleted Nothing (qUnqualified . ucTo <$> ruc) RemoteRescind)) >>= \case + -- should we abort the whole process if we fail to send the event to a remote backend? + Left e -> + Log.err $ + field "error" (show e) + . msg (val "An error occurred while sending a connection cancelled event to a remote backend.") + Right _ -> pure () -- | (Asynchronously) notifies other users of events. notify :: @@ -312,7 +371,7 @@ notify :: notify (toList -> events) orig route conn recipients = do rs <- (\u -> Recipient u RecipientClientsAll) <$$> recipients let pushes = flip map events $ \event -> - newPush1 (Just orig) (toPushFormat event) rs + newPush1 (Just orig) (toJSONObject event) rs & pushConn .~ conn & pushRoute .~ route & pushApsData .~ toApsData event @@ -362,130 +421,8 @@ notifyContacts events orig route conn = do view Team.userId <$> mems ^. Team.teamMembers screenMemberList _ = [] --- Event Serialisation: - -toPushFormat :: Event -> Object -toPushFormat (UserEvent (UserCreated u)) = - KeyMap.fromList - [ "type" .= ("user.new" :: Text), - "user" .= SelfProfile (u {userIdentity = Nothing}) - ] -toPushFormat (UserEvent (UserActivated u)) = - KeyMap.fromList - [ "type" .= ("user.activate" :: Text), - "user" .= SelfProfile u - ] -toPushFormat (UserEvent (UserUpdated (UserUpdatedData i n pic acc ass hdl loc mb ssoId ssoIdDel prots))) = - KeyMap.fromList - [ "type" .= ("user.update" :: Text), - "user" - .= object - ( "id" .= i - # "name" .= n - # "picture" .= pic -- DEPRECATED - # "accent_id" .= acc - # "assets" .= ass - # "handle" .= hdl - # "locale" .= loc - # "managed_by" .= mb - # "sso_id" .= ssoId - # "sso_id_deleted" .= ssoIdDel - # "supported_protocols" .= prots - # [] - ) - ] -toPushFormat (UserEvent (UserIdentityUpdated UserIdentityUpdatedData {..})) = - KeyMap.fromList - [ "type" .= ("user.update" :: Text), - "user" - .= object - ( "id" .= eiuId - # "email" .= eiuEmail - # "phone" .= eiuPhone - # [] - ) - ] -toPushFormat (UserEvent (UserIdentityRemoved (UserIdentityRemovedData i e p))) = - KeyMap.fromList - [ "type" .= ("user.identity-remove" :: Text), - "user" - .= object - ( "id" .= i - # "email" .= e - # "phone" .= p - # [] - ) - ] -toPushFormat (ConnectionEvent (ConnectionUpdated uc _ name)) = - KeyMap.fromList $ - "type" .= ("user.connection" :: Text) - # "connection" .= uc - # "user" .= case name of - Just n -> Just $ object ["name" .= n] - Nothing -> Nothing - # [] -toPushFormat (UserEvent (UserSuspended i)) = - KeyMap.fromList - [ "type" .= ("user.suspend" :: Text), - "id" .= i - ] -toPushFormat (UserEvent (UserResumed i)) = - KeyMap.fromList - [ "type" .= ("user.resume" :: Text), - "id" .= i - ] -toPushFormat (UserEvent (UserDeleted qid)) = - KeyMap.fromList - [ "type" .= ("user.delete" :: Text), - "id" .= qUnqualified qid, - "qualified_id" .= qid - ] -toPushFormat (UserEvent (UserLegalHoldDisabled i)) = - KeyMap.fromList - [ "type" .= ("user.legalhold-disable" :: Text), - "id" .= i - ] -toPushFormat (UserEvent (UserLegalHoldEnabled i)) = - KeyMap.fromList - [ "type" .= ("user.legalhold-enable" :: Text), - "id" .= i - ] -toPushFormat (PropertyEvent (PropertySet _ k v)) = - KeyMap.fromList - [ "type" .= ("user.properties-set" :: Text), - "key" .= k, - "value" .= propertyValue v - ] -toPushFormat (PropertyEvent (PropertyDeleted _ k)) = - KeyMap.fromList - [ "type" .= ("user.properties-delete" :: Text), - "key" .= k - ] -toPushFormat (PropertyEvent (PropertiesCleared _)) = - KeyMap.fromList - [ "type" .= ("user.properties-clear" :: Text) - ] -toPushFormat (ClientEvent (ClientAdded _ c)) = - KeyMap.fromList - [ "type" .= ("user.client-add" :: Text), - "client" .= c - ] -toPushFormat (ClientEvent (ClientRemoved _ clientId)) = - KeyMap.fromList - [ "type" .= ("user.client-remove" :: Text), - "client" .= IdObject clientId - ] -toPushFormat (UserEvent (LegalHoldClientRequested payload)) = - let LegalHoldClientRequestedData targetUser lastPrekey' clientId = payload - in KeyMap.fromList - [ "type" .= ("user.legalhold-request" :: Text), - "id" .= targetUser, - "last_prekey" .= lastPrekey', - "client" .= IdObject clientId - ] - toApsData :: Event -> Maybe V2.ApsData -toApsData (ConnectionEvent (ConnectionUpdated uc _ name)) = +toApsData (ConnectionEvent (ConnectionUpdated uc name)) = case (ucStatus uc, name) of (MissingLegalholdConsent, _) -> Nothing (Pending, n) -> apsConnRequest <$> n @@ -582,78 +519,32 @@ acceptConnectConv from conn = (liftSem . acceptLocalConnectConv from conn . tUnqualified) (const (throwM federationNotImplemented)) --- | Calls 'Galley.API.blockConvH'. -blockLocalConv :: - ( Member (Embed HttpClientIO) r, - Member TinyLog r - ) => - Local UserId -> - Maybe ConnId -> - ConvId -> - Sem r () -blockLocalConv lusr conn cnv = do - Log.debug $ - remote "galley" - . field "conv" (toByteString cnv) - . msg (val "Blocking conversation") - embed $ void $ galleyRequest PUT req - where - req = - paths ["/i/conversations", toByteString' cnv, "block"] - . zUser (tUnqualified lusr) - . maybe id (header "Z-Connection" . fromConnId) conn - . expect2xx - blockConv :: ( Member (Embed HttpClientIO) r, Member TinyLog r ) => Local UserId -> - Maybe ConnId -> Qualified ConvId -> - AppT r () -blockConv lusr conn = - foldQualified - lusr - (liftSem . blockLocalConv lusr conn . tUnqualified) - (const (throwM federationNotImplemented)) - --- | Calls 'Galley.API.unblockConvH'. -unblockLocalConv :: - ( Member (Embed HttpClientIO) r, - Member TinyLog r - ) => - Local UserId -> - Maybe ConnId -> - ConvId -> - Sem r Conversation -unblockLocalConv lusr conn cnv = do + Sem r () +blockConv lusr qcnv = do Log.debug $ remote "galley" - . field "conv" (toByteString cnv) - . msg (val "Unblocking conversation") - embed $ galleyRequest PUT req >>= decodeBody "galley" + . field "conv" (toByteString . qUnqualified $ qcnv) + . field "domain" (toByteString . qDomain $ qcnv) + . msg (val "Blocking conversation") + embed . void $ galleyRequest PUT req where req = - paths ["/i/conversations", toByteString' cnv, "unblock"] + paths + [ "i", + "conversations", + toByteString' (qDomain qcnv), + toByteString' (qUnqualified qcnv), + "block" + ] . zUser (tUnqualified lusr) - . maybe id (header "Z-Connection" . fromConnId) conn . expect2xx -unblockConv :: - ( Member (Embed HttpClientIO) r, - Member TinyLog r - ) => - Local UserId -> - Maybe ConnId -> - Qualified ConvId -> - AppT r Conversation -unblockConv luid conn = - foldQualified - luid - (liftSem . unblockLocalConv luid conn . tUnqualified) - (const (throwM federationNotImplemented)) - upsertOne2OneConversation :: ( MonadReader Env m, MonadIO m, @@ -662,11 +553,11 @@ upsertOne2OneConversation :: HasRequestId m ) => UpsertOne2OneConversationRequest -> - m UpsertOne2OneConversationResponse + m () upsertOne2OneConversation urequest = do response <- galleyRequest POST req case Bilge.statusCode response of - 200 -> decodeBody "galley" response + 200 -> pure () _ -> throwM internalServerError where req = diff --git a/services/brig/src/Brig/IO/Journal.hs b/services/brig/src/Brig/IO/Journal.hs index 054792ae50c..d5faf53332c 100644 --- a/services/brig/src/Brig/IO/Journal.hs +++ b/services/brig/src/Brig/IO/Journal.hs @@ -48,7 +48,7 @@ import Wire.API.User -- without journaling arguments for user updates userActivate :: (MonadReader Env m, MonadIO m) => User -> m () -userActivate u@User {..} = journalEvent UserEvent'USER_ACTIVATE userId (userEmail u) (Just userLocale) userTeam (Just userDisplayName) +userActivate u@User {..} = journalEvent UserEvent'USER_ACTIVATE (userId u) (userEmail u) (Just userLocale) userTeam (Just userDisplayName) userUpdate :: (MonadReader Env m, MonadIO m) => UserId -> Maybe Email -> Maybe Locale -> Maybe Name -> m () userUpdate uid em loc = journalEvent UserEvent'USER_UPDATE uid em loc Nothing diff --git a/libs/galley-types/test/unit/Test/Galley/Permissions.hs b/services/brig/src/Brig/IO/Logging.hs similarity index 53% rename from libs/galley-types/test/unit/Test/Galley/Permissions.hs rename to services/brig/src/Brig/IO/Logging.hs index fa23c1a278e..ec733caa119 100644 --- a/libs/galley-types/test/unit/Test/Galley/Permissions.hs +++ b/services/brig/src/Brig/IO/Logging.hs @@ -15,21 +15,20 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Test.Galley.Permissions where +module Brig.IO.Logging where -import Galley.Types.Teams -import Imports -import Test.Tasty -import Test.Tasty.HUnit -import Wire.API.Team.Permission -import Wire.API.Team.Role +import Data.ByteString.Conversion +import Data.Id +import Data.Qualified +import System.Logger -tests :: TestTree -tests = - testGroup - "permsToInt / rolePermissions / serialization of `Role`s" - [ testCase "partner" $ assertEqual "" (permsToInt . _self $ rolePermissions RoleExternalPartner) 1025, - testCase "member" $ assertEqual "" (permsToInt . _self $ rolePermissions RoleMember) 1587, - testCase "admin" $ assertEqual "" (permsToInt . _self $ rolePermissions RoleAdmin) 5951, - testCase "owner" $ assertEqual "" (permsToInt . _self $ rolePermissions RoleOwner) 8191 - ] +logConnection :: UserId -> Qualified UserId -> Msg -> Msg +logConnection from (Qualified toUser toDomain) = + "connection.from" .= toByteString from + ~~ "connection.to" .= toByteString toUser + ~~ "connection.to_domain" .= toByteString toDomain + +logLocalConnection :: UserId -> UserId -> Msg -> Msg +logLocalConnection from to = + "connection.from" .= toByteString from + ~~ "connection.to" .= toByteString to diff --git a/services/brig/src/Brig/Index/Eval.hs b/services/brig/src/Brig/Index/Eval.hs index ed412d8d0d2..05c5e688882 100644 --- a/services/brig/src/Brig/Index/Eval.hs +++ b/services/brig/src/Brig/Index/Eval.hs @@ -22,49 +22,58 @@ module Brig.Index.Eval ) where +import Brig.App (initHttpManagerWithTLSConfig, mkIndexEnv) import Brig.Index.Migrations import Brig.Index.Options +import Brig.Options import Brig.User.Search.Index import Cassandra qualified as C +import Cassandra.Options import Cassandra.Util (defInitCassandra) import Control.Lens import Control.Monad.Catch import Control.Retry import Data.Aeson (FromJSON) import Data.Aeson qualified as Aeson +import Data.ByteString.Lazy.UTF8 qualified as UTF8 +import Data.Credentials (Credentials (..)) import Data.Metrics qualified as Metrics import Database.Bloodhound qualified as ES import Imports -import Network.HTTP.Client as HTTP import System.Logger qualified as Log import System.Logger.Class (Logger, MonadLogger (..)) +import Util.Options (initCredentials) runCommand :: Logger -> Command -> IO () runCommand l = \case Create es galley -> do - e <- initIndex es galley + e <- initIndex (es ^. esConnection) galley runIndexIO e $ createIndexIfNotPresent (mkCreateIndexSettings es) Reset es galley -> do - e <- initIndex es galley + e <- initIndex (es ^. esConnection) galley runIndexIO e $ resetIndex (mkCreateIndexSettings es) Reindex es cas galley -> do - e <- initIndex es galley + e <- initIndex (es ^. esConnection) galley c <- initDb cas runReindexIO e c reindexAll ReindexSameOrNewer es cas galley -> do - e <- initIndex es galley + e <- initIndex (es ^. esConnection) galley c <- initDb cas runReindexIO e c reindexAllIfSameOrNewer - UpdateMapping esURI indexName galley -> do - e <- initIndex' esURI indexName galley + UpdateMapping esConn galley -> do + e <- initIndex esConn galley runIndexIO e updateMapping Migrate es cas galley -> do migrate l es cas galley ReindexFromAnotherIndex reindexSettings -> do - mgr <- newManager defaultManagerSettings - let bhEnv = initES (view reindexEsServer reindexSettings) mgr + mgr <- + initHttpManagerWithTLSConfig + (reindexSettings ^. reindexEsConnection . to esInsecureSkipVerifyTls) + (reindexSettings ^. reindexEsConnection . to esCaCert) + mCreds <- for (reindexSettings ^. reindexEsConnection . to esCredentials) initCredentials + let bhEnv = initES (reindexSettings ^. reindexEsConnection . to esServer) mgr mCreds ES.runBH bhEnv $ do - let src = view reindexSrcIndex reindexSettings + let src = reindexSettings ^. reindexEsConnection . to esIndex dest = view reindexDestIndex reindexSettings timeoutSeconds = view reindexTimeoutSeconds reindexSettings @@ -85,22 +94,30 @@ runCommand l = \case waitForTaskToComplete @ES.ReindexResponse timeoutSeconds taskNodeId Log.info l $ Log.msg ("Finished reindexing" :: ByteString) where - initIndex es gly = - initIndex' (es ^. esServer) (es ^. esIndex) gly - initIndex' esURI indexName galleyEndpoint = do - mgr <- newManager defaultManagerSettings - IndexEnv - <$> Metrics.metrics - <*> pure l - <*> pure (initES esURI mgr) - <*> pure Nothing - <*> pure indexName - <*> pure Nothing - <*> pure Nothing - <*> pure galleyEndpoint - <*> pure mgr - initES esURI mgr = - ES.mkBHEnv (toESServer esURI) mgr + initIndex :: ESConnectionSettings -> Endpoint -> IO IndexEnv + initIndex esConn gly = do + mgr <- initHttpManagerWithTLSConfig esConn.esInsecureSkipVerifyTls esConn.esCaCert + let esOpts = + ElasticSearchOpts + { url = toESServer esConn.esServer, + index = esConn.esIndex, + credentials = esConn.esCredentials, + insecureSkipVerifyTls = esConn.esInsecureSkipVerifyTls, + caCert = esConn.esCaCert, + additionalWriteIndex = Nothing, + additionalWriteIndexUrl = Nothing, + additionalCredentials = Nothing, + additionalInsecureSkipVerifyTls = False, + additionalCaCert = Nothing + } + + metricsStorage <- Metrics.metrics + mkIndexEnv esOpts l metricsStorage gly mgr + + initES esURI mgr mCreds = + let env = ES.mkBHEnv (toESServer esURI) mgr + in maybe env (\(creds :: Credentials) -> env {ES.bhRequestHook = ES.basicAuthHook (ES.EsUsername creds.username) (ES.EsPassword creds.password)}) mCreds + initDb cas = defInitCassandra (toCassandraOpts cas) l waitForTaskToComplete :: forall a m. (ES.MonadBH m, MonadThrow m, FromJSON a) => Int -> ES.TaskNodeId -> m () @@ -116,7 +133,7 @@ waitForTaskToComplete timeoutSeconds taskNodeId = do throwM $ ReindexFromAnotherIndexError $ "Task failed with error: " - <> cs (Aeson.encode $ ES.taskResponseError task) + <> UTF8.toString (Aeson.encode $ ES.taskResponseError task) where isTaskComplete :: Either ES.EsError (ES.TaskResponse a) -> m Bool isTaskComplete (Left e) = throwM $ ReindexFromAnotherIndexError $ "Error response while getting task: " <> show e diff --git a/services/brig/src/Brig/Index/Migrations.hs b/services/brig/src/Brig/Index/Migrations.hs index da7e78cc1a0..f743f62c157 100644 --- a/services/brig/src/Brig/Index/Migrations.hs +++ b/services/brig/src/Brig/Index/Migrations.hs @@ -20,13 +20,15 @@ module Brig.Index.Migrations ) where +import Brig.App (initHttpManagerWithTLSConfig) import Brig.Index.Migrations.Types import Brig.Index.Options qualified as Opts import Brig.User.Search.Index qualified as Search import Cassandra.Util (defInitCassandra) -import Control.Lens (view, (^.)) +import Control.Lens (to, view, (^.)) import Control.Monad.Catch (MonadThrow, catchAll, finally, throwM) import Data.Aeson (Value, object, (.=)) +import Data.Credentials (Credentials (..)) import Data.Metrics qualified as Metrics import Data.Text qualified as Text import Database.Bloodhound qualified as ES @@ -45,7 +47,7 @@ migrate l es cas galleyEndpoint = do go :: Env -> IO () go env = runMigrationAction env $ do - failIfIndexAbsent (es ^. Opts.esIndex) + failIfIndexAbsent (es ^. Opts.esConnection . to Opts.esIndex) createMigrationsIndexIfNotPresent runMigration expectedMigrationVersion @@ -76,13 +78,19 @@ indexMapping = mkEnv :: Logger -> Opts.ElasticSettings -> Opts.CassandraSettings -> Options.Endpoint -> IO Env mkEnv l es cas galleyEndpoint = do - mgr <- HTTP.newManager HTTP.defaultManagerSettings - Env (ES.mkBHEnv (Opts.toESServer (es ^. Opts.esServer)) mgr) + env <- do + esMgr <- initHttpManagerWithTLSConfig (es ^. Opts.esConnection . to Opts.esInsecureSkipVerifyTls) (es ^. Opts.esConnection . to Opts.esCaCert) + pure $ ES.mkBHEnv (Opts.toESServer (es ^. Opts.esConnection . to Opts.esServer)) esMgr + mCreds <- for (es ^. Opts.esConnection . to Opts.esCredentials) Options.initCredentials + let envWithAuth = maybe env (\(creds :: Credentials) -> env {ES.bhRequestHook = ES.basicAuthHook (ES.EsUsername creds.username) (ES.EsPassword creds.password)}) mCreds + rpcMgr <- HTTP.newManager HTTP.defaultManagerSettings + Env envWithAuth <$> initCassandra <*> initLogger <*> Metrics.metrics - <*> pure (view Opts.esIndex es) - <*> pure mgr + <*> pure (view (Opts.esConnection . to Opts.esIndex) es) + <*> pure mCreds + <*> pure rpcMgr <*> pure galleyEndpoint where initCassandra = defInitCassandra (Opts.toCassandraOpts cas) l diff --git a/services/brig/src/Brig/Index/Migrations/Types.hs b/services/brig/src/Brig/Index/Migrations/Types.hs index dd70c151fa0..853570ffb6f 100644 --- a/services/brig/src/Brig/Index/Migrations/Types.hs +++ b/services/brig/src/Brig/Index/Migrations/Types.hs @@ -24,6 +24,7 @@ import Brig.User.Search.Index qualified as Search import Cassandra qualified as C import Control.Monad.Catch (MonadThrow) import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.=)) +import Data.Credentials (Credentials) import Data.Metrics (Metrics) import Database.Bloodhound qualified as ES import Imports @@ -70,7 +71,7 @@ instance MonadIO m => MonadLogger (MigrationActionT m) where instance MonadIO m => Search.MonadIndexIO (MigrationActionT m) where liftIndexIO m = do Env {..} <- ask - let indexEnv = Search.IndexEnv metrics logger bhEnv Nothing searchIndex Nothing Nothing galleyEndpoint httpManager + let indexEnv = Search.IndexEnv metrics logger bhEnv Nothing searchIndex Nothing Nothing galleyEndpoint httpManager searchIndexCredentials Search.runIndexIO indexEnv m instance MonadIO m => ES.MonadBH (MigrationActionT m) where @@ -82,6 +83,7 @@ data Env = Env logger :: Logger.Logger, metrics :: Metrics, searchIndex :: ES.IndexName, + searchIndexCredentials :: Maybe Credentials, httpManager :: Manager, galleyEndpoint :: Endpoint } diff --git a/services/brig/src/Brig/Index/Options.hs b/services/brig/src/Brig/Index/Options.hs index 89da5997cb4..c0fe469f0ff 100644 --- a/services/brig/src/Brig/Index/Options.hs +++ b/services/brig/src/Brig/Index/Options.hs @@ -22,8 +22,8 @@ module Brig.Index.Options ( Command (..), ElasticSettings, - esServer, - esIndex, + ESConnectionSettings (..), + esConnection, esIndexShardCount, esIndexReplicas, esIndexRefreshInterval, @@ -41,9 +41,8 @@ module Brig.Index.Options toESServer, ReindexFromAnotherIndexSettings, reindexDestIndex, - reindexSrcIndex, - reindexEsServer, reindexTimeoutSeconds, + reindexEsConnection, ) where @@ -59,7 +58,7 @@ import Imports import Options.Applicative import URI.ByteString import URI.ByteString.QQ -import Util.Options (CassandraOpts (..), Endpoint (..)) +import Util.Options (CassandraOpts (..), Endpoint (..), FilePathSecrets) data Command = Create ElasticSettings Endpoint @@ -67,14 +66,22 @@ data Command | Reindex ElasticSettings CassandraSettings Endpoint | ReindexSameOrNewer ElasticSettings CassandraSettings Endpoint | -- | 'ElasticSettings' has shards and other settings that are not needed here. - UpdateMapping (URIRef Absolute) ES.IndexName Endpoint + UpdateMapping ESConnectionSettings Endpoint | Migrate ElasticSettings CassandraSettings Endpoint | ReindexFromAnotherIndex ReindexFromAnotherIndexSettings deriving (Show) +data ESConnectionSettings = ESConnectionSettings + { esServer :: URIRef Absolute, + esIndex :: ES.IndexName, + esCaCert :: Maybe FilePath, + esInsecureSkipVerifyTls :: Bool, + esCredentials :: Maybe FilePathSecrets + } + deriving (Show) + data ElasticSettings = ElasticSettings - { _esServer :: URIRef Absolute, - _esIndex :: ES.IndexName, + { _esConnection :: ESConnectionSettings, _esIndexShardCount :: Int, _esIndexReplicas :: ES.ReplicaCount, _esIndexRefreshInterval :: NominalDiffTime, @@ -91,8 +98,7 @@ data CassandraSettings = CassandraSettings deriving (Show) data ReindexFromAnotherIndexSettings = ReindexFromAnotherIndexSettings - { _reindexEsServer :: URIRef Absolute, - _reindexSrcIndex :: ES.IndexName, + { _reindexEsConnection :: ESConnectionSettings, _reindexDestIndex :: ES.IndexName, _reindexTimeoutSeconds :: Int } @@ -125,8 +131,14 @@ mkCreateIndexSettings es = localElasticSettings :: ElasticSettings localElasticSettings = ElasticSettings - { _esServer = [uri|http://localhost:9200|], - _esIndex = ES.IndexName "directory_test", + { _esConnection = + ESConnectionSettings + { esServer = [uri|https://localhost:9200|], + esIndex = ES.IndexName "directory_test", + esCaCert = Just "test/resources/elasticsearch-ca.pem", + esInsecureSkipVerifyTls = False, + esCredentials = Just "test/resources/elasticsearch-credentials.yaml" + }, _esIndexShardCount = 1, _esIndexReplicas = ES.ReplicaCount 1, _esIndexRefreshInterval = 1, @@ -149,7 +161,7 @@ elasticServerParser = ( long "elasticsearch-server" <> metavar "URL" <> help "Base URL of the Elasticsearch Server." - <> value (view esServer localElasticSettings) + <> value localElasticSettings._esConnection.esServer <> showDefaultWith (view unpackedChars . serializeURIRef') ) where @@ -168,10 +180,20 @@ restrictedElasticSettingsParser = do <> value "directory" <> showDefault ) + mCreds <- credentialsPathParser + mCaCert <- caCertParser + verifyCa <- verifyCaParser pure $ localElasticSettings - & esServer .~ server - & esIndex .~ ES.IndexName (prefix <> "_test") + { _esConnection = + localElasticSettings._esConnection + { esServer = server, + esIndex = ES.IndexName (prefix <> "_test"), + esCredentials = mCreds, + esCaCert = mCaCert, + esInsecureSkipVerifyTls = verifyCa + } + } indexNameParser :: Parser ES.IndexName indexNameParser = @@ -180,15 +202,43 @@ indexNameParser = ( long "elasticsearch-index" <> metavar "STRING" <> help "Elasticsearch Index Name." - <> value (view (esIndex . _IndexName . unpacked) localElasticSettings) + <> value (view (_IndexName . unpacked) localElasticSettings._esConnection.esIndex) <> showDefault ) +connectionSettingsParser :: Parser ESConnectionSettings +connectionSettingsParser = + ESConnectionSettings + <$> elasticServerParser + <*> indexNameParser + <*> caCertParser + <*> verifyCaParser + <*> credentialsPathParser + +caCertParser :: Parser (Maybe FilePath) +caCertParser = + optional + ( option + str + ( long "elasticsearch-ca-cert" + <> metavar "FILE" + <> help "Path to CA Certitificate for TLS validation, system CA bundle is used when unspecified" + ) + ) + +verifyCaParser :: Parser Bool +verifyCaParser = + flag + False -- the default is False + True + ( long "elasticsearch-insecure-skip-tls-verify" + <> help "Skip TLS verification when connecting to Elasticsearch (not recommended)" + ) + elasticSettingsParser :: Parser ElasticSettings elasticSettingsParser = ElasticSettings - <$> elasticServerParser - <*> indexNameParser + <$> connectionSettingsParser <*> indexShardCountParser <*> indexReplicaCountParser <*> indexRefreshIntervalParser @@ -234,6 +284,16 @@ elasticSettingsParser = ) ) +credentialsPathParser :: Parser (Maybe FilePathSecrets) +credentialsPathParser = + optional + ( strOption + ( long "elasticsearch-credentials" + <> metavar "FILE" + <> help "Location of a file containing the Elasticsearch credentials" + ) + ) + cassandraSettingsParser :: Parser CassandraSettings cassandraSettingsParser = CassandraSettings @@ -262,7 +322,8 @@ cassandraSettingsParser = ) ) <*> ( (optional . strOption) - ( long "tls-ca-certificate-file" + ( long "cassandra-ca-cert" + <> metavar "FILE" <> help "Location of a PEM encoded list of CA certificates to be used when verifying the Cassandra server's certificate" ) ) @@ -270,14 +331,7 @@ cassandraSettingsParser = reindexToAnotherIndexSettingsParser :: Parser ReindexFromAnotherIndexSettings reindexToAnotherIndexSettingsParser = ReindexFromAnotherIndexSettings - <$> elasticServerParser - <*> ( ES.IndexName . view packed - <$> strOption - ( long "source-index" - <> metavar "STRING" - <> help "Elasticsearch index name to reindex from" - ) - ) + <$> connectionSettingsParser <*> ( ES.IndexName . view packed <$> strOption ( long "destination-index" @@ -325,7 +379,7 @@ commandParser = <> command "update-mapping" ( info - (UpdateMapping <$> elasticServerParser <*> indexNameParser <*> galleyEndpointParser) + (UpdateMapping <$> connectionSettingsParser <*> galleyEndpointParser) (progDesc "Update mapping of the user index.") ) <> command diff --git a/services/brig/src/Brig/InternalEvent/Process.hs b/services/brig/src/Brig/InternalEvent/Process.hs index 9c04f5c3083..b0e0ba1c870 100644 --- a/services/brig/src/Brig/InternalEvent/Process.hs +++ b/services/brig/src/Brig/InternalEvent/Process.hs @@ -22,23 +22,28 @@ where import Brig.API.User qualified as API import Brig.App +import Brig.Effects.ConnectionStore import Brig.IO.Intra (rmClient) import Brig.IO.Intra qualified as Intra import Brig.InternalEvent.Types import Brig.Options (defDeleteThrottleMillis, setDeleteThrottleMillis) import Brig.Provider.API qualified as API -import Brig.Types.User.Event import Control.Lens (view) import Control.Monad.Catch import Data.ByteString.Conversion +import Data.Qualified (Local) +import Data.Time.Clock (UTCTime) import Imports import Polysemy import Polysemy.Conc +import Polysemy.Input (Input) import Polysemy.Time import Polysemy.TinyLog as Log import System.Logger.Class (field, msg, val, (~~)) +import Wire.API.UserEvent import Wire.NotificationSubsystem import Wire.Sem.Delay +import Wire.Sem.Paging.Cassandra (InternalPaging) -- | Handle an internal event. -- @@ -48,14 +53,17 @@ onEvent :: Member NotificationSubsystem r, Member TinyLog r, Member Delay r, - Member Race r + Member Race r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => InternalNotification -> Sem r () onEvent n = handleTimeout $ case n of DeleteClient clientId uid mcon -> do rmClient uid clientId - Intra.onClientEvent uid mcon (ClientRemoved uid clientId) + Intra.onClientEvent uid mcon (ClientRemoved clientId) DeleteUser uid -> do Log.info $ msg (val "Processing user delete event") diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 22a553228d8..c27fd4cd821 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -30,7 +30,7 @@ import Brig.User.Auth.Cookie.Limit import Brig.ZAuth qualified as ZAuth import Control.Applicative import Control.Lens qualified as Lens -import Data.Aeson (defaultOptions, fieldLabelModifier, genericParseJSON, withText) +import Data.Aeson (defaultOptions, fieldLabelModifier, genericParseJSON) import Data.Aeson qualified as A import Data.Aeson qualified as Aeson import Data.Aeson.Types (typeMismatch) @@ -49,6 +49,7 @@ import Data.Text.Encoding qualified as Text import Data.Time.Clock (DiffTime, NominalDiffTime, secondsToDiffTime) import Data.Yaml (FromJSON (..), ToJSON (..), (.:), (.:?)) import Data.Yaml qualified as Y +import Database.Bloodhound.Types qualified as ES import Galley.Types.Teams (unImplicitLockStatus) import Imports import Network.AMQP.Extended @@ -74,9 +75,9 @@ instance Read Timeout where data ElasticSearchOpts = ElasticSearchOpts { -- | ElasticSearch URL - url :: !Text, + url :: !ES.Server, -- | The name of the ElasticSearch user index - index :: !Text, + index :: !ES.IndexName, -- | An additional index to write user data, useful while migrating to a new -- index. -- There is a bug hidden when using this option. Sometimes a user won't get @@ -85,12 +86,20 @@ data ElasticSearchOpts = ElasticSearchOpts -- tools/db/find-undead which can be used to find the undead users right -- after the migration, if they exist, we can run the reindexing to get data -- in elasticsearch in a consistent state. - additionalWriteIndex :: !(Maybe Text), + additionalWriteIndex :: !(Maybe ES.IndexName), -- | An additional ES URL to write user data, useful while migrating to a - -- new instace of ES. It is necessary to provide 'additionalWriteIndex' for + -- new instance of ES. It is necessary to provide 'additionalWriteIndex' for -- this to be used. If this is 'Nothing' and 'additionalWriteIndex' is -- configured, the 'url' field will be used. - additionalWriteIndexUrl :: !(Maybe Text) + additionalWriteIndexUrl :: !(Maybe ES.Server), + -- | Elasticsearch credentials + credentials :: !(Maybe FilePathSecrets), + -- | Credentials for additional ES index (maily used for migrations) + additionalCredentials :: !(Maybe FilePathSecrets), + insecureSkipVerifyTls :: Bool, + caCert :: Maybe FilePath, + additionalInsecureSkipVerifyTls :: Bool, + additionalCaCert :: Maybe FilePath } deriving (Show, Generic) @@ -359,34 +368,6 @@ instance FromJSON TurnDnsOpts where <$> (asciiOnly =<< o .: "baseDomain") <*> o .:? "discoveryIntervalSeconds" --- | Configurations for whether to show a user's email to others. -data EmailVisibility - = -- | Anyone can see the email of someone who is on ANY team. - -- This may sound strange; but certain on-premise hosters have many different teams - -- and still want them to see each-other's emails. - EmailVisibleIfOnTeam - | -- | Anyone on your team with at least 'Member' privileges can see your email address. - EmailVisibleIfOnSameTeam - | -- | Show your email only to yourself - EmailVisibleToSelf - deriving (Eq, Show, Bounded, Enum) - -instance FromJSON EmailVisibility where - parseJSON = withText "EmailVisibility" $ \case - "visible_if_on_team" -> pure EmailVisibleIfOnTeam - "visible_if_on_same_team" -> pure EmailVisibleIfOnSameTeam - "visible_to_self" -> pure EmailVisibleToSelf - _ -> - fail $ - "unexpected value for EmailVisibility settings: " - <> "expected one of " - <> show (Aeson.encode <$> [(minBound :: EmailVisibility) ..]) - -instance ToJSON EmailVisibility where - toJSON EmailVisibleIfOnTeam = "visible_if_on_team" - toJSON EmailVisibleIfOnSameTeam = "visible_if_on_same_team" - toJSON EmailVisibleToSelf = "visible_to_self" - data ListAllSFTServers = ListAllSFTServers | HideAllSFTServers @@ -420,6 +401,8 @@ data Opts = Opts cassandra :: !CassandraOpts, -- | ElasticSearch settings elasticsearch :: !ElasticSearchOpts, + -- | SFT Federation + multiSFT :: !(Maybe Bool), -- | RabbitMQ settings, required when federation is enabled. rabbitmq :: !(Maybe RabbitMqOpts), -- | AWS settings @@ -440,8 +423,6 @@ data Opts = Opts -- | Disco URL discoUrl :: !(Maybe Text), - -- | GeoDB file path - geoDb :: !(Maybe FilePath), -- | Event queue for -- Brig-generated events (e.g. -- user deletion) @@ -528,7 +509,7 @@ data Settings = Settings -- the given provider id setProviderSearchFilter :: !(Maybe ProviderId), -- | Whether to expose user emails and to whom - setEmailVisibility :: !EmailVisibility, + setEmailVisibility :: !EmailVisibilityConfig, setPropertyMaxKeyLen :: !(Maybe Int64), setPropertyMaxValueLen :: !(Maybe Int64), -- | How long, in milliseconds, to wait @@ -832,7 +813,8 @@ data SFTOptions = SFTOptions { sftBaseDomain :: !DNS.Domain, sftSRVServiceName :: !(Maybe ByteString), -- defaults to defSftServiceName if unset sftDiscoveryIntervalSeconds :: !(Maybe DiffTime), -- defaults to defSftDiscoveryIntervalSeconds - sftListLength :: !(Maybe (Range 1 100 Int)) -- defaults to defSftListLength + sftListLength :: !(Maybe (Range 1 100 Int)), -- defaults to defSftListLength + sftTokenOptions :: !(Maybe SFTTokenOptions) } deriving (Show, Generic) @@ -843,6 +825,19 @@ instance FromJSON SFTOptions where <*> (mapM asciiOnly =<< o .:? "sftSRVServiceName") <*> (secondsToDiffTime <$$> o .:? "sftDiscoveryIntervalSeconds") <*> (o .:? "sftListLength") + <*> (o .:? "sftToken") + +data SFTTokenOptions = SFTTokenOptions + { sttTTL :: !Word32, + sttSecret :: !FilePath + } + deriving (Show, Generic) + +instance FromJSON SFTTokenOptions where + parseJSON = Y.withObject "SFTTokenOptions" $ \o -> + SFTTokenOptions + <$> (o .: "ttl") + <*> (o .: "secret") asciiOnly :: Text -> Y.Parser ByteString asciiOnly t = @@ -912,7 +907,8 @@ Lens.makeLensesFor [ ("optSettings", "optionSettings"), ("elasticsearch", "elasticsearchL"), ("sft", "sftL"), - ("turn", "turnL") + ("turn", "turnL"), + ("multiSFT", "multiSFTL") ] ''Opts @@ -942,8 +938,12 @@ Lens.makeLensesFor Lens.makeLensesFor [ ("url", "urlL"), ("index", "indexL"), + ("caCert", "caCertL"), + ("insecureSkipVerifyTls", "insecureSkipVerifyTlsL"), ("additionalWriteIndex", "additionalWriteIndexL"), - ("additionalWriteIndexUrl", "additionalWriteIndexUrlL") + ("additionalWriteIndexUrl", "additionalWriteIndexUrlL"), + ("additionalCaCert", "additionalCaCertL"), + ("additionalInsecureSkipVerifyTls", "additionalInsecureSkipVerifyTlsL") ] ''ElasticSearchOpts diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index 0bc3963beeb..c59e561e4cb 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -17,10 +17,10 @@ module Brig.Provider.API ( -- * Main stuff - routesInternal, botAPI, servicesAPI, providerAPI, + internalProviderAPI, -- * Event handlers finishDeleteService, @@ -58,7 +58,6 @@ import Control.Exception.Enclosed (handleAny) import Control.Lens (view, (^.)) import Control.Monad.Catch (MonadMask) import Control.Monad.Except -import Data.Aeson hiding (json) import Data.ByteString.Conversion import Data.ByteString.Lazy.Char8 qualified as LC8 import Data.CommaSeparatedList (CommaSeparatedList (fromCommaSeparatedList)) @@ -79,14 +78,9 @@ import Data.Text.Encoding qualified as Text import Data.Text.Lazy qualified as Text import GHC.TypeNats import Imports -import Network.HTTP.Types.Status -import Network.Wai (Response) -import Network.Wai.Predicate (accept) -import Network.Wai.Routing +import Network.HTTP.Types import Network.Wai.Utilities.Error ((!>>)) import Network.Wai.Utilities.Error qualified as Wai -import Network.Wai.Utilities.Response (json) -import Network.Wai.Utilities.ZAuth import OpenSSL.EVP.Digest qualified as SSL import OpenSSL.EVP.PKey qualified as SSL import OpenSSL.PEM qualified as SSL @@ -114,6 +108,7 @@ import Wire.API.Provider.External qualified as Ext import Wire.API.Provider.Service import Wire.API.Provider.Service qualified as Public import Wire.API.Provider.Service.Tag qualified as Public +import Wire.API.Routes.Internal.Brig qualified as BrigIRoutes import Wire.API.Routes.Named (Named (Named)) import Wire.API.Routes.Public.Brig.Bot (BotAPI) import Wire.API.Routes.Public.Brig.Provider (ProviderAPI) @@ -122,7 +117,7 @@ import Wire.API.Team.Feature qualified as Feature import Wire.API.Team.LegalHold (LegalholdProtectee (UnprotectedBot)) import Wire.API.Team.Permission import Wire.API.User hiding (cpNewPassword, cpOldPassword) -import Wire.API.User qualified as Public (UserProfile, publicProfile) +import Wire.API.User qualified as Public (UserProfile, mkUserProfile) import Wire.API.User.Auth import Wire.API.User.Client import Wire.API.User.Client qualified as Public (Client, ClientCapability (ClientSupportsLegalholdImplicitConsent), PubClient (..), UserClientPrekeyMap, UserClients, userClients) @@ -142,6 +137,7 @@ botAPI = :<|> Named @"bot-delete-self" botDeleteSelf :<|> Named @"bot-list-prekeys" botListPrekeys :<|> Named @"bot-update-prekeys" botUpdatePrekeys + :<|> Named @"bot-get-client-v5" botGetClient :<|> Named @"bot-get-client" botGetClient :<|> Named @"bot-claim-users-prekeys" botClaimUsersPrekeys :<|> Named @"bot-list-users" botListUserProfiles @@ -176,11 +172,8 @@ providerAPI = :<|> Named @"provider-get-account" getAccount :<|> Named @"provider-get-profile" getProviderProfile -routesInternal :: Member GalleyProvider r => Routes a (Handler r) () -routesInternal = do - get "/i/provider/activation-code" (continue getActivationCodeH) $ - accept "application" "json" - .&> param "email" +internalProviderAPI :: Member GalleyProvider r => ServerT BrigIRoutes.ProviderAPI (Handler r) +internalProviderAPI = Named @"get-provider-activation-code" getActivationCodeH -------------------------------------------------------------------------------- -- Public API (Unauthenticated) @@ -241,26 +234,15 @@ activateAccountKey key val = do lift $ sendApprovalConfirmMail name email pure . Just $ Public.ProviderActivationResponse email -getActivationCodeH :: Member GalleyProvider r => Public.Email -> (Handler r) Response +getActivationCodeH :: Member GalleyProvider r => Public.Email -> (Handler r) Code.KeyValuePair getActivationCodeH e = do guardSecondFactorDisabled Nothing - json <$> getActivationCode e - -getActivationCode :: Public.Email -> (Handler r) FoundActivationCode -getActivationCode e = do email <- case validateEmail e of Right em -> pure em Left _ -> throwStd (errorToWai @'E.InvalidEmail) gen <- Code.mkGen (Code.ForEmail email) code <- wrapClientE $ Code.lookup (Code.genKey gen) Code.IdentityVerification - maybe (throwStd activationKeyNotFound) (pure . FoundActivationCode) code - -newtype FoundActivationCode = FoundActivationCode Code.Code - -instance ToJSON FoundActivationCode where - toJSON (FoundActivationCode vcode) = - toJSON $ - Code.KeyValuePair (Code.codeKey vcode) (Code.codeValue vcode) + maybe (throwStd activationKeyNotFound) (pure . Code.codeToKeyValuePair) code login :: Member GalleyProvider r => ProviderLogin -> Handler r ProviderTokenCookie login l = do @@ -693,7 +675,7 @@ addBot zuid zcon cid add = do let colour = fromMaybe defaultAccentId (Ext.rsNewBotColour rs) let pict = Pict [] -- Legacy let sref = newServiceRef sid pid - let usr = User (botUserId bid) (Qualified (botUserId bid) domain) Nothing name pict assets colour False locale (Just sref) Nothing Nothing Nothing ManagedByWire defSupportedProtocols + let usr = User (Qualified (botUserId bid) domain) Nothing name pict assets colour False locale (Just sref) Nothing Nothing Nothing ManagedByWire defSupportedProtocols let newClt = (newClient PermanentClientType (Ext.rsNewBotLastPrekey rs)) { newClientPrekeys = Ext.rsNewBotPrekeys rs @@ -751,7 +733,7 @@ guardConvAdmin conv = do botGetSelf :: BotId -> (Handler r) Public.UserProfile botGetSelf bot = do p <- lift $ wrapClient $ User.lookupUser NoPendingInvitations (botUserId bot) - maybe (throwStd (errorToWai @'E.UserNotFound)) (pure . (`Public.publicProfile` UserLegalHoldNoConsent)) p + maybe (throwStd (errorToWai @'E.UserNotFound)) (\u -> pure $ Public.mkUserProfile EmailVisibleToSelf u UserLegalHoldNoConsent) p botGetClient :: Member GalleyProvider r => BotId -> (Handler r) (Maybe Public.Client) botGetClient bot = do diff --git a/services/brig/src/Brig/Provider/DB.hs b/services/brig/src/Brig/Provider/DB.hs index e83919f5bb0..77aefc29ea5 100644 --- a/services/brig/src/Brig/Provider/DB.hs +++ b/services/brig/src/Brig/Provider/DB.hs @@ -17,7 +17,6 @@ module Brig.Provider.DB where -import Brig.Data.Instances () import Brig.Email (EmailKey, emailKeyOrig, emailKeyUniq) import Brig.Types.Instances () import Brig.Types.Provider.Tag diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs index 553a773366f..e7219fef819 100644 --- a/services/brig/src/Brig/Run.hs +++ b/services/brig/src/Brig/Run.hs @@ -22,11 +22,10 @@ module Brig.Run where import AWS.Util (readAuthExpiration) -import Brig.API (sitemap) import Brig.API.Federation import Brig.API.Handler import Brig.API.Internal qualified as IAPI -import Brig.API.Public (DocsAPI, docsAPI, servantSitemap) +import Brig.API.Public import Brig.API.User qualified as API import Brig.AWS (amazonkaEnv, sesQueue) import Brig.AWS qualified as AWS @@ -46,11 +45,13 @@ import Control.Lens (view, (.~), (^.)) import Control.Monad.Catch (MonadCatch, finally) import Control.Monad.Random (randomRIO) import Data.Aeson qualified as Aeson +import Data.ByteString.UTF8 qualified as UTF8 import Data.Id (RequestId (..)) import Data.Metrics.AWS (gaugeTokenRemaing) import Data.Metrics.Servant qualified as Metrics import Data.Proxy (Proxy (Proxy)) import Data.Text (unpack) +import Data.Text.Encoding import Data.UUID as UUID import Data.UUID.V4 as UUID import Imports hiding (head) @@ -59,8 +60,6 @@ import Network.HTTP.Types qualified as HTTP import Network.Wai qualified as Wai import Network.Wai.Middleware.Gunzip qualified as GZip import Network.Wai.Middleware.Gzip qualified as GZip -import Network.Wai.Routing (Tree) -import Network.Wai.Routing.Route (App) import Network.Wai.Utilities (lookupRequestId) import Network.Wai.Utilities.Server import Network.Wai.Utilities.Server qualified as Server @@ -72,6 +71,7 @@ import System.Logger qualified as Log import System.Logger.Class (MonadLogger, err) import Util.Options import Wire.API.Routes.API +import Wire.API.Routes.Internal.Brig qualified as IAPI import Wire.API.Routes.Public.Brig import Wire.API.Routes.Version import Wire.API.Routes.Version.Wai @@ -119,22 +119,16 @@ mkApp o = do e <- newEnv o pure (middleware e $ \reqId -> servantApp (e & requestId .~ reqId), e) where - rtree :: Tree (App (Handler BrigCanonicalEffects)) - rtree = compile sitemap - middleware :: Env -> (RequestId -> Wai.Application) -> Wai.Application middleware e = -- this rewrites the request, so it must be at the top (i.e. applied last) versionMiddleware (e ^. disabledVersions) - . Metrics.servantPlusWAIPrometheusMiddleware (sitemap @BrigCanonicalEffects) (Proxy @ServantCombinedAPI) + . Metrics.servantPrometheusMiddleware (Proxy @ServantCombinedAPI) . GZip.gunzip . GZip.gzip GZip.def . catchErrors (e ^. applog) [Right $ e ^. metrics] . lookupRequestIdMiddleware (e ^. applog) - app :: Env -> Wai.Request -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived - app e r k = runHandler e r (Server.route rtree r k) k - -- the servant API wraps the one defined using wai-routing servantApp :: Env -> Wai.Application servantApp e = @@ -147,7 +141,6 @@ mkApp o = do :<|> hoistServerWithDomain @IAPI.API (toServantHandler e) IAPI.servantSitemap :<|> hoistServerWithDomain @FederationAPI (toServantHandler e) federationSitemap :<|> hoistServerWithDomain @VersionAPI (toServantHandler e) versionAPI - :<|> Servant.Tagged (app e) ) type ServantCombinedAPI = @@ -156,7 +149,6 @@ type ServantCombinedAPI = :<|> IAPI.API :<|> FederationAPI :<|> VersionAPI - :<|> Servant.Raw ) lookupRequestIdMiddleware :: Logger -> (RequestId -> Wai.Application) -> Wai.Application @@ -165,7 +157,7 @@ lookupRequestIdMiddleware logger mkapp req cont = do Just rid -> do mkapp (RequestId rid) req cont Nothing -> do - localRid <- RequestId . cs . UUID.toText <$> UUID.nextRandom + localRid <- RequestId . encodeUtf8 . UUID.toText <$> UUID.nextRandom Log.info logger $ "request-id" .= localRid ~~ "method" .= Wai.requestMethod req @@ -183,7 +175,7 @@ bodyParserErrorFormatter :: Servant.ErrorFormatter bodyParserErrorFormatter _ _ errMsg = Servant.ServerError { Servant.errHTTPCode = HTTP.statusCode HTTP.status400, - Servant.errReasonPhrase = cs $ HTTP.statusMessage HTTP.status400, + Servant.errReasonPhrase = UTF8.toString $ HTTP.statusMessage HTTP.status400, Servant.errBody = Aeson.encode $ Aeson.object @@ -228,7 +220,7 @@ pendingActivationCleanup = do safeForever funName action = forever $ action `catchAny` \exc -> do - err $ "error" .= show exc ~~ msg (val $ cs funName <> " failed") + err $ "error" .= show exc ~~ msg (val $ UTF8.fromString funName <> " failed") -- pause to keep worst-case noise in logs manageable threadDelay 60_000_000 diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index ac70c9623a1..c14ac164d13 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -36,6 +36,7 @@ import Brig.Data.UserKey import Brig.Data.UserKey qualified as Data import Brig.Effects.BlacklistStore (BlacklistStore) import Brig.Effects.BlacklistStore qualified as BlacklistStore +import Brig.Effects.ConnectionStore (ConnectionStore) import Brig.Effects.GalleyProvider (GalleyProvider) import Brig.Effects.GalleyProvider qualified as GalleyProvider import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) @@ -53,11 +54,14 @@ import Control.Monad.Trans.Except (mapExceptT) import Data.ByteString.Conversion (toByteString, toByteString') import Data.Id import Data.List1 qualified as List1 +import Data.Qualified (Local) import Data.Range -import Galley.Types.Teams qualified as Team +import Data.Text.Lazy qualified as LT +import Data.Time.Clock (UTCTime) import Imports hiding (head) import Network.Wai.Utilities hiding (code, message) import Polysemy +import Polysemy.Input (Input) import Polysemy.TinyLog (TinyLog) import Servant hiding (Handler, JSON, addHeader) import System.Logger.Class qualified as Log @@ -81,6 +85,7 @@ import Wire.API.User hiding (fromEmail) import Wire.API.User qualified as Public import Wire.NotificationSubsystem import Wire.Sem.Concurrency +import Wire.Sem.Paging.Cassandra (InternalPaging) servantAPI :: ( Member BlacklistStore r, @@ -142,7 +147,7 @@ createInvitationPublic :: createInvitationPublic uid tid body = do let inviteeRole = fromMaybe defaultRole . irRole $ body inviter <- do - let inviteePerms = Team.rolePermissions inviteeRole + let inviteePerms = Teams.rolePermissions inviteeRole idt <- maybe (throwStd (errorToWai @'E.NoIdentity)) pure =<< lift (fetchUserIdentity uid) from <- maybe (throwStd (errorToWai @'E.NoEmail)) pure (emailIdentity idt) ensurePermissionToAddUser uid tid inviteePerms @@ -156,7 +161,7 @@ createInvitationPublic uid tid body = do fst <$> logInvitationRequest context - (createInvitation' tid inviteeRole (Just (inviterUid inviter)) (inviterEmail inviter) body) + (createInvitation' tid Nothing inviteeRole (Just (inviterUid inviter)) (inviterEmail inviter) body) createInvitationViaScim :: ( Member BlacklistStore r, @@ -167,7 +172,7 @@ createInvitationViaScim :: TeamId -> NewUserScimInvitation -> (Handler r) UserAccount -createInvitationViaScim tid newUser@(NewUserScimInvitation _tid loc name email role) = do +createInvitationViaScim tid newUser@(NewUserScimInvitation _tid uid loc name email role) = do env <- ask let inviteeRole = role fromEmail = env ^. emailSender @@ -185,12 +190,11 @@ createInvitationViaScim tid newUser@(NewUserScimInvitation _tid loc name email r . logTeam tid . logEmail email - (inv, _) <- + void $ logInvitationRequest context $ - createInvitation' tid inviteeRole Nothing fromEmail invreq - let uid = Id (toUUID (inInvitation inv)) + createInvitation' tid (Just uid) inviteeRole Nothing fromEmail invreq - createUserInviteViaScim uid newUser + createUserInviteViaScim newUser logInvitationRequest :: (Msg -> Msg) -> (Handler r) (Invitation, InvitationCode) -> (Handler r) (Invitation, InvitationCode) logInvitationRequest context action = @@ -198,7 +202,12 @@ logInvitationRequest context action = eith <- action' case eith of Left err' -> do - Log.warn $ context . Log.msg @Text ("Failed to create invitation, label: " <> (cs . errorLabel) err') + Log.warn $ + context + . Log.msg @Text + ( "Failed to create invitation, label: " + <> (LT.toStrict . errorLabel) err' + ) pure (Left err') Right result@(_, code) -> do Log.info $ (context . logInvitationCode code) . Log.msg @Text "Successfully created invitation" @@ -209,12 +218,13 @@ createInvitation' :: Member GalleyProvider r ) => TeamId -> + Maybe UserId -> Public.Role -> Maybe UserId -> Email -> Public.InvitationRequest -> Handler r (Public.Invitation, Public.InvitationCode) -createInvitation' tid inviteeRole mbInviterUid fromEmail body = do +createInvitation' tid mUid inviteeRole mbInviterUid fromEmail body = do -- FUTUREWORK: These validations are nearly copy+paste from accountCreation and -- sendActivationCode. Refactor this to a single place @@ -249,7 +259,7 @@ createInvitation' tid inviteeRole mbInviterUid fromEmail body = do showInvitationUrl <- lift $ liftSem $ GalleyProvider.getExposeInvitationURLsToTeamAdmin tid lift $ do - iid <- liftIO DB.mkInvitationId + iid <- maybe (liftIO DB.mkInvitationId) (pure . Id . toUUID) mUid now <- liftIO =<< view currentTime timeout <- setTeamInvitationTimeout <$> view settings (newInv, code) <- @@ -312,7 +322,10 @@ suspendTeam :: Member NotificationSubsystem r, Member (Concurrency 'Unsafe) r, Member GalleyProvider r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => TeamId -> (Handler r) NoContent @@ -328,7 +341,10 @@ unsuspendTeam :: Member NotificationSubsystem r, Member (Concurrency 'Unsafe) r, Member GalleyProvider r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => TeamId -> (Handler r) NoContent @@ -345,7 +361,10 @@ changeTeamAccountStatuses :: Member NotificationSubsystem r, Member (Concurrency 'Unsafe) r, Member GalleyProvider r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => TeamId -> AccountStatus -> diff --git a/services/brig/src/Brig/Team/DB.hs b/services/brig/src/Brig/Team/DB.hs index fb62d5edf69..97db9efcded 100644 --- a/services/brig/src/Brig/Team/DB.hs +++ b/services/brig/src/Brig/Team/DB.hs @@ -38,7 +38,6 @@ module Brig.Team.DB where import Brig.App as App -import Brig.Data.Instances () import Brig.Data.Types as T import Brig.Options import Brig.Team.Template diff --git a/services/brig/src/Brig/Team/Util.hs b/services/brig/src/Brig/Team/Util.hs index eeec7fe8d9a..96669f4c9d6 100644 --- a/services/brig/src/Brig/Team/Util.hs +++ b/services/brig/src/Brig/Team/Util.hs @@ -27,7 +27,6 @@ import Control.Error import Control.Lens import Data.Id import Data.Set qualified as Set -import Galley.Types.Teams import Imports import Polysemy (Member) import Wire.API.Team.Member diff --git a/services/brig/src/Brig/Unique.hs b/services/brig/src/Brig/Unique.hs index 6c5d5f0a2a8..58c95630a8a 100644 --- a/services/brig/src/Brig/Unique.hs +++ b/services/brig/src/Brig/Unique.hs @@ -29,7 +29,6 @@ module Brig.Unique ) where -import Brig.Data.Instances () import Cassandra as C import Control.Concurrent.Timeout import Data.Id diff --git a/services/brig/src/Brig/User/API/Search.hs b/services/brig/src/Brig/User/API/Search.hs index 44a87a7dd50..14035f1e804 100644 --- a/services/brig/src/Brig/User/API/Search.hs +++ b/services/brig/src/Brig/User/API/Search.hs @@ -45,7 +45,6 @@ import Data.Domain (Domain) import Data.Handle (parseHandle) import Data.Id import Data.Range -import Galley.Types.Teams (HiddenPerm (SearchContacts)) import Imports import Network.Wai.Utilities ((!>>)) import Polysemy @@ -55,6 +54,7 @@ import System.Logger.Class qualified as Log import Wire.API.Federation.API.Brig qualified as FedBrig import Wire.API.Federation.API.Brig qualified as S import Wire.API.Routes.FederationDomainConfig +import Wire.API.Team.Member (HiddenPerm (SearchContacts)) import Wire.API.Team.Permission qualified as Public import Wire.API.Team.SearchVisibility (TeamSearchVisibility (..)) import Wire.API.User.Search diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index fece7d7c22c..d329843c74f 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -47,6 +47,7 @@ import Brig.Data.LoginCode qualified as Data import Brig.Data.User qualified as Data import Brig.Data.UserKey import Brig.Data.UserKey qualified as Data +import Brig.Effects.ConnectionStore (ConnectionStore) import Brig.Effects.GalleyProvider (GalleyProvider) import Brig.Effects.GalleyProvider qualified as GalleyProvider import Brig.Email @@ -68,10 +69,13 @@ import Data.List.NonEmpty qualified as NE import Data.List1 (List1) import Data.List1 qualified as List1 import Data.Misc (PlainTextPassword6) +import Data.Qualified (Local) +import Data.Time.Clock (UTCTime) import Data.ZAuth.Token qualified as ZAuth import Imports import Network.Wai.Utilities.Error ((!>>)) import Polysemy +import Polysemy.Input (Input) import Polysemy.TinyLog (TinyLog) import Polysemy.TinyLog qualified as Log import System.Logger (field, msg, val, (~~)) @@ -82,6 +86,7 @@ import Wire.API.User.Auth import Wire.API.User.Auth.LegalHold import Wire.API.User.Auth.Sso import Wire.NotificationSubsystem +import Wire.Sem.Paging.Cassandra (InternalPaging) sendLoginCode :: (Member TinyLog r) => @@ -128,7 +133,10 @@ login :: ( Member GalleyProvider r, Member TinyLog r, Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => Login -> CookieType -> @@ -237,7 +245,10 @@ renewAccess :: ( ZAuth.TokenPair u a, Member TinyLog r, Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => List1 (ZAuth.Token u) -> Maybe (ZAuth.Token a) -> @@ -270,7 +281,10 @@ revokeAccess u pw cc ll = do catchSuspendInactiveUser :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> e -> @@ -296,7 +310,10 @@ newAccess :: ( ZAuth.TokenPair u a, Member TinyLog r, Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => UserId -> Maybe ClientId -> @@ -407,7 +424,10 @@ validateToken ut at = do ssoLogin :: ( Member TinyLog r, Member (Embed HttpClientIO) r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => SsoLogin -> CookieType -> @@ -431,7 +451,10 @@ legalHoldLogin :: ( Member GalleyProvider r, Member (Embed HttpClientIO) r, Member NotificationSubsystem r, - Member TinyLog r + Member TinyLog r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ConnectionStore InternalPaging) r ) => LegalHoldLogin -> CookieType -> diff --git a/services/brig/src/Brig/User/Auth/Cookie.hs b/services/brig/src/Brig/User/Auth/Cookie.hs index 5da62fb8e43..1bd569bc352 100644 --- a/services/brig/src/Brig/User/Auth/Cookie.hs +++ b/services/brig/src/Brig/User/Auth/Cookie.hs @@ -56,7 +56,7 @@ import Data.Metrics qualified as Metrics import Data.Proxy import Data.RetryAfter import Data.Time.Clock -import Imports hiding (cs) +import Imports import Network.Wai (Response) import Network.Wai.Utilities.Response (addHeader) import System.Logger.Class (field, msg, val, (~~)) diff --git a/services/brig/src/Brig/User/Auth/Cookie/Limit.hs b/services/brig/src/Brig/User/Auth/Cookie/Limit.hs index 5c25c4588f2..034f3ced85f 100644 --- a/services/brig/src/Brig/User/Auth/Cookie/Limit.hs +++ b/services/brig/src/Brig/User/Auth/Cookie/Limit.hs @@ -22,7 +22,7 @@ import Data.RetryAfter import Data.Time.Clock import Data.Time.Clock.POSIX import Data.Vector qualified as Vector -import Imports hiding (cs) +import Imports import Statistics.Sample qualified as Stats import Wire.API.User.Auth diff --git a/services/brig/src/Brig/User/Auth/DB/Cookie.hs b/services/brig/src/Brig/User/Auth/DB/Cookie.hs index d52dfbf1944..c0d43ef2341 100644 --- a/services/brig/src/Brig/User/Auth/DB/Cookie.hs +++ b/services/brig/src/Brig/User/Auth/DB/Cookie.hs @@ -23,7 +23,7 @@ import Brig.User.Auth.DB.Instances () import Cassandra import Data.Id import Data.Time.Clock -import Imports hiding (cs) +import Imports import Wire.API.User.Auth newtype TTL = TTL {ttlSeconds :: Int32} diff --git a/services/brig/src/Brig/User/EJPD.hs b/services/brig/src/Brig/User/EJPD.hs index ae7538b6b5f..b5afec1f8f0 100644 --- a/services/brig/src/Brig/User/EJPD.hs +++ b/services/brig/src/Brig/User/EJPD.hs @@ -20,6 +20,8 @@ -- manually.) module Brig.User.EJPD (ejpdRequest) where +import Bilge.Request +import Bilge.Response import Brig.API.Handler import Brig.API.User (lookupHandle) import Brig.App @@ -27,50 +29,55 @@ import Brig.Data.Connection qualified as Conn import Brig.Data.User (lookupUser) import Brig.Effects.GalleyProvider (GalleyProvider) import Brig.Effects.GalleyProvider qualified as GalleyProvider -import Brig.Types.User (HavePendingInvitations (NoPendingInvitations)) import Control.Error hiding (bool) import Control.Lens (view, (^.)) +import Data.Aeson qualified as A +import Data.ByteString.Conversion import Data.Handle (Handle) import Data.Id (UserId) import Data.Set qualified as Set +import Data.Text qualified as T import Imports hiding (head) -import Polysemy +import Network.HTTP.Types.Method +import Polysemy (Member) import Servant.OpenApi.Internal.Orphans () import Wire.API.Connection (Relation, RelationWithHistory (..), relationDropHistory) import Wire.API.Push.Token qualified as PushTok import Wire.API.Routes.Internal.Brig.EJPD (EJPDRequestBody (EJPDRequestBody), EJPDResponseBody (EJPDResponseBody), EJPDResponseItem (EJPDResponseItem)) import Wire.API.Team.Member qualified as Team -import Wire.API.User (User, userDisplayName, userEmail, userHandle, userId, userPhone, userTeam) +import Wire.API.User import Wire.NotificationSubsystem +import Wire.Rpc ejpdRequest :: forall r. ( Member GalleyProvider r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member Rpc r ) => Maybe Bool -> EJPDRequestBody -> - Handler r EJPDResponseBody -ejpdRequest includeContacts (EJPDRequestBody handles) = do - ExceptT $ Right . EJPDResponseBody . catMaybes <$> forM handles (go1 (fromMaybe False includeContacts)) + (Handler r) EJPDResponseBody +ejpdRequest (fromMaybe False -> includeContacts) (EJPDRequestBody handles) = do + ExceptT $ Right . EJPDResponseBody . catMaybes <$> forM handles go1 where -- find uid given handle - go1 :: Bool -> Handle -> (AppT r) (Maybe EJPDResponseItem) - go1 includeContacts' handle = do + go1 :: Handle -> (AppT r) (Maybe EJPDResponseItem) + go1 handle = do mbUid <- wrapClient $ lookupHandle handle mbUsr <- maybe (pure Nothing) (wrapClient . lookupUser NoPendingInvitations) mbUid - maybe (pure Nothing) (fmap Just . go2 includeContacts') mbUsr + maybe (pure Nothing) (fmap Just . go2 includeContacts) mbUsr -- construct response item given uid go2 :: Bool -> User -> (AppT r) EJPDResponseItem - go2 includeContacts' target = do + go2 reallyIncludeContacts target = do let uid = userId target ptoks <- PushTok.tokenText . view PushTok.token <$$> liftSem (getPushTokens uid) mbContacts <- - if includeContacts' + if reallyIncludeContacts then do contacts :: [(UserId, RelationWithHistory)] <- wrapClient $ Conn.lookupContactListWithRelation uid @@ -85,7 +92,7 @@ ejpdRequest includeContacts (EJPDRequestBody handles) = do pure Nothing mbTeamContacts <- - case (includeContacts', userTeam target) of + case (reallyIncludeContacts, userTeam target) of (True, Just tid) -> do memberList <- liftSem $ GalleyProvider.getTeamMembers tid let members = (view Team.userId <$> (memberList ^. Team.teamMembers)) \\ [uid] @@ -99,6 +106,28 @@ ejpdRequest includeContacts (EJPDRequestBody handles) = do _ -> do pure Nothing + mbConversations <- do + -- FUTUREWORK(fisx) + pure Nothing + + mbAssets <- do + urls <- forM (userAssets target) $ \(asset :: Asset) -> do + cgh <- asks (view cargoholdEndpoint) + let key = toByteString' $ assetKey asset + resp <- liftSem $ rpcWithRetries "cargohold" cgh (method GET . paths ["/i/assets", key]) + pure $ + case (statusCode resp, responseJsonEither resp) of + (200, Right (A.String loc)) -> loc + _ -> + T.pack $ + "could not fetch asset: " + <> show key + <> ", error: " + <> show (statusCode resp, responseBody resp) + pure $ case urls of + [] -> Nothing + something -> Just (Set.fromList something) + pure $ EJPDResponseItem uid @@ -110,3 +139,5 @@ ejpdRequest includeContacts (EJPDRequestBody handles) = do (Set.fromList ptoks) mbContacts mbTeamContacts + mbConversations + mbAssets diff --git a/services/brig/src/Brig/User/Handle.hs b/services/brig/src/Brig/User/Handle.hs index 4335f76b4c2..fd62c770c3c 100644 --- a/services/brig/src/Brig/User/Handle.hs +++ b/services/brig/src/Brig/User/Handle.hs @@ -26,7 +26,6 @@ where import Brig.App import Brig.CanonicalInterpreter (runBrigToIO) -import Brig.Data.Instances () import Brig.Data.User qualified as User import Brig.Unique import Cassandra diff --git a/services/brig/src/Brig/User/Search/Index.hs b/services/brig/src/Brig/User/Search/Index.hs index 812842aef82..9df5255ce84 100644 --- a/services/brig/src/Brig/User/Search/Index.hs +++ b/services/brig/src/Brig/User/Search/Index.hs @@ -56,7 +56,6 @@ import Bilge.RPC (RPCException (RPCException)) import Bilge.Request qualified as RPC (empty, host, method, port) import Bilge.Response (responseJsonThrow) import Bilge.Retry (rpcHandlers) -import Brig.Data.Instances () import Brig.Index.Types (CreateIndexSettings (..)) import Brig.Types.Search (SearchVisibilityInbound, defaultSearchVisibilityInbound, searchVisibilityInboundFromFeatureStatus) import Brig.User.Search.Index.Types as Types @@ -70,17 +69,20 @@ import Control.Retry (RetryPolicy, exponentialBackoff, limitRetries, recovering) import Data.Aeson as Aeson import Data.Aeson.Encoding import Data.Aeson.Lens +import Data.ByteString (toStrict) import Data.ByteString.Builder (Builder, toLazyByteString) import Data.ByteString.Conversion (toByteString') import Data.ByteString.Conversion qualified as Bytes import Data.ByteString.Lazy qualified as BL +import Data.Credentials import Data.Handle (Handle) import Data.Id import Data.Map qualified as Map import Data.Metrics import Data.Text qualified as T import Data.Text qualified as Text -import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Data.Text.Encoding +import Data.Text.Encoding.Error import Data.Text.Lazy qualified as LT import Data.Text.Lazy.Builder.Int (decimal) import Data.Text.Lens hiding (text) @@ -112,7 +114,10 @@ data IndexEnv = IndexEnv idxAdditionalName :: Maybe ES.IndexName, idxAdditionalElastic :: Maybe ES.BHEnv, idxGalley :: Endpoint, - idxHttpManager :: Manager + -- | Used to make RPC calls to other wire-server services + idxRpcHttpManager :: Manager, + -- credentials for reindexing have to be passed via the env because bulk API requests are not supported by bloodhound + idxCredentials :: Maybe Credentials } newtype IndexIO a = IndexIO (ReaderT IndexEnv IO a) @@ -150,7 +155,7 @@ instance ES.MonadBH IndexIO where instance MonadHttp IndexIO where handleRequestWithCont req handler = do - manager <- asks idxHttpManager + manager <- asks idxRpcHttpManager liftIO $ withResponse req manager handler withDefaultESUrl :: (MonadIndexIO m) => ES.BH m a -> m a @@ -210,12 +215,13 @@ updateIndex (IndexUpdateUsers updateType ius) = liftIndexIO $ do let (ES.MappingName mpp) = mappingName let (ES.Server base) = ES.bhServer bhe req <- parseRequest (view unpacked $ base <> "/" <> idx <> "/" <> mpp <> "/_bulk") + authHeaders <- mkAuthHeaders res <- liftIO $ httpLbs req { method = "POST", - requestHeaders = [(hContentType, "application/x-ndjson")], -- sic + requestHeaders = [(hContentType, "application/x-ndjson")] <> authHeaders, -- sic requestBody = RequestBodyLBS (toLazyByteString (foldMap bulkEncode ius)) } (ES.bhManager bhe) @@ -229,6 +235,10 @@ updateIndex (IndexUpdateUsers updateType ius) = liftIndexIO $ do (path ("user.index.update.bulk.status." <> review builder (decimal s))) m where + mkAuthHeaders = do + creds <- asks idxCredentials + pure $ maybe [] ((: []) . mkBasicAuthHeader) creds + encodeJSONToString :: ToJSON a => a -> Builder encodeJSONToString = fromEncoding . toEncoding bulkEncode iu = @@ -332,7 +342,12 @@ createIndex' failIfExists (CreateIndexSettings settings shardCount mbDeleteTempl for_ mbDeleteTemplate $ \templateName@(ES.TemplateName tname) -> do tExists <- ES.templateExists templateName when tExists $ do - dr <- traceES (cs ("Delete index template " <> "\"" <> tname <> "\"")) $ ES.deleteTemplate templateName + dr <- + traceES + ( encodeUtf8 + ("Delete index template " <> "\"" <> tname <> "\"") + ) + $ ES.deleteTemplate templateName unless (ES.isSuccess dr) $ throwM (IndexError "Deleting index template failed.") @@ -888,7 +903,11 @@ reindexRowToIndexUser idpUrl (UserScimExternalId _) = Nothing fromUri :: URI -> Text - fromUri = cs . toLazyByteString . serializeURIRef + fromUri = + decodeUtf8With lenientDecode + . toStrict + . toLazyByteString + . serializeURIRef sso :: UserSSOId -> Maybe Sso sso userSsoId = do diff --git a/services/brig/src/Brig/User/Search/SearchIndex.hs b/services/brig/src/Brig/User/Search/SearchIndex.hs index b70fcf3deb3..d9803fff6b5 100644 --- a/services/brig/src/Brig/User/Search/SearchIndex.hs +++ b/services/brig/src/Brig/User/Search/SearchIndex.hs @@ -25,7 +25,6 @@ module Brig.User.Search.SearchIndex where import Brig.App (Env, viewFederationDomain) -import Brig.Data.Instances () import Brig.Types.Search import Brig.User.Search.Index import Control.Lens hiding (setting, (#), (.=)) diff --git a/services/brig/src/Brig/User/Search/TeamSize.hs b/services/brig/src/Brig/User/Search/TeamSize.hs index fa13b843bf4..1fd23bbf1c3 100644 --- a/services/brig/src/Brig/User/Search/TeamSize.hs +++ b/services/brig/src/Brig/User/Search/TeamSize.hs @@ -22,7 +22,6 @@ module Brig.User.Search.TeamSize ) where -import Brig.Data.Instances () import Brig.Types.Team (TeamSize (..)) import Brig.User.Search.Index import Control.Monad.Catch (throwM) diff --git a/services/brig/src/Brig/User/Search/TeamUserSearch.hs b/services/brig/src/Brig/User/Search/TeamUserSearch.hs index 1b60532c063..90bcb969e96 100644 --- a/services/brig/src/Brig/User/Search/TeamUserSearch.hs +++ b/services/brig/src/Brig/User/Search/TeamUserSearch.hs @@ -29,11 +29,11 @@ module Brig.User.Search.TeamUserSearch ) where -import Brig.Data.Instances () import Brig.User.Search.Index import Control.Error (lastMay) import Control.Monad.Catch (MonadThrow (throwM)) import Data.Aeson (decode', encode) +import Data.ByteString (fromStrict, toStrict) import Data.Id (TeamId, idToText) import Data.Range (Range (..)) import Data.Text.Ascii (decodeBase64Url, encodeBase64Url) @@ -67,10 +67,10 @@ teamUserSearch tid mbSearchText mRoleFilter mSortBy mSortOrder (fromRange -> siz either (throwM . IndexLookupError) (pure . mkResult) r where toSearchAfterKey :: PagingState -> Maybe ES.SearchAfterKey - toSearchAfterKey ps = decode' . cs =<< (decodeBase64Url . unPagingState $ ps) + toSearchAfterKey ps = decode' . fromStrict =<< (decodeBase64Url . unPagingState $ ps) fromSearchAfterKey :: ES.SearchAfterKey -> PagingState - fromSearchAfterKey = PagingState . encodeBase64Url . cs . encode + fromSearchAfterKey = PagingState . encodeBase64Url . toStrict . encode mkResult es = let hitsPlusOne = ES.hits . ES.searchHits $ es diff --git a/services/brig/test/integration/API/Calling.hs b/services/brig/test/integration/API/Calling.hs index ffcaad9399f..c8008d01cb6 100644 --- a/services/brig/test/integration/API/Calling.hs +++ b/services/brig/test/integration/API/Calling.hs @@ -33,6 +33,7 @@ import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List.NonEmpty qualified as NonEmpty import Data.Misc (Port (..), mkHttpsUrl) import Data.Set qualified as Set +import Data.String.Conversions import Imports import System.FilePath (()) import Test.Tasty @@ -101,7 +102,7 @@ testSFT b opts = do "when SFT discovery is not enabled, sft_servers shouldn't be returned" Nothing (cfg ^. rtcConfSftServers) - withSettingsOverrides (opts & Opts.sftL ?~ Opts.SFTOptions "integration-tests.zinfra.io" Nothing (Just 0.001) Nothing) $ do + withSettingsOverrides (opts & Opts.sftL ?~ Opts.SFTOptions "integration-tests.zinfra.io" Nothing (Just 0.001) Nothing Nothing) $ do cfg1 <- retryWhileN 10 (isNothing . view rtcConfSftServers) (getTurnConfigurationV2 uid b) -- These values are controlled by https://github.com/zinfra/cailleach/tree/77ca2d23cf2959aa183dd945d0a0b13537a8950d/environments/dns-integration-tests let Right server1 = mkHttpsUrl =<< first show (parseURI laxURIParserOptions "https://sft01.integration-tests.zinfra.io:443") diff --git a/services/brig/test/integration/API/Federation.hs b/services/brig/test/integration/API/Federation.hs index 2f0def2baef..9f416d5b252 100644 --- a/services/brig/test/integration/API/Federation.hs +++ b/services/brig/test/integration/API/Federation.hs @@ -44,7 +44,7 @@ import Wire.API.Federation.API.Brig qualified as S import Wire.API.Federation.Component import Wire.API.Federation.Version import Wire.API.Routes.FederationDomainConfig as FD -import Wire.API.User +import Wire.API.User as User import Wire.API.User.Client import Wire.API.User.Client.Prekey import Wire.API.User.Search @@ -126,7 +126,7 @@ testFulltextSearchMultipleUsers opts brig = do update'' :: UserUpdate <- liftIO $ generate arbitrary let update' = update'' {uupName = Just (Name (fromHandle handle))} update = RequestBodyLBS . encode $ update' - put (brig . path "/self" . contentJson . zUser identityThief.userId . zConn "c" . body update) !!! const 200 === statusCode + put (brig . path "/self" . contentJson . zUser (User.userId identityThief) . zConn "c" . body update) !!! const 200 === statusCode refreshIndex brig @@ -272,9 +272,9 @@ testGetUsersByIdsSuccess :: Brig -> FedClient 'Brig -> Http () testGetUsersByIdsSuccess brig fedBrigClient = do user1 <- randomUser brig user2 <- randomUser brig - let uid1 = user1.userId + let uid1 = User.userId user1 quid1 = userQualifiedId user1 - uid2 = user2.userId + uid2 = User.userId user2 quid2 = userQualifiedId user2 profiles <- runFedClient @"get-users-by-ids" fedBrigClient (Domain "example.com") [uid1, uid2] liftIO $ do @@ -287,7 +287,7 @@ testGetUsersByIdsPartial brig fedBrigClient = do absentUserId :: UserId <- Id <$> lift UUIDv4.nextRandom profiles <- runFedClient @"get-users-by-ids" fedBrigClient (Domain "example.com") $ - [presentUser.userId, absentUserId] + [User.userId presentUser, absentUserId] liftIO $ assertEqual "should return the present user and skip the absent ones" [userQualifiedId presentUser] (profileQualifiedId <$> profiles) @@ -302,7 +302,7 @@ testGetUsersByIdsFederationRestrictionAllowAllFound fedBrigClient = do testClaimPrekeySuccess :: Brig -> FedClient 'Brig -> Http () testClaimPrekeySuccess brig fedBrigClient = do user <- randomUser brig - let uid = user.userId + let uid = User.userId user let new = defNewClient PermanentClientType [head somePrekeys] (head someLastPrekeys) c <- responseJsonError =<< addClient brig uid new mkey <- runFedClient @"claim-prekey" fedBrigClient (Domain "example.com") (uid, clientId c) @@ -351,7 +351,7 @@ addTestClients brig uid idxs = testGetUserClients :: Brig -> FedClient 'Brig -> Http () testGetUserClients brig fedBrigClient = do - uid1 <- (.userId) <$> randomUser brig + uid1 <- User.userId <$> randomUser brig clients :: [Client] <- addTestClients brig uid1 [0, 1, 2] UserMap userClients <- runFedClient @"get-user-clients" fedBrigClient (Domain "example.com") (GetUserClients [uid1]) liftIO $ @@ -373,4 +373,4 @@ testGetUserClientsNotFound fedBrigClient = do testAPIVersion :: Brig -> FedClient 'Brig -> Http () testAPIVersion _brig fedBrigClient = do vinfo <- runFedClient @"api-version" fedBrigClient (Domain "far-away.example.com") () - liftIO $ vinfoSupported vinfo @?= toList supportedVersions + liftIO $ vinfoSupported vinfo @?= map versionInt (toList supportedVersions) diff --git a/services/brig/test/integration/API/Internal.hs b/services/brig/test/integration/API/Internal.hs index b0f7704123b..b4d730fcd94 100644 --- a/services/brig/test/integration/API/Internal.hs +++ b/services/brig/test/integration/API/Internal.hs @@ -34,13 +34,13 @@ import Cassandra qualified as Cass import Cassandra.Util import Control.Exception (ErrorCall (ErrorCall), throwIO) import Control.Lens ((^.), (^?!)) +import Data.Aeson qualified as Aeson import Data.Aeson.Lens qualified as Aeson import Data.Aeson.Types qualified as Aeson import Data.ByteString.Conversion (toByteString') import Data.Default import Data.Id import Data.Qualified -import Data.Set qualified as Set import GHC.TypeLits (KnownSymbol) import Imports import System.IO.Temp @@ -48,20 +48,16 @@ import Test.Tasty import Test.Tasty.HUnit import Util import Util.Options (Endpoint) -import Wire.API.Connection qualified as Conn -import Wire.API.Routes.Internal.Brig import Wire.API.Team.Feature import Wire.API.Team.Feature qualified as ApiFt -import Wire.API.Team.Member qualified as Team import Wire.API.User import Wire.API.User.Client tests :: Opt.Opts -> Manager -> Cass.ClientState -> Brig -> Endpoint -> Gundeck -> Galley -> IO TestTree -tests opts mgr db brig brigep gundeck galley = do +tests opts mgr db brig brigep _gundeck galley = do pure $ testGroup "api/internal" $ - [ test mgr "ejpd requests" $ testEJPDRequest mgr brig brigep gundeck, - test mgr "account features: conferenceCalling" $ + [ test mgr "account features: conferenceCalling" $ testFeatureConferenceCallingByAccount opts mgr db brig brigep galley, test mgr "suspend and unsuspend user" $ testSuspendUser db brig, test mgr "suspend non existing user and verify no db entry" $ @@ -98,54 +94,6 @@ setAccountStatus brig u s = . json (AccountStatusUpdate s) ) -testEJPDRequest :: (TestConstraints m) => Manager -> Brig -> Endpoint -> Gundeck -> m () -testEJPDRequest mgr brig brigep gundeck = do - (handle1, mkUsr1, handle2, mkUsr2, mkUsr3) <- scaffolding brig gundeck - - do - let req = EJPDRequestBody [handle1] - want = - EJPDResponseBody - [ mkUsr1 Nothing Nothing - ] - have <- ejpdRequestClient brigep mgr Nothing req - liftIO $ assertEqual "" want have - - do - let req = EJPDRequestBody [handle1, handle2] - want = - EJPDResponseBody - [ mkUsr1 Nothing Nothing, - mkUsr2 Nothing Nothing - ] - have <- ejpdRequestClient brigep mgr Nothing req - liftIO $ assertEqual "" want have - - do - let req = EJPDRequestBody [handle2] - want = - EJPDResponseBody - [ mkUsr2 - (Just (Set.fromList [(Conn.Accepted, mkUsr1 Nothing Nothing)])) - Nothing - ] - have <- ejpdRequestClient brigep mgr (Just True) req - liftIO $ assertEqual "" want have - - do - let req = EJPDRequestBody [handle1, handle2] - want = - EJPDResponseBody - [ mkUsr1 - (Just (Set.fromList [(Conn.Accepted, mkUsr2 Nothing Nothing)])) - (Just (Set.fromList [mkUsr3 Nothing Nothing], Team.NewListComplete)), - mkUsr2 - (Just (Set.fromList [(Conn.Accepted, mkUsr1 Nothing Nothing)])) - Nothing - ] - have <- ejpdRequestClient brigep mgr (Just True) req - liftIO $ assertEqual "" want have - testFeatureConferenceCallingByAccount :: forall m. (TestConstraints m) => Opt.Opts -> Manager -> Cass.ClientState -> Brig -> Endpoint -> Galley -> m () testFeatureConferenceCallingByAccount (Opt.optSettings -> settings) mgr db brig brigep galley = do let check :: (HasCallStack) => ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig -> m () diff --git a/services/brig/test/integration/API/Internal/Util.hs b/services/brig/test/integration/API/Internal/Util.hs index 5a55b04461b..b37bff338a2 100644 --- a/services/brig/test/integration/API/Internal/Util.hs +++ b/services/brig/test/integration/API/Internal/Util.hs @@ -20,108 +20,28 @@ module API.Internal.Util ( TestConstraints, - MkUsr, - scaffolding, - ejpdRequestClient, getAccountConferenceCallingConfigClient, putAccountConferenceCallingConfigClient, deleteAccountConferenceCallingConfigClient, ) where -import API.Team.Util (createPopulatedBindingTeamWithNamesAndHandles) import Bilge hiding (host, port) -import Control.Lens (view, (^.)) -import Control.Monad.Catch (MonadCatch, MonadThrow, throwM) -import Data.ByteString.Base16 qualified as B16 -import Data.Handle (Handle) +import Control.Lens ((^.)) +import Control.Monad.Catch (MonadCatch) import Data.Id -import Data.List1 qualified as List1 import Data.Proxy (Proxy (Proxy)) -import Data.Set qualified as Set -import Data.Text.Encoding qualified as T +import Data.String.Conversions import Imports import Servant.API ((:>)) import Servant.API.ContentTypes (NoContent) import Servant.Client qualified as Client -import System.Random (randomIO) -import Util import Util.Options (Endpoint, host, port) -import Wire.API.Connection -import Wire.API.Push.V2.Token qualified as PushToken import Wire.API.Routes.Internal.Brig as IAPI import Wire.API.Team.Feature qualified as Public -import Wire.API.Team.Member qualified as Team -import Wire.API.User type TestConstraints m = (MonadFail m, MonadCatch m, MonadIO m, MonadHttp m) -type MkUsr = - Maybe (Set (Relation, EJPDResponseItem)) -> - Maybe (Set EJPDResponseItem, Team.NewListType) -> - EJPDResponseItem - -scaffolding :: - forall m. - (TestConstraints m) => - Brig -> - Gundeck -> - m (Handle, MkUsr, Handle, MkUsr, MkUsr) -scaffolding brig gundeck = do - (_tid, usr1, [usr3]) <- createPopulatedBindingTeamWithNamesAndHandles brig 1 - (_handle1, usr2) <- createUserWithHandle brig - connectUsers brig (userId usr1) (List1.singleton $ userId usr2) - tok1 <- registerPushToken gundeck $ userId usr1 - tok2 <- registerPushToken gundeck $ userId usr2 - tok3 <- registerPushToken gundeck $ userId usr2 - pure - ( fromJust $ userHandle usr1, - mkUsr usr1 (Set.fromList [tok1]), - fromJust $ userHandle usr2, - mkUsr usr2 (Set.fromList [tok2, tok3]), - mkUsr usr3 Set.empty - ) - where - mkUsr :: User -> Set Text -> MkUsr - mkUsr usr toks = - EJPDResponseItem - (userId usr) - (userTeam usr) - (userDisplayName usr) - (userHandle usr) - (userEmail usr) - (userPhone usr) - toks - - registerPushToken :: Gundeck -> UserId -> m Text - registerPushToken gd u = do - t <- randomToken - rsp <- registerPushTokenRequest gd u t - responseJsonEither rsp - & either - (error . show) - (pure . PushToken.tokenText . view PushToken.token) - - registerPushTokenRequest :: Gundeck -> UserId -> PushToken.PushToken -> m ResponseLBS - registerPushTokenRequest gd u t = do - post - ( gd - . path "/push/tokens" - . contentJson - . zUser u - . zConn "random" - . json t - ) - - randomToken :: m PushToken.PushToken - randomToken = liftIO $ do - c <- liftIO $ ClientId <$> (randomIO :: IO Word64) - tok <- (PushToken.Token . T.decodeUtf8) . B16.encode <$> randomBytes 32 - pure $ PushToken.pushToken PushToken.APNSSandbox (PushToken.AppName "test") tok c - -ejpdRequestClientM :: Maybe Bool -> EJPDRequestBody -> Client.ClientM EJPDResponseBody -ejpdRequestClientM = Client.client (Proxy @("i" :> IAPI.EJPDRequest)) - getAccountConferenceCallingConfigClientM :: UserId -> Client.ClientM (Public.WithStatusNoLock Public.ConferenceCallingConfig) getAccountConferenceCallingConfigClientM = Client.client (Proxy @("i" :> IAPI.GetAccountConferenceCallingConfig)) @@ -131,9 +51,6 @@ putAccountConferenceCallingConfigClientM = Client.client (Proxy @("i" :> IAPI.Pu deleteAccountConferenceCallingConfigClientM :: UserId -> Client.ClientM NoContent deleteAccountConferenceCallingConfigClientM = Client.client (Proxy @("i" :> IAPI.DeleteAccountConferenceCallingConfig)) -ejpdRequestClient :: (HasCallStack, MonadThrow m, MonadIO m) => Endpoint -> Manager -> Maybe Bool -> EJPDRequestBody -> m EJPDResponseBody -ejpdRequestClient brigep mgr includeContacts ejpdReqBody = runHereClientM brigep mgr (ejpdRequestClientM includeContacts ejpdReqBody) >>= either throwM pure - getAccountConferenceCallingConfigClient :: (HasCallStack, MonadIO m) => Endpoint -> Manager -> UserId -> m (Either Client.ClientError (Public.WithStatusNoLock Public.ConferenceCallingConfig)) getAccountConferenceCallingConfigClient brigep mgr uid = runHereClientM brigep mgr (getAccountConferenceCallingConfigClientM uid) diff --git a/services/brig/test/integration/API/OAuth.hs b/services/brig/test/integration/API/OAuth.hs index 757815af2c0..cd08aae8317 100644 --- a/services/brig/test/integration/API/OAuth.hs +++ b/services/brig/test/integration/API/OAuth.hs @@ -37,6 +37,7 @@ import Data.Id import Data.Qualified (Qualified (qUnqualified)) import Data.Range import Data.Set as Set hiding (delete, null, (\\)) +import Data.String.Conversions import Data.Text.Ascii (encodeBase16) import Data.Text.Encoding qualified as T import Data.Time @@ -58,7 +59,7 @@ import Wire.API.Conversation.Code (CreateConversationCodeRequest (CreateConversa import Wire.API.Conversation.Role qualified as Role import Wire.API.OAuth import Wire.API.Routes.Bearer (Bearer (Bearer, unBearer)) -import Wire.API.User +import Wire.API.User as User import Wire.API.User.Auth (CookieType (PersistentCookie)) import Wire.Sem.Jwk (readJwk) @@ -185,7 +186,7 @@ testCreateAccessTokenSuccess opts brig = do user <- createUser "alice" brig let redirectUrl = mkUrl "https://example.com" let scopes = OAuthScopes $ Set.singleton ReadSelf - (cid, code) <- generateOAuthClientAndAuthorizationCode brig user.userId scopes redirectUrl + (cid, code) <- generateOAuthClientAndAuthorizationCode brig (User.userId user) scopes redirectUrl let accessTokenRequest = OAuthAccessTokenRequest OAuthGrantTypeAuthorizationCode cid verifier code redirectUrl resp <- createOAuthAccessToken brig accessTokenRequest -- authorization code should be deleted and can only be used once @@ -203,7 +204,7 @@ testCreateAccessTokenSuccess opts brig = do claims.scope @?= scopes (view claimIss $ claims) @?= (expectedDomain ^? stringOrUri @Text) (view claimAud $ claims) @?= (Audience . (: []) <$> expectedDomain ^? stringOrUri @Text) - (view claimSub $ claims) @?= (idToText user.userId ^? stringOrUri) + (view claimSub $ claims) @?= (idToText (User.userId user) ^? stringOrUri) let expTime = (\(NumericDate x) -> x) . fromMaybe (error "exp claim missing") . view claimExp $ claims diffUTCTime expTime now > 0 @?= True let issuingTime = (\(NumericDate x) -> x) . fromMaybe (error "iat claim missing") . view claimIat $ claims @@ -361,7 +362,7 @@ testAccessResourceSuccessNginz brig nginz = do -- with Authorization header containing an OAuth bearer token let redirectUrl = mkUrl "https://example.com" let scopes = OAuthScopes $ Set.fromList [ReadSelf] - (cid, code) <- generateOAuthClientAndAuthorizationCode brig user.userId scopes redirectUrl + (cid, code) <- generateOAuthClientAndAuthorizationCode brig (User.userId user) scopes redirectUrl let accessTokenRequest = OAuthAccessTokenRequest OAuthGrantTypeAuthorizationCode cid verifier code redirectUrl resp <- createOAuthAccessToken brig accessTokenRequest self' <- responseJsonError =<< get (nginz . paths ["self"] . authHeader resp.accessToken) fromMaybe (error "invalid key") @@ -483,7 +484,7 @@ testRefreshTokenRetrieveAccessToken brig nginz = do user <- createUser "alice" brig let redirectUrl = mkUrl "https://example.com" let scopes = OAuthScopes $ Set.fromList [ReadSelf] - (cid, code) <- generateOAuthClientAndAuthorizationCode brig user.userId scopes redirectUrl + (cid, code) <- generateOAuthClientAndAuthorizationCode brig (User.userId user) scopes redirectUrl let accessTokenRequest = OAuthAccessTokenRequest OAuthGrantTypeAuthorizationCode cid verifier code redirectUrl resp <- createOAuthAccessToken brig accessTokenRequest get (nginz . paths ["self"] . authHeader (resp.accessToken)) !!! const 200 === statusCode @@ -498,7 +499,7 @@ testRefreshTokenWrongSignature opts brig = do user <- createUser "alice" brig let redirectUrl = mkUrl "https://example.com" let scopes = OAuthScopes $ Set.fromList [ReadSelf] - (cid, code) <- generateOAuthClientAndAuthorizationCode brig user.userId scopes redirectUrl + (cid, code) <- generateOAuthClientAndAuthorizationCode brig (User.userId user) scopes redirectUrl let accessTokenRequest = OAuthAccessTokenRequest OAuthGrantTypeAuthorizationCode cid verifier code redirectUrl resp <- createOAuthAccessToken brig accessTokenRequest key <- liftIO $ readJwk (fromMaybe "path to jwk not set" (Opt.setOAuthJwkKeyPair $ Opt.optSettings opts)) <&> fromMaybe (error "invalid key") @@ -515,7 +516,7 @@ testRefreshTokenNoTokenId opts brig = do user <- createUser "alice" brig let redirectUrl = mkUrl "https://example.com" let scopes = OAuthScopes $ Set.fromList [ReadSelf] - (cid, _) <- generateOAuthClientAndAuthorizationCode brig user.userId scopes redirectUrl + (cid, _) <- generateOAuthClientAndAuthorizationCode brig (User.userId user) scopes redirectUrl key <- liftIO $ readJwk (fromMaybe "path to jwk not set" (Opt.setOAuthJwkKeyPair $ Opt.optSettings opts)) <&> fromMaybe (error "invalid key") badRefreshToken <- liftIO $ OAuthToken <$> signRefreshToken key emptyClaimsSet let refreshAccessTokenRequest = OAuthRefreshAccessTokenRequest OAuthGrantTypeRefreshToken cid badRefreshToken @@ -528,7 +529,7 @@ testRefreshTokenNonExistingId opts brig = do user <- createUser "alice" brig let redirectUrl = mkUrl "https://example.com" let scopes = OAuthScopes $ Set.fromList [ReadSelf] - (cid, code) <- generateOAuthClientAndAuthorizationCode brig user.userId scopes redirectUrl + (cid, code) <- generateOAuthClientAndAuthorizationCode brig (User.userId user) scopes redirectUrl let accessTokenRequest = OAuthAccessTokenRequest OAuthGrantTypeAuthorizationCode cid verifier code redirectUrl resp <- createOAuthAccessToken brig accessTokenRequest key <- liftIO $ readJwk (fromMaybe "path to jwk not set" (Opt.setOAuthJwkKeyPair $ Opt.optSettings opts)) <&> fromMaybe (error "invalid key") @@ -550,7 +551,7 @@ testRefreshTokenWrongClientId brig = do user <- createUser "alice" brig let redirectUrl = mkUrl "https://example.com" let scopes = OAuthScopes $ Set.fromList [ReadSelf] - (cid, code) <- generateOAuthClientAndAuthorizationCode brig user.userId scopes redirectUrl + (cid, code) <- generateOAuthClientAndAuthorizationCode brig (User.userId user) scopes redirectUrl let accessTokenRequest = OAuthAccessTokenRequest OAuthGrantTypeAuthorizationCode cid verifier code redirectUrl resp <- createOAuthAccessToken brig accessTokenRequest badCid <- randomId @@ -564,7 +565,7 @@ testRefreshTokenWrongGrantType brig = do user <- createUser "alice" brig let redirectUrl = mkUrl "https://example.com" let scopes = OAuthScopes $ Set.fromList [ReadSelf] - (cid, code) <- generateOAuthClientAndAuthorizationCode brig user.userId scopes redirectUrl + (cid, code) <- generateOAuthClientAndAuthorizationCode brig (User.userId user) scopes redirectUrl let accessTokenRequest = OAuthAccessTokenRequest OAuthGrantTypeAuthorizationCode cid verifier code redirectUrl resp <- createOAuthAccessToken brig accessTokenRequest let refreshAccessTokenRequest = OAuthRefreshAccessTokenRequest OAuthGrantTypeAuthorizationCode cid resp.refreshToken @@ -579,7 +580,7 @@ testRefreshTokenExpiredToken opts brig = user <- createUser "alice" brig let redirectUrl = mkUrl "https://example.com" let scopes = OAuthScopes $ Set.fromList [ReadSelf] - (cid, code) <- generateOAuthClientAndAuthorizationCode brig user.userId scopes redirectUrl + (cid, code) <- generateOAuthClientAndAuthorizationCode brig (User.userId user) scopes redirectUrl let accessTokenRequest = OAuthAccessTokenRequest OAuthGrantTypeAuthorizationCode cid verifier code redirectUrl resp <- createOAuthAccessToken brig accessTokenRequest let refreshAccessTokenRequest = OAuthRefreshAccessTokenRequest OAuthGrantTypeRefreshToken cid resp.refreshToken @@ -593,7 +594,7 @@ testRefreshTokenRevokedToken brig = do user <- createUser "alice" brig let redirectUrl = mkUrl "https://example.com" let scopes = OAuthScopes $ Set.fromList [ReadSelf] - (cid, code) <- generateOAuthClientAndAuthorizationCode brig user.userId scopes redirectUrl + (cid, code) <- generateOAuthClientAndAuthorizationCode brig (User.userId user) scopes redirectUrl let accessTokenRequest = OAuthAccessTokenRequest OAuthGrantTypeAuthorizationCode cid verifier code redirectUrl resp <- createOAuthAccessToken brig accessTokenRequest let refreshAccessTokenRequest = OAuthRefreshAccessTokenRequest OAuthGrantTypeRefreshToken cid resp.refreshToken @@ -607,45 +608,45 @@ testListApplicationsWithAccountAccess brig = do alice <- createUser "alice" brig bob <- createUser "bob" brig do - apps <- listOAuthApplications brig alice.userId + apps <- listOAuthApplications brig (User.userId alice) liftIO $ assertEqual "apps" 0 (length apps) - void $ createOAuthApplicationWithAccountAccess brig alice.userId - void $ createOAuthApplicationWithAccountAccess brig alice.userId + void $ createOAuthApplicationWithAccountAccess brig (User.userId alice) + void $ createOAuthApplicationWithAccountAccess brig (User.userId alice) do - aliceApps <- listOAuthApplications brig alice.userId + aliceApps <- listOAuthApplications brig (User.userId alice) liftIO $ assertEqual "apps" 2 (length aliceApps) - bobsApps <- listOAuthApplications brig bob.userId + bobsApps <- listOAuthApplications brig (User.userId bob) liftIO $ assertEqual "apps" 0 (length bobsApps) - void $ createOAuthApplicationWithAccountAccess brig alice.userId - void $ createOAuthApplicationWithAccountAccess brig bob.userId + void $ createOAuthApplicationWithAccountAccess brig (User.userId alice) + void $ createOAuthApplicationWithAccountAccess brig (User.userId bob) do - aliceApps <- listOAuthApplications brig alice.userId + aliceApps <- listOAuthApplications brig (User.userId alice) liftIO $ assertEqual "apps" 3 (length aliceApps) - bobsApps <- listOAuthApplications brig bob.userId + bobsApps <- listOAuthApplications brig (User.userId bob) liftIO $ assertEqual "apps" 1 (length bobsApps) testRevokeApplicationAccountAccess :: Brig -> Http () testRevokeApplicationAccountAccess brig = do user <- createUser "alice" brig do - apps <- listOAuthApplications brig user.userId + apps <- listOAuthApplications brig (User.userId user) liftIO $ assertEqual "apps" 0 (length apps) - for_ [1 .. 3 :: Int] $ const $ createOAuthApplicationWithAccountAccess brig user.userId - cids <- fmap applicationId <$> listOAuthApplications brig user.userId + for_ [1 .. 3 :: Int] $ const $ createOAuthApplicationWithAccountAccess brig (User.userId user) + cids <- fmap applicationId <$> listOAuthApplications brig (User.userId user) liftIO $ assertEqual "apps" 3 (length cids) case cids of [cid1, cid2, cid3] -> do - revokeOAuthApplicationAccess brig user.userId cid1 + revokeOAuthApplicationAccess brig (User.userId user) cid1 do - apps <- listOAuthApplications brig user.userId + apps <- listOAuthApplications brig (User.userId user) liftIO $ assertEqual "apps" 2 (length apps) - revokeOAuthApplicationAccess brig user.userId cid2 + revokeOAuthApplicationAccess brig (User.userId user) cid2 do - apps <- listOAuthApplications brig user.userId + apps <- listOAuthApplications brig (User.userId user) liftIO $ assertEqual "apps" 1 (length apps) - revokeOAuthApplicationAccess brig user.userId cid3 + revokeOAuthApplicationAccess brig (User.userId user) cid3 do - apps <- listOAuthApplications brig user.userId + apps <- listOAuthApplications brig (User.userId user) liftIO $ assertEqual "apps" 0 (length apps) _ -> liftIO $ assertFailure "unexpected number of apps" diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index 0de2cdbb67a..538453d1aed 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/services/brig/test/integration/API/Provider.hs @@ -574,22 +574,22 @@ testClaimUserPrekeys :: Config -> DB.ClientState -> Brig -> Galley -> Http () testClaimUserPrekeys config db brig galley = withTestService config db brig defServiceApp $ \sref _ -> do (pid, sid, u1, _u2, _h) <- prepareUsers sref brig cid <- do - rs <- createConv galley u1.userId [] DB.ClientState -> Brig -> Galley -> Http () testListUserProfiles config db brig galley = withTestService config db brig defServiceApp $ \sref _ -> do (pid, sid, u1, u2, _h) <- prepareUsers sref brig cid <- do - rs <- createConv galley u1.userId [] DB.ClientState -> Brig -> Galley -> Http () testGetUserClients config db brig galley = withTestService config db brig defServiceApp $ \sref _ -> do (pid, sid, u1, _u2, _h) <- prepareUsers sref brig cid <- do - rs <- createConv galley u1.userId [] DB.ClientState -> Brig -> Galley -> Http () @@ -1680,10 +1680,10 @@ testRegisterProvider db' brig = do activateProvider brig (Code.codeKey vcode) (Code.codeValue vcode) !!! const 200 === statusCode Nothing -> do - _rs <- + rs <- getProviderActivationCodeInternal brig email Brig -> m () testSearchWithUmlaut brig = do searcher <- randomUser brig user <- createUser' True "Özi Müller" brig refreshIndex brig - assertCanFind brig searcher.userId user.userQualifiedId "ozi muller" - assertCanFind brig searcher.userId user.userQualifiedId "Özi Müller" + assertCanFind brig (User.userId searcher) user.userQualifiedId "ozi muller" + assertCanFind brig (User.userId searcher) user.userQualifiedId "Özi Müller" testSearchByHandle :: TestConstraints m => Brig -> m () testSearchByHandle brig = do @@ -606,14 +608,13 @@ testSearchOtherDomain opts brig = do -- cluster. This test spins up a proxy server to pass requests to our only ES -- server. The proxy server ensures that only requests to the 'old' index go -- through. -testMigrationToNewIndex :: (TestConstraints m, MonadUnliftIO m) => Manager -> Opt.Opts -> Brig -> m () -testMigrationToNewIndex mgr opts brig = do - -- (optsOldIndex, ES.IndexName -> oldIndexName) <- optsForOldIndex opts - withOldESProxy opts mgr $ \oldESUrl oldESIndex -> do +testMigrationToNewIndex :: (TestConstraints m, MonadUnliftIO m) => Opt.Opts -> Brig -> m () +testMigrationToNewIndex opts brig = do + withOldESProxy opts $ \oldESUrl oldESIndex -> do let optsOldIndex = opts - & Opt.elasticsearchL . Opt.indexL .~ oldESIndex - & Opt.elasticsearchL . Opt.urlL .~ oldESUrl + & Opt.elasticsearchL . Opt.indexL .~ (ES.IndexName oldESIndex) + & Opt.elasticsearchL . Opt.urlL .~ (ES.Server oldESUrl) -- Phase 1: Using old index only (phase1NonTeamUser, teamOwner, phase1TeamUser1, phase1TeamUser2, tid) <- withSettingsOverrides optsOldIndex $ do nonTeamUser <- randomUser brig @@ -625,6 +626,8 @@ testMigrationToNewIndex mgr opts brig = do optsOldIndex & Opt.elasticsearchL . Opt.additionalWriteIndexL ?~ (opts ^. Opt.elasticsearchL . Opt.indexL) & Opt.elasticsearchL . Opt.additionalWriteIndexUrlL ?~ (opts ^. Opt.elasticsearchL . Opt.urlL) + & Opt.elasticsearchL . Opt.additionalCaCertL .~ (opts ^. Opt.elasticsearchL . Opt.caCertL) + & Opt.elasticsearchL . Opt.additionalInsecureSkipVerifyTlsL .~ (opts ^. Opt.elasticsearchL . Opt.insecureSkipVerifyTlsL) (phase2NonTeamUser, phase2TeamUser) <- withSettingsOverrides phase2OptsWhile $ do phase2NonTeamUser <- randomUser brig phase2TeamUser <- inviteAndRegisterUser teamOwner tid brig @@ -649,7 +652,7 @@ testMigrationToNewIndex mgr opts brig = do assertCanFindByName brig phase1TeamUser1 phase2TeamUser -- Run Migrations - let newIndexName = ES.IndexName $ opts ^. Opt.elasticsearchL . Opt.indexL + let newIndexName = opts ^. Opt.elasticsearchL . Opt.indexL taskNodeId <- assertRight =<< runBH opts (ES.reindexAsync $ ES.mkReindexRequest (ES.IndexName oldESIndex) newIndexName) runBH opts $ waitForTaskToComplete @ES.ReindexResponse taskNodeId @@ -685,10 +688,11 @@ testMigrationToNewIndex mgr opts brig = do assertCanFindByName brig phase1TeamUser1 phase3NonTeamUser assertCanFindByName brig phase1TeamUser1 phase3TeamUser -withOldESProxy :: (TestConstraints m, MonadUnliftIO m) => Opt.Opts -> Manager -> (Text -> Text -> m a) -> m a -withOldESProxy opts mgr f = do +withOldESProxy :: (TestConstraints m, MonadUnliftIO m, HasCallStack) => Opt.Opts -> (Text -> Text -> m a) -> m a +withOldESProxy opts f = do indexName <- randomHandle createIndexWithMapping opts indexName oldMapping + mgr <- liftIO $ initHttpManagerWithTLSConfig opts.elasticsearch.insecureSkipVerifyTls opts.elasticsearch.caCert (proxyPort, sock) <- liftIO Warp.openFreePort bracket (async $ liftIO $ Warp.runSettingsSocket Warp.defaultSettings sock $ indexProxyServer indexName opts mgr) @@ -697,13 +701,14 @@ withOldESProxy opts mgr f = do indexProxyServer :: Text -> Opt.Opts -> Manager -> Wai.Application indexProxyServer idx opts mgr = - let proxyURI = either (error . show) id $ URI.parseURI URI.strictURIParserOptions (Text.encodeUtf8 (Opts.url (Opts.elasticsearch opts))) + let toUri (ES.Server url) = either (error . show) id $ URI.parseURI URI.strictURIParserOptions (Text.encodeUtf8 url) + proxyURI = toUri (Opts.url (Opts.elasticsearch opts)) proxyToHost = URI.hostBS . URI.authorityHost . fromMaybe (error "No Host") . URI.uriAuthority $ proxyURI proxyToPort = URI.portNumber . fromMaybe (URI.Port 9200) . URI.authorityPort . fromMaybe (error "No Host") . URI.uriAuthority $ proxyURI proxyApp req = pure $ if headMay (Wai.pathInfo req) == Just idx - then Wai.WPRProxyDest (Wai.ProxyDest proxyToHost proxyToPort) + then Wai.WPRProxyDestSecure (Wai.ProxyDest proxyToHost proxyToPort) else Wai.WPRResponse (Wai.responseLBS HTTP.status400 [] $ "Refusing to proxy to path=" <> cs (Wai.rawPathInfo req)) in waiProxyTo proxyApp Wai.defaultOnExc mgr @@ -727,7 +732,7 @@ testWithBothIndices opts mgr name f = do test mgr "old-index" $ withOldIndex opts f ] -testWithBothIndicesAndOpts :: Opt.Opts -> Manager -> TestName -> (Opt.Opts -> Http ()) -> TestTree +testWithBothIndicesAndOpts :: Opt.Opts -> Manager -> TestName -> (HasCallStack => Opt.Opts -> Http ()) -> TestTree testWithBothIndicesAndOpts opts mgr name f = testGroup name @@ -737,20 +742,20 @@ testWithBothIndicesAndOpts opts mgr name f = f newOpts <* deleteIndex opts indexName ] -withOldIndex :: MonadIO m => Opt.Opts -> WaiTest.Session a -> m a +withOldIndex :: (MonadIO m, HasCallStack) => Opt.Opts -> WaiTest.Session a -> m a withOldIndex opts f = do indexName <- randomHandle createIndexWithMapping opts indexName oldMapping - let newOpts = opts & Opt.elasticsearchL . Opt.indexL .~ indexName + let newOpts = opts & Opt.elasticsearchL . Opt.indexL .~ (ES.IndexName indexName) withSettingsOverrides newOpts f <* deleteIndex opts indexName -optsForOldIndex :: MonadIO m => Opt.Opts -> m (Opt.Opts, Text) +optsForOldIndex :: (MonadIO m, HasCallStack) => Opt.Opts -> m (Opt.Opts, Text) optsForOldIndex opts = do indexName <- randomHandle createIndexWithMapping opts indexName oldMapping - pure (opts & Opt.elasticsearchL . Opt.indexL .~ indexName, indexName) + pure (opts & Opt.elasticsearchL . Opt.indexL .~ (ES.IndexName indexName), indexName) -createIndexWithMapping :: MonadIO m => Opt.Opts -> Text -> Value -> m () +createIndexWithMapping :: (MonadIO m, HasCallStack) => Opt.Opts -> Text -> Value -> m () createIndexWithMapping opts name val = do let indexName = ES.IndexName name createReply <- runBH opts $ ES.createIndexWith [ES.AnalysisSetting analysisSettings] 1 indexName @@ -761,15 +766,17 @@ createIndexWithMapping opts name val = do liftIO $ assertFailure $ "failed to create mapping: " <> show name -- | This doesn't fail if ES returns error because we don't really want to fail the tests for this -deleteIndex :: MonadIO m => Opt.Opts -> Text -> m () +deleteIndex :: (MonadIO m, HasCallStack) => Opt.Opts -> Text -> m () deleteIndex opts name = do let indexName = ES.IndexName name void $ runBH opts $ ES.deleteIndex indexName -runBH :: MonadIO m => Opt.Opts -> ES.BH IO a -> m a -runBH opts = - let esURL = opts ^. Opt.elasticsearchL . Opt.urlL - in liftIO . ES.withBH HTTP.defaultManagerSettings (ES.Server esURL) +runBH :: (MonadIO m, HasCallStack) => Opt.Opts -> ES.BH m a -> m a +runBH opts action = do + let (ES.Server esURL) = opts ^. Opt.elasticsearchL . Opt.urlL + mgr <- liftIO $ initHttpManagerWithTLSConfig opts.elasticsearch.insecureSkipVerifyTls opts.elasticsearch.caCert + let bEnv = mkBHEnv esURL mgr + ES.runBH bEnv action -- | This was copied from at Brig.User.Search.Index at commit 3242aa26 analysisSettings :: ES.Analysis diff --git a/services/brig/test/integration/API/Search/Util.hs b/services/brig/test/integration/API/Search/Util.hs index 8be0145a09c..3141b4be83f 100644 --- a/services/brig/test/integration/API/Search/Util.hs +++ b/services/brig/test/integration/API/Search/Util.hs @@ -26,8 +26,11 @@ import Data.Domain (Domain) import Data.Id import Data.Qualified (Qualified (..)) import Data.Range (Range) +import Data.String.Conversions import Data.Text.Encoding (encodeUtf8) +import Database.Bloodhound qualified as ES import Imports +import Network.HTTP.Client qualified as HTTP import Test.Tasty.HUnit import Util import Wire.API.User @@ -147,3 +150,7 @@ executeTeamUserSearchWithMaybeState brig teamid self mbSearchText mRoleFilter mS HTTP.Manager -> ES.BHEnv +mkBHEnv url mgr = do + (ES.mkBHEnv (ES.Server url) mgr) {ES.bhRequestHook = ES.basicAuthHook (ES.EsUsername "elastic") (ES.EsPassword "changeme")} diff --git a/services/brig/test/integration/API/Settings.hs b/services/brig/test/integration/API/Settings.hs index d3fb5add1aa..f600817a0e8 100644 --- a/services/brig/test/integration/API/Settings.hs +++ b/services/brig/test/integration/API/Settings.hs @@ -30,15 +30,18 @@ import Data.ByteString.Char8 qualified as C8 import Data.ByteString.Conversion import Data.Id import Data.Set qualified as Set -import Galley.Types.Teams qualified as Team import Imports import Test.Tasty hiding (Timeout) import Test.Tasty.HUnit import Util +import Wire.API.Team.Member (rolePermissions) import Wire.API.Team.Permission import Wire.API.Team.Role import Wire.API.User +allEmailVisibilities :: [EmailVisibilityConfig] +allEmailVisibilities = [EmailVisibleIfOnTeam, EmailVisibleIfOnSameTeam (), EmailVisibleToSelf] + tests :: Opts -> Manager -> Brig -> Galley -> IO TestTree tests defOpts manager brig galley = pure $ do testGroup @@ -47,14 +50,14 @@ tests defOpts manager brig galley = pure $ do "setEmailVisibility" [ testGroup "/users/" - $ ((,) <$> [minBound ..] <*> [minBound ..]) + $ ((,) <$> [minBound ..] <*> allEmailVisibilities) <&> \(viewingUserIs, visibility) -> do testCase (show (viewingUserIs, visibility)) . runHttpT manager $ testUsersEmailVisibleIffExpected defOpts brig galley viewingUserIs visibility, testGroup "/users/:uid" - $ ((,) <$> [minBound ..] <*> [minBound ..]) + $ ((,) <$> [minBound ..] <*> allEmailVisibilities) <&> \(viewingUserIs, visibility) -> do testCase (show (viewingUserIs, visibility)) . runHttpT manager @@ -70,13 +73,13 @@ data ViewedUserIs = SameTeam | DifferentTeam | NoTeam data ViewingUserIs = Creator | Member | Guest deriving (Eq, Show, Enum, Bounded) -expectEmailVisible :: Opt.EmailVisibility -> ViewingUserIs -> ViewedUserIs -> Bool -expectEmailVisible Opt.EmailVisibleIfOnTeam = \case +expectEmailVisible :: EmailVisibilityConfig -> ViewingUserIs -> ViewedUserIs -> Bool +expectEmailVisible EmailVisibleIfOnTeam = \case _ -> \case SameTeam -> True DifferentTeam -> True NoTeam -> False -expectEmailVisible Opt.EmailVisibleIfOnSameTeam = \case +expectEmailVisible (EmailVisibleIfOnSameTeam _) = \case Creator -> \case SameTeam -> True DifferentTeam -> False @@ -89,7 +92,7 @@ expectEmailVisible Opt.EmailVisibleIfOnSameTeam = \case SameTeam -> False DifferentTeam -> False NoTeam -> False -expectEmailVisible Opt.EmailVisibleToSelf = \case +expectEmailVisible EmailVisibleToSelf = \case _ -> \case SameTeam -> False DifferentTeam -> False @@ -98,7 +101,7 @@ expectEmailVisible Opt.EmailVisibleToSelf = \case jsonField :: FromJSON a => Key -> Value -> Maybe a jsonField f u = u ^? key f >>= maybeFromJSON -testUsersEmailVisibleIffExpected :: Opts -> Brig -> Galley -> ViewingUserIs -> Opt.EmailVisibility -> Http () +testUsersEmailVisibleIffExpected :: Opts -> Brig -> Galley -> ViewingUserIs -> EmailVisibilityConfig -> Http () testUsersEmailVisibleIffExpected opts brig galley viewingUserIs visibilitySetting = do (viewerId, userA, userB, nonTeamUser) <- setup brig galley viewingUserIs let uids = @@ -131,7 +134,7 @@ testUsersEmailVisibleIffExpected opts brig galley viewingUserIs visibilitySettin where result r = Set.fromList . map (jsonField "id" &&& jsonField "email") <$> responseJsonMaybe r -testGetUserEmailShowsEmailsIffExpected :: Opts -> Brig -> Galley -> ViewingUserIs -> Opt.EmailVisibility -> Http () +testGetUserEmailShowsEmailsIffExpected :: Opts -> Brig -> Galley -> ViewingUserIs -> EmailVisibilityConfig -> Http () testGetUserEmailShowsEmailsIffExpected opts brig galley viewingUserIs visibilitySetting = do (viewerId, userA, userB, nonTeamUser) <- setup brig galley viewingUserIs let expectations :: [(UserId, Maybe Email)] @@ -171,6 +174,6 @@ setup brig galley viewingUserIs = do nonTeamUser <- createUser "joe" brig viewerId <- case viewingUserIs of Creator -> pure creatorId - Member -> userId <$> createTeamMember brig galley creatorId tid (Team.rolePermissions RoleOwner) - Guest -> userId <$> createTeamMember brig galley creatorId tid (Team.rolePermissions RoleExternalPartner) + Member -> userId <$> createTeamMember brig galley creatorId tid (rolePermissions RoleOwner) + Guest -> userId <$> createTeamMember brig galley creatorId tid (rolePermissions RoleExternalPartner) pure (viewerId, userA, userB, nonTeamUser) diff --git a/services/brig/test/integration/API/SystemSettings.hs b/services/brig/test/integration/API/SystemSettings.hs index 1b2f600140c..40b20c0606f 100644 --- a/services/brig/test/integration/API/SystemSettings.hs +++ b/services/brig/test/integration/API/SystemSettings.hs @@ -24,6 +24,7 @@ import Control.Lens import Data.ByteString.Char8 qualified as BS import Data.ByteString.Conversion (toByteString') import Data.Id +import Data.String.Conversions import Imports import Network.Wai.Test as WaiTest import Test.Tasty diff --git a/services/brig/test/integration/API/Team.hs b/services/brig/test/integration/API/Team.hs index 946c4f7e1eb..350fb894d66 100644 --- a/services/brig/test/integration/API/Team.hs +++ b/services/brig/test/integration/API/Team.hs @@ -45,7 +45,6 @@ import Data.Text.Encoding (encodeUtf8) import Data.Time (addUTCTime, getCurrentTime) import Data.UUID qualified as UUID (fromString) import Data.UUID.V4 qualified as UUID -import Galley.Types.Teams qualified as Team import Imports import Network.HTTP.Types qualified as HTTP import Network.Wai qualified as Wai @@ -408,7 +407,7 @@ testInvitationRoles brig galley = do . zConn "c" . paths ["teams", toByteString' tid, "members", toByteString' uid] mem :: TeamMember <- responseJsonError =<< (get memreq creator') <- mkuser True updatePermissions creator tid (creator', fullPermissions) galley -- demote and delete creator, but cannot do it for second owner yet (as someone needs to demote them) - updatePermissions creator' tid (creator, Team.rolePermissions RoleMember) galley + updatePermissions creator' tid (creator, rolePermissions RoleMember) galley deleteUser creator (Just defPassword) brig !!! const 200 === statusCode -- create sso user without email, make an owner Just (userId -> user3) <- mkuser False @@ -969,7 +968,7 @@ testDeleteUserSSO brig galley = do -- can't delete herself, even without email deleteUser user3 (Just defPassword) brig !!! const 403 === statusCode -- delete second owner now, we don't enforce existence of emails in the backend - updatePermissions user3 tid (creator', Team.rolePermissions RoleMember) galley + updatePermissions user3 tid (creator', rolePermissions RoleMember) galley deleteUser creator' (Just defPassword) brig !!! const 200 === statusCode test2FaDisabledForSsoUser :: Brig -> Galley -> Http () diff --git a/services/brig/test/integration/API/TeamUserSearch.hs b/services/brig/test/integration/API/TeamUserSearch.hs index add51662ff9..84e2a8a3701 100644 --- a/services/brig/test/integration/API/TeamUserSearch.hs +++ b/services/brig/test/integration/API/TeamUserSearch.hs @@ -28,12 +28,13 @@ import Data.ByteString.Conversion (toByteString) import Data.Handle (fromHandle) import Data.Id (TeamId, UserId) import Data.Range (unsafeRange) +import Data.String.Conversions import Imports import System.Random.Shuffle (shuffleM) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertBool, assertEqual, (@?=)) import Util (Brig, Galley, randomEmail, test, withSettingsOverrides) -import Wire.API.User (User (..), userEmail) +import Wire.API.User (User (..), userEmail, userId) import Wire.API.User.Identity import Wire.API.User.Search diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index 4d82aa1382f..66254e93fa1 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -57,6 +57,7 @@ import Data.Proxy import Data.Qualified import Data.Range import Data.Set qualified as Set +import Data.String.Conversions import Data.Text qualified as T import Data.Text qualified as Text import Data.Text.Encoding qualified as T diff --git a/services/brig/test/integration/API/User/Auth.hs b/services/brig/test/integration/API/User/Auth.hs index 06a10761028..a52cd738b41 100644 --- a/services/brig/test/integration/API/User/Auth.hs +++ b/services/brig/test/integration/API/User/Auth.hs @@ -25,7 +25,6 @@ module API.User.Auth where import API.Team.Util -import API.User.Util qualified as Util import Bilge hiding (body) import Bilge qualified as Http import Bilge.Assert hiding (assert) @@ -38,7 +37,6 @@ import Cassandra hiding (Value) import Cassandra qualified as DB import Control.Arrow ((&&&)) import Control.Lens (set, (^.)) -import Control.Monad.Catch (MonadCatch) import Control.Retry import Data.Aeson as Aeson hiding (json) import Data.ByteString qualified as BS @@ -49,15 +47,13 @@ import Data.Id import Data.Misc (PlainTextPassword6, plainTextPassword6, plainTextPassword6Unsafe) import Data.Proxy import Data.Qualified -import Data.Range (unsafeRange) import Data.Text qualified as Text -import Data.Text.Ascii (AsciiChars (validate)) import Data.Text.IO (hPutStrLn) import Data.Text.Lazy qualified as Lazy import Data.Time.Clock import Data.UUID.V4 qualified as UUID import Data.ZAuth.Token qualified as ZAuth -import Imports hiding (cs) +import Imports import Network.HTTP.Client (equivCookie) import Network.Wai.Utilities.Error qualified as Error import Test.Tasty @@ -67,11 +63,8 @@ import UnliftIO.Async hiding (wait) import Util import Wire.API.Conversation (Conversation (..)) import Wire.API.Password (Password, mkSafePassword) -import Wire.API.Team.Feature qualified as Public -import Wire.API.User -import Wire.API.User qualified as Public -import Wire.API.User.Auth -import Wire.API.User.Auth qualified as Auth +import Wire.API.User as Public +import Wire.API.User.Auth as Auth import Wire.API.User.Auth.LegalHold import Wire.API.User.Auth.ReAuth import Wire.API.User.Auth.Sso @@ -132,15 +125,6 @@ tests conf m z db b g n = [ test m "nginz-login" (testNginz b n), test m "nginz-legalhold-login" (onlyIfLhWhitelisted (testNginzLegalHold b g n)), test m "nginz-login-multiple-cookies" (testNginzMultipleCookies conf b n) - ], - testGroup - "snd-factor-password-challenge" - [ test m "test-login-verify6-digit-email-code-success" $ testLoginVerify6DigitEmailCodeSuccess b g db, - test m "test-login-verify6-digit-wrong-code-fails" $ testLoginVerify6DigitWrongCodeFails b g, - test m "test-login-verify6-digit-missing-code-fails" $ testLoginVerify6DigitMissingCodeFails b g, - test m "test-login-verify6-digit-expired-code-fails" $ testLoginVerify6DigitExpiredCodeFails conf b g db, - test m "test-login-verify6-digit-resend-code-success-and-rate-limiting" $ testLoginVerify6DigitResendCodeSuccessAndRateLimiting b g conf db, - test m "test-login-verify6-digit-limit-retries" $ testLoginVerify6DigitLimitRetries b g conf db ] ], testGroup @@ -390,7 +374,7 @@ testPhoneLogin brig = do testHandleLogin :: Brig -> Http () testHandleLogin brig = do - usr <- (.userId) <$> randomUser brig + usr <- Public.userId <$> randomUser brig hdl <- randomHandle let update = RequestBodyLBS . encode $ HandleUpdate hdl put (brig . path "/self/handle" . contentJson . zUser usr . zConn "c" . Http.body update) @@ -438,157 +422,6 @@ testSendLoginCode brig = do let _timeout = fromLoginCodeTimeout <$> responseJsonMaybe rsp2 liftIO $ assertEqual "timeout" (Just (Code.Timeout 600)) _timeout -testLoginVerify6DigitEmailCodeSuccess :: Brig -> Galley -> DB.ClientState -> Http () -testLoginVerify6DigitEmailCodeSuccess brig galley db = do - (u, tid) <- createUserWithTeam' brig - let Just email = userEmail u - let checkLoginSucceeds body = login brig body PersistentCookie !!! const 200 === statusCode - Util.setTeamFeatureLockStatus @Public.SndFactorPasswordChallengeConfig galley tid Public.LockStatusUnlocked - Util.setTeamSndFactorPasswordChallenge galley tid Public.FeatureStatusEnabled - Util.generateVerificationCode brig (Public.SendVerificationCode Public.Login email) - key <- Code.mkKey (Code.ForEmail email) - Just vcode <- Util.lookupCode db key Code.AccountLogin - checkLoginSucceeds $ - PasswordLogin $ - PasswordLoginData - (LoginByEmail email) - defPassword - (Just defCookieLabel) - (Just $ Code.codeValue vcode) - -testLoginVerify6DigitResendCodeSuccessAndRateLimiting :: Brig -> Galley -> Opts.Opts -> DB.ClientState -> Http () -testLoginVerify6DigitResendCodeSuccessAndRateLimiting brig galley _opts db = do - (u, tid) <- createUserWithTeam' brig - let Just email = userEmail u - let checkLoginSucceeds body = login brig body PersistentCookie !!! const 200 === statusCode - let getCodeFromDb = do - key <- Code.mkKey (Code.ForEmail email) - Just c <- Util.lookupCode db key Code.AccountLogin - pure c - - Util.setTeamFeatureLockStatus @Public.SndFactorPasswordChallengeConfig galley tid Public.LockStatusUnlocked - Util.setTeamSndFactorPasswordChallenge galley tid Public.FeatureStatusEnabled - - Util.generateVerificationCode brig (Public.SendVerificationCode Public.Login email) - fstCode <- getCodeFromDb - - let tooManyRequests = 429 - Util.generateVerificationCodeExpect tooManyRequests brig (Public.SendVerificationCode Public.Login email) - - void $ retryWhileN 10 ((==) 429 . statusCode) $ Util.generateVerificationCode' brig (Public.SendVerificationCode Public.Login email) - mostRecentCode <- getCodeFromDb - - checkLoginFails brig $ - PasswordLogin $ - PasswordLoginData - (LoginByEmail email) - defPassword - (Just defCookieLabel) - (Just $ Code.codeValue fstCode) - checkLoginSucceeds $ - PasswordLogin $ - PasswordLoginData - (LoginByEmail email) - defPassword - (Just defCookieLabel) - (Just $ Code.codeValue mostRecentCode) - -testLoginVerify6DigitLimitRetries :: Brig -> Galley -> Opts.Opts -> DB.ClientState -> Http () -testLoginVerify6DigitLimitRetries brig galley _opts db = do - (u, tid) <- createUserWithTeam' brig - let Just email = userEmail u - Util.setTeamFeatureLockStatus @Public.SndFactorPasswordChallengeConfig galley tid Public.LockStatusUnlocked - Util.setTeamSndFactorPasswordChallenge galley tid Public.FeatureStatusEnabled - Util.generateVerificationCode brig (Public.SendVerificationCode Public.Login email) - key <- Code.mkKey (Code.ForEmail email) - Just correctCode <- Util.lookupCode db key Code.AccountLogin - let wrongCode = Code.Value $ unsafeRange (fromRight undefined (validate "123456")) - -- login with wrong code should fail 3 times - forM_ [1 .. 3] $ \(_ :: Int) -> - checkLoginFails brig $ - PasswordLogin $ - PasswordLoginData - (LoginByEmail email) - defPassword - (Just defCookieLabel) - (Just wrongCode) - -- after 3 failed attempts, login with correct code should fail as well - checkLoginFails brig $ - PasswordLogin $ - PasswordLoginData - (LoginByEmail email) - defPassword - (Just defCookieLabel) - (Just (Code.codeValue correctCode)) - --- @SF.Channel @TSFI.RESTfulAPI @S2 --- --- Test that login fails with wrong second factor email verification code -testLoginVerify6DigitWrongCodeFails :: Brig -> Galley -> Http () -testLoginVerify6DigitWrongCodeFails brig galley = do - (u, tid) <- createUserWithTeam' brig - let Just email = userEmail u - Util.setTeamFeatureLockStatus @Public.SndFactorPasswordChallengeConfig galley tid Public.LockStatusUnlocked - Util.setTeamSndFactorPasswordChallenge galley tid Public.FeatureStatusEnabled - Util.generateVerificationCode brig (Public.SendVerificationCode Public.Login email) - let wrongCode = Code.Value $ unsafeRange (fromRight undefined (validate "123456")) - checkLoginFails brig $ - PasswordLogin $ - PasswordLoginData - (LoginByEmail email) - defPassword - (Just defCookieLabel) - (Just wrongCode) - --- @END - --- @SF.Channel @TSFI.RESTfulAPI @S2 --- --- Test that login without verification code fails if SndFactorPasswordChallenge feature is enabled in team -testLoginVerify6DigitMissingCodeFails :: Brig -> Galley -> Http () -testLoginVerify6DigitMissingCodeFails brig galley = do - (u, tid) <- createUserWithTeam' brig - let Just email = userEmail u - Util.setTeamFeatureLockStatus @Public.SndFactorPasswordChallengeConfig galley tid Public.LockStatusUnlocked - Util.setTeamSndFactorPasswordChallenge galley tid Public.FeatureStatusEnabled - Util.generateVerificationCode brig (Public.SendVerificationCode Public.Login email) - let body = - PasswordLogin $ - PasswordLoginData - (LoginByEmail email) - defPassword - (Just defCookieLabel) - Nothing - login brig body PersistentCookie !!! do - const 403 === statusCode - const (Just "code-authentication-required") === errorLabel - --- @END - --- @SF.Channel @TSFI.RESTfulAPI @S2 --- --- Test that login fails with expired second factor email verification code -testLoginVerify6DigitExpiredCodeFails :: Opts.Opts -> Brig -> Galley -> DB.ClientState -> Http () -testLoginVerify6DigitExpiredCodeFails opts brig galley db = do - (u, tid) <- createUserWithTeam' brig - let Just email = userEmail u - Util.setTeamFeatureLockStatus @Public.SndFactorPasswordChallengeConfig galley tid Public.LockStatusUnlocked - Util.setTeamSndFactorPasswordChallenge galley tid Public.FeatureStatusEnabled - Util.generateVerificationCode brig (Public.SendVerificationCode Public.Login email) - key <- Code.mkKey (Code.ForEmail email) - Just vcode <- Util.lookupCode db key Code.AccountLogin - let verificationTimeout = round (Opts.setVerificationTimeout (Opts.optSettings opts)) - threadDelay $ ((verificationTimeout + 1) * 1000_000) - checkLoginFails brig $ - PasswordLogin $ - PasswordLoginData - (LoginByEmail email) - defPassword - (Just defCookieLabel) - (Just $ Code.codeValue vcode) - --- @END - -- The testLoginFailure test conforms to the following testing standards: -- @SF.Provisioning @TSFI.RESTfulAPI @S2 -- @@ -703,7 +536,7 @@ testLimitRetries conf brig = do testRegularUserLegalHoldLogin :: Brig -> Http () testRegularUserLegalHoldLogin brig = do -- Create a regular user - uid <- (.userId) <$> randomUser brig + uid <- Public.userId <$> randomUser brig -- fail if user is not a team user legalHoldLogin brig (LegalHoldLogin uid (Just defPassword) Nothing) PersistentCookie !!! do const 403 === statusCode @@ -788,7 +621,7 @@ testLegalHoldLogout brig galley = do testEmailSsoLogin :: Brig -> Http () testEmailSsoLogin brig = do -- Create a user - uid <- (.userId) <$> randomUser brig + uid <- Public.userId <$> randomUser brig now <- liftIO getCurrentTime -- Login and do some checks _rs <- @@ -803,7 +636,7 @@ testEmailSsoLogin brig = do testSuspendedSsoLogin :: Brig -> Http () testSuspendedSsoLogin brig = do -- Create a user and immediately suspend them - uid <- (.userId) <$> randomUser brig + uid <- Public.userId <$> randomUser brig setStatus brig uid Suspended -- Try to login and see if we fail ssoLogin brig (SsoLogin uid Nothing) PersistentCookie !!! do @@ -833,7 +666,7 @@ testInvalidCookie z b = do const 403 === statusCode const (Just "Invalid user token") =~= responseBody -- Expired - user <- (.userId) <$> randomUser b + user <- Public.userId <$> randomUser b let f = set (ZAuth.userTTL (Proxy @u)) 0 t <- toByteString' <$> runZAuth z (ZAuth.localSettings f (ZAuth.newUserToken @u user Nothing)) liftIO $ threadDelay 1000000 @@ -845,7 +678,7 @@ testInvalidCookie z b = do testInvalidToken :: ZAuth.Env -> Brig -> Http () testInvalidToken z b = do - user <- (.userId) <$> randomUser b + user <- Public.userId <$> randomUser b t <- toByteString' <$> runZAuth z (ZAuth.newUserToken @ZAuth.User user Nothing) -- Syntactically invalid @@ -1421,7 +1254,7 @@ testLogout b = do testReauthentication :: Brig -> Http () testReauthentication b = do - u <- (.userId) <$> randomUser b + u <- Public.userId <$> randomUser b let js = Http.body . RequestBodyLBS . encode $ object ["foo" .= ("bar" :: Text)] get (b . paths ["/i/users", toByteString' u, "reauthenticate"] . contentJson . js) !!! do const 403 === statusCode @@ -1515,9 +1348,3 @@ remJson p l ids = wait :: MonadIO m => m () wait = liftIO $ threadDelay 1000000 - -checkLoginFails :: (MonadHttp m, MonadIO m, MonadCatch m) => Brig -> Login -> m () -checkLoginFails brig body = do - login brig body PersistentCookie !!! do - const 403 === statusCode - const (Just "code-authentication-failed") === errorLabel diff --git a/services/brig/test/integration/API/User/Client.hs b/services/brig/test/integration/API/User/Client.hs index 067a2bc641d..df4b7c5faaa 100644 --- a/services/brig/test/integration/API/User/Client.hs +++ b/services/brig/test/integration/API/User/Client.hs @@ -52,6 +52,7 @@ import Data.Nonce (isValidBase64UrlEncodedUUID) import Data.Qualified (Qualified (..)) import Data.Range (unsafeRange) import Data.Set qualified as Set +import Data.String.Conversions import Data.Text.Ascii (AsciiChars (validate), encodeBase64UrlUnpadded, toText) import Data.Text.Encoding qualified as T import Data.Time (addUTCTime) @@ -71,6 +72,8 @@ import UnliftIO (mapConcurrently) import Util import Wire.API.Internal.Notification import Wire.API.MLS.CipherSuite +import Wire.API.Routes.Version +import Wire.API.Routes.Versioned import Wire.API.Team.Feature qualified as Public import Wire.API.User import Wire.API.User qualified as Public @@ -257,7 +260,7 @@ testAddGetClient params brig cannon = do let etype = j ^? key "type" . _String let eclient = j ^? key "client" etype @?= Just "user.client-add" - fmap fromJSON eclient @?= Just (Success c) + fmap fromJSON eclient @?= Just (Success (Versioned @'V5 c)) pure c liftIO $ clientMLSPublicKeys c @?= keys getClient brig uid (clientId c) !!! do @@ -1395,6 +1398,7 @@ data DPoPClaimsSet = DPoPClaimsSet claimHtu :: Text, claimChal :: Text, claimHandle :: Text, + claimDisplayName :: Text, claimTeamId :: Text } deriving (Eq, Show, Generic) @@ -1411,6 +1415,7 @@ instance A.FromJSON DPoPClaimsSet where <*> o A..: "htu" <*> o A..: "chal" <*> o A..: "handle" + <*> o A..: "name" <*> o A..: "team" instance A.ToJSON DPoPClaimsSet where @@ -1420,6 +1425,7 @@ instance A.ToJSON DPoPClaimsSet where & ins "htu" (claimHtu s) & ins "chal" (claimChal s) & ins "handle" (claimHandle s) + & ins "name" (claimDisplayName s) & ins "team" (claimTeamId s) where ins k v (Object o) = Object $ M.insert k (A.toJSON v) o @@ -1456,7 +1462,16 @@ testCreateAccessToken opts n brig = do & claimSub ?~ fromMaybe (error "invalid sub claim") ((clientIdentity :: Text) ^? stringOrUri) & claimJti ?~ "6fc59e7f-b666-4ffc-b738-4f4760c884ca" & claimAud ?~ (maybe (error "invalid sub claim") (Audience . (: [])) (("https://wire.com/acme/challenge/abcd" :: Text) ^? stringOrUri)) - let dpopClaims = DPoPClaimsSet claimsSet' nonceBs "POST" httpsUrl "wa2VrkCtW1sauJ2D3uKY8rc7y4kl4usH" handle (UUID.toText (toUUID tid)) + let dpopClaims = + DPoPClaimsSet + claimsSet' + nonceBs + "POST" + httpsUrl + "wa2VrkCtW1sauJ2D3uKY8rc7y4kl4usH" + handle + (fromName u.userDisplayName) + (UUID.toText (toUUID tid)) signedOrError <- fmap encodeCompact <$> liftIO (signAccessToken dpopClaims) case signedOrError of Left err -> liftIO $ assertFailure $ "failed to sign claims: " <> show err diff --git a/services/brig/test/integration/API/User/Connection.hs b/services/brig/test/integration/API/User/Connection.hs index 90559a710a1..7dbb61f7bcb 100644 --- a/services/brig/test/integration/API/User/Connection.hs +++ b/services/brig/test/integration/API/User/Connection.hs @@ -47,7 +47,7 @@ import Wire.API.Federation.API.Brig import Wire.API.Federation.Component import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.MultiTablePaging -import Wire.API.User +import Wire.API.User as User tests :: ConnectionLimit -> @@ -101,7 +101,7 @@ tests cl _at p b _c g fedBrigClient db = testCreateConnectionInvalidUser :: Brig -> Http () testCreateConnectionInvalidUser brig = do - uid1 <- (.userId) <$> randomUser brig + uid1 <- User.userId <$> randomUser brig -- user does not exist uid2 <- Id <$> liftIO UUID.nextRandom postConnection brig uid1 uid2 !!! do @@ -130,14 +130,14 @@ testCreateConnectionInvalidUserQualified brig = do testCreateManualConnections :: Brig -> Http () testCreateManualConnections brig = do - uid1 <- (.userId) <$> randomUser brig - uid2 <- (.userId) <$> randomUser brig + uid1 <- User.userId <$> randomUser brig + uid2 <- User.userId <$> randomUser brig postConnection brig uid1 uid2 !!! const 201 === statusCode assertConnections brig uid1 [ConnectionStatus uid1 uid2 Sent] assertConnections brig uid2 [ConnectionStatus uid2 uid1 Pending] -- Test that no connections to anonymous users can be created, -- as well as that anonymous users cannot create connections. - uid3 <- (.userId) <$> createAnonUser "foo3" brig + uid3 <- User.userId <$> createAnonUser "foo3" brig postConnection brig uid1 uid3 !!! const 400 === statusCode postConnection brig uid3 uid1 !!! const 403 === statusCode @@ -156,8 +156,8 @@ testCreateManualConnectionsQualified brig = do testCreateMutualConnections :: Brig -> Galley -> Http () testCreateMutualConnections brig galley = do - uid1 <- (.userId) <$> randomUser brig - uid2 <- (.userId) <$> randomUser brig + uid1 <- User.userId <$> randomUser brig + uid2 <- User.userId <$> randomUser brig postConnection brig uid1 uid2 !!! const 201 === statusCode assertConnections brig uid1 [ConnectionStatus uid1 uid2 Sent] assertConnections brig uid2 [ConnectionStatus uid2 uid1 Pending] @@ -198,8 +198,8 @@ testCreateMutualConnectionsQualified brig galley = do testAcceptConnection :: Brig -> Http () testAcceptConnection brig = do - uid1 <- (.userId) <$> randomUser brig - uid2 <- (.userId) <$> randomUser brig + uid1 <- User.userId <$> randomUser brig + uid2 <- User.userId <$> randomUser brig -- Initiate a new connection (A -> B) postConnection brig uid1 uid2 !!! const 201 === statusCode -- B accepts @@ -207,7 +207,7 @@ testAcceptConnection brig = do assertConnections brig uid1 [ConnectionStatus uid1 uid2 Accepted] assertConnections brig uid2 [ConnectionStatus uid2 uid1 Accepted] -- Mutual connection request with a user C - uid3 <- (.userId) <$> randomUser brig + uid3 <- User.userId <$> randomUser brig postConnection brig uid1 uid3 !!! const 201 === statusCode postConnection brig uid3 uid1 !!! const 200 === statusCode assertConnections brig uid1 [ConnectionStatus uid1 uid3 Accepted] @@ -226,8 +226,8 @@ testAcceptConnectionQualified brig = do testIgnoreConnection :: Brig -> Http () testIgnoreConnection brig = do - uid1 <- (.userId) <$> randomUser brig - uid2 <- (.userId) <$> randomUser brig + uid1 <- User.userId <$> randomUser brig + uid2 <- User.userId <$> randomUser brig -- Initiate a new connection (A -> B) postConnection brig uid1 uid2 !!! const 201 === statusCode -- B ignores A @@ -255,8 +255,8 @@ testIgnoreConnectionQualified brig = do testCancelConnection :: Brig -> Http () testCancelConnection brig = do - uid1 <- (.userId) <$> randomUser brig - uid2 <- (.userId) <$> randomUser brig + uid1 <- User.userId <$> randomUser brig + uid2 <- User.userId <$> randomUser brig -- Initiate a new connection (A -> B) postConnection brig uid1 uid2 !!! const 201 === statusCode -- A cancels the request @@ -284,8 +284,8 @@ testCancelConnectionQualified brig = do testCancelConnection2 :: Brig -> Galley -> Http () testCancelConnection2 brig galley = do - uid1 <- (.userId) <$> randomUser brig - uid2 <- (.userId) <$> randomUser brig + uid1 <- User.userId <$> randomUser brig + uid2 <- User.userId <$> randomUser brig -- Initiate a new connection (A -> B) postConnection brig uid1 uid2 !!! const 201 === statusCode -- A cancels the request @@ -361,8 +361,8 @@ testBlockConnection :: Brig -> Http () testBlockConnection brig = do u1 <- randomUser brig u2 <- randomUser brig - let uid1 = u1.userId - let uid2 = u2.userId + let uid1 = User.userId u1 + let uid2 = User.userId u2 -- Initiate a new connection (A -> B) postConnection brig uid1 uid2 !!! const 201 === statusCode -- Even connected users cannot see each other's email @@ -406,8 +406,8 @@ testBlockConnectionQualified :: Brig -> Http () testBlockConnectionQualified brig = do u1 <- randomUser brig u2 <- randomUser brig - let uid1 = u1.userId - uid2 = u2.userId + let uid1 = User.userId u1 + uid2 = User.userId u2 quid1 = userQualifiedId u1 quid2 = userQualifiedId u2 -- Initiate a new connection (A -> B) @@ -453,8 +453,8 @@ testBlockAndResendConnection :: Brig -> Galley -> Http () testBlockAndResendConnection brig galley = do u1 <- randomUser brig u2 <- randomUser brig - let uid1 = u1.userId - let uid2 = u2.userId + let uid1 = User.userId u1 + let uid2 = User.userId u2 -- Initiate a new connection (A -> B) postConnection brig uid1 uid2 !!! const 201 === statusCode -- B blocks A @@ -504,8 +504,8 @@ testBlockAndResendConnectionQualified brig galley = do testUnblockPendingConnection :: Brig -> Http () testUnblockPendingConnection brig = do - u1 <- (.userId) <$> randomUser brig - u2 <- (.userId) <$> randomUser brig + u1 <- User.userId <$> randomUser brig + u2 <- User.userId <$> randomUser brig postConnection brig u1 u2 !!! const 201 === statusCode putConnection brig u1 u2 Blocked !!! const 200 === statusCode assertConnections brig u1 [ConnectionStatus u1 u2 Blocked] @@ -527,8 +527,8 @@ testUnblockPendingConnectionQualified brig = do testAcceptWhileBlocked :: Brig -> Http () testAcceptWhileBlocked brig = do - u1 <- (.userId) <$> randomUser brig - u2 <- (.userId) <$> randomUser brig + u1 <- User.userId <$> randomUser brig + u2 <- User.userId <$> randomUser brig postConnection brig u1 u2 !!! const 201 === statusCode putConnection brig u1 u2 Blocked !!! const 200 === statusCode assertConnections brig u1 [ConnectionStatus u1 u2 Blocked] @@ -564,8 +564,8 @@ testUpdateConnectionNoopQualified brig = do testBadUpdateConnection :: Brig -> Http () testBadUpdateConnection brig = do - uid1 <- (.userId) <$> randomUser brig - uid2 <- (.userId) <$> randomUser brig + uid1 <- User.userId <$> randomUser brig + uid2 <- User.userId <$> randomUser brig postConnection brig uid1 uid2 !!! const 201 === statusCode assertBadUpdate uid1 uid2 Pending assertBadUpdate uid1 uid2 Ignored @@ -594,9 +594,9 @@ testBadUpdateConnectionQualified brig = do testLocalConnectionsPaging :: Brig -> Http () testLocalConnectionsPaging b = do - u <- (.userId) <$> randomUser b + u <- User.userId <$> randomUser b replicateM_ total $ do - u2 <- (.userId) <$> randomUser b + u2 <- User.userId <$> randomUser b postConnection b u u2 !!! const 201 === statusCode foldM_ (next u 2) (0, Nothing) [2, 2, 1, 0] foldM_ (next u total) (0, Nothing) [total, 0] @@ -660,21 +660,21 @@ testAllConnectionsPaging b db = do testConnectionLimit :: Brig -> ConnectionLimit -> Http () testConnectionLimit brig (ConnectionLimit l) = do - uid1 <- (.userId) <$> randomUser brig + uid1 <- User.userId <$> randomUser brig (uid2 : _) <- replicateM (fromIntegral l) (newConn uid1) - uidX <- (.userId) <$> randomUser brig + uidX <- User.userId <$> randomUser brig postConnection brig uid1 uidX !!! assertLimited -- blocked connections do not count towards the limit putConnection brig uid1 uid2 Blocked !!! const 200 === statusCode postConnection brig uid1 uidX !!! const 201 === statusCode -- the next send/accept hits the limit again - uidY <- (.userId) <$> randomUser brig + uidY <- User.userId <$> randomUser brig postConnection brig uid1 uidY !!! assertLimited -- (re-)sending an already accepted connection does not affect the limit postConnection brig uid1 uidX !!! const 200 === statusCode where newConn from = do - to <- (.userId) <$> randomUser brig + to <- User.userId <$> randomUser brig postConnection brig from to !!! const 201 === statusCode pure to assertLimited = do @@ -725,7 +725,7 @@ testConnectOK brig galley fedBrigClient = do testConnectWithAnon :: Brig -> FedClient 'Brig -> Http () testConnectWithAnon brig fedBrigClient = do fromUser <- randomId - toUser <- (.userId) <$> createAnonUser "anon1234" brig + toUser <- User.userId <$> createAnonUser "anon1234" brig res <- runFedClient @"send-connection-action" fedBrigClient (Domain "far-away.example.com") $ NewConnectionRequest fromUser Nothing toUser RemoteConnect @@ -734,7 +734,7 @@ testConnectWithAnon brig fedBrigClient = do testConnectFromAnon :: Brig -> Http () testConnectFromAnon brig = do - anonUser <- (.userId) <$> createAnonUser "anon1234" brig + anonUser <- User.userId <$> createAnonUser "anon1234" brig remoteUser <- fakeRemoteUser postConnectionQualified brig anonUser remoteUser !!! const 403 === statusCode diff --git a/services/brig/test/integration/API/User/PasswordReset.hs b/services/brig/test/integration/API/User/PasswordReset.hs index 26f1b5c41e4..55f19b34c28 100644 --- a/services/brig/test/integration/API/User/PasswordReset.hs +++ b/services/brig/test/integration/API/User/PasswordReset.hs @@ -30,7 +30,7 @@ import Cassandra qualified as DB import Data.Aeson as A import Data.Aeson.KeyMap qualified as KeyMap import Data.Misc -import Imports hiding (cs) +import Imports import Test.Tasty hiding (Timeout) import Util import Wire.API.User diff --git a/services/brig/test/integration/API/User/Property.hs b/services/brig/test/integration/API/User/Property.hs index e87733c5d2d..fd16f35793f 100644 --- a/services/brig/test/integration/API/User/Property.hs +++ b/services/brig/test/integration/API/User/Property.hs @@ -27,6 +27,7 @@ import Brig.Options import Brig.Options qualified as Opt import Data.Aeson import Data.ByteString.Char8 qualified as C +import Data.String.Conversions import Data.Text qualified as T import Imports import Network.Wai.Utilities.Error qualified as Error diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index 031a521e504..dfd26fb1c26 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -47,6 +47,7 @@ import Data.List1 qualified as List1 import Data.Misc import Data.Qualified import Data.Range (unsafeRange) +import Data.String.Conversions import Data.Text.Ascii qualified as Ascii import Data.Vector qualified as Vec import Data.ZAuth.Token qualified as ZAuth diff --git a/services/brig/test/integration/API/UserPendingActivation.hs b/services/brig/test/integration/API/UserPendingActivation.hs index 0537b2af448..db47762b6e4 100644 --- a/services/brig/test/integration/API/UserPendingActivation.hs +++ b/services/brig/test/integration/API/UserPendingActivation.hs @@ -36,6 +36,7 @@ import Data.Aeson.Lens (key, _String) import Data.ByteString.Conversion (fromByteString, toByteString') import Data.Id (InvitationId, TeamId, UserId) import Data.Range (unsafeRange) +import Data.String.Conversions import Data.Text.Encoding (encodeUtf8) import Data.UUID qualified as UUID import Data.UUID.V4 qualified as UUID diff --git a/services/brig/test/integration/Federation/End2end.hs b/services/brig/test/integration/Federation/End2end.hs index b696338e0fe..cf1beffc23c 100644 --- a/services/brig/test/integration/Federation/End2end.hs +++ b/services/brig/test/integration/Federation/End2end.hs @@ -38,7 +38,7 @@ import Data.Qualified import Data.Range (checked) import Data.Set qualified as Set import Federation.Util -import Imports hiding (cs) +import Imports import System.IO.Temp import System.Logger qualified as Log import Test.Tasty diff --git a/services/brig/test/integration/Federation/Util.hs b/services/brig/test/integration/Federation/Util.hs index cb0eb3e35bb..4a1376e8686 100644 --- a/services/brig/test/integration/Federation/Util.hs +++ b/services/brig/test/integration/Federation/Util.hs @@ -35,6 +35,7 @@ import Data.Aeson (FromJSON, Value, decode, (.=)) import Data.Aeson qualified as Aeson import Data.ByteString qualified as BS import Data.ByteString.Conversion (toByteString') +import Data.Default import Data.Domain (Domain (Domain)) import Data.Handle (fromHandle) import Data.Id @@ -79,8 +80,7 @@ import Wire.API.User.Client.Prekey withTempMockFederator :: Opt.Opts -> LByteString -> Session a -> IO (a, [Mock.FederatedRequest]) withTempMockFederator opts resp action = Mock.withTempMockFederator - [("Content-Type", "application/json")] - (const (pure ("application" // "json", resp))) + def {Mock.handler = const (pure ("application" // "json", resp))} $ \mockPort -> do let opts' = opts diff --git a/services/brig/test/integration/Index/Create.hs b/services/brig/test/integration/Index/Create.hs index b31dd74725e..51961e9533d 100644 --- a/services/brig/test/integration/Index/Create.hs +++ b/services/brig/test/integration/Index/Create.hs @@ -17,7 +17,10 @@ module Index.Create where +import API.Search.Util (mkBHEnv) +import Brig.App (initHttpManagerWithTLSConfig) import Brig.Index.Eval qualified as IndexEval +import Brig.Index.Options import Brig.Index.Options qualified as IndexOpts import Brig.Options (Opts (galley)) import Brig.Options qualified as BrigOpts @@ -26,7 +29,6 @@ import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Database.Bloodhound qualified as ES import Imports -import Network.HTTP.Client qualified as HTTP import System.Logger.Class qualified as Log import System.Random as Random import Test.Tasty @@ -47,7 +49,7 @@ spec brigOpts = testCreateIndexWhenNotPresent :: BrigOpts.Opts -> Assertion testCreateIndexWhenNotPresent brigOpts = do - let esURL = brigOpts ^. BrigOpts.elasticsearchL . BrigOpts.urlL + let (ES.Server esURL) = brigOpts ^. BrigOpts.elasticsearchL . BrigOpts.urlL case parseURI strictURIParserOptions (Text.encodeUtf8 esURL) of Left e -> fail $ "Invalid ES URL: " <> show esURL <> "\nerror: " <> show e Right esURI -> do @@ -55,16 +57,25 @@ testCreateIndexWhenNotPresent brigOpts = do let replicas = 2 shards = 2 refreshInterval = 5 + let connSettings = + ESConnectionSettings + { esServer = esURI, + esIndex = indexName, + esCaCert = brigOpts.elasticsearch.caCert, + esInsecureSkipVerifyTls = brigOpts.elasticsearch.insecureSkipVerifyTls, + esCredentials = brigOpts.elasticsearch.credentials + } let esSettings = IndexOpts.localElasticSettings - & IndexOpts.esServer .~ esURI - & IndexOpts.esIndex .~ indexName + & IndexOpts.esConnection .~ connSettings & IndexOpts.esIndexReplicas .~ ES.ReplicaCount replicas & IndexOpts.esIndexShardCount .~ shards & IndexOpts.esIndexRefreshInterval .~ refreshInterval devNullLogger <- Log.create (Log.Path "/dev/null") IndexEval.runCommand devNullLogger (IndexOpts.Create esSettings (galley brigOpts)) - ES.withBH HTTP.defaultManagerSettings (ES.Server esURL) $ do + mgr <- liftIO $ initHttpManagerWithTLSConfig connSettings.esInsecureSkipVerifyTls connSettings.esCaCert + let bEnv = (mkBHEnv esURL mgr) {ES.bhRequestHook = ES.basicAuthHook (ES.EsUsername "elastic") (ES.EsPassword "changeme")} + ES.runBH bEnv $ do indexExists <- ES.indexExists indexName lift $ assertBool "Index should exist" indexExists @@ -75,33 +86,42 @@ testCreateIndexWhenNotPresent brigOpts = do Right indexSettings -> do assertEqual "Shard count should be set" (ES.ShardCount replicas) (ES.indexShards . ES.sSummaryFixedSettings $ indexSettings) assertEqual "Replica count should be set" (ES.ReplicaCount replicas) (ES.indexReplicas . ES.sSummaryFixedSettings $ indexSettings) - assertEqual "Refresh internval should be set" [ES.RefreshInterval refreshInterval] (ES.sSummaryUpdateable indexSettings) + assertEqual "Refresh interval should be set" [ES.RefreshInterval refreshInterval] (ES.sSummaryUpdateable indexSettings) testCreateIndexWhenPresent :: BrigOpts.Opts -> Assertion testCreateIndexWhenPresent brigOpts = do - let esURL = brigOpts ^. BrigOpts.elasticsearchL . BrigOpts.urlL + let (ES.Server esURL) = brigOpts ^. BrigOpts.elasticsearchL . BrigOpts.urlL case parseURI strictURIParserOptions (Text.encodeUtf8 esURL) of Left e -> fail $ "Invalid ES URL: " <> show esURL <> "\nerror: " <> show e Right esURI -> do indexName <- ES.IndexName . Text.pack <$> replicateM 20 (Random.randomRIO ('a', 'z')) - ES.withBH HTTP.defaultManagerSettings (ES.Server esURL) $ do - _ <- ES.createIndex (ES.IndexSettings (ES.ShardCount 1) (ES.ReplicaCount 1)) indexName - indexExists <- ES.indexExists indexName - lift $ - assertBool "Index should exist" indexExists let replicas = 2 shards = 2 refreshInterval = 5 - let esSettings = + connSettings = + ESConnectionSettings + { esServer = esURI, + esIndex = indexName, + esCaCert = brigOpts.elasticsearch.caCert, + esInsecureSkipVerifyTls = brigOpts.elasticsearch.insecureSkipVerifyTls, + esCredentials = brigOpts.elasticsearch.credentials + } + esSettings = IndexOpts.localElasticSettings - & IndexOpts.esServer .~ esURI - & IndexOpts.esIndex .~ indexName + & IndexOpts.esConnection .~ connSettings & IndexOpts.esIndexReplicas .~ ES.ReplicaCount replicas & IndexOpts.esIndexShardCount .~ shards & IndexOpts.esIndexRefreshInterval .~ refreshInterval + mgr <- liftIO $ initHttpManagerWithTLSConfig connSettings.esInsecureSkipVerifyTls connSettings.esCaCert + let bEnv = (mkBHEnv esURL mgr) {ES.bhRequestHook = ES.basicAuthHook (ES.EsUsername "elastic") (ES.EsPassword "changeme")} + ES.runBH bEnv $ do + _ <- ES.createIndex (ES.IndexSettings (ES.ShardCount 1) (ES.ReplicaCount 1)) indexName + indexExists <- ES.indexExists indexName + lift $ + assertBool "Index should exist" indexExists devNullLogger <- Log.create (Log.Path "/dev/null") IndexEval.runCommand devNullLogger (IndexOpts.Create esSettings (galley brigOpts)) - ES.withBH HTTP.defaultManagerSettings (ES.Server esURL) $ do + ES.runBH bEnv $ do indexExists <- ES.indexExists indexName lift $ assertBool "Index should still exist" indexExists @@ -112,4 +132,4 @@ testCreateIndexWhenPresent brigOpts = do Right indexSettings -> do assertEqual "Shard count should not be updated" (ES.ShardCount 1) (ES.indexShards . ES.sSummaryFixedSettings $ indexSettings) assertEqual "Replica count should not be updated" (ES.ReplicaCount 1) (ES.indexReplicas . ES.sSummaryFixedSettings $ indexSettings) - assertEqual "Refresh internval should not be updated" [] (ES.sSummaryUpdateable indexSettings) + assertEqual "Refresh interval should not be updated" [] (ES.sSummaryUpdateable indexSettings) diff --git a/services/brig/test/integration/Run.hs b/services/brig/test/integration/Run.hs index 190a2553d80..1b3e0cd563d 100644 --- a/services/brig/test/integration/Run.hs +++ b/services/brig/test/integration/Run.hs @@ -35,32 +35,26 @@ import API.User qualified as User import API.UserPendingActivation qualified as UserPendingActivation import Bilge hiding (header, host, port) import Bilge qualified -import Brig.API (sitemap) import Brig.AWS qualified as AWS -import Brig.CanonicalInterpreter +import Brig.App (initHttpManagerWithTLSConfig) import Brig.Options qualified as Opts import Cassandra.Util (defInitCassandra) import Control.Lens import Data.Aeson import Data.ByteString.Char8 qualified as B8 -import Data.Metrics.Test (pathsConsistencyCheck) -import Data.Metrics.WaiRoute (treeToPaths) import Data.Text.Encoding (encodeUtf8) import Data.Yaml (decodeFileEither) import Federation.End2end qualified import Imports hiding (local) import Index.Create qualified import Network.HTTP.Client qualified as HTTP -import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.URI (pathSegments) -import Network.Wai.Utilities.Server (compile) import OpenSSL (withOpenSSL) import Options.Applicative hiding (action) import SMTP qualified import System.Environment (withArgs) import System.Logger qualified as Logger import Test.Tasty -import Test.Tasty.HUnit import Test.Tasty.Ingredients import Test.Tasty.Runners import Test.Tasty.Runners.AntXML @@ -133,7 +127,7 @@ runTests iConf brigOpts otherArgs = do awsOpts = Opts.aws brigOpts lg <- Logger.new Logger.defSettings -- TODO: use mkLogger'? db <- defInitCassandra (brigOpts.cassandra) lg - mg <- newManager tlsManagerSettings + mg <- initHttpManagerWithTLSConfig False Nothing let fedBrigClient = FedClient @'Brig mg (brig iConf) emailAWSOpts <- parseEmailAWSOpts awsEnv <- AWS.mkEnv lg awsOpts emailAWSOpts mg @@ -159,12 +153,7 @@ runTests iConf brigOpts otherArgs = do withArgs otherArgs . defaultMainWithIngredients (listingTests : (composeReporters antXMLRunner consoleTestReporter) : defaultIngredients) $ testGroup "Brig API Integration" - $ [ testCase "sitemap" $ - assertEqual - "inconcistent sitemap" - mempty - (pathsConsistencyCheck . treeToPaths . compile $ Brig.API.sitemap @BrigCanonicalEffects), - userApi, + $ [ userApi, providerApi, searchApis, teamApis, diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index 91cd6b674b6..e39db21d288 100644 --- a/services/brig/test/integration/Util.hs +++ b/services/brig/test/integration/Util.hs @@ -50,6 +50,7 @@ import Data.ByteString.Builder (toLazyByteString) import Data.ByteString.Char8 (pack) import Data.ByteString.Char8 qualified as B8 import Data.ByteString.Conversion +import Data.Default import Data.Domain (Domain (..), domainText, mkDomain) import Data.Handle (Handle (..)) import Data.Id @@ -60,6 +61,7 @@ import Data.Proxy import Data.Qualified hiding (isLocal) import Data.Range import Data.Sequence qualified as Seq +import Data.String.Conversions import Data.Text qualified as T import Data.Text qualified as Text import Data.Text.Ascii qualified as Ascii @@ -1078,7 +1080,7 @@ circumventSettingsOverride = runHttpT -- -- Beware: (1) Not all async parts of brig are running in this. (2) other services will -- see the old, unaltered brig. -withSettingsOverrides :: MonadIO m => Opt.Opts -> WaiTest.Session a -> m a +withSettingsOverrides :: (MonadIO m, HasCallStack) => Opt.Opts -> WaiTest.Session a -> m a withSettingsOverrides opts action = liftIO $ do (brigApp, env) <- Run.mkApp opts sftDiscovery <- @@ -1231,8 +1233,7 @@ withMockedFederatorAndGalley opts _domain fedResp galleyHandler action = do result <- assertRight <=< runExceptT $ withTempMockedService initState galleyHandler $ \galleyMockState -> Mock.withTempMockFederator - [("Content-Type", "application/json")] - ((\r -> pure ("application" // "json", r)) <=< fedResp) + def {Mock.handler = (\r -> pure ("application" // "json", r)) <=< fedResp} $ \fedMockPort -> do let opts' = opts diff --git a/services/brig/test/resources/elasticsearch-ca.pem b/services/brig/test/resources/elasticsearch-ca.pem new file mode 120000 index 00000000000..ed6d4718bf2 --- /dev/null +++ b/services/brig/test/resources/elasticsearch-ca.pem @@ -0,0 +1 @@ +../../../../deploy/dockerephemeral/docker/elasticsearch-ca.pem \ No newline at end of file diff --git a/services/brig/test/resources/elasticsearch-credentials.yaml b/services/brig/test/resources/elasticsearch-credentials.yaml new file mode 100644 index 00000000000..c1865766f56 --- /dev/null +++ b/services/brig/test/resources/elasticsearch-credentials.yaml @@ -0,0 +1,2 @@ +username: "elastic" +password: "changeme" diff --git a/services/brig/test/unit/Test/Brig/Calling.hs b/services/brig/test/unit/Test/Brig/Calling.hs index 044c289f9d1..007a2041743 100644 --- a/services/brig/test/unit/Test/Brig/Calling.hs +++ b/services/brig/test/unit/Test/Brig/Calling.hs @@ -21,13 +21,13 @@ module Test.Brig.Calling (tests) where import Brig.Calling -import Brig.Calling.API (CallsConfigVersion (..), NoTurnServers, newConfig) -import Brig.Calling.Internal (sftServerFromSrvTarget) +import Brig.Calling.API +import Brig.Calling.Internal import Brig.Effects.SFT import Brig.Options import Control.Concurrent.Timeout qualified as System import Control.Lens ((^.)) -import Control.Monad.Catch (throwM) +import Control.Monad.Catch import Data.Bifunctor import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NonEmpty @@ -39,14 +39,14 @@ import Data.Timeout import Imports import Network.DNS import OpenSSL -import OpenSSL.EVP.Digest (getDigestByName) +import OpenSSL.EVP.Digest import Polysemy import Polysemy.Error import Polysemy.TinyLog import Test.Brig.Effects.Delay import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.QuickCheck (Arbitrary (..), generate) +import Test.Tasty.QuickCheck import URI.ByteString import UnliftIO.Async qualified as Async import Wire.API.Call.Config @@ -83,12 +83,12 @@ tests = assertEqual "should use the service name to form domain" "_foo._tcp.example.com." - (mkSFTDomain (SFTOptions "example.com" (Just "foo") Nothing Nothing)), + (mkSFTDomain (SFTOptions "example.com" (Just "foo") Nothing Nothing Nothing)), testCase "when service name is not provided" $ assertEqual "should assume service name to be 'sft'" "_sft._tcp.example.com." - (mkSFTDomain (SFTOptions "example.com" Nothing Nothing Nothing)) + (mkSFTDomain (SFTOptions "example.com" Nothing Nothing Nothing Nothing)) ], testGroup "sftDiscoveryLoop" $ [ testCase "when service can be discovered" $ void testSFTDiscoveryLoopWhenSuccessful @@ -126,7 +126,8 @@ testSFTDiscoveryLoopWhenSuccessful = do fakeDNSEnv <- newFakeDNSEnv (\_ -> SrvAvailable returnedEntries) let intervalInSeconds = 0.001 intervalInMicroseconds = 1000 - sftEnv <- mkSFTEnv $ SFTOptions "foo.example.com" Nothing (Just intervalInSeconds) Nothing + Just sha512 <- getDigestByName "SHA512" + sftEnv <- mkSFTEnv sha512 $ SFTOptions "foo.example.com" Nothing (Just intervalInSeconds) Nothing Nothing tick <- newEmptyMVar delayCallsTVar <- newTVarIO [] @@ -315,17 +316,18 @@ testSFTStaticV2NoStaticUrl = do <*> pure "foo.example.com" <*> pure 5 <*> pure (unsafeRange 1) + <*> pure Nothing turnUri <- generate arbitrary cfg <- runM @IO . ignoreLogs . interpretSFTInMemory mempty . throwErrorInIO @_ @NoTurnServers - $ newConfig env (Discovered turnUri) Nothing (Just sftEnv) (Just . unsafeRange $ 2) ListAllSFTServers CallsConfigV2 + $ newConfig env (Discovered turnUri) Nothing (Just sftEnv) (Just . unsafeRange $ 2) ListAllSFTServers (CallsConfigV2 Nothing) assertEqual "when SFT static URL is disabled, sft_servers_all should be from SFT environment" - (Just . fmap (sftServerFromSrvTarget . srvTarget) . toList $ servers) - (cfg ^. rtcConfSftServersAll) + (Just . fmap ((^. sftURL) . sftServerFromSrvTarget . srvTarget) . toList $ servers) + ((^. authURL) <$$> cfg ^. rtcConfSftServersAll) -- The v2 endpoint `GET /calls/config/v2` with an SFT static URL that gives an error testSFTStaticV2StaticUrlError :: IO () @@ -337,7 +339,7 @@ testSFTStaticV2StaticUrlError = do . ignoreLogs . interpretSFTInMemory mempty -- an empty lookup map, meaning there was an error . throwErrorInIO @_ @NoTurnServers - $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 2) ListAllSFTServers CallsConfigV2 + $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 2) ListAllSFTServers (CallsConfigV2 Nothing) assertEqual "when SFT static URL is enabled (and setSftListAllServers is enabled), but returns error, sft_servers_all should be omitted" Nothing @@ -354,13 +356,13 @@ testSFTStaticV2StaticUrlList = do cfg <- runM @IO . ignoreLogs - . interpretSFTInMemory (Map.singleton staticUrl (SFTGetResponse . Right $ servers)) + . interpretSFTInMemory (Map.singleton staticUrl (SFTGetResponse $ Right servers)) . throwErrorInIO @_ @NoTurnServers - $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 3) ListAllSFTServers CallsConfigV2 + $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 3) ListAllSFTServers (CallsConfigV2 Nothing) assertEqual "when SFT static URL and setSftListAllServers are enabled, sft_servers_all should be from /sft_servers_all.json" - (Just servers) - (cfg ^. rtcConfSftServersAll) + ((^. sftURL) <$$> Just servers) + ((^. authURL) <$$> cfg ^. rtcConfSftServersAll) testSFTStaticV2ListAllServersDisabled :: IO () testSFTStaticV2ListAllServersDisabled = do @@ -374,7 +376,7 @@ testSFTStaticV2ListAllServersDisabled = do . ignoreLogs . interpretSFTInMemory (Map.singleton staticUrl (SFTGetResponse . Right $ servers)) . throwErrorInIO @_ @NoTurnServers - $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 3) HideAllSFTServers CallsConfigV2 + $ newConfig env (Discovered turnUri) (Just staticUrl) Nothing (Just . unsafeRange $ 3) HideAllSFTServers (CallsConfigV2 Nothing) assertEqual "when SFT static URL is enabled and setSftListAllServers is \"disabled\" then sft_servers_all is missing" Nothing diff --git a/services/cannon/src/Cannon/Types.hs b/services/cannon/src/Cannon/Types.hs index 63dbdb42c37..9dc29f2e2e8 100644 --- a/services/cannon/src/Cannon/Types.hs +++ b/services/cannon/src/Cannon/Types.hs @@ -126,7 +126,7 @@ lookupReqId :: Logger -> Request -> IO RequestId lookupReqId l r = case lookup requestIdName (requestHeaders r) of Just rid -> pure $ RequestId rid Nothing -> do - localRid <- RequestId . cs . UUID.toText <$> UUID.nextRandom + localRid <- RequestId . UUID.toASCIIBytes <$> UUID.nextRandom Log.info l $ "request-id" .= localRid ~~ "method" .= requestMethod r diff --git a/services/cannon/src/Cannon/WS.hs b/services/cannon/src/Cannon/WS.hs index 1cc3b3aaa84..6837457b636 100644 --- a/services/cannon/src/Cannon/WS.hs +++ b/services/cannon/src/Cannon/WS.hs @@ -67,7 +67,7 @@ import Data.List.Extra (chunksOf) import Data.Text.Encoding (decodeUtf8) import Data.Timeout (TimeoutUnit (..), (#)) import Gundeck.Types -import Imports hiding (cs, threadDelay) +import Imports hiding (threadDelay) import Network.HTTP.Types.Method import Network.HTTP.Types.Status import Network.Wai.Utilities.Error diff --git a/services/cargohold/cargohold.cabal b/services/cargohold/cargohold.cabal index 7723b5814f9..f3c5ad95c44 100644 --- a/services/cargohold/cargohold.cabal +++ b/services/cargohold/cargohold.cabal @@ -269,6 +269,7 @@ executable cargohold-integration , cargohold , cargohold-types , containers + , data-default , federator , http-api-data , http-client >=0.7 diff --git a/services/cargohold/default.nix b/services/cargohold/default.nix index 9c9c13d493b..58b2e770a30 100644 --- a/services/cargohold/default.nix +++ b/services/cargohold/default.nix @@ -19,6 +19,7 @@ , conduit-extra , containers , crypton +, data-default , errors , exceptions , extended @@ -138,6 +139,7 @@ mkDerivation { bytestring-conversion cargohold-types containers + data-default federator HsOpenSSL http-api-data diff --git a/services/cargohold/src/CargoHold/API/Public.hs b/services/cargohold/src/CargoHold/API/Public.hs index 4435fc9e3e1..794e4ae0318 100644 --- a/services/cargohold/src/CargoHold/API/Public.hs +++ b/services/cargohold/src/CargoHold/API/Public.hs @@ -27,21 +27,25 @@ import qualified CargoHold.Types.V3 as V3 import Control.Lens import Control.Monad.Trans.Except (throwE) import Data.ByteString.Builder +import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Lazy as LBS import Data.Domain import Data.Id import Data.Kind import Data.Qualified +import Data.Text.Encoding +import Data.Text.Encoding.Error import Imports hiding (head) import qualified Network.HTTP.Types as HTTP import Servant.API import Servant.Server hiding (Handler) -import URI.ByteString +import URI.ByteString as URI import Wire.API.Asset import Wire.API.Federation.API import Wire.API.Routes.AssetBody import Wire.API.Routes.Internal.Brig (brigInternalClient) import Wire.API.Routes.Internal.Cargohold +import Wire.API.Routes.Named import Wire.API.Routes.Public.Cargohold import Wire.API.User (AccountStatus (Active), AccountStatusResp (..)) @@ -74,7 +78,23 @@ servantSitemap = :<|> deleteAssetV4 internalSitemap :: ServerT InternalAPI Handler -internalSitemap = pure () +internalSitemap = + pure () + :<|> Named @"iGetAsset" iDownloadAssetV3 + +-- | Like 'downloadAssetV3' below, but it works without user session token, and has a +-- different route type. +iDownloadAssetV3 :: V3.AssetKey -> Handler Text +iDownloadAssetV3 key = do + render <$> V3.downloadUnsafe key Nothing + where + -- (NB: don't use HttpsUrl here, as in some test environments we legitimately use "http"!) + render :: URI.URI -> Text + render = + decodeUtf8With lenientDecode + . LBS.toStrict + . Builder.toLazyByteString + . URI.serializeURIRef class HasLocation (tag :: PrincipalTag) where assetLocation :: Local AssetKey -> [Text] diff --git a/services/cargohold/src/CargoHold/API/V3.hs b/services/cargohold/src/CargoHold/API/V3.hs index d96d772d5ce..4b4c58f374a 100644 --- a/services/cargohold/src/CargoHold/API/V3.hs +++ b/services/cargohold/src/CargoHold/API/V3.hs @@ -18,6 +18,7 @@ module CargoHold.API.V3 ( upload, download, + downloadUnsafe, checkMetadata, delete, renewToken, @@ -112,6 +113,9 @@ download own key tok mbHost = runMaybeT $ do checkMetadata (Just own) key tok lift $ genSignedURL (S3.mkKey key) mbHost +downloadUnsafe :: V3.AssetKey -> Maybe Text -> Handler URI +downloadUnsafe key mbHost = genSignedURL (S3.mkKey key) mbHost + checkMetadata :: Maybe V3.Principal -> V3.AssetKey -> Maybe V3.AssetToken -> MaybeT Handler () checkMetadata mown key tok = do s3 <- lift (S3.getMetadataV3 key) >>= maybe mzero pure diff --git a/services/cargohold/src/CargoHold/Run.hs b/services/cargohold/src/CargoHold/Run.hs index be0228da1ef..2a7165e162d 100644 --- a/services/cargohold/src/CargoHold/Run.hs +++ b/services/cargohold/src/CargoHold/Run.hs @@ -104,7 +104,7 @@ mkApp o = Codensity $ \k -> lookupReqId l r = case lookup requestIdName $ Wai.requestHeaders r of Just rid -> pure $ RequestId rid Nothing -> do - localRid <- RequestId . cs . UUID.toText <$> UUID.nextRandom + localRid <- RequestId . UUID.toASCIIBytes <$> UUID.nextRandom Log.info l $ "request-id" .= localRid ~~ "method" .= Wai.requestMethod r diff --git a/services/cargohold/test/integration/API/Util.hs b/services/cargohold/test/integration/API/Util.hs index 1c9e1057248..2c51dc9b29f 100644 --- a/services/cargohold/test/integration/API/Util.hs +++ b/services/cargohold/test/integration/API/Util.hs @@ -42,6 +42,7 @@ import Data.ByteString.Builder import qualified Data.ByteString.Char8 as C import Data.ByteString.Conversion import qualified Data.ByteString.Lazy as Lazy +import Data.Default import Data.Id import Data.Qualified import Data.Text.Encoding (decodeLatin1, encodeUtf8) @@ -223,7 +224,7 @@ withMockFederator :: TestM a -> TestM (a, [FederatedRequest]) withMockFederator respond action = do - withTempMockFederator [] respond $ \p -> + withTempMockFederator def {handler = respond} $ \p -> withSettingsOverrides (federator . _Just %~ setLocalEndpoint (fromIntegral p)) action diff --git a/services/federator/default.nix b/services/federator/default.nix index 0871b678a85..423926f9509 100644 --- a/services/federator/default.nix +++ b/services/federator/default.nix @@ -52,6 +52,7 @@ , servant-client , servant-client-core , servant-server +, string-conversions , tasty , tasty-hunit , tasty-quickcheck @@ -61,6 +62,7 @@ , transformers , types-common , unix +, utf8-string , uuid , wai , wai-extra @@ -88,6 +90,7 @@ mkDerivation { containers crypton-x509 crypton-x509-validation + data-default dns dns-util exceptions @@ -119,6 +122,7 @@ mkDerivation { transformers types-common unix + utf8-string uuid wai wai-utilities @@ -153,11 +157,11 @@ mkDerivation { QuickCheck random servant-client-core + string-conversions tasty-hunit text types-common uuid - wai-utilities wire-api wire-api-federation yaml @@ -188,6 +192,7 @@ mkDerivation { servant-client servant-client-core servant-server + string-conversions tasty tasty-hunit tasty-quickcheck diff --git a/services/federator/federator.cabal b/services/federator/federator.cabal index fe6fa823004..4fa411b3be0 100644 --- a/services/federator/federator.cabal +++ b/services/federator/federator.cabal @@ -115,6 +115,7 @@ library , containers , crypton-x509 , crypton-x509-validation + , data-default , dns , dns-util , exceptions @@ -146,6 +147,7 @@ library , transformers , types-common , unix + , utf8-string , uuid , wai , wai-utilities @@ -302,11 +304,11 @@ executable federator-integration , QuickCheck , random , servant-client-core + , string-conversions , tasty-hunit , text , types-common , uuid - , wai-utilities , wire-api , wire-api-federation , yaml @@ -404,6 +406,7 @@ test-suite federator-tests , servant-client , servant-client-core , servant-server + , string-conversions , tasty , tasty-hunit , tasty-quickcheck diff --git a/services/federator/src/Federator/Discovery.hs b/services/federator/src/Federator/Discovery.hs index 9050125e68c..901042f86ba 100644 --- a/services/federator/src/Federator/Discovery.hs +++ b/services/federator/src/Federator/Discovery.hs @@ -96,7 +96,7 @@ runFederatorDiscovery = interpret $ \case -- FUTUREWORK(federation): This string conversion is wrong, we should encode -- this using IDNA encoding or expect domain to be bytestring everywhere -- (https://wearezeta.atlassian.net/browse/SQCORE-912) - domainSrv d = cs $ "_wire-server-federator._tcp." <> domainText d + domainSrv d = Text.encodeUtf8 $ "_wire-server-federator._tcp." <> domainText d lookupDomainByDNS :: ( Member DNSLookup r, diff --git a/services/federator/src/Federator/ExternalServer.hs b/services/federator/src/Federator/ExternalServer.hs index 513bf5d73e8..4a2f83d4c5f 100644 --- a/services/federator/src/Federator/ExternalServer.hs +++ b/services/federator/src/Federator/ExternalServer.hs @@ -148,7 +148,7 @@ callInward component (RPC rpc) mReqId originDomain (CertHeader cert) wreq = do rid <- case mReqId of Just r -> pure r Nothing -> do - localRid <- liftIO $ RequestId . cs . UUID.toText <$> UUID.nextRandom + localRid <- liftIO $ RequestId . Text.encodeUtf8 . UUID.toText <$> UUID.nextRandom info $ "request-id" .= localRid ~~ "method" .= Wai.requestMethod wreq diff --git a/services/federator/src/Federator/Health.hs b/services/federator/src/Federator/Health.hs index 7a2228b74d0..857a3e56415 100644 --- a/services/federator/src/Federator/Health.hs +++ b/services/federator/src/Federator/Health.hs @@ -1,5 +1,7 @@ module Federator.Health where +import Data.ByteString (fromStrict) +import Data.ByteString.UTF8 qualified as UTF8 import Imports import Network.HTTP.Client import Network.HTTP.Types.Status qualified as HTTP @@ -20,4 +22,11 @@ status mgr otherName otherPort False = do res <- liftIO $ httpNoBody req mgr if HTTP.statusIsSuccessful $ responseStatus res then pure NoContent - else throwError Servant.err500 {Servant.errBody = otherName <> " server responded with status code = " <> cs (show (responseStatus res))} + else + throwError + Servant.err500 + { Servant.errBody = + otherName + <> " server responded with status code = " + <> (fromStrict . UTF8.fromString . show . responseStatus $ res) + } diff --git a/services/federator/src/Federator/InternalServer.hs b/services/federator/src/Federator/InternalServer.hs index 13dd401f3b6..ef6cbd0cce4 100644 --- a/services/federator/src/Federator/InternalServer.hs +++ b/services/federator/src/Federator/InternalServer.hs @@ -27,6 +27,7 @@ import Data.Domain import Data.Id import Data.Metrics.Servant qualified as Metrics import Data.Proxy +import Data.Text.Encoding qualified as T import Data.UUID as UUID import Data.UUID.V4 as UUID import Federator.Env @@ -117,7 +118,7 @@ callOutward mReqId targetDomain component (RPC path) req = do rid <- case mReqId of Just r -> pure r Nothing -> do - localRid <- liftIO $ RequestId . cs . UUID.toText <$> UUID.nextRandom + localRid <- liftIO $ RequestId . T.encodeUtf8 . UUID.toText <$> UUID.nextRandom info $ "request-id" .= localRid ~~ "method" .= Wai.requestMethod req diff --git a/services/federator/src/Federator/MockServer.hs b/services/federator/src/Federator/MockServer.hs index 81b657d9760..463967531ba 100644 --- a/services/federator/src/Federator/MockServer.hs +++ b/services/federator/src/Federator/MockServer.hs @@ -19,6 +19,7 @@ module Federator.MockServer ( -- * Federator mock server + MockFederator (..), MockException (..), withTempMockFederator, FederatedRequest (..), @@ -44,6 +45,7 @@ import Control.Monad.Catch hiding (fromException) import Control.Monad.Trans.Except import Control.Monad.Trans.Maybe import Data.Aeson qualified as Aeson +import Data.Default import Data.Domain import Data.Text qualified as Text import Data.Text.Lazy qualified as LText @@ -66,6 +68,7 @@ import Servant.API import Servant.Server (Tagged (..)) import Servant.Server.Generic import Wire.API.Federation.API (Component) +import Wire.API.Federation.API.Common import Wire.API.Federation.Domain import Wire.API.Federation.Version import Wire.Sem.Logger.TinyLog @@ -104,16 +107,15 @@ mockServer :: Member (Error ValidationError) r ) => IORef [FederatedRequest] -> - [HTTP.Header] -> - (FederatedRequest -> IO (HTTP.MediaType, LByteString)) -> + MockFederator -> (Sem r Wai.Response -> IO Wai.Response) -> API AsServer -mockServer remoteCalls headers resp interpreter = +mockServer remoteCalls mock interpreter = Federator.InternalServer.API { status = const $ pure NoContent, internalRequest = \_mReqId targetDomain component rpc -> Tagged $ \req respond -> - respond =<< interpreter (mockInternalRequest remoteCalls headers resp targetDomain component rpc req) + respond =<< interpreter (mockInternalRequest remoteCalls mock targetDomain component rpc req) } mockInternalRequest :: @@ -123,14 +125,13 @@ mockInternalRequest :: Member (Error ValidationError) r ) => IORef [FederatedRequest] -> - [HTTP.Header] -> - (FederatedRequest -> IO (HTTP.MediaType, LByteString)) -> + MockFederator -> Domain -> Component -> RPC -> Wai.Request -> Sem r Wai.Response -mockInternalRequest remoteCalls headers resp targetDomain component (RPC path) req = do +mockInternalRequest remoteCalls mock targetDomain component (RPC path) req = do domainTxt <- note NoOriginDomain $ lookup originDomainHeaderName (Wai.requestHeaders req) originDomain <- parseDomain domainTxt reqBody <- embed $ Wai.lazyRequestBody req @@ -145,20 +146,34 @@ mockInternalRequest remoteCalls headers resp targetDomain component (RPC path) r ) (ct, resBody) <- if path == "api-version" - then pure ("application/json", Aeson.encode versionInfo) + then pure ("application/json", Aeson.encode (VersionInfo mock.versions)) else do modifyIORef remoteCalls (<> [fedRequest]) fromException @MockException . handle (throw . handleException) - $ resp fedRequest - let headers' = ("Content-Type", HTTP.renderHeader ct) : headers - pure $ Wai.responseLBS HTTP.status200 headers' resBody + $ mock.handler fedRequest + let headers = ("Content-Type", HTTP.renderHeader ct) : mock.headers + pure $ Wai.responseLBS HTTP.status200 headers resBody where handleException :: SomeException -> MockException handleException e = case Exception.fromException e of Just mockE -> mockE Nothing -> MockErrorResponse HTTP.status500 (LText.pack (displayException e)) +data MockFederator = MockFederator + { headers :: [HTTP.Header], + handler :: FederatedRequest -> IO (HTTP.MediaType, LByteString), + versions :: [Int] + } + +instance Default MockFederator where + def = + MockFederator + { headers = [], + handler = \_ -> pure ("application/json", Aeson.encode EmptyResponse), + versions = map versionInt (toList supportedVersions) + } + -- | Spawn a mock federator on a random port and run an action while it is running. -- -- A mock federator is a web application that parses requests of the same form @@ -166,11 +181,10 @@ mockInternalRequest remoteCalls headers resp targetDomain component (RPC path) r -- forwarding them to a remote federator. withTempMockFederator :: (MonadIO m, MonadMask m) => - [HTTP.Header] -> - (FederatedRequest -> IO (HTTP.MediaType, LByteString)) -> + MockFederator -> (Warp.Port -> m a) -> m (a, [FederatedRequest]) -withTempMockFederator headers resp action = do +withTempMockFederator mock action = do remoteCalls <- newIORef [] let interpreter = runM @@ -180,7 +194,7 @@ withTempMockFederator headers resp action = do ServerError, MockException ] - app = genericServe (mockServer remoteCalls headers resp interpreter) + app = genericServe (mockServer remoteCalls mock interpreter) result <- bracket (liftIO (startMockServer Nothing app)) diff --git a/services/federator/src/Federator/Remote.hs b/services/federator/src/Federator/Remote.hs index 48b75cdd0db..2bc3ae9a05b 100644 --- a/services/federator/src/Federator/Remote.hs +++ b/services/federator/src/Federator/Remote.hs @@ -63,10 +63,10 @@ data RemoteError deriving (Show) instance AsWai RemoteError where - toWai (RemoteError _ _ e) = - federationRemoteHTTP2Error e - toWai (RemoteErrorResponse _ _ status body) = - federationRemoteResponseError status body + toWai (RemoteError target msg err) = + federationRemoteHTTP2Error target msg err + toWai (RemoteErrorResponse target msg status body) = + federationRemoteResponseError target msg status body data Remote m a where DiscoverAndCall :: diff --git a/services/federator/src/Federator/Response.hs b/services/federator/src/Federator/Response.hs index 04662a1da3a..6f70df5a390 100644 --- a/services/federator/src/Federator/Response.hs +++ b/services/federator/src/Federator/Response.hs @@ -29,6 +29,7 @@ import Control.Lens import Control.Monad.Codensity import Data.ByteString.Builder import Data.Kind +import Data.Text qualified as T import Federator.Discovery import Federator.Env import Federator.Error @@ -172,7 +173,7 @@ getFederationDomainConfigs :: Env -> IO FedUp.FederationDomainConfigs getFederationDomainConfigs env = do let mgr = env ^. httpManager Endpoint h p = env ^. service $ Brig - baseurl = BaseUrl Http (cs h) (fromIntegral p) "" + baseurl = BaseUrl Http (T.unpack h) (fromIntegral p) "" clientEnv = mkClientEnv mgr baseurl FedUp.getFederationDomainConfigs clientEnv >>= \case Right v -> pure v diff --git a/services/federator/src/Federator/Service.hs b/services/federator/src/Federator/Service.hs index 691f4629dff..b4f859d52bf 100644 --- a/services/federator/src/Federator/Service.hs +++ b/services/federator/src/Federator/Service.hs @@ -94,7 +94,7 @@ interpretServiceHTTP = interpret $ \case path = rpcPath, requestHeaders = [ ("Content-Type", "application/json"), - (originDomainHeaderName, cs (domainText domain)), + (originDomainHeaderName, Text.encodeUtf8 (domainText domain)), (RPC.requestIdName, unRequestId rid) ] <> headers diff --git a/services/federator/test/integration/Test/Federator/IngressSpec.hs b/services/federator/test/integration/Test/Federator/IngressSpec.hs index 38c75dbfb68..62b4f1b7401 100644 --- a/services/federator/test/integration/Test/Federator/IngressSpec.hs +++ b/services/federator/test/integration/Test/Federator/IngressSpec.hs @@ -25,6 +25,7 @@ import Data.Binary.Builder import Data.Domain import Data.Id import Data.LegalHold (UserLegalHoldStatus (UserLegalHoldNoConsent)) +import Data.String.Conversions import Data.Text.Encoding qualified as Text import Federator.Discovery import Federator.Monitor (FederationSetupError) @@ -58,7 +59,7 @@ spec env = do brig <- view teBrig <$> ask user <- randomUser brig - let expectedProfile = publicProfile user UserLegalHoldNoConsent + let expectedProfile = mkUserProfile EmailVisibleToSelf user UserLegalHoldNoConsent runTestSem $ do resp <- liftToCodensity diff --git a/services/federator/test/integration/Test/Federator/InwardSpec.hs b/services/federator/test/integration/Test/Federator/InwardSpec.hs index 3b4cc55bd9b..33cd7e89c92 100644 --- a/services/federator/test/integration/Test/Federator/InwardSpec.hs +++ b/services/federator/test/integration/Test/Federator/InwardSpec.hs @@ -33,7 +33,6 @@ import Data.Text.Encoding import Federator.Options hiding (federatorExternal) import Imports import Network.HTTP.Types qualified as HTTP -import Network.Wai.Utilities.Error qualified as E import Test.Federator.Util import Test.Hspec import Test.QuickCheck (arbitrary, generate) @@ -71,7 +70,7 @@ spec env = brig <- view teBrig <$> ask user <- randomUser brig - let expectedProfile = publicProfile user UserLegalHoldNoConsent + let expectedProfile = mkUserProfile EmailVisibleToSelf user UserLegalHoldNoConsent bdy <- responseJsonError =<< inwardCall "/federation/brig/get-users-by-ids" (encode [userId user]) @@ -99,11 +98,10 @@ spec env = it "should return 404 'no-endpoint' response from Brig" $ runTestFederator env $ do - err <- - responseJsonError - =<< inwardCall "/federation/brig/this-endpoint-does-not-exist" (encode Aeson.emptyObject) - - (FederatedRequest -> IO (MediaType, LByteString)) -> + MockFederator -> FederatorClient c a -> IO (Either ResponseFailure a, [FederatedRequest]) -withMockFederatorClient headers resp action = withTempMockFederator headers resp $ \port -> do +withMockFederatorClient mock action = withTempMockFederator mock $ \port -> do mgr <- defaultHttp2Manager let env = FederatorClientEnv @@ -114,8 +111,7 @@ testClientSuccess = do (actualResponse, sentRequests) <- withMockFederatorClient - defaultHeaders - (const (pure ("application/json", Aeson.encode (Just expectedResponse)))) + def {handler = const (pure ("application/json", Aeson.encode (Just expectedResponse)))} $ fedClient @'Brig @"get-user-by-handle" handle sentRequests @@ -157,8 +153,7 @@ testClientFailure = do (actualResponse, _) <- withMockFederatorClient - defaultHeaders - (const (throw (MockErrorResponse HTTP.status422 "wrong domain"))) + def {handler = const (throw (MockErrorResponse HTTP.status422 "wrong domain"))} $ do fedClient @'Brig @"get-user-by-handle" handle @@ -174,8 +169,7 @@ testFederatorFailure = do (actualResponse, _) <- withMockFederatorClient - defaultHeaders - (const (throw (MockErrorResponse HTTP.status403 "invalid path"))) + def {handler = const (throw (MockErrorResponse HTTP.status403 "invalid path"))} $ do fedClient @'Brig @"get-user-by-handle" handle @@ -190,7 +184,7 @@ testClientExceptions = do handle <- generate arbitrary (response, _) <- - withMockFederatorClient defaultHeaders (const (evaluate (error "unhandled exception"))) $ + withMockFederatorClient def {handler = const (evaluate (error "unhandled exception"))} $ fedClient @'Brig @"get-user-by-handle" handle case response of @@ -218,8 +212,10 @@ testClientConnectionError = do testResponseHeaders :: IO () testResponseHeaders = do (r, _) <- withTempMockFederator - [("X-Foo", "bar")] - (const $ pure ("application" // "json", mempty)) + def + { headers = [("X-Foo", "bar")], + handler = const $ pure ("application" // "json", mempty) + } $ \port -> do let req = HTTP2.requestBuilder diff --git a/services/federator/test/unit/Test/Federator/ExternalServer.hs b/services/federator/test/unit/Test/Federator/ExternalServer.hs index 48680d09d33..ec0b0438e24 100644 --- a/services/federator/test/unit/Test/Federator/ExternalServer.hs +++ b/services/federator/test/unit/Test/Federator/ExternalServer.hs @@ -24,6 +24,7 @@ import Data.ByteString qualified as BS import Data.Default import Data.Domain import Data.Sequence as Seq +import Data.String.Conversions import Data.Text.Encoding qualified as Text import Federator.Discovery import Federator.Error.ServerError (ServerError (..)) diff --git a/services/galley/default.nix b/services/galley/default.nix index 279ee871813..7148f3c23b4 100644 --- a/services/galley/default.nix +++ b/services/galley/default.nix @@ -27,6 +27,7 @@ , conduit , containers , cookie +, cql , crypton , crypton-x509 , currency-codes @@ -89,6 +90,7 @@ , ssl-util , stm , streaming-commons +, string-conversions , tagged , tasty , tasty-ant-xml @@ -109,6 +111,7 @@ , unliftio , unordered-containers , uri-bytestring +, utf8-string , uuid , uuid-types , vector @@ -151,6 +154,7 @@ mkDerivation { cereal comonad containers + cql crypton crypton-x509 currency-codes @@ -206,6 +210,7 @@ mkDerivation { types-common-journal unliftio uri-bytestring + utf8-string uuid wai wai-extra @@ -281,6 +286,7 @@ mkDerivation { sop-core ssl-util streaming-commons + string-conversions tagged tasty tasty-ant-xml diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 4088a64b453..7197ea7ce6e 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -138,6 +138,7 @@ library Galley.Cassandra.Conversation.MLS Galley.Cassandra.ConversationList Galley.Cassandra.CustomBackend + Galley.Cassandra.GetAllTeamFeatureConfigs Galley.Cassandra.Instances Galley.Cassandra.LegalHold Galley.Cassandra.Proposal @@ -149,6 +150,7 @@ library Galley.Cassandra.Team Galley.Cassandra.TeamFeatures Galley.Cassandra.TeamNotifications + Galley.Cassandra.Util Galley.Data.Conversation Galley.Data.Conversation.Types Galley.Data.Scope @@ -301,6 +303,7 @@ library , cereal >=0.4 , comonad , containers >=0.5 + , cql , crypton , crypton-x509 , currency-codes >=2.0 @@ -335,7 +338,7 @@ library , resourcet >=1.1 , retry >=0.5 , safe-exceptions >=0.1 - , saml2-web-sso >=0.19 + , saml2-web-sso >=0.20 , schema-profunctor , servant , servant-client @@ -356,6 +359,7 @@ library , types-common-journal >=0.1 , unliftio >=0.2 , uri-bytestring >=0.2 + , utf8-string , uuid >=1.3 , wai >=3.0 , wai-extra >=3.0 @@ -517,7 +521,7 @@ executable galley-integration , quickcheck-instances , random , retry - , saml2-web-sso >=0.19 + , saml2-web-sso >=0.20 , schema-profunctor , servant-client , servant-client-core @@ -526,6 +530,7 @@ executable galley-integration , sop-core , ssl-util , streaming-commons + , string-conversions , tagged , tasty >=0.8 , tasty-ant-xml @@ -575,7 +580,6 @@ executable galley-migrate-data , containers , exceptions , extended - , galley-types , imports , lens , optparse-applicative diff --git a/services/galley/galley.integration.yaml b/services/galley/galley.integration.yaml index 15146fc480e..acf9326915f 100644 --- a/services/galley/galley.integration.yaml +++ b/services/galley/galley.integration.yaml @@ -50,6 +50,9 @@ settings: mlsPrivateKeyPaths: removal: ed25519: test/resources/ed25519.pem + ecdsa_secp256r1_sha256: test/resources/ecdsa_secp256r1_sha256.pem + ecdsa_secp384r1_sha384: test/resources/ecdsa_secp384r1_sha384.pem + ecdsa_secp521r1_sha512: test/resources/ecdsa_secp521r1_sha512.pem guestLinkTTLSeconds: 604800 # We explicitly do not disable any API version. Please make sure the configuration value is the same in all these configs: # brig, cannon, cargohold, galley, gundeck, proxy, spar. diff --git a/services/galley/migrate-data/src/V3_BackfillTeamAdmins.hs b/services/galley/migrate-data/src/V3_BackfillTeamAdmins.hs index d0eb1e2a071..6578b4e9631 100644 --- a/services/galley/migrate-data/src/V3_BackfillTeamAdmins.hs +++ b/services/galley/migrate-data/src/V3_BackfillTeamAdmins.hs @@ -23,9 +23,9 @@ import Data.Conduit.Internal (zipSources) import Data.Conduit.List qualified as C import Data.Id import Galley.DataMigration.Types -import Galley.Types.Teams import Imports import System.Logger.Class qualified as Log +import Wire.API.Team.Member import Wire.API.Team.Permission import Wire.API.Team.Role diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index 0b373dc9574..156954e3131 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -90,7 +90,6 @@ import Galley.Effects.TeamStore qualified as E import Galley.Env (Env) import Galley.Options import Galley.Types.Conversations.Members -import Galley.Types.Teams (IsPerm (hasPermission)) import Galley.Types.UserList import Galley.Validation import Gundeck.Types.Push.V2 qualified as PushV2 @@ -154,6 +153,7 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con Member LegalHoldStore r, Member MemberStore r, Member ProposalStore r, + Member Random r, Member SubConversationStore r, Member TeamStore r, Member TinyLog r, @@ -171,6 +171,7 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con Member (Input Env) r, Member ProposalStore r, Member SubConversationStore r, + Member Random r, Member TinyLog r ) HasConversationActionEffects 'ConversationRemoveMembersTag r = @@ -184,6 +185,7 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con Member FederatorAccess r, Member NotificationSubsystem r, Member (Error InternalError) r, + Member Random r, Member TinyLog r, Member (Error NoChanges) r ) @@ -229,7 +231,8 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con Member TinyLog r, Member (Input UTCTime) r, Member ConversationStore r, - Member SubConversationStore r + Member SubConversationStore r, + Member Random r ) HasConversationActionEffects 'ConversationMessageTimerUpdateTag r = ( Member ConversationStore r, @@ -256,6 +259,7 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con Member (Input UTCTime) r, Member MemberStore r, Member ProposalStore r, + Member Random r, Member SubConversationStore r, Member TeamFeatureStore r, Member TeamStore r, @@ -720,7 +724,6 @@ updateLocalConversation :: Member ExternalAccess r, Member NotificationSubsystem r, Member (Input UTCTime) r, - Member (Logger (Log.Msg -> Log.Msg)) r, HasConversationActionEffects tag r, SingI tag ) => @@ -760,7 +763,6 @@ updateLocalConversationUnchecked :: Member ExternalAccess r, Member NotificationSubsystem r, Member (Input UTCTime) r, - Member (Logger (Log.Msg -> Log.Msg)) r, HasConversationActionEffects tag r ) => Local Conversation -> @@ -861,9 +863,9 @@ notifyConversationAction :: forall tag r. ( Member BackendNotificationQueueAccess r, Member ExternalAccess r, + Member (Error FederationError) r, Member NotificationSubsystem r, - Member (Input UTCTime) r, - Member (Logger (Log.Msg -> Log.Msg)) r + Member (Input UTCTime) r ) => Sing tag -> Qualified UserId -> @@ -884,22 +886,19 @@ notifyConversationAction tag quid notifyOrigDomain con lconv targets action = do (tUnqualified lcnv) uids (SomeConversationAction tag action) - handleError :: FederationError -> Sem r (Maybe ConversationUpdate) - handleError fedErr = - logRemoteNotificationError @"on-conversation-updated" fedErr $> Nothing - update <- - fmap (fromMaybe (mkUpdate [])) - . (either handleError (pure . asum . map tUnqualified)) - <=< enqueueNotificationsConcurrently Q.Persistent (toList (bmRemotes targets)) - $ \ruids -> do - let update = mkUpdate (tUnqualified ruids) - -- if notifyOrigDomain is false, filter out user from quid's domain, - -- because quid's backend will update local state and notify its users - -- itself using the ConversationUpdate returned by this function - if notifyOrigDomain || tDomain ruids /= qDomain quid - then fedQueueClient @'OnConversationUpdatedTag update $> Nothing - else pure (Just update) + fmap (fromMaybe (mkUpdate []) . asum . map tUnqualified) $ + enqueueNotificationsConcurrently Q.Persistent (toList (bmRemotes targets)) $ + \ruids -> do + let update = mkUpdate (tUnqualified ruids) + -- if notifyOrigDomain is false, filter out user from quid's domain, + -- because quid's backend will update local state and notify its users + -- itself using the ConversationUpdate returned by this function + if notifyOrigDomain || tDomain ruids /= qDomain quid + then do + makeConversationUpdateBundle update >>= sendBundle + pure Nothing + else pure (Just update) -- notify local participants and bots pushConversationEvent con e (qualifyAs lcnv (bmLocals targets)) (bmBots targets) @@ -924,14 +923,14 @@ updateLocalStateOfRemoteConv :: updateLocalStateOfRemoteConv rcu con = do loc <- qualifyLocal () let cu = tUnqualified rcu - rconvId = fmap F.cuConvId rcu + rconvId = fmap (.convId) rcu qconvId = tUntagged rconvId -- Note: we generally do not send notifications to users that are not part of -- the conversation (from our point of view), to prevent spam from the remote -- backend. See also the comment below. (presentUsers, allUsersArePresent) <- - E.selectRemoteMembers (F.cuAlreadyPresentUsers cu) rconvId + E.selectRemoteMembers cu.alreadyPresentUsers rconvId -- Perform action, and determine extra notification targets. -- @@ -942,12 +941,12 @@ updateLocalStateOfRemoteConv rcu con = do -- updated, we do **not** add them to the list of targets, because we have no -- way to make sure that they are actually supposed to receive that notification. - (mActualAction, extraTargets) <- case F.cuAction cu of + (mActualAction, extraTargets) <- case cu.action of sca@(SomeConversationAction singTag action) -> case singTag of SConversationJoinTag -> do let ConversationJoin toAdd role = action let (localUsers, remoteUsers) = partitionQualified loc toAdd - addedLocalUsers <- Set.toList <$> addLocalUsersToRemoteConv rconvId (F.cuOrigUserId cu) localUsers + addedLocalUsers <- Set.toList <$> addLocalUsersToRemoteConv rconvId cu.origUserId localUsers let allAddedUsers = map (tUntagged . qualifyAs loc) addedLocalUsers <> map tUntagged remoteUsers pure $ ( fmap @@ -956,7 +955,7 @@ updateLocalStateOfRemoteConv rcu con = do addedLocalUsers ) SConversationLeaveTag -> do - let users = foldQualified loc (pure . tUnqualified) (const []) (F.cuOrigUserId cu) + let users = foldQualified loc (pure . tUnqualified) (const []) cu.origUserId E.deleteMembersInRemoteConversation rconvId users pure (Just sca, []) SConversationRemoveMembersTag -> do @@ -976,7 +975,7 @@ updateLocalStateOfRemoteConv rcu con = do unless allUsersArePresent $ P.warn $ - Log.field "conversation" (toByteString' (F.cuConvId cu)) + Log.field "conversation" (toByteString' cu.convId) . Log.field "domain" (toByteString' (tDomain rcu)) . Log.msg ( "Attempt to send notification about conversation update \ @@ -986,7 +985,7 @@ updateLocalStateOfRemoteConv rcu con = do -- Send notifications for mActualAction $ \(SomeConversationAction tag action) -> do - let event = conversationActionToEvent tag (F.cuTime cu) (F.cuOrigUserId cu) qconvId Nothing action + let event = conversationActionToEvent tag cu.time cu.origUserId qconvId Nothing action targets = nubOrd $ presentUsers <> extraTargets -- FUTUREWORK: support bots? pushConversationEvent con event (qualifyAs loc targets) [] $> event @@ -1045,7 +1044,8 @@ kickMember :: Member (Input Env) r, Member MemberStore r, Member SubConversationStore r, - Member TinyLog r + Member TinyLog r, + Member Random r ) => Qualified UserId -> Local Conversation -> diff --git a/services/galley/src/Galley/API/Clients.hs b/services/galley/src/Galley/API/Clients.hs index 9ae38817dc8..a45fa6f607b 100644 --- a/services/galley/src/Galley/API/Clients.hs +++ b/services/galley/src/Galley/API/Clients.hs @@ -47,9 +47,11 @@ import Polysemy import Polysemy.Error import Polysemy.Input import Polysemy.TinyLog qualified as P +import System.Logger.Message import Wire.API.Conversation hiding (Member) import Wire.API.Federation.API import Wire.API.Federation.API.Galley +import Wire.API.Federation.Error import Wire.API.Routes.MultiTablePaging import Wire.NotificationSubsystem import Wire.Sem.Paging.Cassandra (CassandraPaging) @@ -91,33 +93,41 @@ addClientH (usr ::: clt) = do rmClientH :: forall p1 r. ( p1 ~ CassandraPaging, - ( Member ClientStore r, - Member ConversationStore r, - Member ExternalAccess r, - Member BackendNotificationQueueAccess r, - Member FederatorAccess r, - Member NotificationSubsystem r, - Member (Input Env) r, - Member (Input (Local ())) r, - Member (Input UTCTime) r, - Member (ListItems p1 ConvId) r, - Member (ListItems p1 (Remote ConvId)) r, - Member MemberStore r, - Member (Error InternalError) r, - Member ProposalStore r, - Member SubConversationStore r, - Member P.TinyLog r - ) + Member ClientStore r, + Member ConversationStore r, + Member (Error FederationError) r, + Member ExternalAccess r, + Member BackendNotificationQueueAccess r, + Member NotificationSubsystem r, + Member (Input Env) r, + Member (Input (Local ())) r, + Member (Input UTCTime) r, + Member (ListItems p1 ConvId) r, + Member (ListItems p1 (Remote ConvId)) r, + Member MemberStore r, + Member (Error InternalError) r, + Member ProposalStore r, + Member Random r, + Member SubConversationStore r, + Member P.TinyLog r ) => UserId ::: ClientId -> Sem r Response rmClientH (usr ::: cid) = do - lusr <- qualifyLocal usr - let nRange1000 = toRange (Proxy @1000) :: Range 1 1000 Int32 - firstConvIds <- Query.conversationIdsPageFrom lusr (GetPaginatedConversationIds Nothing nRange1000) - goConvs nRange1000 firstConvIds lusr - - E.deleteClient usr cid + clients <- E.getClients [usr] + if (cid `elem` clientIds usr clients) + then do + lusr <- qualifyLocal usr + let nRange1000 = toRange (Proxy @1000) :: Range 1 1000 Int32 + firstConvIds <- Query.conversationIdsPageFrom lusr (GetPaginatedConversationIds Nothing nRange1000) + goConvs nRange1000 firstConvIds lusr + E.deleteClient usr cid + else + P.debug + ( field "user" (idToText usr) + . field "client" (clientToText cid) + . msg (val "rmClientH: client already gone") + ) pure empty where goConvs :: Range 1 1000 Int32 -> ConvIdsPage -> Local UserId -> Sem r () @@ -138,5 +148,8 @@ rmClientH (usr ::: cid) = do removeRemoteMLSClients :: Range 1 1000 [Remote ConvId] -> Sem r () removeRemoteMLSClients convIds = do for_ (bucketRemote (fromRange convIds)) $ \remoteConvs -> - let rpc = void $ fedQueueClient @'OnClientRemovedTag (ClientRemovedRequest usr cid (tUnqualified remoteConvs)) - in enqueueNotification remoteConvs Q.Persistent rpc + let rpc = + fedQueueClient + @'OnClientRemovedTag + (ClientRemovedRequest usr cid (tUnqualified remoteConvs)) + in enqueueNotification Q.Persistent remoteConvs rpc diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index f255c0d9658..2df5b92e5c8 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -45,7 +45,6 @@ import Data.UUID.Tagged qualified as U import Galley.API.Action import Galley.API.Error import Galley.API.MLS -import Galley.API.MLS.Keys (getMLSRemovalKey) import Galley.API.Mapping import Galley.API.One2One import Galley.API.Util @@ -91,7 +90,8 @@ import Wire.NotificationSubsystem -- | The public-facing endpoint for creating group conversations in the client -- API up to and including version 3. createGroupConversationUpToV3 :: - ( Member BrigAccess r, + ( Member BackendNotificationQueueAccess r, + Member BrigAccess r, Member ConversationStore r, Member (ErrorS 'ConvAccessDenied) r, Member (Error FederationError) r, @@ -129,7 +129,8 @@ createGroupConversationUpToV3 lusr conn newConv = mapError UnreachableBackendsLe -- | The public-facing endpoint for creating group conversations in the client -- API in version 4 and above. createGroupConversation :: - ( Member BrigAccess r, + ( Member BackendNotificationQueueAccess r, + Member BrigAccess r, Member ConversationStore r, Member (ErrorS 'ConvAccessDenied) r, Member (Error FederationError) r, @@ -169,7 +170,8 @@ createGroupConversation lusr conn newConv = do CreateGroupConversation conv mempty createGroupConversationGeneric :: - ( Member BrigAccess r, + ( Member BackendNotificationQueueAccess r, + Member BrigAccess r, Member ConversationStore r, Member (ErrorS 'ConvAccessDenied) r, Member (Error FederationError) r, @@ -204,8 +206,6 @@ createGroupConversationGeneric lusr conn newConv = do when (newConvProtocol newConv == BaseProtocolMLSTag) $ do -- Here we fail early in order to notify users of this misconfiguration assertMLSEnabled - unlessM (isJust <$> getMLSRemovalKey) $ - throw (InternalErrorWithDescription "No backend removal key is configured (See 'mlsPrivateKeyPaths' in galley's config). Refusing to create MLS conversation.") lcnv <- traverse (const E.createConversationId) lusr do @@ -309,7 +309,8 @@ createProteusSelfConversation lusr = do conversationCreated lusr c createOne2OneConversation :: - ( Member BrigAccess r, + ( Member BackendNotificationQueueAccess r, + Member BrigAccess r, Member ConversationStore r, Member (Error FederationError) r, Member (Error InternalError) r, @@ -386,7 +387,8 @@ createOne2OneConversation lusr zcon j = Nothing -> throwS @'TeamNotFound createLegacyOne2OneConversationUnchecked :: - ( Member ConversationStore r, + ( Member BackendNotificationQueueAccess r, + Member ConversationStore r, Member (Error FederationError) r, Member (Error InternalError) r, Member (Error InvalidInput) r, @@ -428,7 +430,8 @@ createLegacyOne2OneConversationUnchecked self zcon name mtid other = do Right () -> conversationCreated self c createOne2OneConversationUnchecked :: - ( Member ConversationStore r, + ( Member BackendNotificationQueueAccess r, + Member ConversationStore r, Member (Error FederationError) r, Member (Error InternalError) r, Member (Error UnreachableBackends) r, @@ -452,7 +455,8 @@ createOne2OneConversationUnchecked self zcon name mtid other = do create (one2OneConvId BaseProtocolProteusTag (tUntagged self) other) self zcon name mtid other createOne2OneConversationLocally :: - ( Member ConversationStore r, + ( Member BackendNotificationQueueAccess r, + Member ConversationStore r, Member (Error FederationError) r, Member (Error InternalError) r, Member (Error UnreachableBackends) r, @@ -502,7 +506,8 @@ createOne2OneConversationRemotely _ _ _ _ _ _ = throw FederationNotImplemented createConnectConversation :: - ( Member ConversationStore r, + ( Member BackendNotificationQueueAccess r, + Member ConversationStore r, Member (ErrorS 'ConvNotFound) r, Member (Error FederationError) r, Member (Error InternalError) r, @@ -654,6 +659,7 @@ notifyCreatedConversation :: Member (Error UnreachableBackends) r, Member FederatorAccess r, Member NotificationSubsystem r, + Member BackendNotificationQueueAccess r, Member (Input UTCTime) r, Member P.TinyLog r ) => diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 7e292c55aab..7bbc9c8bd8d 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -84,7 +84,9 @@ import Wire.API.Event.Conversation import Wire.API.Federation.API import Wire.API.Federation.API.Common (EmptyResponse (..)) import Wire.API.Federation.API.Galley +import Wire.API.Federation.Endpoint import Wire.API.Federation.Error +import Wire.API.Federation.Version import Wire.API.MLS.Credential import Wire.API.MLS.GroupInfo import Wire.API.MLS.Serialisation @@ -119,6 +121,7 @@ federationSitemap = :<|> Named @"on-client-removed" onClientRemoved :<|> Named @"on-message-sent" onMessageSent :<|> Named @"on-mls-message-sent" onMLSMessageSent + :<|> Named @(Versioned 'V0 "on-conversation-updated") onConversationUpdatedV0 :<|> Named @"on-conversation-updated" onConversationUpdated :<|> Named @"on-user-deleted-conversations" onUserDeleted @@ -126,12 +129,14 @@ onClientRemoved :: ( Member BackendNotificationQueueAccess r, Member ConversationStore r, Member ExternalAccess r, + Member (Error FederationError) r, Member NotificationSubsystem r, Member (Input Env) r, Member (Input (Local ())) r, Member (Input UTCTime) r, Member MemberStore r, Member ProposalStore r, + Member Random r, Member SubConversationStore r, Member TinyLog r ) => @@ -225,6 +230,20 @@ onConversationUpdated requestingDomain cu = do void $ updateLocalStateOfRemoteConv rcu Nothing pure EmptyResponse +onConversationUpdatedV0 :: + ( Member BrigAccess r, + Member NotificationSubsystem r, + Member ExternalAccess r, + Member (Input (Local ())) r, + Member MemberStore r, + Member P.TinyLog r + ) => + Domain -> + ConversationUpdateV0 -> + Sem r EmptyResponse +onConversationUpdatedV0 domain cu = + onConversationUpdated domain (conversationUpdateFromV0 cu) + -- as of now this will not generate the necessary events on the leaver's domain leaveConversation :: ( Member BackendNotificationQueueAccess r, @@ -238,6 +257,7 @@ leaveConversation :: Member (Input UTCTime) r, Member MemberStore r, Member ProposalStore r, + Member Random r, Member SubConversationStore r, Member TinyLog r ) => @@ -378,6 +398,7 @@ onUserDeleted :: ( Member BackendNotificationQueueAccess r, Member ConversationStore r, Member FireAndForget r, + Member (Error FederationError) r, Member ExternalAccess r, Member NotificationSubsystem r, Member (Input (Local ())) r, @@ -385,6 +406,7 @@ onUserDeleted :: Member (Input Env) r, Member MemberStore r, Member ProposalStore r, + Member Random r, Member SubConversationStore r, Member TinyLog r ) => @@ -452,6 +474,7 @@ updateConversation :: Member TeamStore r, Member TinyLog r, Member ConversationStore r, + Member Random r, Member SubConversationStore r, Member TeamFeatureStore r, Member (Input (Local ())) r @@ -464,7 +487,7 @@ updateConversation origDomain updateRequest = do let rusr = toRemoteUnsafe origDomain updateRequest.user lcnv = qualifyAs loc updateRequest.convId - mkResponse $ case action updateRequest of + mkResponse $ case updateRequest.action of SomeConversationAction tag action -> case tag of SConversationJoinTag -> mapToGalleyError @(HasConversationActionGalleyErrors 'ConversationJoinTag) @@ -571,6 +594,7 @@ sendMLSCommitBundle :: Member Resource r, Member TeamStore r, Member P.TinyLog r, + Member Random r, Member SubConversationStore r, Member ProposalStore r ) => @@ -662,6 +686,7 @@ getSubConversationForRemoteUser domain GetSubConversationsRequest {..} = leaveSubConversation :: ( HasLeaveSubConversationEffects r, + Member (Error FederationError) r, Member (Input (Local ())) r, Member Resource r ) => diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index edd2d4a14d0..0236f5f23dc 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -26,6 +26,7 @@ where import Control.Exception.Safe (catchAny) import Control.Lens hiding (Getter, Setter, (.=)) +import Data.ByteString.UTF8 qualified as UTF8 import Data.Id as Id import Data.Json.Util (ToJSONObject (toJSONObject)) import Data.Map qualified as Map @@ -51,12 +52,12 @@ import Galley.API.Teams.Features import Galley.API.Update qualified as Update import Galley.API.Util import Galley.App +import Galley.Cassandra.TeamFeatures (getAllFeatureConfigsForServer) import Galley.Data.Conversation qualified as Data import Galley.Effects import Galley.Effects.BackendNotificationQueueAccess import Galley.Effects.ClientStore import Galley.Effects.ConversationStore -import Galley.Effects.FederatorAccess import Galley.Effects.LegalHoldStore as LegalHoldStore import Galley.Effects.MemberStore qualified as E import Galley.Effects.TeamStore @@ -126,9 +127,13 @@ conversationAPI :: API IConversationAPI GalleyEffects conversationAPI = mkNamedAPI @"conversation-get-member" Query.internalGetMember <@> mkNamedAPI @"conversation-accept-v2" Update.acceptConv + <@> mkNamedAPI @"conversation-block-unqualified" Update.blockConvUnqualified <@> mkNamedAPI @"conversation-block" Update.blockConv + <@> mkNamedAPI @"conversation-unblock-unqualified" Update.unblockConvUnqualified <@> mkNamedAPI @"conversation-unblock" Update.unblockConv <@> mkNamedAPI @"conversation-meta" Query.getConversationMeta + <@> mkNamedAPI @"conversation-mls-one-to-one" Query.getMLSOne2OneConversation + <@> mkNamedAPI @"conversation-mls-one-to-one-established" Query.isMLSOne2OneEstablished legalholdWhitelistedTeamsAPI :: API ILegalholdWhitelistedTeamsAPI GalleyEffects legalholdWhitelistedTeamsAPI = mkAPI $ \tid -> hoistAPIHandler Imports.id (base tid) @@ -301,9 +306,9 @@ rmUser :: Member ClientStore r, Member ConversationStore r, Member (Error DynError) r, + Member (Error FederationError) r, Member (Error InternalError) r, Member ExternalAccess r, - Member FederatorAccess r, Member NotificationSubsystem r, Member (Input Env) r, Member (Input Opts) r, @@ -314,6 +319,7 @@ rmUser :: Member MemberStore r, Member ProposalStore r, Member P.TinyLog r, + Member Random r, Member SubConversationStore r, Member TeamFeatureStore r, Member TeamStore r @@ -409,39 +415,22 @@ rmUser lusr conn = do notifyRemoteMembers now qUser cid remotes = do let convUpdate = ConversationUpdate - { cuTime = now, - cuOrigUserId = qUser, - cuConvId = cid, - cuAlreadyPresentUsers = tUnqualified remotes, - cuAction = SomeConversationAction (sing @'ConversationLeaveTag) () + { time = now, + origUserId = qUser, + convId = cid, + alreadyPresentUsers = tUnqualified remotes, + action = SomeConversationAction (sing @'ConversationLeaveTag) () } - let rpc = fedClient @'Galley @"on-conversation-updated" convUpdate - runFederatedEither remotes rpc - >>= logAndIgnoreError "Error in onConversationUpdated call" (qUnqualified qUser) + enqueueNotification Q.Persistent remotes $ do + makeConversationUpdateBundle convUpdate + >>= sendBundle leaveRemoteConversations :: Range 1 UserDeletedNotificationMaxConvs [Remote ConvId] -> Sem r () leaveRemoteConversations cids = for_ (bucketRemote (fromRange cids)) $ \remoteConvs -> do let userDelete = UserDeletedConversationsNotification (tUnqualified lusr) (unsafeRange (tUnqualified remoteConvs)) - let rpc = void $ fedQueueClient @'OnUserDeletedConversationsTag userDelete - enqueueNotification remoteConvs Q.Persistent rpc - - -- FUTUREWORK: Add a retry mechanism if there are federation errrors. - -- See https://wearezeta.atlassian.net/browse/SQCORE-1091 - logAndIgnoreError :: Text -> UserId -> Either FederationError a -> Sem r () - logAndIgnoreError message usr res = do - case res of - Left federationError -> - P.err - ( Log.msg - ( "Federation error while notifying remote backends of a user deletion (Galley). " - <> message - <> " " - <> (cs . show $ federationError) - ) - . Log.field "user" (show usr) - ) - Right _ -> pure () + let rpc = fedQueueClient @'OnUserDeletedConversationsTag userDelete + enqueueNotification Q.Persistent remoteConvs rpc deleteLoop :: App () deleteLoop = do @@ -467,7 +456,7 @@ safeForever :: String -> App () -> App () safeForever funName action = forever $ action `catchAny` \exc -> do - err $ "error" .= show exc ~~ msg (val $ cs funName <> " failed") + err $ "error" .= show exc ~~ msg (val $ UTF8.fromString funName <> " failed") threadDelay 60000000 -- pause to keep worst-case noise in logs manageable guardLegalholdPolicyConflictsH :: diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 16d8ece876f..79a3eb942e4 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -165,6 +165,7 @@ removeSettingsInternalPaging :: Member MemberStore r, Member ProposalStore r, Member P.TinyLog r, + Member Random r, Member SubConversationStore r, Member TeamFeatureStore r, Member (TeamMemberStore InternalPaging) r, @@ -209,6 +210,7 @@ removeSettings :: Member MemberStore r, Member ProposalStore r, Member P.TinyLog r, + Member Random r, Member SubConversationStore r ) => UserId -> @@ -262,6 +264,7 @@ removeSettings' :: Member (TeamMemberStore p) r, Member TeamStore r, Member ProposalStore r, + Member Random r, Member P.TinyLog r, Member SubConversationStore r ) => @@ -348,6 +351,7 @@ grantConsent :: Member MemberStore r, Member ProposalStore r, Member P.TinyLog r, + Member Random r, Member SubConversationStore r, Member TeamStore r ) => @@ -395,6 +399,7 @@ requestDevice :: Member MemberStore r, Member ProposalStore r, Member P.TinyLog r, + Member Random r, Member SubConversationStore r, Member TeamFeatureStore r, Member TeamStore r @@ -475,6 +480,7 @@ approveDevice :: Member MemberStore r, Member ProposalStore r, Member P.TinyLog r, + Member Random r, Member SubConversationStore r, Member TeamFeatureStore r, Member TeamStore r @@ -551,6 +557,7 @@ disableForUser :: Member MemberStore r, Member ProposalStore r, Member P.TinyLog r, + Member Random r, Member SubConversationStore r, Member TeamStore r ) => @@ -605,6 +612,7 @@ changeLegalholdStatus :: Member MemberStore r, Member TeamStore r, Member ProposalStore r, + Member Random r, Member P.TinyLog r, Member SubConversationStore r ) => @@ -720,6 +728,7 @@ handleGroupConvPolicyConflicts :: Member MemberStore r, Member ProposalStore r, Member P.TinyLog r, + Member Random r, Member SubConversationStore r, Member TeamStore r ) => diff --git a/services/galley/src/Galley/API/MLS.hs b/services/galley/src/Galley/API/MLS.hs index 2b06791739d..2b8c0b6fd67 100644 --- a/services/galley/src/Galley/API/MLS.hs +++ b/services/galley/src/Galley/API/MLS.hs @@ -25,7 +25,6 @@ module Galley.API.MLS ) where -import Control.Lens (view) import Data.Id import Data.Qualified import Galley.API.MLS.Enabled @@ -43,8 +42,6 @@ getMLSPublicKeys :: Member (ErrorS 'MLSNotEnabled) r ) => Local UserId -> - Sem r MLSPublicKeys + Sem r (MLSKeysByPurpose MLSPublicKeys) getMLSPublicKeys _ = do - assertMLSEnabled - keys <- inputs (view mlsKeys) - pure $ mlsKeysToPublic keys + fmap mlsKeysToPublic <$> getMLSPrivateKeys diff --git a/services/galley/src/Galley/API/MLS/Commit/Core.hs b/services/galley/src/Galley/API/MLS/Commit/Core.hs index 7aef8d86e06..0386d3d4738 100644 --- a/services/galley/src/Galley/API/MLS/Commit/Core.hs +++ b/services/galley/src/Galley/API/MLS/Commit/Core.hs @@ -88,7 +88,8 @@ type HasProposalActionEffects r = Member SubConversationStore r, Member TeamStore r, Member TinyLog r, - Member NotificationSubsystem r + Member NotificationSubsystem r, + Member Random r ) getCommitData :: diff --git a/services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs b/services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs index 907e9ecb36d..364feaf5ce2 100644 --- a/services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs +++ b/services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs @@ -33,7 +33,7 @@ import Galley.API.MLS.Types import Galley.API.MLS.Util import Galley.Effects import Galley.Effects.MemberStore -import Imports hiding (cs) +import Imports import Polysemy import Polysemy.Error import Polysemy.Resource (Resource) @@ -41,6 +41,7 @@ import Polysemy.State import Wire.API.Conversation.Protocol import Wire.API.Error import Wire.API.Error.Galley +import Wire.API.Federation.Error import Wire.API.MLS.Commit import Wire.API.MLS.Credential import Wire.API.MLS.LeafNode @@ -121,7 +122,8 @@ getExternalCommitData senderIdentity lConvOrSub epoch commit = do processExternalCommit :: forall r. - ( Member (ErrorS 'MLSStaleMessage) r, + ( Member (Error FederationError) r, + Member (ErrorS 'MLSStaleMessage) r, Member (ErrorS 'MLSSubConvClientNotInParent) r, Member Resource r, HasProposalActionEffects r diff --git a/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs b/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs index 8525429d944..8a1bbe7fe21 100644 --- a/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs +++ b/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs @@ -70,7 +70,8 @@ processInternalCommit :: Member (ErrorS 'MLSStaleMessage) r, Member (ErrorS 'MissingLegalholdConsent) r, Member SubConversationStore r, - Member Resource r + Member Resource r, + Member Random r ) => ClientIdentity -> Maybe ConnId -> diff --git a/services/galley/src/Galley/API/MLS/Enabled.hs b/services/galley/src/Galley/API/MLS/Enabled.hs index 1af66279a2a..d8106726f0f 100644 --- a/services/galley/src/Galley/API/MLS/Enabled.hs +++ b/services/galley/src/Galley/API/MLS/Enabled.hs @@ -15,22 +15,19 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Galley.API.MLS.Enabled - ( isMLSEnabled, - assertMLSEnabled, - ) -where +module Galley.API.MLS.Enabled where -import Galley.API.MLS.Keys +import Control.Lens (view) import Galley.Env -import Imports +import Imports hiding (getFirst) import Polysemy import Polysemy.Input import Wire.API.Error import Wire.API.Error.Galley +import Wire.API.MLS.Keys isMLSEnabled :: Member (Input Env) r => Sem r Bool -isMLSEnabled = isJust <$> getMLSRemovalKey +isMLSEnabled = inputs (isJust . view mlsKeys) -- | Fail if MLS is not enabled. Only use this function at the beginning of an -- MLS endpoint, NOT in utility functions. @@ -39,6 +36,11 @@ assertMLSEnabled :: Member (ErrorS 'MLSNotEnabled) r ) => Sem r () -assertMLSEnabled = - unlessM isMLSEnabled $ - throwS @'MLSNotEnabled +assertMLSEnabled = void getMLSPrivateKeys + +getMLSPrivateKeys :: + ( Member (Input Env) r, + Member (ErrorS 'MLSNotEnabled) r + ) => + Sem r (MLSKeysByPurpose MLSPrivateKeys) +getMLSPrivateKeys = noteS @'MLSNotEnabled =<< inputs (view mlsKeys) diff --git a/services/galley/src/Galley/API/MLS/Keys.hs b/services/galley/src/Galley/API/MLS/Keys.hs index 3db1ebfd9c3..f8bfe8e458b 100644 --- a/services/galley/src/Galley/API/MLS/Keys.hs +++ b/services/galley/src/Galley/API/MLS/Keys.hs @@ -15,16 +15,43 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Galley.API.MLS.Keys (getMLSRemovalKey) where +module Galley.API.MLS.Keys (getMLSRemovalKey, SomeKeyPair (..)) where +import Control.Error.Util (hush) import Control.Lens (view) -import Crypto.PubKey.Ed25519 (PublicKey, SecretKey) +import Data.Proxy import Galley.Env -import Imports +import Imports hiding (getFirst) import Polysemy +import Polysemy.Error import Polysemy.Input -import Wire.API.MLS.Credential (SignaturePurpose (RemovalPurpose)) +import Wire.API.MLS.CipherSuite import Wire.API.MLS.Keys -getMLSRemovalKey :: Member (Input Env) r => Sem r (Maybe (SecretKey, PublicKey)) -getMLSRemovalKey = mlsKeyPair_ed25519 <$> (inputs (view mlsKeys) <*> pure RemovalPurpose) +data SomeKeyPair where + SomeKeyPair :: forall ss. IsSignatureScheme ss => Proxy ss -> KeyPair ss -> SomeKeyPair + +getMLSRemovalKey :: + Member (Input Env) r => + SignatureSchemeTag -> + Sem r (Maybe SomeKeyPair) +getMLSRemovalKey ss = fmap hush . runError @() $ do + keysByPurpose <- note () =<< inputs (view mlsKeys) + let keys = keysByPurpose.removal + case ss of + Ed25519 -> pure $ SomeKeyPair (Proxy @Ed25519) (mlsKeyPair_ed25519 keys) + Ecdsa_secp256r1_sha256 -> + pure $ + SomeKeyPair + (Proxy @Ecdsa_secp256r1_sha256) + (mlsKeyPair_ecdsa_secp256r1_sha256 keys) + Ecdsa_secp384r1_sha384 -> + pure $ + SomeKeyPair + (Proxy @Ecdsa_secp384r1_sha384) + (mlsKeyPair_ecdsa_secp384r1_sha384 keys) + Ecdsa_secp521r1_sha512 -> + pure $ + SomeKeyPair + (Proxy @Ecdsa_secp521r1_sha512) + (mlsKeyPair_ecdsa_secp521r1_sha512 keys) diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index 3afffb4d0a3..39c897665af 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -115,7 +115,6 @@ type MLSBundleStaticErrors = postMLSMessageFromLocalUser :: ( HasProposalEffects r, - Member (Error FederationError) r, Member (ErrorS 'ConvAccessDenied) r, Member (ErrorS 'ConvMemberNotFound) r, Member (ErrorS 'ConvNotFound) r, @@ -149,7 +148,7 @@ postMLSMessageFromLocalUser lusr c conn smsg = do postMLSCommitBundle :: ( HasProposalEffects r, Members MLSBundleStaticErrors r, - Member (Error FederationError) r, + Member Random r, Member Resource r, Member SubConversationStore r ) => @@ -171,7 +170,7 @@ postMLSCommitBundle loc qusr c ctype qConvOrSub conn bundle = postMLSCommitBundleFromLocalUser :: ( HasProposalEffects r, Members MLSBundleStaticErrors r, - Member (Error FederationError) r, + Member Random r, Member Resource r, Member SubConversationStore r ) => @@ -194,7 +193,8 @@ postMLSCommitBundleToLocalConv :: ( HasProposalEffects r, Members MLSBundleStaticErrors r, Member Resource r, - Member SubConversationStore r + Member SubConversationStore r, + Member Random r ) => Qualified UserId -> ClientId -> @@ -318,7 +318,6 @@ postMLSCommitBundleToRemoteConv loc qusr c con bundle ctype rConvOrSubId = do postMLSMessage :: ( HasProposalEffects r, - Member (Error FederationError) r, Member (ErrorS 'ConvAccessDenied) r, Member (ErrorS 'ConvMemberNotFound) r, Member (ErrorS 'ConvNotFound) r, @@ -417,7 +416,6 @@ postMLSMessageToLocalConv qusr c con msg ctype convOrSubId = do postMLSMessageToRemoteConv :: ( Members MLSMessageStaticErrors r, - Member (Error FederationError) r, HasProposalEffects r ) => Local x -> diff --git a/services/galley/src/Galley/API/MLS/One2One.hs b/services/galley/src/Galley/API/MLS/One2One.hs index c194d72302e..a5b01e129a3 100644 --- a/services/galley/src/Galley/API/MLS/One2One.hs +++ b/services/galley/src/Galley/API/MLS/One2One.hs @@ -30,7 +30,7 @@ import Galley.API.MLS.Types import Galley.Data.Conversation.Types qualified as Data import Galley.Effects.ConversationStore import Galley.Types.UserList -import Imports hiding (cs) +import Imports import Polysemy import Wire.API.Conversation hiding (Member) import Wire.API.Conversation.Protocol @@ -109,7 +109,7 @@ remoteMLSOne2OneConversation lself rother rc = let members = ConvMembers { cmSelf = defMember (tUntagged lself), - cmOthers = [] + cmOthers = rc.members.others } in Conversation { cnvQualifiedId = tUntagged (qualifyAs rother rc.id), diff --git a/services/galley/src/Galley/API/MLS/Propagate.hs b/services/galley/src/Galley/API/MLS/Propagate.hs index 53efadec2dc..b0fe16e6c8c 100644 --- a/services/galley/src/Galley/API/MLS/Propagate.hs +++ b/services/galley/src/Galley/API/MLS/Propagate.hs @@ -27,7 +27,6 @@ import Data.Qualified import Data.Time import Galley.API.MLS.Types import Galley.API.Push -import Galley.API.Util import Galley.Data.Services import Galley.Effects import Galley.Effects.BackendNotificationQueueAccess @@ -36,11 +35,13 @@ import Gundeck.Types.Push.V2 (RecipientClients (..)) import Imports import Network.AMQP qualified as Q import Polysemy +import Polysemy.Error import Polysemy.Input import Polysemy.TinyLog hiding (trace) import Wire.API.Event.Conversation import Wire.API.Federation.API import Wire.API.Federation.API.Galley +import Wire.API.Federation.Error import Wire.API.MLS.Credential import Wire.API.MLS.Message import Wire.API.MLS.Serialisation @@ -53,6 +54,7 @@ import Wire.NotificationSubsystem -- a requirement from Core Crypto and the clients. propagateMessage :: ( Member BackendNotificationQueueAccess r, + Member (Error FederationError) r, Member ExternalAccess r, Member (Input UTCTime) r, Member TinyLog r, @@ -87,21 +89,23 @@ propagateMessage qusr mSenderClient lConvOrSub con msg cm = do newMessagePush botMap con mm (lmems >>= toList . localMemberRecipient mlsConv) e -- send to remotes - (either (logRemoteNotificationError @"on-mls-message-sent") (const (pure ())) <=< enqueueNotificationsConcurrently Q.Persistent (map remoteMemberQualify rmems)) $ - \rs -> - fedQueueClient @'OnMLSMessageSentTag $ - RemoteMLSMessage - { time = now, - sender = qusr, - metadata = mm, - conversation = qUnqualified qcnv, - subConversation = sconv, - recipients = - Map.fromList $ - tUnqualified rs - >>= toList . remoteMemberMLSClients, - message = Base64ByteString msg.raw - } + void $ + enqueueNotificationsConcurrently Q.Persistent (map remoteMemberQualify rmems) $ + \rs -> + fedQueueClient + @'OnMLSMessageSentTag + RemoteMLSMessage + { time = now, + sender = qusr, + metadata = mm, + conversation = qUnqualified qcnv, + subConversation = sconv, + recipients = + Map.fromList $ + tUnqualified rs + >>= toList . remoteMemberMLSClients, + message = Base64ByteString msg.raw + } where cmWithoutSender = maybe cm (flip cmRemoveClient cm . mkClientIdentity qusr) mSenderClient diff --git a/services/galley/src/Galley/API/MLS/Proposal.hs b/services/galley/src/Galley/API/MLS/Proposal.hs index 39d56406b4c..4df31ac4c97 100644 --- a/services/galley/src/Galley/API/MLS/Proposal.hs +++ b/services/galley/src/Galley/API/MLS/Proposal.hs @@ -48,7 +48,7 @@ import Galley.Effects.BrigAccess import Galley.Effects.ProposalStore import Galley.Env import Galley.Options -import Imports hiding (cs) +import Imports import Polysemy import Polysemy.Error import Polysemy.Input @@ -58,6 +58,7 @@ import Wire.API.Conversation hiding (Member) import Wire.API.Conversation.Protocol import Wire.API.Error import Wire.API.Error.Galley +import Wire.API.Federation.Error import Wire.API.MLS.AuthenticatedContent import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage @@ -116,6 +117,7 @@ type HasProposalEffects r = Member ConversationStore r, Member NotificationSubsystem r, Member (Error InternalError) r, + Member (Error FederationError) r, Member (Error MLSProposalFailure) r, Member (Error MLSProtocolError) r, Member (ErrorS 'MLSClientMismatch) r, diff --git a/services/galley/src/Galley/API/MLS/Removal.hs b/services/galley/src/Galley/API/MLS/Removal.hs index f48631e7d23..2b70748035a 100644 --- a/services/galley/src/Galley/API/MLS/Removal.hs +++ b/services/galley/src/Galley/API/MLS/Removal.hs @@ -27,11 +27,12 @@ where import Data.Bifunctor import Data.Id import Data.Map qualified as Map +import Data.Proxy import Data.Qualified import Data.Set qualified as Set import Data.Time import Galley.API.MLS.Conversation -import Galley.API.MLS.Keys (getMLSRemovalKey) +import Galley.API.MLS.Keys import Galley.API.MLS.Propagate import Galley.API.MLS.Types import Galley.Data.Conversation.Types @@ -42,13 +43,16 @@ import Galley.Effects.ProposalStore import Galley.Effects.SubConversationStore import Galley.Env import Galley.Types.Conversations.Members -import Imports hiding (cs) +import Imports import Polysemy +import Polysemy.Error import Polysemy.Input import Polysemy.TinyLog import System.Logger qualified as Log import Wire.API.Conversation.Protocol +import Wire.API.Federation.Error import Wire.API.MLS.AuthenticatedContent +import Wire.API.MLS.CipherSuite import Wire.API.MLS.Credential import Wire.API.MLS.LeafNode import Wire.API.MLS.Message @@ -56,16 +60,20 @@ import Wire.API.MLS.Proposal import Wire.API.MLS.Serialisation import Wire.API.MLS.SubConversation import Wire.NotificationSubsystem +import Wire.Sem.Random -- | Send remove proposals for a set of clients to clients in the ClientMap. createAndSendRemoveProposals :: - ( Member (Input UTCTime) r, + forall r t. + ( Member (Error FederationError) r, + Member (Input UTCTime) r, Member TinyLog r, Member BackendNotificationQueueAccess r, Member ExternalAccess r, Member NotificationSubsystem r, Member ProposalStore r, Member (Input Env) r, + Member Random r, Foldable t ) => Local ConvOrSubConv -> @@ -81,22 +89,22 @@ createAndSendRemoveProposals :: Sem r () createAndSendRemoveProposals lConvOrSubConv indices qusr cm = do let meta = (tUnqualified lConvOrSubConv).mlsMeta - mKeyPair <- getMLSRemovalKey + mKeyPair <- getMLSRemovalKey (csSignatureScheme (cnvmlsCipherSuite meta)) case mKeyPair of Nothing -> do warn $ Log.msg ("No backend removal key is configured (See 'mlsPrivateKeyPaths' in galley's config). Not able to remove client from MLS conversation." :: Text) - Just (secKey, pubKey) -> do + Just (SomeKeyPair (_ :: Proxy ss) kp) -> do for_ indices $ \idx -> do let proposal = mkRawMLS (RemoveProposal idx) - pmsg = - mkSignedPublicMessage - secKey - pubKey - (cnvmlsGroupId meta) - (cnvmlsEpoch meta) - (TaggedSenderExternal 0) - (FramedContentProposal proposal) - msg = mkRawMLS (mkMessage (MessagePublic pmsg)) + pmsg <- + liftRandom $ + mkSignedPublicMessage @ss + kp + (cnvmlsGroupId meta) + (cnvmlsEpoch meta) + (TaggedSenderExternal 0) + (FramedContentProposal proposal) + let msg = mkRawMLS (mkMessage (MessagePublic pmsg)) storeProposal (cnvmlsGroupId meta) (cnvmlsEpoch meta) @@ -106,7 +114,8 @@ createAndSendRemoveProposals lConvOrSubConv indices qusr cm = do propagateMessage qusr Nothing lConvOrSubConv Nothing msg cm removeClientsWithClientMapRecursively :: - ( Member (Input UTCTime) r, + ( Member (Error FederationError) r, + Member (Input UTCTime) r, Member TinyLog r, Member BackendNotificationQueueAccess r, Member ExternalAccess r, @@ -115,6 +124,7 @@ removeClientsWithClientMapRecursively :: Member ProposalStore r, Member SubConversationStore r, Member (Input Env) r, + Member Random r, Functor f, Foldable f ) => @@ -138,7 +148,8 @@ removeClientsWithClientMapRecursively lMlsConv getClients qusr = do removeClientsFromSubConvs lMlsConv getClients qusr removeClientsFromSubConvs :: - ( Member (Input UTCTime) r, + ( Member (Error FederationError) r, + Member (Input UTCTime) r, Member TinyLog r, Member BackendNotificationQueueAccess r, Member ExternalAccess r, @@ -147,6 +158,7 @@ removeClientsFromSubConvs :: Member ProposalStore r, Member SubConversationStore r, Member (Input Env) r, + Member Random r, Functor f, Foldable f ) => @@ -177,12 +189,14 @@ removeClientsFromSubConvs lMlsConv getClients qusr = do -- | Send remove proposals for a single client of a user to the local conversation. removeClient :: ( Member BackendNotificationQueueAccess r, + Member (Error FederationError) r, Member ExternalAccess r, Member NotificationSubsystem r, Member (Input Env) r, Member (Input UTCTime) r, Member MemberStore r, Member ProposalStore r, + Member Random r, Member SubConversationStore r, Member TinyLog r ) => @@ -212,12 +226,14 @@ data RemoveUserIncludeMain -- | Send remove proposals for all clients of the user to the local conversation. removeUser :: ( Member BackendNotificationQueueAccess r, + Member (Error FederationError) r, Member ExternalAccess r, Member NotificationSubsystem r, Member (Input Env) r, Member (Input UTCTime) r, Member MemberStore r, Member ProposalStore r, + Member Random r, Member SubConversationStore r, Member TinyLog r ) => @@ -257,12 +273,14 @@ listSubConversations' cid = do -- | Send remove proposals for clients of users that are not part of a conversation removeExtraneousClients :: ( Member BackendNotificationQueueAccess r, + Member (Error FederationError) r, Member ExternalAccess r, Member NotificationSubsystem r, Member (Input Env) r, Member (Input UTCTime) r, Member MemberStore r, Member ProposalStore r, + Member Random r, Member SubConversationStore r, Member TinyLog r ) => diff --git a/services/galley/src/Galley/API/MLS/SubConversation.hs b/services/galley/src/Galley/API/MLS/SubConversation.hs index 7841a718396..37a400a9672 100644 --- a/services/galley/src/Galley/API/MLS/SubConversation.hs +++ b/services/galley/src/Galley/API/MLS/SubConversation.hs @@ -50,7 +50,7 @@ import Galley.Effects import Galley.Effects.FederatorAccess import Galley.Effects.MemberStore qualified as Eff import Galley.Effects.SubConversationStore qualified as Eff -import Imports hiding (cs) +import Imports import Polysemy import Polysemy.Error import Polysemy.Input @@ -335,6 +335,7 @@ type HasLeaveSubConversationEffects r = Input UTCTime, MemberStore, ProposalStore, + Random, SubConversationStore, TinyLog ] @@ -377,6 +378,7 @@ leaveLocalSubConversation :: Member (Error MLSProtocolError) r, Member (ErrorS 'MLSStaleMessage) r, Member (ErrorS 'MLSNotEnabled) r, + Member (Error FederationError) r, Member Resource r, Members LeaveSubConversationStaticErrors r ) => diff --git a/services/galley/src/Galley/API/MLS/Types.hs b/services/galley/src/Galley/API/MLS/Types.hs index 13a14d9b6a4..5cfce7bd88a 100644 --- a/services/galley/src/Galley/API/MLS/Types.hs +++ b/services/galley/src/Galley/API/MLS/Types.hs @@ -27,7 +27,7 @@ import Data.Qualified import GHC.Records (HasField (..)) import Galley.Data.Conversation.Types import Galley.Types.Conversations.Members -import Imports hiding (cs) +import Imports import Wire.API.Conversation import Wire.API.Conversation.Protocol import Wire.API.MLS.CipherSuite diff --git a/services/galley/src/Galley/API/MLS/Welcome.hs b/services/galley/src/Galley/API/MLS/Welcome.hs index 02f336562a1..6f051263247 100644 --- a/services/galley/src/Galley/API/MLS/Welcome.hs +++ b/services/galley/src/Galley/API/MLS/Welcome.hs @@ -26,11 +26,14 @@ import Data.Aeson qualified as A import Data.Domain import Data.Id import Data.Json.Util +import Data.List1 +import Data.Map qualified as Map import Data.Qualified import Data.Time import Galley.API.Push import Galley.Effects.ExternalAccess import Galley.Effects.FederatorAccess +import Gundeck.Types.Push.V2 (RecipientClients (..)) import Imports import Network.Wai.Utilities.JSONResponse import Polysemy @@ -49,7 +52,7 @@ import Wire.API.MLS.Serialisation import Wire.API.MLS.SubConversation import Wire.API.MLS.Welcome import Wire.API.Message -import Wire.NotificationSubsystem (NotificationSubsystem) +import Wire.NotificationSubsystem sendWelcomes :: ( Member FederatorAccess r, @@ -88,9 +91,17 @@ sendLocalWelcomes :: Local [(UserId, ClientId)] -> Sem r () sendLocalWelcomes qcnv qusr con now welcome lclients = do + -- only create one notification per user + let rcpts = + map (\(u, cs) -> Recipient u (RecipientClientsSome (List1 cs))) + . Map.assocs + . foldr + (\(u, c) -> Map.insertWith (<>) u (pure c)) + mempty + $ tUnqualified lclients let e = Event qcnv Nothing qusr now $ EdMLSWelcome welcome.raw runMessagePush lclients (Just qcnv) $ - newMessagePush mempty con defMessageMetadata (tUnqualified lclients) e + newMessagePush mempty con defMessageMetadata rcpts e sendRemoteWelcomes :: ( Member FederatorAccess r, diff --git a/services/galley/src/Galley/API/Message.hs b/services/galley/src/Galley/API/Message.hs index 355fccd7942..b436ea62250 100644 --- a/services/galley/src/Galley/API/Message.hs +++ b/services/galley/src/Galley/API/Message.hs @@ -680,26 +680,28 @@ sendRemoteMessages :: MessageMetadata -> Map (UserId, ClientId) Text -> Sem r (Set (UserId, ClientId)) -sendRemoteMessages domain now sender senderClient lcnv metadata messages = (handle =<<) $ do - let rcpts = - foldr - (\((u, c), t) -> Map.insertWith (<>) u (Map.singleton c t)) - mempty - (Map.assocs messages) - rm = - RemoteMessage - { time = now, - _data = mmData metadata, - sender = sender, - senderClient = senderClient, - conversation = tUnqualified lcnv, - priority = mmNativePriority metadata, - push = mmNativePush metadata, - transient = mmTransient metadata, - recipients = UserClientMap rcpts - } - let rpc = void $ fedQueueClient @'OnMessageSentTag rm - enqueueNotification domain Q.Persistent rpc +sendRemoteMessages domain now sender senderClient lcnv metadata messages = + -- FUTUREWORK: a FederationError here just means that queueing did not work. + -- It should not result in clients ending up in failedToSend. + (handle <=< runError) $ do + let rcpts = + foldr + (\((u, c), t) -> Map.insertWith (<>) u (Map.singleton c t)) + mempty + (Map.assocs messages) + rm = + RemoteMessage + { time = now, + _data = mmData metadata, + sender = sender, + senderClient = senderClient, + conversation = tUnqualified lcnv, + priority = mmNativePriority metadata, + push = mmNativePush metadata, + transient = mmTransient metadata, + recipients = UserClientMap rcpts + } + enqueueNotification Q.Persistent domain (fedQueueClient @'OnMessageSentTag rm) where handle :: Either FederationError a -> Sem r (Set (UserId, ClientId)) handle (Right _) = pure mempty diff --git a/services/galley/src/Galley/API/One2One.hs b/services/galley/src/Galley/API/One2One.hs index 039ca96f012..05b1d16b9c4 100644 --- a/services/galley/src/Galley/API/One2One.hs +++ b/services/galley/src/Galley/API/One2One.hs @@ -58,17 +58,8 @@ iUpsertOne2OneConversation :: Member MemberStore r ) => UpsertOne2OneConversationRequest -> - Sem r UpsertOne2OneConversationResponse + Sem r () iUpsertOne2OneConversation UpsertOne2OneConversationRequest {..} = do - let convId = - fromMaybe - ( one2OneConvId - BaseProtocolProteusTag - (tUntagged uooLocalUser) - (tUntagged uooRemoteUser) - ) - uooConvId - let dolocal :: Local ConvId -> Sem r () dolocal lconvId = do mbConv <- getConversation (tUnqualified lconvId) @@ -90,7 +81,7 @@ iUpsertOne2OneConversation UpsertOne2OneConversationRequest {..} = do void $ createMember lconvId uooLocalUser unless (null (convRemoteMembers conv)) $ acceptConnectConversation (tUnqualified lconvId) - (LocalActor, Excluded) -> + (LocalActor, Excluded) -> do deleteMembers (tUnqualified lconvId) (UserList [tUnqualified uooLocalUser] []) @@ -111,5 +102,4 @@ iUpsertOne2OneConversation UpsertOne2OneConversationRequest {..} = do deleteMembersInRemoteConversation rconvId [tUnqualified uooLocalUser] (RemoteActor, _) -> pure () - foldQualified uooLocalUser dolocal doremote convId - pure (UpsertOne2OneConversationResponse convId) + foldQualified uooLocalUser dolocal doremote uooConvId diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 37b2f295dc7..e634b3f542b 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -38,6 +38,7 @@ module Galley.API.Query getMLSSelfConversation, getMLSSelfConversationWithError, getMLSOne2OneConversation, + isMLSOne2OneEstablished, ) where @@ -57,7 +58,6 @@ import Data.Range import Data.Set qualified as Set import Galley.API.Error import Galley.API.MLS -import Galley.API.MLS.Keys import Galley.API.MLS.One2One import Galley.API.MLS.Types import Galley.API.Mapping @@ -65,6 +65,7 @@ import Galley.API.Mapping qualified as Mapping import Galley.API.One2One import Galley.API.Util import Galley.Data.Conversation qualified as Data +import Galley.Data.Conversation.Types qualified as Data import Galley.Data.Types (Code (codeConversation)) import Galley.Data.Types qualified as Data import Galley.Effects @@ -77,7 +78,7 @@ import Galley.Env import Galley.Options import Galley.Types.Conversations.Members import Galley.Types.Teams -import Imports hiding (cs) +import Imports import Network.Wai import Network.Wai.Predicate hiding (Error, result, setStatus) import Network.Wai.Utilities hiding (Error) @@ -89,6 +90,7 @@ import System.Logger.Class qualified as Logger import Wire.API.Conversation hiding (Member) import Wire.API.Conversation qualified as Public import Wire.API.Conversation.Code +import Wire.API.Conversation.Protocol import Wire.API.Conversation.Role import Wire.API.Conversation.Role qualified as Public import Wire.API.Error @@ -434,9 +436,7 @@ conversationIdsPageFrom lusr state = do -- backend removal key is a proxy for it) the self-conversation is not -- returned or attempted to be created; in that case we skip anything related -- to it. - whenM (isJust <$> getMLSRemovalKey) - . void - $ getMLSSelfConversation lusr + whenM isMLSEnabled $ void $ getMLSSelfConversation lusr conversationIdsPageFromV2 ListGlobalSelf lusr state getConversations :: @@ -792,7 +792,7 @@ getRemoteMLSOne2OneConversation lself qother rconv = do -- a conversation can only be remote if it is hosted on the other user's domain rother <- if qDomain qother == tDomain rconv - then pure (toRemoteUnsafe (tDomain rconv) (qUnqualified qother)) + then pure (qualifyAs rconv (qUnqualified qother)) else throw (InternalErrorWithDescription "Unexpected 1-1 conversation domain") resp <- @@ -806,6 +806,67 @@ getRemoteMLSOne2OneConversation lself qother rconv = do throw (FederationUnexpectedBody "Backend mismatch when retrieving a remote 1-1 conversation") GetOne2OneConversationNotConnected -> throwS @'NotConnected +-- | Check if an MLS 1-1 conversation has been established, namely if its epoch +-- is non-zero. The conversation will only be stored in the database when its +-- first commit arrives. +-- +-- For the federated case, we do not make the assumption that the other backend +-- uses the same function to calculate the conversation ID and corresponding +-- group ID, however we /do/ assume that the two backends agree on which of the +-- two is responsible for hosting the conversation. +isMLSOne2OneEstablished :: + ( Member ConversationStore r, + Member (Input Env) r, + Member (Error FederationError) r, + Member (Error InternalError) r, + Member (ErrorS 'MLSNotEnabled) r, + Member (ErrorS 'NotConnected) r, + Member FederatorAccess r + ) => + Local UserId -> + Qualified UserId -> + Sem r Bool +isMLSOne2OneEstablished lself qother = do + assertMLSEnabled + let convId = one2OneConvId BaseProtocolMLSTag (tUntagged lself) qother + foldQualified + lself + isLocalMLSOne2OneEstablished + (isRemoteMLSOne2OneEstablished lself qother) + convId + +isLocalMLSOne2OneEstablished :: + Member ConversationStore r => + Local ConvId -> + Sem r Bool +isLocalMLSOne2OneEstablished lconv = do + mconv <- E.getConversation (tUnqualified lconv) + pure $ case mconv of + Nothing -> False + Just conv -> do + let meta = fst <$> Data.mlsMetadata conv + maybe False ((> 0) . epochNumber . cnvmlsEpoch) meta + +isRemoteMLSOne2OneEstablished :: + ( Member (ErrorS 'NotConnected) r, + Member (Error FederationError) r, + Member (Error InternalError) r, + Member FederatorAccess r + ) => + Local UserId -> + Qualified UserId -> + Remote conv -> + Sem r Bool +isRemoteMLSOne2OneEstablished lself qother rconv = do + conv <- getRemoteMLSOne2OneConversation lself qother rconv + pure . (> 0) $ case cnvProtocol conv of + ProtocolProteus -> 0 + ProtocolMLS meta -> ep meta + ProtocolMixed meta -> ep meta + where + ep :: ConversationMLSData -> Word64 + ep = epochNumber . cnvmlsEpoch + ------------------------------------------------------------------------------- -- Helpers diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 95272e6a832..f8a44b29b0a 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -122,7 +122,6 @@ import Polysemy.Input import Polysemy.Output import Polysemy.TinyLog qualified as P import SAML2.WebSSO qualified as SAML -import System.Logger (Msg) import System.Logger qualified as Log import Wire.API.Conversation (ConversationRemoveMembers (..)) import Wire.API.Conversation.Role (wireConvRoles) @@ -885,6 +884,7 @@ deleteTeamMember :: Member BrigAccess r, Member ConversationStore r, Member (Error AuthenticationError) r, + Member (Error FederationError) r, Member (Error InvalidInput) r, Member (ErrorS 'AccessDenied) r, Member (ErrorS 'TeamMemberNotFound) r, @@ -913,6 +913,7 @@ deleteNonBindingTeamMember :: Member BrigAccess r, Member ConversationStore r, Member (Error AuthenticationError) r, + Member (Error FederationError) r, Member (Error InvalidInput) r, Member (ErrorS 'AccessDenied) r, Member (ErrorS 'TeamMemberNotFound) r, @@ -942,6 +943,7 @@ deleteTeamMember' :: Member ConversationStore r, Member (Error AuthenticationError) r, Member (Error InvalidInput) r, + Member (Error FederationError) r, Member (ErrorS 'AccessDenied) r, Member (ErrorS 'TeamMemberNotFound) r, Member (ErrorS 'TeamNotFound) r, @@ -1009,9 +1011,9 @@ uncheckedDeleteTeamMember :: ( Member BackendNotificationQueueAccess r, Member ConversationStore r, Member NotificationSubsystem r, + Member (Error FederationError) r, Member ExternalAccess r, Member (Input UTCTime) r, - Member (P.Logger (Log.Msg -> Log.Msg)) r, Member MemberStore r, Member TeamStore r ) => @@ -1059,10 +1061,10 @@ removeFromConvsAndPushConvLeaveEvent :: forall r. ( Member BackendNotificationQueueAccess r, Member ConversationStore r, + Member (Error FederationError) r, Member ExternalAccess r, Member NotificationSubsystem r, Member (Input UTCTime) r, - Member (P.Logger (Log.Msg -> Log.Msg)) r, Member MemberStore r, Member TeamStore r ) => @@ -1149,8 +1151,7 @@ deleteTeamConversation :: Member NotificationSubsystem r, Member (Input UTCTime) r, Member SubConversationStore r, - Member TeamStore r, - Member (P.Logger (Msg -> Msg)) r + Member TeamStore r ) => Local UserId -> ConnId -> diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index e9085fca925..6425dd772a9 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -22,7 +22,6 @@ module Galley.API.Teams.Features setFeatureStatusInternal, patchFeatureStatusInternal, getFeatureStatusForUser, - getAllFeatureConfigsForServer, getAllFeatureConfigsForTeam, getAllFeatureConfigsForUser, updateLockStatus, @@ -38,6 +37,7 @@ where import Control.Lens import Data.ByteString.Conversion (toByteString') +import Data.ByteString.UTF8 qualified as UTF8 import Data.Id import Data.Json.Util import Data.Kind @@ -204,7 +204,7 @@ pushFeatureConfigEvent tid event = do P.warn $ Log.field "action" (Log.val "Features.pushFeatureConfigEvent") . Log.field "feature" (Log.val (toByteString' . Event._eventFeatureName $ event)) - . Log.field "team" (Log.val (cs . show $ tid)) + . Log.field "team" (Log.val (UTF8.fromString . show $ tid)) . Log.msg @Text "Fanout limit exceeded. Events will not be sent." else do let recipients = membersToRecipients Nothing (memList ^. teamMembers) @@ -319,7 +319,8 @@ instance SetFeatureConfig LegalholdConfig where Member TeamFeatureStore r, Member TeamStore r, Member (TeamMemberStore InternalPaging) r, - Member P.TinyLog r + Member P.TinyLog r, + Member Random r ) -- we're good to update the status now. diff --git a/services/galley/src/Galley/API/Teams/Features/Get.hs b/services/galley/src/Galley/API/Teams/Features/Get.hs index c0ca2b2c9c4..79f1b4e0ba8 100644 --- a/services/galley/src/Galley/API/Teams/Features/Get.hs +++ b/services/galley/src/Galley/API/Teams/Features/Get.hs @@ -193,15 +193,13 @@ getAllFeatureConfigsForUser zusr = do maybe (throwS @'NotATeamMember) (const $ pure ()) zusrMembership case mbTeam of Just tid -> - getAllFeatureConfigsTeam tid + TeamFeatures.getAllFeatureConfigs tid Nothing -> getAllFeatureConfigsUser zusr getAllFeatureConfigsForTeam :: forall r. ( Member (ErrorS 'NotATeamMember) r, - Member (Input Opts) r, - Member LegalHoldStore r, Member TeamFeatureStore r, Member TeamStore r ) => @@ -211,7 +209,7 @@ getAllFeatureConfigsForTeam :: getAllFeatureConfigsForTeam luid tid = do zusrMembership <- getTeamMember tid (tUnqualified luid) maybe (throwS @'NotATeamMember) (const $ pure ()) zusrMembership - getAllFeatureConfigsTeam tid + TeamFeatures.getAllFeatureConfigs tid getAllFeatureConfigsForServer :: forall r. @@ -276,38 +274,6 @@ getAllFeatureConfigsUser uid = <*> getConfigForUser @EnforceFileDownloadLocationConfig uid <*> getConfigForUser @LimitedEventFanoutConfig uid -getAllFeatureConfigsTeam :: - forall r. - ( Member (Input Opts) r, - Member LegalHoldStore r, - Member TeamFeatureStore r, - Member TeamStore r - ) => - TeamId -> - Sem r AllFeatureConfigs -getAllFeatureConfigsTeam tid = - AllFeatureConfigs - <$> getConfigForTeam @LegalholdConfig tid - <*> getConfigForTeam @SSOConfig tid - <*> getConfigForTeam @SearchVisibilityAvailableConfig tid - <*> getConfigForTeam @SearchVisibilityInboundConfig tid - <*> getConfigForTeam @ValidateSAMLEmailsConfig tid - <*> getConfigForTeam @DigitalSignaturesConfig tid - <*> getConfigForTeam @AppLockConfig tid - <*> getConfigForTeam @FileSharingConfig tid - <*> getConfigForTeam @ClassifiedDomainsConfig tid - <*> getConfigForTeam @ConferenceCallingConfig tid - <*> getConfigForTeam @SelfDeletingMessagesConfig tid - <*> getConfigForTeam @GuestLinksConfig tid - <*> getConfigForTeam @SndFactorPasswordChallengeConfig tid - <*> getConfigForTeam @MLSConfig tid - <*> getConfigForTeam @ExposeInvitationURLsToTeamAdminConfig tid - <*> getConfigForTeam @OutlookCalIntegrationConfig tid - <*> getConfigForTeam @MlsE2EIdConfig tid - <*> getConfigForTeam @MlsMigrationConfig tid - <*> getConfigForTeam @EnforceFileDownloadLocationConfig tid - <*> getConfigForTeam @LimitedEventFanoutConfig tid - -- | Note: this is an internal function which doesn't cover all features, e.g. LegalholdConfig genericGetConfigForTeam :: forall cfg r. @@ -473,7 +439,8 @@ instance GetFeatureConfig ExposeInvitationURLsToTeamAdminConfig where computeConfigForTeam teamAllowed teamDbStatus = if teamAllowed then makeConfig LockStatusUnlocked teamDbStatus - else makeConfig LockStatusLocked FeatureStatusDisabled + else -- FUTUREWORK: use default feature status instead + makeConfig LockStatusLocked FeatureStatusDisabled makeConfig :: LockStatus -> FeatureStatus -> WithStatus ExposeInvitationURLsToTeamAdminConfig makeConfig lockStatus status = diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index c6195576758..ec436a030f6 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -21,7 +21,9 @@ module Galley.API.Update ( -- * Managing Conversations acceptConv, blockConv, + blockConvUnqualified, unblockConv, + unblockConvUnqualified, checkReusableCode, joinConversationByReusableCode, joinConversationById, @@ -119,7 +121,6 @@ import Polysemy import Polysemy.Error import Polysemy.Input import Polysemy.TinyLog -import System.Logger (Msg) import Wire.API.Conversation hiding (Member) import Wire.API.Conversation.Action import Wire.API.Conversation.Code @@ -164,6 +165,22 @@ acceptConv lusr conn cnv = do conversationView lusr conv' blockConv :: + ( Member ConversationStore r, + Member (ErrorS 'ConvNotFound) r, + Member (ErrorS 'InvalidOperation) r, + Member MemberStore r + ) => + Local UserId -> + Qualified ConvId -> + Sem r () +blockConv lusr qcnv = + foldQualified + lusr + (blockConvUnqualified (tUnqualified lusr) . tUnqualified) + (blockRemoteConv lusr) + qcnv + +blockConvUnqualified :: ( Member ConversationStore r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'InvalidOperation) r, @@ -172,7 +189,7 @@ blockConv :: UserId -> ConvId -> Sem r () -blockConv zusr cnv = do +blockConvUnqualified zusr cnv = do conv <- E.getConversation cnv >>= noteS @'ConvNotFound unless (Data.convType conv `elem` [ConnectConv, One2OneConv]) $ throwS @'InvalidOperation @@ -180,7 +197,38 @@ blockConv zusr cnv = do when (zusr `isMember` mems) $ E.deleteMembers cnv (UserList [zusr] []) +blockRemoteConv :: + ( Member (ErrorS 'ConvNotFound) r, + Member MemberStore r + ) => + Local UserId -> + Remote ConvId -> + Sem r () +blockRemoteConv (tUnqualified -> usr) rcnv = do + unlessM (E.checkLocalMemberRemoteConv usr rcnv) $ throwS @'ConvNotFound + E.deleteMembersInRemoteConversation rcnv [usr] + unblockConv :: + ( Member ConversationStore r, + Member (Error InternalError) r, + Member (ErrorS 'ConvNotFound) r, + Member (ErrorS 'InvalidOperation) r, + Member NotificationSubsystem r, + Member (Input UTCTime) r, + Member MemberStore r, + Member TinyLog r + ) => + Local UserId -> + Maybe ConnId -> + Qualified ConvId -> + Sem r () +unblockConv lusr conn = + foldQualified + lusr + (void . unblockConvUnqualified lusr conn . tUnqualified) + (unblockRemoteConv lusr) + +unblockConvUnqualified :: ( Member ConversationStore r, Member (Error InternalError) r, Member (ErrorS 'ConvNotFound) r, @@ -194,7 +242,7 @@ unblockConv :: Maybe ConnId -> ConvId -> Sem r Conversation -unblockConv lusr conn cnv = do +unblockConvUnqualified lusr conn cnv = do conv <- E.getConversation cnv >>= noteS @'ConvNotFound unless (Data.convType conv `elem` [ConnectConv, One2OneConv]) $ @@ -202,6 +250,15 @@ unblockConv lusr conn cnv = do conv' <- acceptOne2One lusr conv conn conversationView lusr conv' +unblockRemoteConv :: + ( Member MemberStore r + ) => + Local UserId -> + Remote ConvId -> + Sem r () +unblockRemoteConv lusr rcnv = do + E.createMembersInRemoteConversation rcnv [tUnqualified lusr] + -- conversation updates handleUpdateResult :: UpdateResult Event -> Response @@ -231,6 +288,7 @@ type UpdateConversationAccessEffects = Input UTCTime, MemberStore, ProposalStore, + Random, SubConversationStore, TeamStore, TinyLog @@ -372,8 +430,7 @@ updateConversationMessageTimer :: Member (Error FederationError) r, Member ExternalAccess r, Member NotificationSubsystem r, - Member (Input UTCTime) r, - Member (Logger (Msg -> Msg)) r + Member (Input UTCTime) r ) => Local UserId -> ConnId -> @@ -405,8 +462,7 @@ updateConversationMessageTimerUnqualified :: Member (Error FederationError) r, Member ExternalAccess r, Member NotificationSubsystem r, - Member (Input UTCTime) r, - Member (Logger (Msg -> Msg)) r + Member (Input UTCTime) r ) => Local UserId -> ConnId -> @@ -432,8 +488,7 @@ deleteLocalConversation :: Member MemberStore r, Member ProposalStore r, Member (Input UTCTime) r, - Member TeamStore r, - Member (Logger (Msg -> Msg)) r + Member TeamStore r ) => Local UserId -> ConnId -> @@ -662,6 +717,7 @@ updateConversationProtocolWithLocalUser :: Member NotificationSubsystem r, Member ExternalAccess r, Member FederatorAccess r, + Member Random r, Member ProposalStore r, Member SubConversationStore r, Member TeamFeatureStore r, @@ -695,6 +751,7 @@ joinConversationByReusableCode :: Member BrigAccess r, Member CodeStore r, Member ConversationStore r, + Member (Error FederationError) r, Member (ErrorS 'CodeNotFound) r, Member (ErrorS 'InvalidConversationPassword) r, Member (ErrorS 'ConvAccessDenied) r, @@ -709,8 +766,7 @@ joinConversationByReusableCode :: Member (Input UTCTime) r, Member MemberStore r, Member TeamStore r, - Member TeamFeatureStore r, - Member (Logger (Msg -> Msg)) r + Member TeamFeatureStore r ) => Local UserId -> ConnId -> @@ -727,6 +783,7 @@ joinConversationById :: ( Member BackendNotificationQueueAccess r, Member BrigAccess r, Member ConversationStore r, + Member (Error FederationError) r, Member (ErrorS 'ConvAccessDenied) r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'InvalidOperation) r, @@ -737,8 +794,7 @@ joinConversationById :: Member (Input Opts) r, Member (Input UTCTime) r, Member MemberStore r, - Member TeamStore r, - Member (Logger (Msg -> Msg)) r + Member TeamStore r ) => Local UserId -> ConnId -> @@ -752,6 +808,7 @@ joinConversation :: forall r. ( Member BackendNotificationQueueAccess r, Member BrigAccess r, + Member (Error FederationError) r, Member (ErrorS 'ConvAccessDenied) r, Member (ErrorS 'InvalidOperation) r, Member (ErrorS 'NotATeamMember) r, @@ -761,8 +818,7 @@ joinConversation :: Member (Input Opts) r, Member (Input UTCTime) r, Member MemberStore r, - Member TeamStore r, - Member (Logger (Msg -> Msg)) r + Member TeamStore r ) => Local UserId -> ConnId -> @@ -818,6 +874,7 @@ addMembers :: Member LegalHoldStore r, Member MemberStore r, Member ProposalStore r, + Member Random r, Member SubConversationStore r, Member TeamStore r, Member TinyLog r @@ -859,6 +916,7 @@ addMembersUnqualifiedV2 :: Member LegalHoldStore r, Member MemberStore r, Member ProposalStore r, + Member Random r, Member SubConversationStore r, Member TeamStore r, Member TinyLog r @@ -900,6 +958,7 @@ addMembersUnqualified :: Member LegalHoldStore r, Member MemberStore r, Member ProposalStore r, + Member Random r, Member SubConversationStore r, Member TeamStore r, Member TinyLog r @@ -989,8 +1048,7 @@ updateOtherMemberLocalConv :: Member ExternalAccess r, Member NotificationSubsystem r, Member (Input UTCTime) r, - Member MemberStore r, - Member (Logger (Msg -> Msg)) r + Member MemberStore r ) => Local ConvId -> Local UserId -> @@ -1016,8 +1074,7 @@ updateOtherMemberUnqualified :: Member ExternalAccess r, Member NotificationSubsystem r, Member (Input UTCTime) r, - Member MemberStore r, - Member (Logger (Msg -> Msg)) r + Member MemberStore r ) => Local UserId -> ConnId -> @@ -1042,8 +1099,7 @@ updateOtherMember :: Member ExternalAccess r, Member NotificationSubsystem r, Member (Input UTCTime) r, - Member MemberStore r, - Member (Logger (Msg -> Msg)) r + Member MemberStore r ) => Local UserId -> ConnId -> @@ -1080,6 +1136,7 @@ removeMemberUnqualified :: Member (Input UTCTime) r, Member MemberStore r, Member ProposalStore r, + Member Random r, Member SubConversationStore r, Member TinyLog r ) => @@ -1108,6 +1165,7 @@ removeMemberQualified :: Member (Input UTCTime) r, Member MemberStore r, Member ProposalStore r, + Member Random r, Member SubConversationStore r, Member TinyLog r ) => @@ -1183,6 +1241,7 @@ removeMemberFromLocalConv :: Member (Input UTCTime) r, Member MemberStore r, Member ProposalStore r, + Member Random r, Member SubConversationStore r, Member TinyLog r ) => @@ -1374,7 +1433,6 @@ updateConversationName :: Member ExternalAccess r, Member NotificationSubsystem r, Member (Input UTCTime) r, - Member (Logger (Msg -> Msg)) r, Member TeamStore r ) => Local UserId -> @@ -1401,7 +1459,6 @@ updateUnqualifiedConversationName :: Member ExternalAccess r, Member NotificationSubsystem r, Member (Input UTCTime) r, - Member (Logger (Msg -> Msg)) r, Member TeamStore r ) => Local UserId -> @@ -1424,7 +1481,6 @@ updateLocalConversationName :: Member ExternalAccess r, Member NotificationSubsystem r, Member (Input UTCTime) r, - Member (Logger (Msg -> Msg)) r, Member TeamStore r ) => Local UserId -> diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index b4759ef59e2..0c8d4df22fb 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -45,6 +45,7 @@ import Galley.Data.Conversation qualified as Data import Galley.Data.Services (BotMember, newBotMember) import Galley.Data.Types qualified as DataTypes import Galley.Effects +import Galley.Effects.BackendNotificationQueueAccess import Galley.Effects.BrigAccess import Galley.Effects.CodeStore import Galley.Effects.ConversationStore @@ -60,6 +61,7 @@ import Galley.Types.Teams import Galley.Types.UserList import Gundeck.Types.Push.V2 qualified as PushV2 import Imports hiding (forkIO) +import Network.AMQP qualified as Q import Network.HTTP.Types import Network.Wai import Network.Wai.Predicate hiding (Error, fromEither) @@ -823,12 +825,12 @@ ensureNoUnreachableBackends results = do throw (UnreachableBackends (map (tDomain . fst) errors)) pure values --- | Notify remote users of being added to a new conversation. In case a remote --- domain is unreachable, an exception is thrown, the conversation deleted and --- the client gets an error response. +-- | Notify remote users of being added to a new conversation. registerRemoteConversationMemberships :: ( Member ConversationStore r, Member (Error UnreachableBackends) r, + Member (Error FederationError) r, + Member BackendNotificationQueueAccess r, Member FederatorAccess r ) => -- | The time stamp when the conversation was created @@ -861,6 +863,7 @@ registerRemoteConversationMemberships now lusr lc = deleteOnUnreachable $ do -- reachable members in buckets per remote domain let joined :: [Remote [RemoteMember]] = allRemoteBuckets + joinedCoupled :: [Remote ([RemoteMember], NonEmpty (Remote UserId))] joinedCoupled = foldMap ( \ruids -> @@ -869,14 +872,12 @@ registerRemoteConversationMemberships now lusr lc = deleteOnUnreachable $ do filter (\r -> tDomain r /= tDomain ruids) joined in case NE.nonEmpty nj of Nothing -> [] - Just v -> [(ruids, v)] + Just v -> [fmap (,v) ruids] ) joined - void . (ensureNoUnreachableBackends =<<) $ - -- Send an update to remotes about the final list of participants - runFederatedConcurrentlyBucketsEither joinedCoupled $ - fedClient @'Galley @"on-conversation-updated" . convUpdateJoin + void $ enqueueNotificationsConcurrentlyBuckets Q.Persistent joinedCoupled $ \z -> + makeConversationUpdateBundle (convUpdateJoin z) >>= sendBundle where creator :: Maybe UserId creator = cnvmCreator . DataTypes.convMetadata . tUnqualified $ lc @@ -893,14 +894,14 @@ registerRemoteConversationMemberships now lusr lc = deleteOnUnreachable $ do toMembers :: [RemoteMember] -> Set OtherMember toMembers rs = Set.fromList $ localNonCreators <> fmap remoteMemberToOther rs - convUpdateJoin :: (QualifiedWithTag t [RemoteMember], NonEmpty (QualifiedWithTag t' UserId)) -> ConversationUpdate - convUpdateJoin (toNotify, newMembers) = + convUpdateJoin :: Remote ([RemoteMember], NonEmpty (Remote UserId)) -> ConversationUpdate + convUpdateJoin (tUnqualified -> (toNotify, newMembers)) = ConversationUpdate - { cuTime = now, - cuOrigUserId = tUntagged lusr, - cuConvId = DataTypes.convId (tUnqualified lc), - cuAlreadyPresentUsers = fmap (tUnqualified . rmId) . tUnqualified $ toNotify, - cuAction = + { time = now, + origUserId = tUntagged lusr, + convId = DataTypes.convId (tUnqualified lc), + alreadyPresentUsers = fmap (tUnqualified . rmId) toNotify, + action = SomeConversationAction (sing @'ConversationJoinTag) -- FUTUREWORK(md): replace the member role with whatever is provided in diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index a4f780bdb78..445328a17fa 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -49,6 +49,7 @@ import Cassandra hiding (Set) import Cassandra.Util (initCassandraForService) import Control.Error hiding (err) import Control.Lens hiding ((.=)) +import Data.Id import Data.Metrics.Middleware import Data.Misc import Data.Qualified @@ -66,12 +67,12 @@ import Galley.Cassandra.LegalHold import Galley.Cassandra.Proposal import Galley.Cassandra.SearchVisibility import Galley.Cassandra.Services -import Galley.Cassandra.SubConversation (interpretSubConversationStoreToCassandra) +import Galley.Cassandra.SubConversation import Galley.Cassandra.Team import Galley.Cassandra.TeamFeatures import Galley.Cassandra.TeamNotifications import Galley.Effects -import Galley.Effects.FireAndForget (interpretFireAndForget) +import Galley.Effects.FireAndForget import Galley.Effects.WaiRoutes.IO import Galley.Env import Galley.External @@ -83,6 +84,7 @@ import Galley.Options hiding (brig, endpoint, federator) import Galley.Options qualified as O import Galley.Queue import Galley.Queue qualified as Q +import Galley.Types.Teams (FeatureLegalHold) import Galley.Types.Teams qualified as Teams import HTTP2.Client.Manager (Http2Manager, http2ManagerWithSSLCtx) import Imports hiding (forkIO) @@ -171,7 +173,7 @@ createEnv m o l = do <$> Q.new 16000 <*> initExtEnv <*> maybe (pure Nothing) (fmap Just . Aws.mkEnv l mgr) (o ^. journal) - <*> loadAllMLSKeys (fold (o ^. settings . mlsPrivateKeyPaths)) + <*> traverse loadAllMLSKeys (o ^. settings . mlsPrivateKeyPaths) <*> traverse (mkRabbitMqChannelMVar l) (o ^. rabbitmq) <*> pure codeURIcfg @@ -259,6 +261,8 @@ evalGalley e = . interpretWaiRoutes . runInputConst (e ^. options) . runInputConst (toLocalUnsafe (e ^. options . settings . federationDomain) ()) + . interpretTeamFeatureSpecialContext e + . runInputSem getAllFeatureConfigsForServer . interpretInternalTeamListToCassandra . interpretTeamListToCassandra . interpretLegacyConversationListToCassandra @@ -268,11 +272,11 @@ evalGalley e = . interpretTeamMemberStoreToCassandra lh . interpretTeamStoreToCassandra lh . interpretTeamNotificationStoreToCassandra - . interpretTeamFeatureStoreToCassandra . interpretServiceStoreToCassandra . interpretSearchVisibilityStoreToCassandra . interpretMemberStoreToCassandra . interpretLegalHoldStoreToCassandra lh + . interpretTeamFeatureStoreToCassandra . interpretCustomBackendStoreToCassandra . randomToIO . interpretSubConversationStoreToCassandra @@ -292,3 +296,10 @@ evalGalley e = . interpretBrigAccess where lh = view (options . settings . featureFlags . Teams.flagLegalHold) e + +interpretTeamFeatureSpecialContext :: Env -> Sem (Input (Maybe [TeamId], FeatureLegalHold) ': r) a -> Sem r a +interpretTeamFeatureSpecialContext e = + runInputConst + ( e ^. options . settings . exposeInvitationURLsTeamAllowlist, + e ^. options . settings . featureFlags . Teams.flagLegalHold + ) diff --git a/services/galley/src/Galley/Cassandra/Client.hs b/services/galley/src/Galley/Cassandra/Client.hs index 419feef79e6..bc37fece531 100644 --- a/services/galley/src/Galley/Cassandra/Client.hs +++ b/services/galley/src/Galley/Cassandra/Client.hs @@ -28,6 +28,7 @@ import Data.Id import Data.List.Split (chunksOf) import Galley.Cassandra.Queries qualified as Cql import Galley.Cassandra.Store +import Galley.Cassandra.Util import Galley.Effects.ClientStore (ClientStore (..)) import Galley.Env import Galley.Monad @@ -37,6 +38,7 @@ import Galley.Types.Clients qualified as Clients import Imports import Polysemy import Polysemy.Input +import Polysemy.TinyLog import UnliftIO qualified updateClient :: Bool -> UserId -> ClientId -> Client () @@ -60,13 +62,24 @@ eraseClients user = retry x5 (write Cql.rmClients (params LocalQuorum (Identity interpretClientStoreToCassandra :: ( Member (Embed IO) r, Member (Input ClientState) r, - Member (Input Env) r + Member (Input Env) r, + Member TinyLog r ) => Sem (ClientStore ': r) a -> Sem r a interpretClientStoreToCassandra = interpret $ \case - GetClients uids -> embedClient $ lookupClients uids - CreateClient uid cid -> embedClient $ updateClient True uid cid - DeleteClient uid cid -> embedClient $ updateClient False uid cid - DeleteClients uid -> embedClient $ eraseClients uid - UseIntraClientListing -> embedApp . view $ options . settings . intraListing + GetClients uids -> do + logEffect "ClientStore.GetClients" + embedClient $ lookupClients uids + CreateClient uid cid -> do + logEffect "ClientStore.CreateClient" + embedClient $ updateClient True uid cid + DeleteClient uid cid -> do + logEffect "ClientStore.DeleteClient" + embedClient $ updateClient False uid cid + DeleteClients uid -> do + logEffect "ClientStore.DeleteClients" + embedClient $ eraseClients uid + UseIntraClientListing -> do + logEffect "ClientStore.UseIntraClientListing" + embedApp . view $ options . settings . intraListing diff --git a/services/galley/src/Galley/Cassandra/Code.hs b/services/galley/src/Galley/Cassandra/Code.hs index f5b2770b38a..407e6ceedea 100644 --- a/services/galley/src/Galley/Cassandra/Code.hs +++ b/services/galley/src/Galley/Cassandra/Code.hs @@ -26,6 +26,7 @@ import Data.Code import Data.Map qualified as Map import Galley.Cassandra.Queries qualified as Cql import Galley.Cassandra.Store +import Galley.Cassandra.Util import Galley.Data.Types import Galley.Data.Types qualified as Code import Galley.Effects.CodeStore (CodeStore (..)) @@ -33,22 +34,35 @@ import Galley.Env import Imports import Polysemy import Polysemy.Input +import Polysemy.TinyLog import Wire.API.Password interpretCodeStoreToCassandra :: ( Member (Embed IO) r, Member (Input ClientState) r, - Member (Input Env) r + Member (Input Env) r, + Member TinyLog r ) => Sem (CodeStore ': r) a -> Sem r a interpretCodeStoreToCassandra = interpret $ \case - GetCode k s -> embedClient $ lookupCode k s - CreateCode code mPw -> embedClient $ insertCode code mPw - DeleteCode k s -> embedClient $ deleteCode k s - MakeKey cid -> Code.mkKey cid - GenerateCode cid s t -> Code.generate cid s t + GetCode k s -> do + logEffect "CodeStore.GetCode" + embedClient $ lookupCode k s + CreateCode code mPw -> do + logEffect "CodeStore.CreateCode" + embedClient $ insertCode code mPw + DeleteCode k s -> do + logEffect "CodeStore.DeleteCode" + embedClient $ deleteCode k s + MakeKey cid -> do + logEffect "CodeStore.MakeKey" + Code.mkKey cid + GenerateCode cid s t -> do + logEffect "CodeStore.GenerateCode" + Code.generate cid s t GetConversationCodeURI mbHost -> do + logEffect "CodeStore.GetConversationCodeURI" env <- input case env ^. convCodeURI of Left uri -> pure (Just uri) diff --git a/services/galley/src/Galley/Cassandra/Conversation.hs b/services/galley/src/Galley/Cassandra/Conversation.hs index 2d24adb63b2..e685085b0a0 100644 --- a/services/galley/src/Galley/Cassandra/Conversation.hs +++ b/services/galley/src/Galley/Cassandra/Conversation.hs @@ -41,13 +41,14 @@ import Galley.Cassandra.Conversation.MLS import Galley.Cassandra.Conversation.Members import Galley.Cassandra.Queries qualified as Cql import Galley.Cassandra.Store +import Galley.Cassandra.Util import Galley.Data.Conversation import Galley.Data.Conversation.Types import Galley.Effects.ConversationStore (ConversationStore (..)) import Galley.Types.Conversations.Members import Galley.Types.ToUserRole import Galley.Types.UserList -import Imports hiding (cs) +import Imports import Polysemy import Polysemy.Input import Polysemy.TinyLog @@ -198,8 +199,8 @@ conversationMeta conv = getGroupInfo :: ConvId -> Client (Maybe GroupInfoData) getGroupInfo cid = do - runIdentity - <$$> retry + (runIdentity =<<) + <$> retry x1 ( query1 Cql.selectGroupInfo @@ -450,27 +451,75 @@ interpretConversationStoreToCassandra :: Sem (ConversationStore ': r) a -> Sem r a interpretConversationStoreToCassandra = interpret $ \case - CreateConversationId -> Id <$> embed nextRandom - CreateConversation loc nc -> embedClient $ createConversation loc nc - CreateMLSSelfConversation lusr -> embedClient $ createMLSSelfConversation lusr - GetConversation cid -> embedClient $ getConversation cid - GetConversationEpoch cid -> embedClient $ getConvEpoch cid - GetConversations cids -> localConversations cids - GetConversationMetadata cid -> embedClient $ conversationMeta cid - GetGroupInfo cid -> embedClient $ getGroupInfo cid - IsConversationAlive cid -> embedClient $ isConvAlive cid - SelectConversations uid cids -> embedClient $ localConversationIdsOf uid cids - GetRemoteConversationStatus uid cids -> embedClient $ remoteConversationStatus uid cids - SetConversationType cid ty -> embedClient $ updateConvType cid ty - SetConversationName cid value -> embedClient $ updateConvName cid value - SetConversationAccess cid value -> embedClient $ updateConvAccess cid value - SetConversationReceiptMode cid value -> embedClient $ updateConvReceiptMode cid value - SetConversationMessageTimer cid value -> embedClient $ updateConvMessageTimer cid value - SetConversationEpoch cid epoch -> embedClient $ updateConvEpoch cid epoch - SetConversationCipherSuite cid cs -> embedClient $ updateConvCipherSuite cid cs - DeleteConversation cid -> embedClient $ deleteConversation cid - SetGroupInfo cid gib -> embedClient $ setGroupInfo cid gib - AcquireCommitLock gId epoch ttl -> embedClient $ acquireCommitLock gId epoch ttl - ReleaseCommitLock gId epoch -> embedClient $ releaseCommitLock gId epoch - UpdateToMixedProtocol cid ct cs -> updateToMixedProtocol cid ct cs - UpdateToMLSProtocol cid -> updateToMLSProtocol cid + CreateConversationId -> do + logEffect "ConversationStore.CreateConversationId" + Id <$> embed nextRandom + CreateConversation loc nc -> do + logEffect "ConversationStore.CreateConversation" + embedClient $ createConversation loc nc + CreateMLSSelfConversation lusr -> do + logEffect "ConversationStore.CreateMLSSelfConversation" + embedClient $ createMLSSelfConversation lusr + GetConversation cid -> do + logEffect "ConversationStore.GetConversation" + embedClient $ getConversation cid + GetConversationEpoch cid -> do + logEffect "ConversationStore.GetConversationEpoch" + embedClient $ getConvEpoch cid + GetConversations cids -> do + logEffect "ConversationStore.GetConversations" + localConversations cids + GetConversationMetadata cid -> do + logEffect "ConversationStore.GetConversationMetadata" + embedClient $ conversationMeta cid + GetGroupInfo cid -> do + logEffect "ConversationStore.GetGroupInfo" + embedClient $ getGroupInfo cid + IsConversationAlive cid -> do + logEffect "ConversationStore.IsConversationAlive" + embedClient $ isConvAlive cid + SelectConversations uid cids -> do + logEffect "ConversationStore.SelectConversations" + embedClient $ localConversationIdsOf uid cids + GetRemoteConversationStatus uid cids -> do + logEffect "ConversationStore.GetRemoteConversationStatus" + embedClient $ remoteConversationStatus uid cids + SetConversationType cid ty -> do + logEffect "ConversationStore.SetConversationType" + embedClient $ updateConvType cid ty + SetConversationName cid value -> do + logEffect "ConversationStore.SetConversationName" + embedClient $ updateConvName cid value + SetConversationAccess cid value -> do + logEffect "ConversationStore.SetConversationAccess" + embedClient $ updateConvAccess cid value + SetConversationReceiptMode cid value -> do + logEffect "ConversationStore.SetConversationReceiptMode" + embedClient $ updateConvReceiptMode cid value + SetConversationMessageTimer cid value -> do + logEffect "ConversationStore.SetConversationMessageTimer" + embedClient $ updateConvMessageTimer cid value + SetConversationEpoch cid epoch -> do + logEffect "ConversationStore.SetConversationEpoch" + embedClient $ updateConvEpoch cid epoch + SetConversationCipherSuite cid cs -> do + logEffect "ConversationStore.SetConversationCipherSuite" + embedClient $ updateConvCipherSuite cid cs + DeleteConversation cid -> do + logEffect "ConversationStore.DeleteConversation" + embedClient $ deleteConversation cid + SetGroupInfo cid gib -> do + logEffect "ConversationStore.SetGroupInfo" + embedClient $ setGroupInfo cid gib + AcquireCommitLock gId epoch ttl -> do + logEffect "ConversationStore.AcquireCommitLock" + embedClient $ acquireCommitLock gId epoch ttl + ReleaseCommitLock gId epoch -> do + logEffect "ConversationStore.ReleaseCommitLock" + embedClient $ releaseCommitLock gId epoch + UpdateToMixedProtocol cid ct cs -> do + logEffect "ConversationStore.UpdateToMixedProtocol" + updateToMixedProtocol cid ct cs + UpdateToMLSProtocol cid -> do + logEffect "ConversationStore.UpdateToMLSProtocol" + updateToMLSProtocol cid diff --git a/services/galley/src/Galley/Cassandra/Conversation/Members.hs b/services/galley/src/Galley/Cassandra/Conversation/Members.hs index abd3a0139e6..4b0482f712b 100644 --- a/services/galley/src/Galley/Cassandra/Conversation/Members.hs +++ b/services/galley/src/Galley/Cassandra/Conversation/Members.hs @@ -39,13 +39,15 @@ import Galley.Cassandra.Instances () import Galley.Cassandra.Queries qualified as Cql import Galley.Cassandra.Services import Galley.Cassandra.Store +import Galley.Cassandra.Util import Galley.Effects.MemberStore (MemberStore (..)) import Galley.Types.Conversations.Members import Galley.Types.ToUserRole import Galley.Types.UserList -import Imports hiding (Set, cs) +import Imports hiding (Set) import Polysemy import Polysemy.Input +import Polysemy.TinyLog import UnliftIO qualified import Wire.API.Conversation.Member hiding (Member) import Wire.API.Conversation.Role @@ -390,34 +392,76 @@ removeAllMLSClients groupId = do interpretMemberStoreToCassandra :: ( Member (Embed IO) r, - Member (Input ClientState) r + Member (Input ClientState) r, + Member TinyLog r ) => Sem (MemberStore ': r) a -> Sem r a interpretMemberStoreToCassandra = interpret $ \case - CreateMembers cid ul -> embedClient $ addMembers cid ul - CreateMembersInRemoteConversation rcid uids -> + CreateMembers cid ul -> do + logEffect "MemberStore.CreateMembers" + embedClient $ addMembers cid ul + CreateMembersInRemoteConversation rcid uids -> do + logEffect "MemberStore.CreateMembersInRemoteConversation" embedClient $ addLocalMembersToRemoteConv rcid uids - CreateBotMember sr bid cid -> embedClient $ addBotMember sr bid cid - GetLocalMember cid uid -> embedClient $ member cid uid - GetLocalMembers cid -> embedClient $ members cid - GetAllLocalMembers -> embedClient allMembers - GetRemoteMember cid uid -> embedClient $ lookupRemoteMember cid (tDomain uid) (tUnqualified uid) - GetRemoteMembers rcid -> embedClient $ lookupRemoteMembers rcid - CheckLocalMemberRemoteConv uid rcnv -> fmap (not . null) $ embedClient $ lookupLocalMemberRemoteConv uid rcnv - SelectRemoteMembers uids rcnv -> embedClient $ filterRemoteConvMembers uids rcnv - SetSelfMember qcid luid upd -> embedClient $ updateSelfMember qcid luid upd - SetOtherMember lcid quid upd -> + CreateBotMember sr bid cid -> do + logEffect "MemberStore.CreateBotMember" + embedClient $ addBotMember sr bid cid + GetLocalMember cid uid -> do + logEffect "MemberStore.GetLocalMember" + embedClient $ member cid uid + GetLocalMembers cid -> do + logEffect "MemberStore.GetLocalMembers" + embedClient $ members cid + GetAllLocalMembers -> do + logEffect "MemberStore.GetAllLocalMembers" + embedClient allMembers + GetRemoteMember cid uid -> do + logEffect "MemberStore.GetRemoteMember" + embedClient $ lookupRemoteMember cid (tDomain uid) (tUnqualified uid) + GetRemoteMembers rcid -> do + logEffect "MemberStore.GetRemoteMembers" + embedClient $ lookupRemoteMembers rcid + CheckLocalMemberRemoteConv uid rcnv -> do + logEffect "MemberStore.CheckLocalMemberRemoteConv" + fmap (not . null) $ embedClient $ lookupLocalMemberRemoteConv uid rcnv + SelectRemoteMembers uids rcnv -> do + logEffect "MemberStore.SelectRemoteMembers" + embedClient $ filterRemoteConvMembers uids rcnv + SetSelfMember qcid luid upd -> do + logEffect "MemberStore.SetSelfMember" + embedClient $ updateSelfMember qcid luid upd + SetOtherMember lcid quid upd -> do + logEffect "MemberStore.SetOtherMember" embedClient $ updateOtherMemberLocalConv lcid quid upd - DeleteMembers cnv ul -> embedClient $ removeMembersFromLocalConv cnv ul - DeleteMembersInRemoteConversation rcnv uids -> + DeleteMembers cnv ul -> do + logEffect "MemberStore.DeleteMembers" + embedClient $ removeMembersFromLocalConv cnv ul + DeleteMembersInRemoteConversation rcnv uids -> do + logEffect "MemberStore.DeleteMembersInRemoteConversation" embedClient $ removeLocalMembersFromRemoteConv rcnv uids - AddMLSClients lcnv quid cs -> embedClient $ addMLSClients lcnv quid cs - PlanClientRemoval lcnv cids -> embedClient $ planMLSClientRemoval lcnv cids - RemoveMLSClients lcnv quid cs -> embedClient $ removeMLSClients lcnv quid cs - RemoveAllMLSClients gid -> embedClient $ removeAllMLSClients gid - LookupMLSClients lcnv -> embedClient $ lookupMLSClients lcnv - LookupMLSClientLeafIndices lcnv -> embedClient $ lookupMLSClientLeafIndices lcnv - GetRemoteMembersByDomain dom -> embedClient $ lookupRemoteMembersByDomain dom - GetLocalMembersByDomain dom -> embedClient $ lookupLocalMembersByDomain dom + AddMLSClients lcnv quid cs -> do + logEffect "MemberStore.AddMLSClients" + embedClient $ addMLSClients lcnv quid cs + PlanClientRemoval lcnv cids -> do + logEffect "MemberStore.PlanClientRemoval" + embedClient $ planMLSClientRemoval lcnv cids + RemoveMLSClients lcnv quid cs -> do + logEffect "MemberStore.RemoveMLSClients" + embedClient $ removeMLSClients lcnv quid cs + RemoveAllMLSClients gid -> do + logEffect "MemberStore.RemoveAllMLSClients" + embedClient $ removeAllMLSClients gid + LookupMLSClients lcnv -> do + logEffect "MemberStore.LookupMLSClients" + embedClient $ lookupMLSClients lcnv + LookupMLSClientLeafIndices lcnv -> do + logEffect "MemberStore.LookupMLSClientLeafIndices" + embedClient $ lookupMLSClientLeafIndices lcnv + GetRemoteMembersByDomain dom -> do + logEffect "MemberStore.GetRemoteMembersByDomain" + embedClient $ lookupRemoteMembersByDomain dom + GetLocalMembersByDomain dom -> do + logEffect "MemberStore.GetLocalMembersByDomain" + embedClient $ lookupLocalMembersByDomain dom diff --git a/services/galley/src/Galley/Cassandra/ConversationList.hs b/services/galley/src/Galley/Cassandra/ConversationList.hs index 623fd7e59b0..9c43da34793 100644 --- a/services/galley/src/Galley/Cassandra/ConversationList.hs +++ b/services/galley/src/Galley/Cassandra/ConversationList.hs @@ -29,10 +29,12 @@ import Data.Range import Galley.Cassandra.Instances () import Galley.Cassandra.Queries qualified as Cql import Galley.Cassandra.Store +import Galley.Cassandra.Util import Galley.Effects.ListItems import Imports hiding (max) import Polysemy import Polysemy.Input +import Polysemy.TinyLog import Wire.Sem.Paging.Cassandra -- | Deprecated, use 'localConversationIdsPageFrom' @@ -66,27 +68,36 @@ remoteConversationIdsPageFrom usr pagingState max = interpretConversationListToCassandra :: ( Member (Embed IO) r, - Member (Input ClientState) r + Member (Input ClientState) r, + Member TinyLog r ) => Sem (ListItems CassandraPaging ConvId ': r) a -> Sem r a interpretConversationListToCassandra = interpret $ \case - ListItems uid ps max -> embedClient $ localConversationIdsPageFrom uid ps max + ListItems uid ps max -> do + logEffect "ConversationList.ListItems" + embedClient $ localConversationIdsPageFrom uid ps max interpretRemoteConversationListToCassandra :: ( Member (Embed IO) r, - Member (Input ClientState) r + Member (Input ClientState) r, + Member TinyLog r ) => Sem (ListItems CassandraPaging (Remote ConvId) ': r) a -> Sem r a interpretRemoteConversationListToCassandra = interpret $ \case - ListItems uid ps max -> embedClient $ remoteConversationIdsPageFrom uid ps (fromRange max) + ListItems uid ps max -> do + logEffect "RemoteConversationList.ListItems" + embedClient $ remoteConversationIdsPageFrom uid ps (fromRange max) interpretLegacyConversationListToCassandra :: ( Member (Embed IO) r, - Member (Input ClientState) r + Member (Input ClientState) r, + Member TinyLog r ) => Sem (ListItems LegacyPaging ConvId ': r) a -> Sem r a interpretLegacyConversationListToCassandra = interpret $ \case - ListItems uid ps max -> embedClient $ conversationIdsFrom uid ps max + ListItems uid ps max -> do + logEffect "LegacyConversationList.ListItems" + embedClient $ conversationIdsFrom uid ps max diff --git a/services/galley/src/Galley/Cassandra/CustomBackend.hs b/services/galley/src/Galley/Cassandra/CustomBackend.hs index cabe4a3a43e..f06f8187ac9 100644 --- a/services/galley/src/Galley/Cassandra/CustomBackend.hs +++ b/services/galley/src/Galley/Cassandra/CustomBackend.hs @@ -24,22 +24,31 @@ import Data.Domain (Domain) import Galley.Cassandra.Instances () import Galley.Cassandra.Queries qualified as Cql import Galley.Cassandra.Store +import Galley.Cassandra.Util import Galley.Effects.CustomBackendStore (CustomBackendStore (..)) import Imports import Polysemy import Polysemy.Input +import Polysemy.TinyLog import Wire.API.CustomBackend interpretCustomBackendStoreToCassandra :: ( Member (Embed IO) r, - Member (Input ClientState) r + Member (Input ClientState) r, + Member TinyLog r ) => Sem (CustomBackendStore ': r) a -> Sem r a interpretCustomBackendStoreToCassandra = interpret $ \case - GetCustomBackend dom -> embedClient $ getCustomBackend dom - SetCustomBackend dom b -> embedClient $ setCustomBackend dom b - DeleteCustomBackend dom -> embedClient $ deleteCustomBackend dom + GetCustomBackend dom -> do + logEffect "CustomBackendStore.GetCustomBackend" + embedClient $ getCustomBackend dom + SetCustomBackend dom b -> do + logEffect "CustomBackendStore.SetCustomBackend" + embedClient $ setCustomBackend dom b + DeleteCustomBackend dom -> do + logEffect "CustomBackendStore.DeleteCustomBackend" + embedClient $ deleteCustomBackend dom getCustomBackend :: MonadClient m => Domain -> m (Maybe CustomBackend) getCustomBackend domain = diff --git a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs new file mode 100644 index 00000000000..d6b070c7f91 --- /dev/null +++ b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs @@ -0,0 +1,380 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Galley.Cassandra.GetAllTeamFeatureConfigs where + +import Cassandra +import Cassandra qualified as C +import Data.Id +import Data.Misc (HttpsUrl) +import Data.Time +import Database.CQL.Protocol +import Galley.Cassandra.Instances () +import Galley.Types.Teams (FeatureLegalHold (..)) +import Imports +import Wire.API.Conversation.Protocol (ProtocolTag) +import Wire.API.MLS.CipherSuite +import Wire.API.Team.Feature + +data AllTeamFeatureConfigsRow = AllTeamFeatureConfigsRow + { -- legalhold + legalhold :: Maybe FeatureStatus, + -- sso + sso :: Maybe FeatureStatus, + -- search visibility + searchVisibility :: Maybe FeatureStatus, + -- validate saml emails + validateSamlEmails :: Maybe FeatureStatus, + -- digital signatures + digitalSignatures :: Maybe FeatureStatus, + -- app lock + appLock :: Maybe FeatureStatus, + appLockEnforce :: Maybe EnforceAppLock, + appLockInactivityTimeoutSecs :: Maybe Int32, + -- file sharing + fileSharing :: Maybe FeatureStatus, + fileSharingLock :: Maybe LockStatus, + -- self deleting messages + selfDeletingMessages :: Maybe FeatureStatus, + selfDeletingMessagesTtl :: Maybe Int32, + selfDeletingMessagesLock :: Maybe LockStatus, + -- conference calling + conferenceCalling :: Maybe FeatureStatus, + conferenceCallingTtl :: Maybe FeatureTTL, + -- guest links + guestLinks :: Maybe FeatureStatus, + guestLinksLock :: Maybe LockStatus, + -- snd factor + sndFactor :: Maybe FeatureStatus, + sndFactorLock :: Maybe LockStatus, + -- mls + mls :: Maybe FeatureStatus, + mlsDefaultProtocol :: Maybe ProtocolTag, + mlsToggleUsers :: Maybe (C.Set UserId), + mlsAllowedCipherSuites :: Maybe (C.Set CipherSuiteTag), + mlsDefaultCipherSuite :: Maybe CipherSuiteTag, + mlsSupportedProtocols :: Maybe (C.Set ProtocolTag), + mlsLock :: Maybe LockStatus, + -- mls e2eid + mlsE2eid :: Maybe FeatureStatus, + mlsE2eidGracePeriod :: Maybe Int32, + mlsE2eidAcmeDiscoverUrl :: Maybe HttpsUrl, + mlsE2eidLock :: Maybe LockStatus, + -- mls migration + mlsMigration :: Maybe FeatureStatus, + mlsMigrationStartTime :: Maybe UTCTime, + mlsMigrationFinalizeRegardlessAfter :: Maybe UTCTime, + mlsMigrationLock :: Maybe LockStatus, + -- expose invitation urls + exposeInvitationUrls :: Maybe FeatureStatus, + -- outlook calendar integration + outlookCalIntegration :: Maybe FeatureStatus, + outlookCalIntegrationLock :: Maybe LockStatus, + -- enforce download location + enforceDownloadLocation :: Maybe FeatureStatus, + enforceDownloadLocation_Location :: Maybe Text, + enforceDownloadLocationLock :: Maybe LockStatus, + -- limit event fanout + limitEventFanout :: Maybe FeatureStatus + } + deriving (Generic, Show) + +recordInstance ''AllTeamFeatureConfigsRow + +emptyRow :: AllTeamFeatureConfigsRow +emptyRow = + AllTeamFeatureConfigsRow + { legalhold = Nothing, + sso = Nothing, + searchVisibility = Nothing, + validateSamlEmails = Nothing, + digitalSignatures = Nothing, + appLock = Nothing, + appLockEnforce = Nothing, + appLockInactivityTimeoutSecs = Nothing, + fileSharing = Nothing, + fileSharingLock = Nothing, + selfDeletingMessages = Nothing, + selfDeletingMessagesTtl = Nothing, + selfDeletingMessagesLock = Nothing, + conferenceCalling = Nothing, + conferenceCallingTtl = Nothing, + guestLinks = Nothing, + guestLinksLock = Nothing, + sndFactor = Nothing, + sndFactorLock = Nothing, + mls = Nothing, + mlsDefaultProtocol = Nothing, + mlsToggleUsers = Nothing, + mlsAllowedCipherSuites = Nothing, + mlsDefaultCipherSuite = Nothing, + mlsSupportedProtocols = Nothing, + mlsLock = Nothing, + mlsE2eid = Nothing, + mlsE2eidGracePeriod = Nothing, + mlsE2eidAcmeDiscoverUrl = Nothing, + mlsE2eidLock = Nothing, + mlsMigration = Nothing, + mlsMigrationStartTime = Nothing, + mlsMigrationFinalizeRegardlessAfter = Nothing, + mlsMigrationLock = Nothing, + exposeInvitationUrls = Nothing, + outlookCalIntegration = Nothing, + outlookCalIntegrationLock = Nothing, + enforceDownloadLocation = Nothing, + enforceDownloadLocation_Location = Nothing, + enforceDownloadLocationLock = Nothing, + limitEventFanout = Nothing + } + +allFeatureConfigsFromRow :: + -- id of team of which we want to see the feature + TeamId -> + -- team id list is from "settings.exposeInvitationURLsTeamAllowlist" + Maybe [TeamId] -> + FeatureLegalHold -> + Bool -> + AllFeatureConfigs -> + AllTeamFeatureConfigsRow -> + AllFeatureConfigs +allFeatureConfigsFromRow ourteam allowListForExposeInvitationURLs featureLH hasTeamImplicitLegalhold serverConfigs row = + AllFeatureConfigs + { afcLegalholdStatus = legalholdComputeFeatureStatus row.legalhold, + afcSSOStatus = + computeConfig + row.sso + Nothing + FeatureTTLUnlimited + (Just SSOConfig) + serverConfigs.afcSSOStatus, + afcTeamSearchVisibilityAvailable = + computeConfig + row.searchVisibility + Nothing + FeatureTTLUnlimited + (Just SearchVisibilityAvailableConfig) + serverConfigs.afcTeamSearchVisibilityAvailable, + afcSearchVisibilityInboundConfig = + computeConfig + row.searchVisibility + Nothing + FeatureTTLUnlimited + (Just SearchVisibilityInboundConfig) + serverConfigs.afcSearchVisibilityInboundConfig, + afcValidateSAMLEmails = + computeConfig + row.validateSamlEmails + Nothing + FeatureTTLUnlimited + (Just ValidateSAMLEmailsConfig) + serverConfigs.afcValidateSAMLEmails, + afcDigitalSignatures = + computeConfig + row.digitalSignatures + Nothing + FeatureTTLUnlimited + (Just DigitalSignaturesConfig) + serverConfigs.afcDigitalSignatures, + afcAppLock = + computeConfig + row.appLock + Nothing + FeatureTTLUnlimited + appLockConfig + serverConfigs.afcAppLock, + afcFileSharing = + computeConfig + row.fileSharing + row.fileSharingLock + FeatureTTLUnlimited + (Just FileSharingConfig) + serverConfigs.afcFileSharing, + afcClassifiedDomains = + computeConfig Nothing Nothing FeatureTTLUnlimited Nothing serverConfigs.afcClassifiedDomains, + afcConferenceCalling = + computeConfig + row.conferenceCalling + Nothing + (fromMaybe FeatureTTLUnlimited row.conferenceCallingTtl) + (Just ConferenceCallingConfig) + serverConfigs.afcConferenceCalling, + afcSelfDeletingMessages = + computeConfig + row.selfDeletingMessages + row.selfDeletingMessagesLock + FeatureTTLUnlimited + selfDeletingMessagesConfig + serverConfigs.afcSelfDeletingMessages, + afcGuestLink = + computeConfig + row.guestLinks + row.guestLinksLock + FeatureTTLUnlimited + (Just GuestLinksConfig) + serverConfigs.afcGuestLink, + afcSndFactorPasswordChallenge = + computeConfig + row.sndFactor + row.sndFactorLock + FeatureTTLUnlimited + (Just SndFactorPasswordChallengeConfig) + serverConfigs.afcSndFactorPasswordChallenge, + afcMLS = + computeConfig + row.mls + row.mlsLock + FeatureTTLUnlimited + mlsConfig + serverConfigs.afcMLS, + afcExposeInvitationURLsToTeamAdmin = exposeInvitationURLsComputeFeatureStatus row.exposeInvitationUrls, + afcOutlookCalIntegration = + computeConfig + row.outlookCalIntegration + row.outlookCalIntegrationLock + FeatureTTLUnlimited + (Just OutlookCalIntegrationConfig) + serverConfigs.afcOutlookCalIntegration, + afcMlsE2EId = + computeConfig + row.mlsE2eid + row.mlsE2eidLock + FeatureTTLUnlimited + mlsE2eidConfig + serverConfigs.afcMlsE2EId, + afcMlsMigration = + computeConfig + row.mlsMigration + row.mlsMigrationLock + FeatureTTLUnlimited + mlsMigrationConfig + serverConfigs.afcMlsMigration, + afcEnforceFileDownloadLocation = + computeConfig + row.enforceDownloadLocation + row.enforceDownloadLocationLock + FeatureTTLUnlimited + downloadLocationConfig + serverConfigs.afcEnforceFileDownloadLocation, + afcLimitedEventFanout = + computeConfig + row.limitEventFanout + Nothing + FeatureTTLUnlimited + (Just LimitedEventFanoutConfig) + serverConfigs.afcLimitedEventFanout + } + where + computeConfig :: Maybe FeatureStatus -> Maybe LockStatus -> FeatureTTL -> Maybe cfg -> WithStatus cfg -> WithStatus cfg + computeConfig mDbStatus mDbLock dbTtl mDbCfg serverCfg = + let withStatusNoLock = case (mDbStatus, mDbCfg) of + (Just dbStatus, Just dbCfg) -> + Just $ + WithStatusNoLock + { wssTTL = dbTtl, + wssStatus = dbStatus, + wssConfig = dbCfg + } + _ -> Nothing + in computeFeatureConfigForTeamUser withStatusNoLock mDbLock serverCfg + + -- FUTUREWORK: the following lines are duplicated in + -- "Galley.Cassandra.TeamFeatures"; make sure the pairs don't diverge! + appLockConfig = AppLockConfig <$> row.appLockEnforce <*> row.appLockInactivityTimeoutSecs + + selfDeletingMessagesConfig = SelfDeletingMessagesConfig <$> row.selfDeletingMessagesTtl + + mlsConfig = + MLSConfig + <$> maybe (Just []) (Just . C.fromSet) row.mlsToggleUsers + <*> row.mlsDefaultProtocol + <*> maybe (Just []) (Just . C.fromSet) row.mlsAllowedCipherSuites + <*> row.mlsDefaultCipherSuite + <*> maybe (Just []) (Just . C.fromSet) row.mlsSupportedProtocols + + mlsE2eidConfig = + Just $ + MlsE2EIdConfig + (toGracePeriodOrDefault row.mlsE2eidGracePeriod) + row.mlsE2eidAcmeDiscoverUrl + where + toGracePeriodOrDefault :: Maybe Int32 -> NominalDiffTime + toGracePeriodOrDefault = maybe (verificationExpiration $ wsConfig defFeatureStatus) fromIntegral + + mlsMigrationConfig = + Just $ + MlsMigrationConfig + { startTime = row.mlsMigrationStartTime, + finaliseRegardlessAfter = row.mlsMigrationFinalizeRegardlessAfter + } + + downloadLocationConfig = Just $ EnforceFileDownloadLocationConfig row.enforceDownloadLocation_Location + + -- FUTUREWORK: this duplicates logic hidden elsewhere for the other getters and setters. do not change lightly! + exposeInvitationURLsComputeFeatureStatus :: + Maybe FeatureStatus -> + WithStatus ExposeInvitationURLsToTeamAdminConfig + exposeInvitationURLsComputeFeatureStatus mFeatureStatus = + if ourteam `elem` fromMaybe [] allowListForExposeInvitationURLs + then + serverConfigs.afcExposeInvitationURLsToTeamAdmin + & maybe id setStatus mFeatureStatus + & setLockStatus LockStatusUnlocked + else serverConfigs.afcExposeInvitationURLsToTeamAdmin + + -- FUTUREWORK: this duplicates logic hidden elsewhere for the other getters and setters. do not change lightly! + legalholdComputeFeatureStatus :: Maybe FeatureStatus -> WithStatus LegalholdConfig + legalholdComputeFeatureStatus mStatusValue = setStatus status defFeatureStatus + where + status = + if isLegalHoldEnabledForTeam + then FeatureStatusEnabled + else FeatureStatusDisabled + isLegalHoldEnabledForTeam = + case featureLH of + FeatureLegalHoldDisabledPermanently -> False + FeatureLegalHoldDisabledByDefault -> maybe False ((==) FeatureStatusEnabled) mStatusValue + FeatureLegalHoldWhitelistTeamsAndImplicitConsent -> hasTeamImplicitLegalhold + +getAllFeatureConfigs :: MonadClient m => Maybe [TeamId] -> FeatureLegalHold -> Bool -> AllFeatureConfigs -> TeamId -> m AllFeatureConfigs +getAllFeatureConfigs allowListForExposeInvitationURLs featureLH hasTeamImplicitLegalhold serverConfigs tid = do + mRow <- retry x1 $ query1 select (params LocalQuorum (Identity tid)) + pure + $ allFeatureConfigsFromRow + tid + allowListForExposeInvitationURLs + featureLH + hasTeamImplicitLegalhold + serverConfigs + $ maybe emptyRow asRecord mRow + where + select :: + PrepQuery + R + (Identity TeamId) + (TupleType AllTeamFeatureConfigsRow) + select = + "select \ + \legalhold_status, \ + \sso_status, \ + \search_visibility_status, \ + \validate_saml_emails, \ + \digital_signatures, \ + \app_lock_status, app_lock_enforce, app_lock_inactivity_timeout_secs, \ + \file_sharing, file_sharing_lock_status, \ + \self_deleting_messages_status, self_deleting_messages_ttl, self_deleting_messages_lock_status, \ + \conference_calling, ttl(conference_calling), \ + \guest_links_status, guest_links_lock_status, \ + \snd_factor_password_challenge_status, snd_factor_password_challenge_lock_status, \ + \\ + \mls_status, mls_default_protocol, mls_protocol_toggle_users, mls_allowed_ciphersuites, \ + \mls_default_ciphersuite, mls_supported_protocols, mls_lock_status, \ + \\ + \mls_e2eid_status, mls_e2eid_grace_period, mls_e2eid_acme_discovery_url, mls_e2eid_lock_status, \ + \\ + \mls_migration_status, mls_migration_start_time, mls_migration_finalise_regardless_after, \ + \mls_migration_lock_status, \ + \\ + \expose_invitation_urls_to_team_admin, \ + \outlook_cal_integration_status, outlook_cal_integration_lock_status, \ + \enforce_file_download_location_status, enforce_file_download_location, enforce_file_download_location_lock_status, \ + \limited_event_fanout_status \ + \from team_features where team_id = ?" diff --git a/services/galley/src/Galley/Cassandra/Instances.hs b/services/galley/src/Galley/Cassandra/Instances.hs index 7e9c9f43406..d1911434dd4 100644 --- a/services/galley/src/Galley/Cassandra/Instances.hs +++ b/services/galley/src/Galley/Cassandra/Instances.hs @@ -27,13 +27,11 @@ import Cassandra.CQL import Control.Error (note) import Data.ByteString.Conversion import Data.ByteString.Lazy qualified as LBS -import Data.Domain (Domain, domainText, mkDomain) import Data.Either.Combinators hiding (fromRight) import Data.Text qualified as T import Data.Text.Encoding qualified as T import Galley.Types.Bot () import Imports -import Wire.API.Asset (AssetKey, assetKeyToText) import Wire.API.Conversation import Wire.API.Conversation.Protocol import Wire.API.MLS.CipherSuite @@ -164,12 +162,6 @@ instance Cql TeamSearchVisibility where toCql SearchVisibilityStandard = CqlInt 0 toCql SearchVisibilityNoNameOutsideTeam = CqlInt 1 -instance Cql Domain where - ctype = Tagged TextColumn - toCql = CqlText . domainText - fromCql (CqlText txt) = mkDomain txt - fromCql _ = Left "Domain: Text expected" - instance Cql Public.EnforceAppLock where ctype = Tagged IntColumn toCql (Public.EnforceAppLock False) = CqlInt 0 @@ -214,28 +206,12 @@ instance Cql Icon where fromCql (CqlText txt) = pure . fromRight DefaultIcon . runParser parser . T.encodeUtf8 $ txt fromCql _ = Left "Icon: Text expected" -instance Cql AssetKey where - ctype = Tagged TextColumn - toCql = CqlText . assetKeyToText - fromCql (CqlText txt) = runParser parser . T.encodeUtf8 $ txt - fromCql _ = Left "AssetKey: Text expected" - instance Cql Epoch where ctype = Tagged BigIntColumn toCql = CqlBigInt . fromIntegral . epochNumber fromCql (CqlBigInt n) = pure (Epoch (fromIntegral n)) fromCql _ = Left "epoch: bigint expected" -instance Cql CipherSuiteTag where - ctype = Tagged IntColumn - toCql = CqlInt . fromIntegral . cipherSuiteNumber . tagCipherSuite - - fromCql (CqlInt index) = - case cipherSuiteTag (CipherSuite (fromIntegral index)) of - Just tag -> Right tag - Nothing -> Left "CipherSuiteTag: unexpected index" - fromCql _ = Left "CipherSuiteTag: int expected" - instance Cql ProposalRef where ctype = Tagged BlobColumn toCql = CqlBlob . LBS.fromStrict . unProposalRef diff --git a/services/galley/src/Galley/Cassandra/LegalHold.hs b/services/galley/src/Galley/Cassandra/LegalHold.hs index db37db2657f..ccc4b9c53f5 100644 --- a/services/galley/src/Galley/Cassandra/LegalHold.hs +++ b/services/galley/src/Galley/Cassandra/LegalHold.hs @@ -38,6 +38,7 @@ import Data.Misc import Galley.Cassandra.Instances () import Galley.Cassandra.Queries qualified as Q import Galley.Cassandra.Store +import Galley.Cassandra.Util import Galley.Effects.LegalHoldStore (LegalHoldStore (..)) import Galley.Env import Galley.External.LegalHoldService.Internal @@ -50,6 +51,7 @@ import OpenSSL.PEM qualified as SSL import OpenSSL.RSA qualified as SSL import Polysemy import Polysemy.Input +import Polysemy.TinyLog import Ssl.Util qualified as SSL import Wire.API.Provider.Service import Wire.API.User.Client.Prekey @@ -57,28 +59,53 @@ import Wire.API.User.Client.Prekey interpretLegalHoldStoreToCassandra :: ( Member (Embed IO) r, Member (Input ClientState) r, - Member (Input Env) r + Member (Input Env) r, + Member TinyLog r ) => FeatureLegalHold -> Sem (LegalHoldStore ': r) a -> Sem r a interpretLegalHoldStoreToCassandra lh = interpret $ \case - CreateSettings s -> embedClient $ createSettings s - GetSettings tid -> embedClient $ getSettings tid - RemoveSettings tid -> embedClient $ removeSettings tid - InsertPendingPrekeys uid pkeys -> embedClient $ insertPendingPrekeys uid pkeys - SelectPendingPrekeys uid -> embedClient $ selectPendingPrekeys uid - DropPendingPrekeys uid -> embedClient $ dropPendingPrekeys uid - SetUserLegalHoldStatus tid uid st -> embedClient $ setUserLegalHoldStatus tid uid st - SetTeamLegalholdWhitelisted tid -> embedClient $ setTeamLegalholdWhitelisted tid - UnsetTeamLegalholdWhitelisted tid -> embedClient $ unsetTeamLegalholdWhitelisted tid - IsTeamLegalholdWhitelisted tid -> embedClient $ isTeamLegalholdWhitelisted lh tid + CreateSettings s -> do + logEffect "LegalHoldStore.CreateSettings" + embedClient $ createSettings s + GetSettings tid -> do + logEffect "LegalHoldStore.GetSettings" + embedClient $ getSettings tid + RemoveSettings tid -> do + logEffect "LegalHoldStore.RemoveSettings" + embedClient $ removeSettings tid + InsertPendingPrekeys uid pkeys -> do + logEffect "LegalHoldStore.InsertPendingPrekeys" + embedClient $ insertPendingPrekeys uid pkeys + SelectPendingPrekeys uid -> do + logEffect "LegalHoldStore.SelectPendingPrekeys" + embedClient $ selectPendingPrekeys uid + DropPendingPrekeys uid -> do + logEffect "LegalHoldStore.DropPendingPrekeys" + embedClient $ dropPendingPrekeys uid + SetUserLegalHoldStatus tid uid st -> do + logEffect "LegalHoldStore.SetUserLegalHoldStatus" + embedClient $ setUserLegalHoldStatus tid uid st + SetTeamLegalholdWhitelisted tid -> do + logEffect "LegalHoldStore.SetTeamLegalholdWhitelisted" + embedClient $ setTeamLegalholdWhitelisted tid + UnsetTeamLegalholdWhitelisted tid -> do + logEffect "LegalHoldStore.UnsetTeamLegalholdWhitelisted" + embedClient $ unsetTeamLegalholdWhitelisted tid + IsTeamLegalholdWhitelisted tid -> do + logEffect "LegalHoldStore.IsTeamLegalholdWhitelisted" + embedClient $ isTeamLegalholdWhitelisted lh tid -- FUTUREWORK: should this action be part of a separate effect? - MakeVerifiedRequestFreshManager fpr url r -> + MakeVerifiedRequestFreshManager fpr url r -> do + logEffect "LegalHoldStore.MakeVerifiedRequestFreshManager" embedApp $ makeVerifiedRequestFreshManager fpr url r - MakeVerifiedRequest fpr url r -> + MakeVerifiedRequest fpr url r -> do + logEffect "LegalHoldStore.MakeVerifiedRequest" embedApp $ makeVerifiedRequest fpr url r - ValidateServiceKey sk -> embed @IO $ validateServiceKey sk + ValidateServiceKey sk -> do + logEffect "LegalHoldStore.ValidateServiceKey" + embed @IO $ validateServiceKey sk -- | Returns 'False' if legal hold is not enabled for this team -- The Caller is responsible for checking whether legal hold is enabled for this team diff --git a/services/galley/src/Galley/Cassandra/Proposal.hs b/services/galley/src/Galley/Cassandra/Proposal.hs index 04263a234c2..68aae2e0f07 100644 --- a/services/galley/src/Galley/Cassandra/Proposal.hs +++ b/services/galley/src/Galley/Cassandra/Proposal.hs @@ -25,10 +25,12 @@ import Cassandra import Data.Timeout import Galley.Cassandra.Instances () import Galley.Cassandra.Store +import Galley.Cassandra.Util import Galley.Effects.ProposalStore import Imports import Polysemy import Polysemy.Input +import Polysemy.TinyLog import Wire.API.MLS.Epoch import Wire.API.MLS.Group import Wire.API.MLS.Proposal @@ -40,24 +42,28 @@ defaultTTL = 28 # Day interpretProposalStoreToCassandra :: ( Member (Embed IO) r, - Member (Input ClientState) r + Member (Input ClientState) r, + Member TinyLog r ) => Sem (ProposalStore ': r) a -> Sem r a -interpretProposalStoreToCassandra = - interpret $ - embedClient . \case - StoreProposal groupId epoch ref origin raw -> - retry x5 $ - write (storeQuery defaultTTL) (params LocalQuorum (groupId, epoch, ref, origin, raw)) - GetProposal groupId epoch ref -> - runIdentity <$$> retry x1 (query1 getQuery (params LocalQuorum (groupId, epoch, ref))) - GetAllPendingProposalRefs groupId epoch -> - runIdentity <$$> retry x1 (query getAllPendingRef (params LocalQuorum (groupId, epoch))) - GetAllPendingProposals groupId epoch -> - retry x1 (query getAllPending (params LocalQuorum (groupId, epoch))) - DeleteAllProposals groupId -> - retry x5 (write deleteAllProposalsForGroup (params LocalQuorum (Identity groupId))) +interpretProposalStoreToCassandra = interpret $ \case + StoreProposal groupId epoch ref origin raw -> do + logEffect "ProposalStore.StoreProposal" + embedClient . retry x5 $ + write (storeQuery defaultTTL) (params LocalQuorum (groupId, epoch, ref, origin, raw)) + GetProposal groupId epoch ref -> do + logEffect "ProposalStore.GetProposal" + embedClient (runIdentity <$$> retry x1 (query1 getQuery (params LocalQuorum (groupId, epoch, ref)))) + GetAllPendingProposalRefs groupId epoch -> do + logEffect "ProposalStore.GetAllPendingProposalRefs" + embedClient (runIdentity <$$> retry x1 (query getAllPendingRef (params LocalQuorum (groupId, epoch)))) + GetAllPendingProposals groupId epoch -> do + logEffect "ProposalStore.GetAllPendingProposals" + embedClient $ retry x1 (query getAllPending (params LocalQuorum (groupId, epoch))) + DeleteAllProposals groupId -> do + logEffect "ProposalStore.DeleteAllProposals" + embedClient $ retry x5 (write deleteAllProposalsForGroup (params LocalQuorum (Identity groupId))) storeQuery :: Timeout -> PrepQuery W (GroupId, Epoch, ProposalRef, ProposalOrigin, RawMLS Proposal) () storeQuery ttl = diff --git a/services/galley/src/Galley/Cassandra/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs index 560d8d9a19f..ef6e26f5a4a 100644 --- a/services/galley/src/Galley/Cassandra/Queries.hs +++ b/services/galley/src/Galley/Cassandra/Queries.hs @@ -305,7 +305,7 @@ deleteConv = "delete from conversation using timestamp 32503680000000000 where c markConvDeleted :: PrepQuery W (Identity ConvId) () markConvDeleted = {- `IF EXISTS`, but that requires benchmarking -} "update conversation set deleted = true where conv = ?" -selectGroupInfo :: PrepQuery R (Identity ConvId) (Identity GroupInfoData) +selectGroupInfo :: PrepQuery R (Identity ConvId) (Identity (Maybe GroupInfoData)) selectGroupInfo = "select public_group_state from conversation where conv = ?" updateGroupInfo :: PrepQuery W (GroupInfoData, ConvId) () diff --git a/services/galley/src/Galley/Cassandra/SearchVisibility.hs b/services/galley/src/Galley/Cassandra/SearchVisibility.hs index 5612739030f..84505b5809a 100644 --- a/services/galley/src/Galley/Cassandra/SearchVisibility.hs +++ b/services/galley/src/Galley/Cassandra/SearchVisibility.hs @@ -22,22 +22,31 @@ import Data.Id import Galley.Cassandra.Instances () import Galley.Cassandra.Queries import Galley.Cassandra.Store +import Galley.Cassandra.Util import Galley.Effects.SearchVisibilityStore (SearchVisibilityStore (..)) import Imports import Polysemy import Polysemy.Input +import Polysemy.TinyLog import Wire.API.Team.SearchVisibility interpretSearchVisibilityStoreToCassandra :: ( Member (Embed IO) r, - Member (Input ClientState) r + Member (Input ClientState) r, + Member TinyLog r ) => Sem (SearchVisibilityStore ': r) a -> Sem r a interpretSearchVisibilityStoreToCassandra = interpret $ \case - GetSearchVisibility tid -> embedClient $ getSearchVisibility tid - SetSearchVisibility tid value -> embedClient $ setSearchVisibility tid value - ResetSearchVisibility tid -> embedClient $ resetSearchVisibility tid + GetSearchVisibility tid -> do + logEffect "SearchVisibilityStore.GetSearchVisibility" + embedClient $ getSearchVisibility tid + SetSearchVisibility tid value -> do + logEffect "SearchVisibilityStore.SetSearchVisibility" + embedClient $ setSearchVisibility tid value + ResetSearchVisibility tid -> do + logEffect "SearchVisibilityStore.ResetSearchVisibility" + embedClient $ resetSearchVisibility tid -- | Return whether a given team is allowed to enable/disable sso getSearchVisibility :: MonadClient m => TeamId -> m TeamSearchVisibility diff --git a/services/galley/src/Galley/Cassandra/Services.hs b/services/galley/src/Galley/Cassandra/Services.hs index 17cc86f2cc6..47810380b34 100644 --- a/services/galley/src/Galley/Cassandra/Services.hs +++ b/services/galley/src/Galley/Cassandra/Services.hs @@ -22,6 +22,7 @@ import Control.Lens import Data.Id import Galley.Cassandra.Queries import Galley.Cassandra.Store +import Galley.Cassandra.Util import Galley.Data.Services import Galley.Effects.ServiceStore hiding (deleteService) import Galley.Types.Bot.Service qualified as Bot @@ -29,6 +30,7 @@ import Galley.Types.Conversations.Members (lmService, newMember) import Imports import Polysemy import Polysemy.Input +import Polysemy.TinyLog import Wire.API.Provider.Service hiding (DeleteService) -- FUTUREWORK: support adding bots to a remote conversation @@ -49,14 +51,21 @@ addBotMember s bot cnv = do interpretServiceStoreToCassandra :: ( Member (Embed IO) r, - Member (Input ClientState) r + Member (Input ClientState) r, + Member TinyLog r ) => Sem (ServiceStore ': r) a -> Sem r a interpretServiceStoreToCassandra = interpret $ \case - CreateService s -> embedClient $ insertService s - GetService sr -> embedClient $ lookupService sr - DeleteService sr -> embedClient $ deleteService sr + CreateService s -> do + logEffect "ServiceStore.CreateService" + embedClient $ insertService s + GetService sr -> do + logEffect "ServiceStore.GetService" + embedClient $ lookupService sr + DeleteService sr -> do + logEffect "ServiceStore.DeleteService" + embedClient $ deleteService sr insertService :: MonadClient m => Bot.Service -> m () insertService s = do diff --git a/services/galley/src/Galley/Cassandra/Store.hs b/services/galley/src/Galley/Cassandra/Store.hs index a25fa5ab289..16794523557 100644 --- a/services/galley/src/Galley/Cassandra/Store.hs +++ b/services/galley/src/Galley/Cassandra/Store.hs @@ -21,7 +21,7 @@ module Galley.Cassandra.Store where import Cassandra -import Imports hiding (cs) +import Imports import Polysemy import Polysemy.Input diff --git a/services/galley/src/Galley/Cassandra/SubConversation.hs b/services/galley/src/Galley/Cassandra/SubConversation.hs index 5827435aaa3..4a00cf0a29e 100644 --- a/services/galley/src/Galley/Cassandra/SubConversation.hs +++ b/services/galley/src/Galley/Cassandra/SubConversation.hs @@ -31,10 +31,12 @@ import Galley.API.MLS.Types import Galley.Cassandra.Conversation.MLS import Galley.Cassandra.Queries qualified as Cql import Galley.Cassandra.Store (embedClient) +import Galley.Cassandra.Util import Galley.Effects.SubConversationStore (SubConversationStore (..)) -import Imports hiding (cs) +import Imports import Polysemy import Polysemy.Input +import Polysemy.TinyLog import Wire.API.Conversation.Protocol import Wire.API.MLS.CipherSuite import Wire.API.MLS.Group @@ -124,20 +126,40 @@ listSubConversations cid = do ) interpretSubConversationStoreToCassandra :: - Members '[Embed IO, Input ClientState] r => + ( Member (Embed IO) r, + Member (Input ClientState) r, + Member TinyLog r + ) => Sem (SubConversationStore ': r) a -> Sem r a interpretSubConversationStoreToCassandra = interpret $ \case - CreateSubConversation convId subConvId suite groupId -> + CreateSubConversation convId subConvId suite groupId -> do + logEffect "SubConversationStore.CreateSubConversation" embedClient (insertSubConversation convId subConvId suite groupId) - GetSubConversation convId subConvId -> embedClient (selectSubConversation convId subConvId) - GetSubConversationGroupInfo convId subConvId -> embedClient (selectSubConvGroupInfo convId subConvId) - GetSubConversationEpoch convId subConvId -> embedClient (selectSubConvEpoch convId subConvId) - SetSubConversationGroupInfo convId subConvId mPgs -> embedClient (updateSubConvGroupInfo convId subConvId mPgs) - SetSubConversationEpoch cid sconv epoch -> embedClient $ setEpochForSubConversation cid sconv epoch - SetSubConversationCipherSuite cid sconv cs -> embedClient $ setCipherSuiteForSubConversation cid sconv cs - ListSubConversations cid -> embedClient $ listSubConversations cid - DeleteSubConversation convId subConvId -> embedClient $ deleteSubConversation convId subConvId + GetSubConversation convId subConvId -> do + logEffect "SubConversationStore.GetSubConversation" + embedClient (selectSubConversation convId subConvId) + GetSubConversationGroupInfo convId subConvId -> do + logEffect "SubConversationStore.GetSubConversationGroupInfo" + embedClient (selectSubConvGroupInfo convId subConvId) + GetSubConversationEpoch convId subConvId -> do + logEffect "SubConversationStore.GetSubConversationEpoch" + embedClient (selectSubConvEpoch convId subConvId) + SetSubConversationGroupInfo convId subConvId mPgs -> do + logEffect "SubConversationStore.SetSubConversationGroupInfo" + embedClient (updateSubConvGroupInfo convId subConvId mPgs) + SetSubConversationEpoch cid sconv epoch -> do + logEffect "SubConversationStore.SetSubConversationEpoch" + embedClient (setEpochForSubConversation cid sconv epoch) + SetSubConversationCipherSuite cid sconv cs -> do + logEffect "SubConversationStore.SetSubConversationCipherSuite" + embedClient (setCipherSuiteForSubConversation cid sconv cs) + ListSubConversations cid -> do + logEffect "SubConversationStore.ListSubConversations" + embedClient (listSubConversations cid) + DeleteSubConversation convId subConvId -> do + logEffect "SubConversationStore.DeleteSubConversation" + embedClient (deleteSubConversation convId subConvId) -------------------------------------------------------------------------------- -- Utilities diff --git a/services/galley/src/Galley/Cassandra/Team.hs b/services/galley/src/Galley/Cassandra/Team.hs index f6322b1015e..84b5458d115 100644 --- a/services/galley/src/Galley/Cassandra/Team.hs +++ b/services/galley/src/Galley/Cassandra/Team.hs @@ -44,6 +44,7 @@ import Galley.Cassandra.Conversation qualified as C import Galley.Cassandra.LegalHold (isTeamLegalholdWhitelisted) import Galley.Cassandra.Queries qualified as Cql import Galley.Cassandra.Store +import Galley.Cassandra.Util import Galley.Effects.ListItems import Galley.Effects.TeamMemberStore import Galley.Effects.TeamStore (TeamStore (..)) @@ -54,6 +55,7 @@ import Galley.Types.Teams import Imports hiding (Set, max) import Polysemy import Polysemy.Input +import Polysemy.TinyLog import UnliftIO qualified import Wire.API.Routes.Internal.Galley.TeamsIntra import Wire.API.Team @@ -65,92 +67,160 @@ import Wire.Sem.Paging.Cassandra interpretTeamStoreToCassandra :: ( Member (Embed IO) r, Member (Input Env) r, - Member (Input ClientState) r + Member (Input ClientState) r, + Member TinyLog r ) => FeatureLegalHold -> Sem (TeamStore ': r) a -> Sem r a interpretTeamStoreToCassandra lh = interpret $ \case - CreateTeamMember tid mem -> embedClient $ addTeamMember tid mem - SetTeamMemberPermissions perm0 tid uid perm1 -> - embedClient $ updateTeamMember perm0 tid uid perm1 - CreateTeam t uid n i k b -> embedClient $ createTeam t uid n i k b - DeleteTeamMember tid uid -> embedClient $ removeTeamMember tid uid - GetBillingTeamMembers tid -> embedClient $ listBillingTeamMembers tid - GetTeamAdmins tid -> embedClient $ listTeamAdmins tid - GetTeam tid -> embedClient $ team tid - GetTeamName tid -> embedClient $ getTeamName tid - GetTeamConversation tid cid -> embedClient $ teamConversation tid cid - GetTeamConversations tid -> embedClient $ getTeamConversations tid - SelectTeams uid tids -> embedClient $ teamIdsOf uid tids - GetTeamMember tid uid -> embedClient $ teamMember lh tid uid - GetTeamMembersWithLimit tid n -> embedClient $ teamMembersWithLimit lh tid n - GetTeamMembers tid -> embedClient $ teamMembersCollectedWithPagination lh tid - SelectTeamMembers tid uids -> embedClient $ teamMembersLimited lh tid uids - GetUserTeams uid -> embedClient $ userTeams uid - GetUsersTeams uids -> embedClient $ usersTeams uids - GetOneUserTeam uid -> embedClient $ oneUserTeam uid - GetTeamsBindings tid -> embedClient $ getTeamsBindings tid - GetTeamBinding tid -> embedClient $ getTeamBinding tid - GetTeamCreationTime tid -> embedClient $ teamCreationTime tid - DeleteTeam tid -> embedClient $ deleteTeam tid - DeleteTeamConversation tid cid -> embedClient $ removeTeamConv tid cid - SetTeamData tid upd -> embedClient $ updateTeam tid upd - SetTeamStatus tid st -> embedClient $ updateTeamStatus tid st - FanoutLimit -> embedApp $ currentFanoutLimit <$> view options - GetLegalHoldFlag -> + CreateTeamMember tid mem -> do + logEffect "TeamStore.CreateTeamMember" + embedClient (addTeamMember tid mem) + SetTeamMemberPermissions perm0 tid uid perm1 -> do + logEffect "TeamStore.SetTeamMemberPermissions" + embedClient (updateTeamMember perm0 tid uid perm1) + CreateTeam t uid n i k b -> do + logEffect "TeamStore.CreateTeam" + embedClient (createTeam t uid n i k b) + DeleteTeamMember tid uid -> do + logEffect "TeamStore.DeleteTeamMember" + embedClient (removeTeamMember tid uid) + GetBillingTeamMembers tid -> do + logEffect "TeamStore.GetBillingTeamMembers" + embedClient (listBillingTeamMembers tid) + GetTeamAdmins tid -> do + logEffect "TeamStore.GetTeamAdmins" + embedClient (listTeamAdmins tid) + GetTeam tid -> do + logEffect "TeamStore.GetTeam" + embedClient (team tid) + GetTeamName tid -> do + logEffect "TeamStore.GetTeamName" + embedClient (getTeamName tid) + GetTeamConversation tid cid -> do + logEffect "TeamStore.GetTeamConversation" + embedClient (teamConversation tid cid) + GetTeamConversations tid -> do + logEffect "TeamStore.GetTeamConversations" + embedClient (getTeamConversations tid) + SelectTeams uid tids -> do + logEffect "TeamStore.SelectTeams" + embedClient (teamIdsOf uid tids) + GetTeamMember tid uid -> do + logEffect "TeamStore.GetTeamMember" + embedClient (teamMember lh tid uid) + GetTeamMembersWithLimit tid n -> do + logEffect "TeamStore.GetTeamMembersWithLimit" + embedClient (teamMembersWithLimit lh tid n) + GetTeamMembers tid -> do + logEffect "TeamStore.GetTeamMembers" + embedClient (teamMembersCollectedWithPagination lh tid) + SelectTeamMembers tid uids -> do + logEffect "TeamStore.SelectTeamMembers" + embedClient (teamMembersLimited lh tid uids) + GetUserTeams uid -> do + logEffect "TeamStore.GetUserTeams" + embedClient (userTeams uid) + GetUsersTeams uids -> do + logEffect "TeamStore.GetUsersTeams" + embedClient (usersTeams uids) + GetOneUserTeam uid -> do + logEffect "TeamStore.GetOneUserTeam" + embedClient (oneUserTeam uid) + GetTeamsBindings tid -> do + logEffect "TeamStore.GetTeamsBindings" + embedClient (getTeamsBindings tid) + GetTeamBinding tid -> do + logEffect "TeamStore.GetTeamBinding" + embedClient (getTeamBinding tid) + GetTeamCreationTime tid -> do + logEffect "TeamStore.GetTeamCreationTime" + embedClient (teamCreationTime tid) + DeleteTeam tid -> do + logEffect "TeamStore.DeleteTeam" + embedClient (deleteTeam tid) + DeleteTeamConversation tid cid -> do + logEffect "TeamStore.DeleteTeamConversation" + embedClient (removeTeamConv tid cid) + SetTeamData tid upd -> do + logEffect "TeamStore.SetTeamData" + embedClient (updateTeam tid upd) + SetTeamStatus tid st -> do + logEffect "TeamStore.SetTeamStatus" + embedClient (updateTeamStatus tid st) + FanoutLimit -> do + logEffect "TeamStore.FanoutLimit" + embedApp (currentFanoutLimit <$> view options) + GetLegalHoldFlag -> do + logEffect "TeamStore.GetLegalHoldFlag" view (options . settings . featureFlags . flagLegalHold) <$> input EnqueueTeamEvent e -> do + logEffect "TeamStore.EnqueueTeamEvent" menv <- inputs (view aEnv) for_ menv $ \env -> - embed @IO $ Aws.execute env (Aws.enqueue e) - SelectTeamMembersPaginated tid uids mps lim -> embedClient $ selectSomeTeamMembersPaginated lh tid uids mps lim + embed @IO (Aws.execute env (Aws.enqueue e)) + SelectTeamMembersPaginated tid uids mps lim -> do + logEffect "TeamStore.SelectTeamMembersPaginated" + embedClient (selectSomeTeamMembersPaginated lh tid uids mps lim) interpretTeamListToCassandra :: ( Member (Embed IO) r, - Member (Input ClientState) r + Member (Input ClientState) r, + Member TinyLog r ) => Sem (ListItems LegacyPaging TeamId ': r) a -> Sem r a interpretTeamListToCassandra = interpret $ \case - ListItems uid ps lim -> embedClient $ teamIdsFrom uid ps lim + ListItems uid ps lim -> do + logEffect "TeamList.ListItems" + embedClient $ teamIdsFrom uid ps lim interpretInternalTeamListToCassandra :: ( Member (Embed IO) r, - Member (Input ClientState) r + Member (Input ClientState) r, + Member TinyLog r ) => Sem (ListItems InternalPaging TeamId ': r) a -> Sem r a interpretInternalTeamListToCassandra = interpret $ \case - ListItems uid mps lim -> embedClient $ case mps of - Nothing -> do - page <- teamIdsForPagination uid Nothing lim - mkInternalPage page pure - Just ps -> ipNext ps + ListItems uid mps lim -> do + logEffect "InternalTeamList.ListItems" + embedClient $ case mps of + Nothing -> do + page <- teamIdsForPagination uid Nothing lim + mkInternalPage page pure + Just ps -> ipNext ps interpretTeamMemberStoreToCassandra :: ( Member (Embed IO) r, - Member (Input ClientState) r + Member (Input ClientState) r, + Member TinyLog r ) => FeatureLegalHold -> Sem (TeamMemberStore InternalPaging ': r) a -> Sem r a interpretTeamMemberStoreToCassandra lh = interpret $ \case - ListTeamMembers tid mps lim -> embedClient $ case mps of - Nothing -> do - page <- teamMembersForPagination tid Nothing lim - mkInternalPage page (newTeamMember' lh tid) - Just ps -> ipNext ps + ListTeamMembers tid mps lim -> do + logEffect "TeamMemberStore.ListTeamMembers" + embedClient $ case mps of + Nothing -> do + page <- teamMembersForPagination tid Nothing lim + mkInternalPage page (newTeamMember' lh tid) + Just ps -> ipNext ps interpretTeamMemberStoreToCassandraWithPaging :: ( Member (Embed IO) r, - Member (Input ClientState) r + Member (Input ClientState) r, + Member TinyLog r ) => FeatureLegalHold -> Sem (TeamMemberStore CassandraPaging ': r) a -> Sem r a interpretTeamMemberStoreToCassandraWithPaging lh = interpret $ \case - ListTeamMembers tid mps lim -> embedClient $ teamMembersPageFrom lh tid mps lim + ListTeamMembers tid mps lim -> do + logEffect "TeamMemberStore.ListTeamMembers" + embedClient $ teamMembersPageFrom lh tid mps lim createTeam :: Maybe TeamId -> diff --git a/services/galley/src/Galley/Cassandra/TeamFeatures.hs b/services/galley/src/Galley/Cassandra/TeamFeatures.hs index 8e33a267a02..dc8e82fe6ce 100644 --- a/services/galley/src/Galley/Cassandra/TeamFeatures.hs +++ b/services/galley/src/Galley/Cassandra/TeamFeatures.hs @@ -18,6 +18,7 @@ module Galley.Cassandra.TeamFeatures ( interpretTeamFeatureStoreToCassandra, getFeatureConfigMulti, + getAllFeatureConfigsForServer, ) where @@ -27,12 +28,19 @@ import Control.Monad.Trans.Maybe import Data.Id import Data.Misc (HttpsUrl) import Data.Time +import Galley.API.Teams.Features.Get +import Galley.Cassandra.GetAllTeamFeatureConfigs import Galley.Cassandra.Instances () import Galley.Cassandra.Store +import Galley.Cassandra.Util +import Galley.Effects (LegalHoldStore) +import Galley.Effects.LegalHoldStore qualified as LH import Galley.Effects.TeamFeatureStore qualified as TFS +import Galley.Types.Teams (FeatureLegalHold) import Imports import Polysemy import Polysemy.Input +import Polysemy.TinyLog import UnliftIO.Async (pooledMapConcurrentlyN) import Wire.API.Conversation.Protocol (ProtocolTag) import Wire.API.MLS.CipherSuite @@ -40,16 +48,42 @@ import Wire.API.Team.Feature interpretTeamFeatureStoreToCassandra :: ( Member (Embed IO) r, - Member (Input ClientState) r + Member (Input ClientState) r, + Member (Input AllFeatureConfigs) r, + Member (Input (Maybe [TeamId], FeatureLegalHold)) r, + Member LegalHoldStore r, + Member TinyLog r ) => Sem (TFS.TeamFeatureStore ': r) a -> Sem r a interpretTeamFeatureStoreToCassandra = interpret $ \case - TFS.GetFeatureConfig sing tid -> embedClient $ getFeatureConfig sing tid - TFS.GetFeatureConfigMulti sing tids -> embedClient $ getFeatureConfigMulti sing tids - TFS.SetFeatureConfig sing tid wsnl -> embedClient $ setFeatureConfig sing tid wsnl - TFS.GetFeatureLockStatus sing tid -> embedClient $ getFeatureLockStatus sing tid - TFS.SetFeatureLockStatus sing tid ls -> embedClient $ setFeatureLockStatus sing tid ls + TFS.GetFeatureConfig sing tid -> do + logEffect "TeamFeatureStore.GetFeatureConfig" + embedClient $ getFeatureConfig sing tid + TFS.GetFeatureConfigMulti sing tids -> do + logEffect "TeamFeatureStore.GetFeatureConfigMulti" + embedClient $ getFeatureConfigMulti sing tids + TFS.SetFeatureConfig sing tid wsnl -> do + logEffect "TeamFeatureStore.SetFeatureConfig" + embedClient $ setFeatureConfig sing tid wsnl + TFS.GetFeatureLockStatus sing tid -> do + logEffect "TeamFeatureStore.GetFeatureLockStatus" + embedClient $ getFeatureLockStatus sing tid + TFS.SetFeatureLockStatus sing tid ls -> do + logEffect "TeamFeatureStore.SetFeatureLockStatus" + embedClient $ setFeatureLockStatus sing tid ls + TFS.GetAllFeatureConfigs tid -> do + logEffect "TeamFeatureStore.GetAllFeatureConfigs" + serverConfigs <- input + (allowListForExposeInvitationURLs, featureLH) <- input + hasTeamImplicitLegalhold <- LH.isTeamLegalholdWhitelisted tid + embedClient $ + getAllFeatureConfigs + allowListForExposeInvitationURLs + featureLH + hasTeamImplicitLegalhold + serverConfigs + tid getFeatureConfig :: MonadClient m => FeatureSingleton cfg -> TeamId -> m (Maybe (WithStatusNoLock cfg)) getFeatureConfig FeatureSingletonLegalholdConfig tid = getTrivialConfigC "legalhold_status" tid @@ -66,6 +100,8 @@ getFeatureConfig FeatureSingletonAppLockConfig tid = runMaybeT $ do WithStatusNoLock <$> mStatus <*> (AppLockConfig <$> mEnforce <*> mTimeout) + -- FUTUREWORK: the above line is duplicated in + -- "Galley.Cassandra.GetAllTeamFeatureConfigs"; make sure the two don't diverge! <*> Just FeatureTTLUnlimited where select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe EnforceAppLock, Maybe Int32) @@ -81,6 +117,8 @@ getFeatureConfig FeatureSingletonSelfDeletingMessagesConfig tid = runMaybeT $ do WithStatusNoLock <$> mEnabled <*> fmap SelfDeletingMessagesConfig mTimeout + -- FUTUREWORK: the above line is duplicated in + -- "Galley.Cassandra.GetAllTeamFeatureConfigs"; make sure the two don't diverge! <*> Just FeatureTTLUnlimited where select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe Int32) @@ -92,7 +130,12 @@ getFeatureConfig FeatureSingletonConferenceCallingConfig tid = do retry x1 q <&> \case Nothing -> Nothing Just (Nothing, _) -> Nothing - Just (Just status, mTtl) -> Just . forgetLock . setStatus status . setWsTTL (fromMaybe FeatureTTLUnlimited mTtl) $ defFeatureStatus + Just (Just status, mTtl) -> + Just + . forgetLock + . setStatus status + . setWsTTL (fromMaybe FeatureTTLUnlimited mTtl) + $ defFeatureStatus where select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe FeatureTTL) select = @@ -108,7 +151,9 @@ getFeatureConfig FeatureSingletonMLSConfig tid = do Just (status, defaultProtocol, protocolToggleUsers, allowedCipherSuites, defaultCipherSuite, supportedProtocols) -> WithStatusNoLock <$> status - <*> ( MLSConfig + <*> ( -- FUTUREWORK: this block is duplicated in + -- "Galley.Cassandra.GetAllTeamFeatureConfigs"; make sure the two don't diverge! + MLSConfig <$> maybe (Just []) (Just . C.fromSet) protocolToggleUsers <*> defaultProtocol <*> maybe (Just []) (Just . C.fromSet) allowedCipherSuites @@ -130,7 +175,10 @@ getFeatureConfig FeatureSingletonMlsE2EIdConfig tid = do Just $ WithStatusNoLock fs - (MlsE2EIdConfig (toGracePeriodOrDefault mGracePeriod) mUrl) + ( -- FUTUREWORK: this block is duplicated in + -- "Galley.Cassandra.GetAllTeamFeatureConfigs"; make sure the two don't diverge! + MlsE2EIdConfig (toGracePeriodOrDefault mGracePeriod) mUrl + ) FeatureTTLUnlimited where toGracePeriodOrDefault :: Maybe Int32 -> NominalDiffTime @@ -149,6 +197,8 @@ getFeatureConfig FeatureSingletonMlsMigration tid = do Just $ WithStatusNoLock fs + -- FUTUREWORK: the following expression is duplicated in + -- "Galley.Cassandra.GetAllTeamFeatureConfigs"; make sure the two don't diverge! MlsMigrationConfig { startTime = startTime, finaliseRegardlessAfter = finaliseRegardlessAfter diff --git a/services/galley/src/Galley/Cassandra/TeamNotifications.hs b/services/galley/src/Galley/Cassandra/TeamNotifications.hs index e34762d5458..2138cbd6812 100644 --- a/services/galley/src/Galley/Cassandra/TeamNotifications.hs +++ b/services/galley/src/Galley/Cassandra/TeamNotifications.hs @@ -38,6 +38,7 @@ import Data.Sequence qualified as Seq import Data.Time (nominalDay, nominalDiffTimeToSeconds) import Data.UUID.V1 qualified as UUID import Galley.Cassandra.Store +import Galley.Cassandra.Util import Galley.Data.TeamNotifications import Galley.Effects import Galley.Effects.TeamNotificationStore (TeamNotificationStore (..)) @@ -46,18 +47,26 @@ import Network.HTTP.Types import Network.Wai.Utilities hiding (Error) import Polysemy import Polysemy.Input +import Polysemy.TinyLog hiding (err) import Wire.API.Internal.Notification interpretTeamNotificationStoreToCassandra :: ( Member (Embed IO) r, - Member (Input ClientState) r + Member (Input ClientState) r, + Member TinyLog r ) => Sem (TeamNotificationStore ': r) a -> Sem r a interpretTeamNotificationStoreToCassandra = interpret $ \case - CreateTeamNotification tid nid objs -> embedClient $ add tid nid objs - GetTeamNotifications tid mnid lim -> embedClient $ fetch tid mnid lim - MkNotificationId -> embed mkNotificationId + CreateTeamNotification tid nid objs -> do + logEffect "TeamNotificationStore.CreateTeamNotification" + embedClient $ add tid nid objs + GetTeamNotifications tid mnid lim -> do + logEffect "TeamNotificationStore.GetTeamNotifications" + embedClient $ fetch tid mnid lim + MkNotificationId -> do + logEffect "TeamNotificationStore.MkNotificationId" + embed mkNotificationId -- | 'Data.UUID.V1.nextUUID' is sometimes unsuccessful, so we try a few times. mkNotificationId :: IO NotificationId diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/Token.hs b/services/galley/src/Galley/Cassandra/Util.hs similarity index 72% rename from libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/Token.hs rename to services/galley/src/Galley/Cassandra/Util.hs index 2fa8207ddc9..2e3169fb523 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/Token.hs +++ b/services/galley/src/Galley/Cassandra/Util.hs @@ -15,15 +15,13 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Test.Wire.API.Golden.Manual.Token where +module Galley.Cassandra.Util where -import Data.Id -import Wire.API.Push.V2.Token +import Data.ByteString +import Imports +import Polysemy +import Polysemy.TinyLog +import System.Logger.Message -testObject_Token_1 :: PushToken -testObject_Token_1 = - pushToken - APNSVoIPSandbox - (AppName {appNameText = "j{\110746\SOH_\1084873M"}) - (Token {tokenText = "K"}) - (ClientId {clientToWord64 = 6}) +logEffect :: Member TinyLog r => ByteString -> Sem r () +logEffect = debug . msg . val diff --git a/services/galley/src/Galley/Effects.hs b/services/galley/src/Galley/Effects.hs index fbca2a7e3a3..7138512bd18 100644 --- a/services/galley/src/Galley/Effects.hs +++ b/services/galley/src/Galley/Effects.hs @@ -42,6 +42,7 @@ module Galley.Effects SearchVisibilityStore, ServiceStore, SubConversationStore, + Random, TeamFeatureStore, TeamMemberStore, TeamNotificationStore, @@ -92,11 +93,14 @@ import Galley.Effects.TeamStore import Galley.Effects.WaiRoutes import Galley.Env import Galley.Options +import Galley.Types.Teams (FeatureLegalHold) +import Imports import Polysemy import Polysemy.Error import Polysemy.Input import Polysemy.TinyLog import Wire.API.Error +import Wire.API.Team.Feature (AllFeatureConfigs) import Wire.GundeckAPIAccess import Wire.NotificationSubsystem import Wire.Rpc @@ -122,11 +126,11 @@ type GalleyEffects1 = SubConversationStore, Random, CustomBackendStore, + TeamFeatureStore, LegalHoldStore, MemberStore, SearchVisibilityStore, ServiceStore, - TeamFeatureStore, TeamNotificationStore, TeamStore, TeamMemberStore InternalPaging, @@ -136,6 +140,8 @@ type GalleyEffects1 = ListItems LegacyPaging ConvId, ListItems LegacyPaging TeamId, ListItems InternalPaging TeamId, + Input AllFeatureConfigs, + Input (Maybe [TeamId], FeatureLegalHold), Input (Local ()), Input Opts, WaiRoutes, diff --git a/services/galley/src/Galley/Effects/BackendNotificationQueueAccess.hs b/services/galley/src/Galley/Effects/BackendNotificationQueueAccess.hs index bdefa146314..9c2fe5d4004 100644 --- a/services/galley/src/Galley/Effects/BackendNotificationQueueAccess.hs +++ b/services/galley/src/Galley/Effects/BackendNotificationQueueAccess.hs @@ -1,11 +1,10 @@ -{-# LANGUAGE TemplateHaskell #-} - module Galley.Effects.BackendNotificationQueueAccess where import Data.Qualified import Imports import Network.AMQP qualified as Q import Polysemy +import Polysemy.Error import Wire.API.Federation.BackendNotifications import Wire.API.Federation.Component import Wire.API.Federation.Error @@ -13,8 +12,8 @@ import Wire.API.Federation.Error data BackendNotificationQueueAccess m a where EnqueueNotification :: KnownComponent c => - Remote x -> Q.DeliveryMode -> + Remote x -> FedQueueClient c a -> BackendNotificationQueueAccess m (Either FederationError a) EnqueueNotificationsConcurrently :: @@ -23,5 +22,49 @@ data BackendNotificationQueueAccess m a where f (Remote x) -> (Remote [x] -> FedQueueClient c a) -> BackendNotificationQueueAccess m (Either FederationError [Remote a]) + EnqueueNotificationsConcurrentlyBuckets :: + (KnownComponent c, Foldable f, Functor f) => + Q.DeliveryMode -> + f (Remote x) -> + (Remote x -> FedQueueClient c a) -> + BackendNotificationQueueAccess m (Either FederationError [Remote a]) + +enqueueNotification :: + ( KnownComponent c, + Member (Error FederationError) r, + Member BackendNotificationQueueAccess r + ) => + Q.DeliveryMode -> + Remote x -> + FedQueueClient c a -> + Sem r a +enqueueNotification m r q = send (EnqueueNotification m r q) >>= either throw pure + +enqueueNotificationsConcurrently :: + ( KnownComponent c, + Foldable f, + Functor f, + Member (Error FederationError) r, + Member BackendNotificationQueueAccess r + ) => + Q.DeliveryMode -> + f (Remote x) -> + (Remote [x] -> FedQueueClient c a) -> + Sem r [Remote a] +enqueueNotificationsConcurrently m r q = + send (EnqueueNotificationsConcurrently m r q) + >>= either throw pure -makeSem ''BackendNotificationQueueAccess +enqueueNotificationsConcurrentlyBuckets :: + ( KnownComponent c, + Foldable f, + Functor f, + Member (Error FederationError) r, + Member BackendNotificationQueueAccess r + ) => + Q.DeliveryMode -> + f (Remote x) -> + (Remote x -> FedQueueClient c a) -> + Sem r [Remote a] +enqueueNotificationsConcurrentlyBuckets m r q = + send (EnqueueNotificationsConcurrentlyBuckets m r q) >>= either throw pure diff --git a/services/galley/src/Galley/Effects/FederatorAccess.hs b/services/galley/src/Galley/Effects/FederatorAccess.hs index 8afd28cb842..cfa3b508c76 100644 --- a/services/galley/src/Galley/Effects/FederatorAccess.hs +++ b/services/galley/src/Galley/Effects/FederatorAccess.hs @@ -63,11 +63,11 @@ data FederatorAccess m a where -- already in buckets. The buckets are paired with arbitrary data that affect -- the payload of the request for each remote backend. RunFederatedConcurrentlyBucketsEither :: - forall (c :: Component) a m x y. - (KnownComponent c) => - [(Remote [x], y)] -> - ((Remote [x], y) -> FederatorClient c a) -> - FederatorAccess m [Either (Remote [x], FederationError) (Remote a)] + forall (c :: Component) f a m x. + (KnownComponent c, Foldable f) => + f (Remote x) -> + (Remote x -> FederatorClient c a) -> + FederatorAccess m [Either (Remote x, FederationError) (Remote a)] IsFederationConfigured :: FederatorAccess m Bool makeSem ''FederatorAccess diff --git a/services/galley/src/Galley/Effects/TeamFeatureStore.hs b/services/galley/src/Galley/Effects/TeamFeatureStore.hs index 13a43eea34b..5011d72a3ce 100644 --- a/services/galley/src/Galley/Effects/TeamFeatureStore.hs +++ b/services/galley/src/Galley/Effects/TeamFeatureStore.hs @@ -17,15 +17,7 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Galley.Effects.TeamFeatureStore - ( TeamFeatureStore (..), - getFeatureConfig, - getFeatureConfigMulti, - setFeatureConfig, - getFeatureLockStatus, - setFeatureLockStatus, - ) -where +module Galley.Effects.TeamFeatureStore where import Data.Id import Imports @@ -55,5 +47,8 @@ data TeamFeatureStore m a where TeamId -> LockStatus -> TeamFeatureStore m () + GetAllFeatureConfigs :: + TeamId -> + TeamFeatureStore m AllFeatureConfigs makeSem ''TeamFeatureStore diff --git a/services/galley/src/Galley/Env.hs b/services/galley/src/Galley/Env.hs index ca8f4212f9d..87a0ddbd70f 100644 --- a/services/galley/src/Galley/Env.hs +++ b/services/galley/src/Galley/Env.hs @@ -42,7 +42,6 @@ import OpenSSL.Session as Ssl import Ssl.Util import System.Logger import Util.Options -import Wire.API.MLS.Credential import Wire.API.MLS.Keys import Wire.API.Team.Member import Wire.NotificationSubsystem.Interpreter @@ -64,7 +63,7 @@ data Env = Env _deleteQueue :: Q.Queue DeleteItem, _extEnv :: ExtEnv, _aEnv :: Maybe Aws.Env, - _mlsKeys :: SignaturePurpose -> MLSKeys, + _mlsKeys :: Maybe (MLSKeysByPurpose MLSPrivateKeys), _rabbitmqChannel :: Maybe (MVar Q.Channel), _convCodeURI :: Either HttpsUrl (Map Text HttpsUrl) } diff --git a/services/galley/src/Galley/External.hs b/services/galley/src/Galley/External.hs index 605ac731d0e..c1bf5eecc48 100644 --- a/services/galley/src/Galley/External.hs +++ b/services/galley/src/Galley/External.hs @@ -26,6 +26,7 @@ import Data.ByteString.Conversion.To import Data.Id import Data.Misc import Galley.Cassandra.Services +import Galley.Cassandra.Util import Galley.Data.Services (BotMember, botMemId, botMemService) import Galley.Effects import Galley.Effects.ExternalAccess (ExternalAccess (..)) @@ -39,6 +40,7 @@ import Network.HTTP.Types.Method import Network.HTTP.Types.Status (status410) import Polysemy import Polysemy.Input +import Polysemy.TinyLog import Ssl.Util (withVerifiedSslConnection) import System.Logger.Class qualified as Log import System.Logger.Message (field, msg, val, (~~)) @@ -49,14 +51,21 @@ import Wire.API.Provider.Service (serviceRefId, serviceRefProvider) interpretExternalAccess :: ( Member (Embed IO) r, - Member (Input Env) r + Member (Input Env) r, + Member TinyLog r ) => Sem (ExternalAccess ': r) a -> Sem r a interpretExternalAccess = interpret $ \case - Deliver pp -> embedApp $ deliver (toList pp) - DeliverAsync pp -> embedApp $ deliverAsync (toList pp) - DeliverAndDeleteAsync cid pp -> embedApp $ deliverAndDeleteAsync cid (toList pp) + Deliver pp -> do + logEffect "ExternalAccess.Deliver" + embedApp $ deliver (toList pp) + DeliverAsync pp -> do + logEffect "ExternalAccess.DeliverAsync" + embedApp $ deliverAsync (toList pp) + DeliverAndDeleteAsync cid pp -> do + logEffect "ExternalAccess.DeliverAndDeleteAsync" + embedApp $ deliverAndDeleteAsync cid (toList pp) -- | Like deliver, but ignore orphaned bots and return immediately. -- diff --git a/services/galley/src/Galley/Intra/BackendNotificationQueue.hs b/services/galley/src/Galley/Intra/BackendNotificationQueue.hs index 316a94dcce7..756ce2379a6 100644 --- a/services/galley/src/Galley/Intra/BackendNotificationQueue.hs +++ b/services/galley/src/Galley/Intra/BackendNotificationQueue.hs @@ -8,6 +8,7 @@ import Control.Monad.Trans.Except import Control.Retry import Data.Domain import Data.Qualified +import Galley.Cassandra.Util import Galley.Effects.BackendNotificationQueueAccess (BackendNotificationQueueAccess (..)) import Galley.Env import Galley.Monad @@ -16,6 +17,7 @@ import Imports import Network.AMQP qualified as Q import Polysemy import Polysemy.Input +import Polysemy.TinyLog import System.Logger.Class qualified as Log import UnliftIO import Wire.API.Federation.BackendNotifications @@ -23,15 +25,21 @@ import Wire.API.Federation.Error interpretBackendNotificationQueueAccess :: ( Member (Embed IO) r, - Member (Input Env) r + Member (Input Env) r, + Member TinyLog r ) => Sem (BackendNotificationQueueAccess ': r) a -> Sem r a interpretBackendNotificationQueueAccess = interpret $ \case - EnqueueNotification remote deliveryMode action -> do - embedApp . runExceptT $ enqueueNotification (tDomain remote) deliveryMode action + EnqueueNotification deliveryMode remote action -> do + logEffect "BackendNotificationQueueAccess.EnqueueNotification" + embedApp . runExceptT $ enqueueNotification deliveryMode (tDomain remote) action EnqueueNotificationsConcurrently m xs rpc -> do + logEffect "BackendNotificationQueueAccess.EnqueueNotificationsConcurrently" embedApp . runExceptT $ enqueueNotificationsConcurrently m xs rpc + EnqueueNotificationsConcurrentlyBuckets m xs rpc -> do + logEffect "BackendNotificationQueueAccess.EnqueueNotificationsConcurrentlyBuckets" + embedApp . runExceptT $ enqueueNotificationsConcurrentlyBuckets m xs rpc getChannel :: ExceptT FederationError App (MVar Q.Channel) getChannel = view rabbitmqChannel >>= maybe (throwE FederationNotConfigured) pure @@ -61,8 +69,8 @@ enqueueSingleNotification remoteDomain deliveryMode chanVar action = do Just chan -> do liftIO $ enqueue chan rid ownDomain remoteDomain deliveryMode action -enqueueNotification :: Domain -> Q.DeliveryMode -> FedQueueClient c a -> ExceptT FederationError App a -enqueueNotification remoteDomain deliveryMode action = do +enqueueNotification :: Q.DeliveryMode -> Domain -> FedQueueClient c a -> ExceptT FederationError App a +enqueueNotification deliveryMode remoteDomain action = do chanVar <- getChannel lift $ enqueueSingleNotification remoteDomain deliveryMode chanVar action @@ -72,11 +80,24 @@ enqueueNotificationsConcurrently :: f (Remote x) -> (Remote [x] -> FedQueueClient c a) -> ExceptT FederationError App [Remote a] -enqueueNotificationsConcurrently m xs f = do - chanVar <- getChannel - lift $ pooledForConcurrentlyN 8 (bucketRemote xs) $ \r -> - qualifyAs r - <$> enqueueSingleNotification (tDomain r) m chanVar (f r) +enqueueNotificationsConcurrently m xs f = + enqueueNotificationsConcurrentlyBuckets m (bucketRemote xs) f + +enqueueNotificationsConcurrentlyBuckets :: + (Foldable f) => + Q.DeliveryMode -> + f (Remote x) -> + (Remote x -> FedQueueClient c a) -> + ExceptT FederationError App [Remote a] +enqueueNotificationsConcurrentlyBuckets m xs f = do + case toList xs of + -- only attempt to get a channel if there is at least one notification to send + [] -> pure [] + _ -> do + chanVar <- getChannel + lift $ pooledForConcurrentlyN 8 (toList xs) $ \r -> + qualifyAs r + <$> enqueueSingleNotification (tDomain r) m chanVar (f r) data NoRabbitMqChannel = NoRabbitMqChannel deriving (Show) diff --git a/services/galley/src/Galley/Intra/Effects.hs b/services/galley/src/Galley/Intra/Effects.hs index 70a78b982a4..ef071400ab0 100644 --- a/services/galley/src/Galley/Intra/Effects.hs +++ b/services/galley/src/Galley/Intra/Effects.hs @@ -23,6 +23,7 @@ module Galley.Intra.Effects where import Galley.API.Error +import Galley.Cassandra.Util import Galley.Effects.BotAccess (BotAccess (..)) import Galley.Effects.BrigAccess (BrigAccess (..)) import Galley.Effects.SparAccess (SparAccess (..)) @@ -36,66 +37,106 @@ import Imports import Polysemy import Polysemy.Error import Polysemy.Input -import Polysemy.TinyLog qualified as P +import Polysemy.TinyLog import UnliftIO qualified interpretBrigAccess :: ( Member (Embed IO) r, Member (Error InternalError) r, - Member P.TinyLog r, + Member TinyLog r, Member (Input Env) r ) => Sem (BrigAccess ': r) a -> Sem r a interpretBrigAccess = interpret $ \case - GetConnectionsUnqualified uids muids mrel -> + GetConnectionsUnqualified uids muids mrel -> do + logEffect "BrigAccess.GetConnectionsUnqualified" embedApp $ getConnectionsUnqualified uids muids mrel - GetConnectionsUnqualifiedBidi uids1 uids2 mrel1 mrel2 -> + GetConnectionsUnqualifiedBidi uids1 uids2 mrel1 mrel2 -> do + logEffect "BrigAccess.GetConnectionsUnqualifiedBidi" embedApp $ UnliftIO.concurrently (getConnectionsUnqualified uids1 (Just uids2) mrel1) (getConnectionsUnqualified uids2 (Just uids1) mrel2) - GetConnections uids mquids mrel -> + GetConnections uids mquids mrel -> do + logEffect "BrigAccess.GetConnections" embedApp $ getConnections uids mquids mrel - PutConnectionInternal uc -> embedApp $ putConnectionInternal uc - ReauthUser uid reauth -> embedApp $ reAuthUser uid reauth - LookupActivatedUsers uids -> embedApp $ lookupActivatedUsers uids - GetUsers uids -> embedApp $ getUsers uids - DeleteUser uid -> embedApp $ deleteUser uid - GetContactList uid -> embedApp $ getContactList uid - GetRichInfoMultiUser uids -> embedApp $ getRichInfoMultiUser uids - GetSize tid -> embedApp $ getSize tid - LookupClients uids -> embedApp $ lookupClients uids - LookupClientsFull uids -> embedApp $ lookupClientsFull uids - NotifyClientsAboutLegalHoldRequest self other pk -> + PutConnectionInternal uc -> do + logEffect "BrigAccess.PutConnectionInternal" + embedApp $ putConnectionInternal uc + ReauthUser uid reauth -> do + logEffect "BrigAccess.ReauthUser" + embedApp $ reAuthUser uid reauth + LookupActivatedUsers uids -> do + logEffect "BrigAccess.LookupActivatedUsers" + embedApp $ lookupActivatedUsers uids + GetUsers uids -> do + logEffect "BrigAccess.GetUsers" + embedApp $ getUsers uids + DeleteUser uid -> do + logEffect "BrigAccess.DeleteUser" + embedApp $ deleteUser uid + GetContactList uid -> do + logEffect "BrigAccess.GetContactList" + embedApp $ getContactList uid + GetRichInfoMultiUser uids -> do + logEffect "BrigAccess.GetRichInfoMultiUser" + embedApp $ getRichInfoMultiUser uids + GetSize tid -> do + logEffect "BrigAccess.GetSize" + embedApp $ getSize tid + LookupClients uids -> do + logEffect "BrigAccess.LookupClients" + embedApp $ lookupClients uids + LookupClientsFull uids -> do + logEffect "BrigAccess.LookupClientsFull" + embedApp $ lookupClientsFull uids + NotifyClientsAboutLegalHoldRequest self other pk -> do + logEffect "BrigAccess.NotifyClientsAboutLegalHoldRequest" embedApp $ notifyClientsAboutLegalHoldRequest self other pk - GetLegalHoldAuthToken uid mpwd -> getLegalHoldAuthToken uid mpwd - AddLegalHoldClientToUserEither uid conn pks lpk -> + GetLegalHoldAuthToken uid mpwd -> do + logEffect "BrigAccess.GetLegalHoldAuthToken" + getLegalHoldAuthToken uid mpwd + AddLegalHoldClientToUserEither uid conn pks lpk -> do + logEffect "BrigAccess.AddLegalHoldClientToUserEither" embedApp $ addLegalHoldClientToUser uid conn pks lpk - RemoveLegalHoldClientFromUser uid -> + RemoveLegalHoldClientFromUser uid -> do + logEffect "BrigAccess.RemoveLegalHoldClientFromUser" embedApp $ removeLegalHoldClientFromUser uid - GetAccountConferenceCallingConfigClient uid -> + GetAccountConferenceCallingConfigClient uid -> do + logEffect "BrigAccess.GetAccountConferenceCallingConfigClient" embedApp $ getAccountConferenceCallingConfigClient uid - GetLocalMLSClients qusr ss -> embedApp $ getLocalMLSClients qusr ss - UpdateSearchVisibilityInbound status -> + GetLocalMLSClients qusr ss -> do + logEffect "BrigAccess.GetLocalMLSClients" + embedApp $ getLocalMLSClients qusr ss + UpdateSearchVisibilityInbound status -> do + logEffect "BrigAccess.UpdateSearchVisibilityInbound" embedApp $ updateSearchVisibilityInbound status interpretSparAccess :: ( Member (Embed IO) r, - Member (Input Env) r + Member (Input Env) r, + Member TinyLog r ) => Sem (SparAccess ': r) a -> Sem r a interpretSparAccess = interpret $ \case - DeleteTeam tid -> embedApp $ deleteTeam tid - LookupScimUserInfos uids -> embedApp $ lookupScimUserInfos uids + DeleteTeam tid -> do + logEffect "SparAccess.DeleteTeam" + embedApp $ deleteTeam tid + LookupScimUserInfos uids -> do + logEffect "SparAccess.LookupScimUserInfos" + embedApp $ lookupScimUserInfos uids interpretBotAccess :: ( Member (Embed IO) r, - Member (Input Env) r + Member (Input Env) r, + Member TinyLog r ) => Sem (BotAccess ': r) a -> Sem r a interpretBotAccess = interpret $ \case - DeleteBot cid bid -> embedApp $ deleteBot cid bid + DeleteBot cid bid -> do + logEffect "BotAccess.DeleteBot" + embedApp $ deleteBot cid bid diff --git a/services/galley/src/Galley/Intra/Federator.hs b/services/galley/src/Galley/Intra/Federator.hs index 6e09422c98a..565cd417d3e 100644 --- a/services/galley/src/Galley/Intra/Federator.hs +++ b/services/galley/src/Galley/Intra/Federator.hs @@ -21,6 +21,7 @@ import Control.Lens import Control.Monad.Except import Data.Bifunctor import Data.Qualified +import Galley.Cassandra.Util import Galley.Effects.FederatorAccess (FederatorAccess (..)) import Galley.Env import Galley.Env qualified as E @@ -29,27 +30,37 @@ import Galley.Options import Imports import Polysemy import Polysemy.Input +import Polysemy.TinyLog import UnliftIO import Wire.API.Federation.Client import Wire.API.Federation.Error interpretFederatorAccess :: ( Member (Embed IO) r, - Member (Input Env) r + Member (Input Env) r, + Member TinyLog r ) => Sem (FederatorAccess ': r) a -> Sem r a interpretFederatorAccess = interpret $ \case - RunFederated dom rpc -> embedApp $ runFederated dom rpc - RunFederatedEither dom rpc -> embedApp $ runFederatedEither dom rpc - RunFederatedConcurrently rs f -> embedApp $ runFederatedConcurrently rs f - RunFederatedConcurrentlyEither rs f -> - embedApp $ - runFederatedConcurrentlyEither rs f - RunFederatedConcurrentlyBucketsEither rs f -> - embedApp $ - runFederatedConcurrentlyBucketsEither rs f - IsFederationConfigured -> embedApp $ isJust <$> view E.federator + RunFederated dom rpc -> do + logEffect "FederatorAccess.RunFederated" + embedApp $ runFederated dom rpc + RunFederatedEither dom rpc -> do + logEffect "FederatorAccess.RunFederatedEither" + embedApp $ runFederatedEither dom rpc + RunFederatedConcurrently rs f -> do + logEffect "FederatorAccess.RunFederatedConcurrently" + embedApp $ runFederatedConcurrently rs f + RunFederatedConcurrentlyEither rs f -> do + logEffect "FederatorAccess.RunFederatedConcurrentlyEither" + embedApp $ runFederatedConcurrentlyEither rs f + RunFederatedConcurrentlyBucketsEither rs f -> do + logEffect "FederatorAccess.RunFederatedConcurrentlyBucketsEither" + embedApp $ runFederatedConcurrentlyBucketsEither rs f + IsFederationConfigured -> do + logEffect "FederatorAccess.IsFederationConfigured" + embedApp $ isJust <$> view E.federator runFederatedEither :: Remote x -> @@ -102,9 +113,10 @@ runFederatedConcurrentlyEither xs rpc = bimap (r,) (qualifyAs r) <$> runFederatedEither r (rpc r) runFederatedConcurrentlyBucketsEither :: - [(Remote [a], y)] -> - ((Remote [a], y) -> FederatorClient c b) -> - App [Either (Remote [a], FederationError) (Remote b)] + Foldable f => + f (Remote x) -> + (Remote x -> FederatorClient c b) -> + App [Either (Remote x, FederationError) (Remote b)] runFederatedConcurrentlyBucketsEither xs rpc = - pooledForConcurrentlyN 8 xs $ \(r, v) -> - bimap (r,) (qualifyAs r) <$> runFederatedEither r (rpc (r, v)) + pooledForConcurrentlyN 8 (toList xs) $ \r -> + bimap (r,) (qualifyAs r) <$> runFederatedEither r (rpc r) diff --git a/services/galley/src/Galley/Intra/User.hs b/services/galley/src/Galley/Intra/User.hs index 01c1dc64ccd..27b3497afae 100644 --- a/services/galley/src/Galley/Intra/User.hs +++ b/services/galley/src/Galley/Intra/User.hs @@ -46,6 +46,7 @@ import Data.ByteString.Char8 qualified as BSC import Data.ByteString.Conversion import Data.Id import Data.Qualified +import Data.Text qualified as Text import Data.Text.Lazy qualified as Lazy import Galley.API.Error import Galley.Env @@ -253,11 +254,11 @@ runHereClientM action = do mgr <- view manager brigep <- view brig let env = Client.mkClientEnv mgr baseurl - baseurl = Client.BaseUrl Client.Http (cs $ brigep ^. host) (fromIntegral $ brigep ^. port) "" + baseurl = Client.BaseUrl Client.Http (Text.unpack $ brigep ^. host) (fromIntegral $ brigep ^. port) "" liftIO $ Client.runClientM action env handleServantResp :: Either Client.ClientError a -> App a handleServantResp (Right cfg) = pure cfg -handleServantResp (Left errmsg) = throwM . internalErrorWithDescription . cs . show $ errmsg +handleServantResp (Left errmsg) = throwM . internalErrorWithDescription . Lazy.pack . show $ errmsg diff --git a/services/galley/src/Galley/Keys.hs b/services/galley/src/Galley/Keys.hs index 7614ed9fc9f..5cbfa540b21 100644 --- a/services/galley/src/Galley/Keys.hs +++ b/services/galley/src/Galley/Keys.hs @@ -22,22 +22,26 @@ module Galley.Keys ) where +import Control.Error.Util import Control.Exception -import Crypto.PubKey.Ed25519 +import Crypto.ECC hiding (KeyPair) +import Crypto.Error +import Crypto.PubKey.ECDSA qualified as ECDSA +import Crypto.PubKey.Ed25519 qualified as Ed25519 import Data.ASN1.BinaryEncoding +import Data.ASN1.BitArray import Data.ASN1.Encoding import Data.ASN1.Types import Data.Bifunctor import Data.ByteString.Lazy qualified as LBS -import Data.Map qualified as Map import Data.PEM +import Data.Proxy import Data.X509 import Imports import Wire.API.MLS.CipherSuite -import Wire.API.MLS.Credential import Wire.API.MLS.Keys -type MLSPrivateKeyPaths = Map SignaturePurpose (Map SignatureSchemeTag FilePath) +type MLSPrivateKeyPaths = MLSKeysByPurpose (MLSKeys FilePath) data MLSPrivateKeyException = MLSPrivateKeyException { mpkePath :: FilePath, @@ -48,28 +52,115 @@ data MLSPrivateKeyException = MLSPrivateKeyException instance Exception MLSPrivateKeyException where displayException e = mpkePath e <> ": " <> mpkeMsg e -mapToFunction :: (Ord k, Monoid m) => Map k m -> k -> m -mapToFunction m x = Map.findWithDefault mempty x m +loadAllMLSKeys :: MLSPrivateKeyPaths -> IO (MLSKeysByPurpose MLSPrivateKeys) +loadAllMLSKeys = traverse loadMLSKeys -loadAllMLSKeys :: MLSPrivateKeyPaths -> IO (SignaturePurpose -> MLSKeys) -loadAllMLSKeys = fmap mapToFunction . traverse loadMLSKeys +loadMLSKeys :: MLSKeys FilePath -> IO MLSPrivateKeys +loadMLSKeys paths = + MLSPrivateKeys + <$> loadKeyPair @Ed25519 paths.ed25519 + <*> loadKeyPair @Ecdsa_secp256r1_sha256 paths.ecdsa_secp256r1_sha256 + <*> loadKeyPair @Ecdsa_secp384r1_sha384 paths.ecdsa_secp384r1_sha384 + <*> loadKeyPair @Ecdsa_secp521r1_sha512 paths.ecdsa_secp521r1_sha512 -loadMLSKeys :: Map SignatureSchemeTag FilePath -> IO MLSKeys -loadMLSKeys m = - MLSKeys - <$> traverse loadEd25519KeyPair (Map.lookup Ed25519 m) +class LoadKeyPair (ss :: SignatureSchemeTag) where + loadKeyPair :: FilePath -> IO (KeyPair ss) -loadEd25519KeyPair :: FilePath -> IO (SecretKey, PublicKey) +instance LoadKeyPair Ed25519 where + loadKeyPair = loadEd25519KeyPair + +instance LoadKeyPair Ecdsa_secp256r1_sha256 where + loadKeyPair = loadECDSAKeyPair @Curve_P256R1 + +instance LoadKeyPair Ecdsa_secp384r1_sha384 where + loadKeyPair = loadECDSAKeyPair @Curve_P384R1 + +instance LoadKeyPair Ecdsa_secp521r1_sha512 where + loadKeyPair = loadECDSAKeyPair @Curve_P521R1 + +class CurveOID c where + curveOID :: [Integer] + +instance CurveOID Curve_P256R1 where + curveOID = [1, 2, 840, 10045, 3, 1, 7] + +instance CurveOID Curve_P384R1 where + curveOID = [1, 3, 132, 0, 34] + +instance CurveOID Curve_P521R1 where + curveOID = [1, 3, 132, 0, 35] + +loadECDSAKeyPair :: + forall c. + (ECDSA.EllipticCurveECDSA c, CurveOID c) => + FilePath -> + IO (ECDSA.PrivateKey c, ECDSA.PublicKey c) +loadECDSAKeyPair path = do + bytes <- LBS.readFile path + either (throwIO . MLSPrivateKeyException path) pure $ + decodeEcdsaKeyPair @c bytes + +loadEd25519KeyPair :: FilePath -> IO (Ed25519.SecretKey, Ed25519.PublicKey) loadEd25519KeyPair path = do bytes <- LBS.readFile path priv <- either (throwIO . MLSPrivateKeyException path) pure $ decodeEd25519PrivateKey bytes - pure (priv, toPublic priv) + pure (priv, Ed25519.toPublic priv) + +decodeEcdsaKeyPair :: + forall c. + (ECDSA.EllipticCurveECDSA c, CurveOID c) => + LByteString -> + Either String (ECDSA.PrivateKey c, ECDSA.PublicKey c) +decodeEcdsaKeyPair bytes = do + let curve = Proxy @c + pems <- pemParseLBS bytes + pem <- expectOne "private key" pems + let content = pemContent pem + -- parse outer pkcs8 container as BER + asn1 <- first displayException (decodeASN1' BER content) + (oid, key) <- case asn1 of + [ Start Sequence, + IntVal _version, + Start Sequence, + OID [1, 2, 840, 10045, 2, 1], -- ecdsa + OID oid, + End Sequence, + OctetString key, + End Sequence + ] -> pure (oid, key) + _ -> Left "invalid ECDSA key format: expected pkcs8" + note + ( "private key curve mismatch, expected " + <> show (curveOID @c) + <> ", found " + <> show oid + ) + $ guard (oid == curveOID @c) + -- parse key bytestring as BER again, this should be in the format of rfc5915 + asn1' <- first displayException (decodeASN1' BER key) + (privBS, pubBS) <- case asn1' of + [ Start Sequence, + IntVal _version, + OctetString priv, + Start (Container Context _), + BitString (BitArray _ pub), + End (Container Context _), + End Sequence + ] -> pure (priv, pub) + _ -> Left "invalid ECDSA key format: expected rfc5915 private key format" + priv <- + first displayException . eitherCryptoError $ + ECDSA.decodePrivate curve privBS + pub <- + first displayException . eitherCryptoError $ + ECDSA.decodePublic curve pubBS + pure (priv, pub) decodeEd25519PrivateKey :: LByteString -> - Either String SecretKey + Either String Ed25519.SecretKey decodeEd25519PrivateKey bytes = do pems <- pemParseLBS bytes pem <- expectOne "private key" pems @@ -81,11 +172,11 @@ decodeEd25519PrivateKey bytes = do PrivKeyEd25519 sec -> pure sec _ -> Left $ "invalid signature scheme (expected ed25519)" where - expectOne :: String -> [a] -> Either String a - expectOne label [] = Left $ "no " <> label <> " found" - expectOne _ [x] = pure x - expectOne label _ = Left $ "found multiple " <> label <> "s" - expectEmpty :: [a] -> Either String () expectEmpty [] = pure () expectEmpty _ = Left "extraneous ASN.1 data" + +expectOne :: String -> [a] -> Either String a +expectOne label [] = Left $ "no " <> label <> " found" +expectOne _ [x] = pure x +expectOne label _ = Left $ "found multiple " <> label <> "s" diff --git a/services/galley/src/Galley/Monad.hs b/services/galley/src/Galley/Monad.hs index c9be145a29e..1780f3d827c 100644 --- a/services/galley/src/Galley/Monad.hs +++ b/services/galley/src/Galley/Monad.hs @@ -26,7 +26,7 @@ import Control.Lens import Control.Monad.Catch import Control.Monad.Except import Galley.Env -import Imports hiding (cs, log) +import Imports hiding (log) import Polysemy import Polysemy.Input import System.Logger diff --git a/services/galley/src/Galley/Options.hs b/services/galley/src/Galley/Options.hs index 499b85949e6..3e1b97aa1cf 100644 --- a/services/galley/src/Galley/Options.hs +++ b/services/galley/src/Galley/Options.hs @@ -135,11 +135,6 @@ data Settings = Settings -- - wire.com -- - example.com _federationDomain :: !Domain, - -- | When true, galley will assume data in `billing_team_member` table is - -- consistent and use it for billing. - -- When false, billing information for large teams is not guaranteed to have all - -- the owners. - -- Defaults to false. _mlsPrivateKeyPaths :: !(Maybe MLSPrivateKeyPaths), -- | FUTUREWORK: 'setFeatureFlags' should be renamed to 'setFeatureConfigs' in all types. _featureFlags :: !FeatureFlags, diff --git a/services/galley/src/Galley/Run.hs b/services/galley/src/Galley/Run.hs index 592ad9f3ed8..744e9dc4220 100644 --- a/services/galley/src/Galley/Run.hs +++ b/services/galley/src/Galley/Run.hs @@ -32,6 +32,7 @@ import Control.Exception (finally) import Control.Lens (view, (.~), (^.)) import Control.Monad.Codensity import Data.Aeson qualified as Aeson +import Data.ByteString.UTF8 qualified as UTF8 import Data.Id import Data.Metrics (Metrics) import Data.Metrics.AWS (gaugeTokenRemaing) @@ -133,7 +134,7 @@ mkApp opts = lookupReqId l r = case lookup requestIdName $ requestHeaders r of Just rid -> pure $ RequestId rid Nothing -> do - localRid <- RequestId . cs . UUID.toText <$> UUID.nextRandom + localRid <- RequestId . UUID.toASCIIBytes <$> UUID.nextRandom Log.info l $ "request-id" .= localRid ~~ "method" .= requestMethod r @@ -155,7 +156,7 @@ bodyParserErrorFormatter' :: Servant.ErrorFormatter bodyParserErrorFormatter' _ _ errMsg = Servant.ServerError { Servant.errHTTPCode = HTTP.statusCode HTTP.status400, - Servant.errReasonPhrase = cs $ HTTP.statusMessage HTTP.status400, + Servant.errReasonPhrase = UTF8.toString $ HTTP.statusMessage HTTP.status400, Servant.errBody = Aeson.encode $ Aeson.object diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 21c0c844a08..fbf625a5138 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -132,7 +132,6 @@ tests s = test s "metrics" metrics, test s "fetch conversation by qualified ID (v2)" testGetConvQualifiedV2, test s "create Proteus conversation" postProteusConvOk, - test s "create conversation with remote users all reachable" (postConvWithRemoteUsersOk $ Set.fromList [rb1, rb2]), test s "create conversation with remote users some unreachable" (postConvWithUnreachableRemoteUsers $ Set.fromList [rb1, rb2, rb3, rb4]), test s "get empty conversations" getConvsOk, test s "get conversations by ids" getConvsOk2, @@ -242,7 +241,6 @@ tests s = test s "existing has password, requested has password - 409" postCodeWithPasswordExistsWithPasswordRequested ], test s "remove user with only local convs" removeUserNoFederation, - test s "remove user with local and remote convs" removeUser, test s "iUpsertOne2OneConversation" testAllOne2OneConversationRequests, test s "post message - reject if missing client" postMessageRejectIfMissingClients, test s "post message - client that is not in group doesn't receive message" postMessageClientNotInGroupDoesNotReceiveMsg, @@ -412,121 +410,6 @@ postConvWithUnreachableRemoteUsers rbs = do groupConvs WS.assertNoEvent (3 # Second) [wsAlice, wsAlex] -postConvWithRemoteUsersOk :: Set (Remote Backend) -> TestM () -postConvWithRemoteUsersOk rbs = do - c <- view tsCannon - (alice, qAlice) <- randomUserTuple - (alex, qAlex) <- randomUserTuple - (amy, qAmy) <- randomUserTuple - connectUsers alice (list1 alex [amy]) - (allRemotes, participatingRemotes) <- do - v <- forM (toList rbs) $ \rb -> do - users <- connectBackend alice rb - pure (users, participating rb users) - pure $ foldr (\(a, p) acc -> bimap ((<>) a) ((<>) p) acc) ([], []) v - liftIO $ - assertBool "Not every backend is reachable in the test" (allRemotes == participatingRemotes) - - let convName = "some chat" - otherLocals = [qAlex, qAmy] - WS.bracketR3 c alice alex amy $ \(wsAlice, wsAlex, wsAmy) -> do - let joiners = allRemotes <> otherLocals - unreachableBackends = - Set.fromList $ - foldMap - ( \rb -> - guard (rbReachable rb == BackendUnreachable) - $> tDomain rb - ) - rbs - (rsp, federatedRequests) <- - withTempMockFederator' - ( asum - [ getNotFullyConnectedBackendsMock, - mockUnreachableFor unreachableBackends, - "on-conversation-created" ~> EmptyResponse, - "on-conversation-updated" ~> EmptyResponse - ] - ) - $ postConvQualified - alice - Nothing - defNewProteusConv - { newConvName = checked convName, - newConvQualifiedUsers = joiners - } - minimalShouldBePresent) - qcid <- - assertConv - rsp - RegularConv - (Just alice) - qAlice - (otherLocals <> participatingRemotes) - (Just convName) - Nothing - let cid = qUnqualified qcid - cvs <- mapM (convView qcid) [alice, alex, amy] - liftIO $ - mapM_ WS.assertSuccess - =<< Async.mapConcurrently (checkWs qAlice) (zip cvs [wsAlice, wsAlex, wsAmy]) - - liftIO $ do - let expectedReqs = - Set.fromList $ - [ "on-conversation-created", - "on-conversation-updated" - ] - in assertBool "Some federated calls are missing" $ - expectedReqs `Set.isSubsetOf` Set.fromList (frRPC <$> federatedRequests) - - -- assertions on the conversation.create event triggering federation request - let fedReqsCreated = filter (\r -> frRPC r == "on-conversation-created") federatedRequests - fedReqCreatedBodies <- for fedReqsCreated $ assertRight . parseFedRequest - forM_ fedReqCreatedBodies $ \(fedReqCreatedBody :: ConversationCreated ConvId) -> liftIO $ do - fedReqCreatedBody.origUserId @?= alice - fedReqCreatedBody.cnvId @?= cid - fedReqCreatedBody.cnvType @?= RegularConv - fedReqCreatedBody.cnvAccess @?= [InviteAccess] - fedReqCreatedBody.cnvAccessRoles - @?= Set.fromList [TeamMemberAccessRole, NonTeamMemberAccessRole, ServiceAccessRole] - fedReqCreatedBody.cnvName @?= Just convName - assertBool "Notifying an incorrect set of conversation members" $ - minimalShouldBePresentSet `Set.isSubsetOf` fedReqCreatedBody.nonCreatorMembers - fedReqCreatedBody.messageTimer @?= Nothing - fedReqCreatedBody.receiptMode @?= Nothing - - -- assertions on the conversation.member-join event triggering federation request - let fedReqsAdd = filter (\r -> frRPC r == "on-conversation-updated") federatedRequests - fedReqAddBodies <- for fedReqsAdd $ assertRight . parseFedRequest - forM_ fedReqAddBodies $ \(fedReqAddBody :: ConversationUpdate) -> liftIO $ do - fedReqAddBody.cuOrigUserId @?= qAlice - fedReqAddBody.cuConvId @?= cid - -- This remote backend must already have their users in the conversation, - -- otherwise they should not be receiving the conversation update message - assertBool "The list of already present users should be non-empty" - . not - . null - $ fedReqAddBody.cuAlreadyPresentUsers - case fedReqAddBody.cuAction of - SomeConversationAction SConversationJoinTag _action -> pure () - _ -> assertFailure @() "Unexpected update action" - where - toOtherMember qid = OtherMember qid Nothing roleNameWireAdmin - convView cnv usr = - responseJsonError =<< getConvQualified usr cnv do - ntfTransient n @?= False - let e = List1.head (WS.unpackPayload n) - evtConv e @?= cnvQualifiedId cnv - evtType e @?= ConvCreate - evtFrom e @?= qalice - case evtData e of - EdConversation c' -> assertConvEquals cnv c' - _ -> assertFailure "Unexpected event data" - -- @SF.Separation @TSFI.RESTfulAPI @S2 -- This test verifies whether a message actually gets sent all the way to -- cannon. @@ -745,7 +628,7 @@ postMessageRejectIfMissingClients = do checkSendWitMissingClientsShouldFail where mkMsg :: ByteString -> (UserId, ClientId) -> (UserId, ClientId, Text) - mkMsg text (userId, clientId) = (userId, clientId, toBase64Text text) + mkMsg text (uid, clientId) = (uid, clientId, toBase64Text text) -- @END @@ -1286,7 +1169,6 @@ testJoinCodeConv = do testGetCodeRejectedIfGuestLinksDisabled :: TestM () testGetCodeRejectedIfGuestLinksDisabled = do - galley <- viewGalley (owner, teamId, []) <- Util.createBindingTeamWithNMembers 0 Right accessRoles <- liftIO $ genAccessRolesV2 [TeamMemberAccessRole, GuestAccessRole] [] let createConvWithGuestLink = do @@ -1296,7 +1178,7 @@ testGetCodeRejectedIfGuestLinksDisabled = do convId <- createConvWithGuestLink let checkGetCode expectedStatus = getConvCode owner convId !!! const expectedStatus === statusCode let setStatus tfStatus = - TeamFeatures.putTeamFeatureFlagWithGalley @Public.GuestLinksConfig galley owner teamId (Public.WithStatusNoLock tfStatus Public.GuestLinksConfig Public.FeatureTTLUnlimited) !!! do + TeamFeatures.putTeamFeature @Public.GuestLinksConfig owner teamId (Public.WithStatusNoLock tfStatus Public.GuestLinksConfig Public.FeatureTTLUnlimited) !!! do const 200 === statusCode checkGetCode 200 @@ -1307,13 +1189,12 @@ testGetCodeRejectedIfGuestLinksDisabled = do testPostCodeRejectedIfGuestLinksDisabled :: TestM () testPostCodeRejectedIfGuestLinksDisabled = do - galley <- viewGalley (owner, teamId, []) <- Util.createBindingTeamWithNMembers 0 Right noGuestsAccess <- liftIO $ genAccessRolesV2 [NonTeamMemberAccessRole] [GuestAccessRole] convId <- decodeConvId <$> postTeamConv teamId owner [] (Just "testConversation") [CodeAccess] (Just noGuestsAccess) Nothing let checkPostCode expectedStatus = postConvCode owner convId !!! statusCode === const expectedStatus let setStatus tfStatus = - TeamFeatures.putTeamFeatureFlagWithGalley @Public.GuestLinksConfig galley owner teamId (Public.WithStatusNoLock tfStatus Public.GuestLinksConfig Public.FeatureTTLUnlimited) !!! do + TeamFeatures.putTeamFeature @Public.GuestLinksConfig owner teamId (Public.WithStatusNoLock tfStatus Public.GuestLinksConfig Public.FeatureTTLUnlimited) !!! do const 200 === statusCode checkPostCode 201 @@ -1326,7 +1207,6 @@ testPostCodeRejectedIfGuestLinksDisabled = do -- Check if guests cannot join anymore if guest invite feature was disabled on team level testJoinTeamConvGuestLinksDisabled :: TestM () testJoinTeamConvGuestLinksDisabled = do - galley <- viewGalley let convName = "testConversation" (owner, teamId, [alice]) <- Util.createBindingTeamWithNMembers 1 eve <- ephemeralUser @@ -1336,7 +1216,7 @@ testJoinTeamConvGuestLinksDisabled = do cCode <- (.code) . decodeConvCodeEvent <$> postConvCode owner convId let checkFeatureStatus fstatus = - Util.getTeamFeatureFlagWithGalley @Public.GuestLinksConfig galley owner teamId !!! do + Util.getTeamFeature @Public.GuestLinksConfig owner teamId !!! do const 200 === statusCode const (Right (Public.withStatus fstatus Public.LockStatusUnlocked Public.GuestLinksConfig Public.FeatureTTLUnlimited)) === responseJsonEither @@ -1352,7 +1232,7 @@ testJoinTeamConvGuestLinksDisabled = do -- disabled guest links feature let disabled = Public.WithStatusNoLock Public.FeatureStatusDisabled Public.GuestLinksConfig Public.FeatureTTLUnlimited - TeamFeatures.putTeamFeatureFlagWithGalley @Public.GuestLinksConfig galley owner teamId disabled !!! do + TeamFeatures.putTeamFeature @Public.GuestLinksConfig owner teamId disabled !!! do const 200 === statusCode -- guest can't join if guest link feature is disabled @@ -1371,7 +1251,7 @@ testJoinTeamConvGuestLinksDisabled = do -- after re-enabling, the old link is still valid let enabled = Public.WithStatusNoLock Public.FeatureStatusEnabled Public.GuestLinksConfig Public.FeatureTTLUnlimited - TeamFeatures.putTeamFeatureFlagWithGalley @Public.GuestLinksConfig galley owner teamId enabled !!! do + TeamFeatures.putTeamFeature @Public.GuestLinksConfig owner teamId enabled !!! do const 200 === statusCode getJoinCodeConv eve' (conversationKey cCode) (conversationCode cCode) !!! do const (Right (ConversationCoverView convId (Just convName) False)) === responseJsonEither @@ -1385,7 +1265,6 @@ testJoinTeamConvGuestLinksDisabled = do testJoinNonTeamConvGuestLinksDisabled :: TestM () testJoinNonTeamConvGuestLinksDisabled = do - galley <- viewGalley let convName = "testConversation" (owner, teamId, []) <- Util.createBindingTeamWithNMembers 0 userNotInTeam <- randomUser @@ -1400,7 +1279,7 @@ testJoinNonTeamConvGuestLinksDisabled = do -- for non-team conversations it still works if status is disabled for the team but not server wide let tfStatus = Public.WithStatusNoLock Public.FeatureStatusDisabled Public.GuestLinksConfig Public.FeatureTTLUnlimited - TeamFeatures.putTeamFeatureFlagWithGalley @Public.GuestLinksConfig galley owner teamId tfStatus !!! do + TeamFeatures.putTeamFeature @Public.GuestLinksConfig owner teamId tfStatus !!! do const 200 === statusCode getJoinCodeConv userNotInTeam (conversationKey cCode) (conversationCode cCode) !!! do @@ -1639,7 +1518,7 @@ getGuestLinksStatusFromForeignTeamConv = do localDomain <- viewFederationDomain galley <- viewGalley let setTeamStatus u tid tfStatus = - TeamFeatures.putTeamFeatureFlagWithGalley @Public.GuestLinksConfig galley u tid (Public.WithStatusNoLock tfStatus Public.GuestLinksConfig Public.FeatureTTLUnlimited) !!! do + TeamFeatures.putTeamFeature @Public.GuestLinksConfig u tid (Public.WithStatusNoLock tfStatus Public.GuestLinksConfig Public.FeatureTTLUnlimited) !!! do const 200 === statusCode let checkGuestLinksStatus u c s = getGuestLinkStatus galley u c !!! do @@ -1867,11 +1746,11 @@ paginateConvListIds = do conv <- randomId let cu = ConversationUpdate - { cuTime = now, - cuOrigUserId = qChad, - cuConvId = conv, - cuAlreadyPresentUsers = [], - cuAction = SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (pure qAlice) roleNameWireMember) + { time = now, + origUserId = qChad, + convId = conv, + alreadyPresentUsers = [], + action = SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (pure qAlice) roleNameWireMember) } void $ runFedClient @"on-conversation-updated" fedGalleyClient chadDomain cu @@ -1883,11 +1762,11 @@ paginateConvListIds = do conv <- randomId let cu = ConversationUpdate - { cuTime = now, - cuOrigUserId = qDee, - cuConvId = conv, - cuAlreadyPresentUsers = [], - cuAction = SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (pure qAlice) roleNameWireMember) + { time = now, + origUserId = qDee, + convId = conv, + alreadyPresentUsers = [], + action = SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (pure qAlice) roleNameWireMember) } void $ runFedClient @"on-conversation-updated" fedGalleyClient deeDomain cu @@ -1928,11 +1807,11 @@ paginateConvListIdsPageEndingAtLocalsAndDomain = do conv <- randomId let cu = ConversationUpdate - { cuTime = now, - cuOrigUserId = qChad, - cuConvId = conv, - cuAlreadyPresentUsers = [], - cuAction = SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (pure qAlice) roleNameWireMember) + { time = now, + origUserId = qChad, + convId = conv, + alreadyPresentUsers = [], + action = SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (pure qAlice) roleNameWireMember) } void $ runFedClient @"on-conversation-updated" fedGalleyClient chadDomain cu @@ -1946,11 +1825,11 @@ paginateConvListIdsPageEndingAtLocalsAndDomain = do conv <- randomId let cu = ConversationUpdate - { cuTime = now, - cuOrigUserId = qDee, - cuConvId = conv, - cuAlreadyPresentUsers = [], - cuAction = SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (pure qAlice) roleNameWireMember) + { time = now, + origUserId = qDee, + convId = conv, + alreadyPresentUsers = [], + action = SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (pure qAlice) roleNameWireMember) } void $ runFedClient @"on-conversation-updated" fedGalleyClient deeDomain cu @@ -3204,11 +3083,11 @@ putRemoteConvMemberOk update = do now <- liftIO getCurrentTime let cu = ConversationUpdate - { cuTime = now, - cuOrigUserId = qbob, - cuConvId = qUnqualified qconv, - cuAlreadyPresentUsers = [], - cuAction = + { time = now, + origUserId = qbob, + convId = qUnqualified qconv, + alreadyPresentUsers = [], + action = SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (pure qalice) roleNameWireMember) } void $ runFedClient @"on-conversation-updated" fedGalleyClient remoteDomain cu @@ -3349,11 +3228,11 @@ putRemoteReceiptModeOk = do now <- liftIO getCurrentTime let cuAddAlice = ConversationUpdate - { cuTime = now, - cuOrigUserId = qbob, - cuConvId = qUnqualified qconv, - cuAlreadyPresentUsers = [], - cuAction = + { time = now, + origUserId = qbob, + convId = qUnqualified qconv, + alreadyPresentUsers = [], + action = SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (pure qalice) roleNameWireAdmin) } void $ runFedClient @"on-conversation-updated" fedGalleyClient remoteDomain cuAddAlice @@ -3364,11 +3243,11 @@ putRemoteReceiptModeOk = do connectWithRemoteUser adam qbob let cuAddAdam = ConversationUpdate - { cuTime = now, - cuOrigUserId = qbob, - cuConvId = qUnqualified qconv, - cuAlreadyPresentUsers = [], - cuAction = + { time = now, + origUserId = qbob, + convId = qUnqualified qconv, + alreadyPresentUsers = [], + action = SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (pure qadam) roleNameWireMember) } void $ runFedClient @"on-conversation-updated" fedGalleyClient remoteDomain cuAddAdam @@ -3377,11 +3256,11 @@ putRemoteReceiptModeOk = do let action = ConversationReceiptModeUpdate newReceiptMode let responseConvUpdate = ConversationUpdate - { cuTime = now, - cuOrigUserId = qalice, - cuConvId = qUnqualified qconv, - cuAlreadyPresentUsers = [adam], - cuAction = + { time = now, + origUserId = qalice, + convId = qUnqualified qconv, + alreadyPresentUsers = [adam], + action = SomeConversationAction (sing @'ConversationReceiptModeUpdateTag) action } let mockResponse = mockReply (ConversationUpdateResponseUpdate responseConvUpdate) @@ -3553,137 +3432,6 @@ removeUserNoFederation = do (mems3 >>= other bob) @?= Nothing (mems3 >>= other carl) @?= Just (OtherMember carl Nothing roleNameWireAdmin) -removeUser :: TestM () -removeUser = do - c <- view tsCannon - [alice, alexDel, amy] <- replicateM 3 randomQualifiedUser - let [alice', alexDel', amy'] = qUnqualified <$> [alice, alexDel, amy] - - let bDomain = Domain "b.example.com" - bart <- randomQualifiedId bDomain - berta <- randomQualifiedId bDomain - - let cDomain = Domain "c.example.com" - carl <- randomQualifiedId cDomain - - let dDomain = Domain "d.example.com" - dwight <- randomQualifiedId dDomain - dory <- randomQualifiedId dDomain - - connectUsers alice' (list1 alexDel' [amy']) - connectWithRemoteUser alice' bart - connectWithRemoteUser alice' berta - connectWithRemoteUser alexDel' bart - connectWithRemoteUser alice' carl - connectWithRemoteUser alexDel' carl - connectWithRemoteUser alice' dwight - connectWithRemoteUser alexDel' dory - - qconvA1 <- decodeQualifiedConvId <$> postConv alice' [alexDel'] (Just "gossip") [] Nothing Nothing - qconvA2 <- decodeQualifiedConvId <$> postConvWithRemoteUsers alice' Nothing defNewProteusConv {newConvQualifiedUsers = [alexDel, amy, berta, dwight]} - qconvA3 <- decodeQualifiedConvId <$> postConv alice' [amy'] (Just "gossip3") [] Nothing Nothing - qconvA4 <- decodeQualifiedConvId <$> postConvWithRemoteUsers alice' Nothing defNewProteusConv {newConvQualifiedUsers = [alexDel, bart, carl]} - convB1 <- randomId -- a remote conversation at 'bDomain' that Alice, AlexDel and Bart will be in - convB2 <- randomId -- a remote conversation at 'bDomain' that AlexDel and Bart will be in - convC1 <- randomId -- a remote conversation at 'cDomain' that AlexDel and Carl will be in - convD1 <- randomId -- a remote conversation at 'cDomain' that AlexDel and Dory will be in - now <- liftIO getCurrentTime - fedGalleyClient <- view tsFedGalleyClient - let nc cid creator quids = - ConversationCreated - { time = now, - origUserId = qUnqualified creator, - cnvId = cid, - cnvType = RegularConv, - cnvAccess = [], - cnvAccessRoles = Set.fromList [], - cnvName = Just "gossip4", - nonCreatorMembers = Set.fromList $ createOtherMember <$> quids, - messageTimer = Nothing, - receiptMode = Nothing, - protocol = ProtocolProteus - } - void $ runFedClient @"on-conversation-created" fedGalleyClient bDomain $ nc convB1 bart [alice, alexDel] - void $ runFedClient @"on-conversation-created" fedGalleyClient bDomain $ nc convB2 bart [alexDel] - void $ runFedClient @"on-conversation-created" fedGalleyClient cDomain $ nc convC1 carl [alexDel] - void $ runFedClient @"on-conversation-created" fedGalleyClient dDomain $ nc convD1 dory [alexDel] - - WS.bracketR3 c alice' alexDel' amy' $ \(wsAlice, wsAlexDel, wsAmy) -> do - let handler = do - d <- frTargetDomain <$> getRequest - asum - [ do - guard (d == dDomain) - throw (DiscoveryFailureSrvNotAvailable "dDomain"), - do - guard (d `elem` [bDomain, cDomain]) - "leave-conversation" ~> LeaveConversationResponse (Right mempty) - ] - (_, fedRequests) <- - withTempMockFederator' handler $ - deleteUser alexDel' !!! const 200 === statusCode - - liftIO $ do - assertEqual ("expect exactly 4 federated requests in : " <> show fedRequests) 4 (length fedRequests) - - liftIO $ do - WS.assertMatchN_ (5 # Second) [wsAlice, wsAlexDel] $ - wsAssertMembersLeave qconvA1 alexDel [alexDel] - WS.assertMatchN_ (5 # Second) [wsAlice, wsAlexDel, wsAmy] $ - wsAssertMembersLeave qconvA2 alexDel [alexDel] - - liftIO $ do - let bConvUpdateRPCs = filter (matchFedRequest bDomain "on-conversation-updated") fedRequests - bConvUpdates <- mapM (assertRight . eitherDecode . frBody) bConvUpdateRPCs - - bConvUpdatesA2 <- assertOne $ filter (\cu -> cuConvId cu == qUnqualified qconvA2) bConvUpdates - cuOrigUserId bConvUpdatesA2 @?= alexDel - cuAction bConvUpdatesA2 @?= SomeConversationAction (sing @'ConversationLeaveTag) () - cuAlreadyPresentUsers bConvUpdatesA2 @?= [qUnqualified berta] - - bConvUpdatesA4 <- assertOne $ filter (\cu -> cuConvId cu == qUnqualified qconvA4) bConvUpdates - cuOrigUserId bConvUpdatesA4 @?= alexDel - cuAction bConvUpdatesA4 @?= SomeConversationAction (sing @'ConversationLeaveTag) () - cuAlreadyPresentUsers bConvUpdatesA4 @?= [qUnqualified bart] - - liftIO $ do - cConvUpdateRPC <- assertOne $ filter (matchFedRequest cDomain "on-conversation-updated") fedRequests - Right convUpdate <- pure . eitherDecode . frBody $ cConvUpdateRPC - cuConvId convUpdate @?= qUnqualified qconvA4 - cuOrigUserId convUpdate @?= alexDel - cuAction convUpdate @?= SomeConversationAction (sing @'ConversationLeaveTag) () - cuAlreadyPresentUsers convUpdate @?= [qUnqualified carl] - - liftIO $ do - dConvUpdateRPC <- assertOne $ filter (matchFedRequest dDomain "on-conversation-updated") fedRequests - Right convUpdate <- pure . eitherDecode . frBody $ dConvUpdateRPC - cuConvId convUpdate @?= qUnqualified qconvA2 - cuOrigUserId convUpdate @?= alexDel - cuAction convUpdate @?= SomeConversationAction (sing @'ConversationLeaveTag) () - cuAlreadyPresentUsers convUpdate @?= [qUnqualified dwight] - - -- Check memberships - mems1 <- fmap cnvMembers . responseJsonError =<< getConvQualified alice' qconvA1 - mems2 <- fmap cnvMembers . responseJsonError =<< getConvQualified alice' qconvA2 - mems3 <- fmap cnvMembers . responseJsonError =<< getConvQualified alice' qconvA3 - mems4 <- fmap cnvMembers . responseJsonError =<< getConvQualified alice' qconvA4 - let findOther u = find ((== u) . omQualifiedId) . cmOthers - liftIO $ do - findOther alexDel mems1 @?= Nothing - findOther alexDel mems2 @?= Nothing - findOther amy mems2 @?= Just (OtherMember amy Nothing roleNameWireAdmin) - findOther alexDel mems3 @?= Nothing - findOther amy mems3 @?= Just (OtherMember amy Nothing roleNameWireAdmin) - findOther alexDel mems4 @?= Nothing - where - createOtherMember :: Qualified UserId -> OtherMember - createOtherMember quid = - OtherMember - { omQualifiedId = quid, - omService = Nothing, - omConvRoleName = roleNameWireAdmin - } - testAllOne2OneConversationRequests :: TestM () testAllOne2OneConversationRequests = do for_ [LocalActor, RemoteActor] $ \actor -> @@ -3694,16 +3442,11 @@ testAllOne2OneConversationRequests = do testOne2OneConversationRequest :: Bool -> Actor -> DesiredMembership -> TestM () testOne2OneConversationRequest shouldBeLocal actor desired = do alice <- qTagUnsafe <$> randomQualifiedUser - (bob, expectedConvId) <- generateRemoteAndConvId shouldBeLocal alice + (bob, convId) <- generateRemoteAndConvId shouldBeLocal alice - convId <- do - let req = UpsertOne2OneConversationRequest alice bob actor desired Nothing - res <- - iUpsertOne2OneConversation req - responseJsonError res - - liftIO $ convId @?= expectedConvId + do + let req = UpsertOne2OneConversationRequest alice bob actor desired convId + iUpsertOne2OneConversation req !!! statusCode === const 200 if shouldBeLocal then diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 22236c3c810..e6bd8eea883 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -120,12 +120,9 @@ getConversationsAllFound = do uooRemoteUser = rAlice, uooActor = LocalActor, uooActorDesiredMembership = Included, - uooConvId = Just cnv1Id + uooConvId = cnv1Id } - UpsertOne2OneConversationResponse cnv1IdReturned <- - responseJsonError - =<< iUpsertOne2OneConversation createO2O - liftIO $ assertEqual "Mismatch in the generated conversation ID" cnv1IdReturned cnv1Id + iUpsertOne2OneConversation createO2O !!! const 200 === statusCode do convs <- @@ -244,11 +241,11 @@ addLocalUser = do now <- liftIO getCurrentTime let cu = FedGalley.ConversationUpdate - { FedGalley.cuTime = now, - FedGalley.cuOrigUserId = qbob, - FedGalley.cuConvId = conv, - FedGalley.cuAlreadyPresentUsers = [charlie], - FedGalley.cuAction = + { FedGalley.time = now, + FedGalley.origUserId = qbob, + FedGalley.convId = conv, + FedGalley.alreadyPresentUsers = [charlie], + FedGalley.action = SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (qalice :| [qdee]) roleNameWireMember) } WS.bracketRN c [alice, charlie, dee] $ \[wsA, wsC, wsD] -> do @@ -298,15 +295,15 @@ addUnconnectedUsersOnly = do -- Bob attempts to add unconnected Charlie (possible abuse) let cu = FedGalley.ConversationUpdate - { FedGalley.cuTime = now, - FedGalley.cuOrigUserId = qBob, - FedGalley.cuConvId = conv, - FedGalley.cuAlreadyPresentUsers = [alice], - FedGalley.cuAction = + { FedGalley.time = now, + FedGalley.origUserId = qBob, + FedGalley.convId = conv, + FedGalley.alreadyPresentUsers = [alice], + FedGalley.action = SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (qCharlie :| []) roleNameWireMember) } -- Alice receives no notifications from this - void $ runFedClient @"on-conversation-updated" fedGalleyClient remoteDomain cu + void $ runFedClient @("on-conversation-updated") fedGalleyClient remoteDomain cu WS.assertNoEvent (5 # Second) [wsA] -- | This test invokes the federation endpoint: @@ -332,20 +329,20 @@ removeLocalUser = do now <- liftIO getCurrentTime let cuAdd = FedGalley.ConversationUpdate - { FedGalley.cuTime = now, - FedGalley.cuOrigUserId = qBob, - FedGalley.cuConvId = conv, - FedGalley.cuAlreadyPresentUsers = [], - FedGalley.cuAction = + { FedGalley.time = now, + FedGalley.origUserId = qBob, + FedGalley.convId = conv, + FedGalley.alreadyPresentUsers = [], + FedGalley.action = SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (pure qAlice) roleNameWireMember) } cuRemove = FedGalley.ConversationUpdate - { FedGalley.cuTime = addUTCTime (secondsToNominalDiffTime 5) now, - FedGalley.cuOrigUserId = qAlice, - FedGalley.cuConvId = conv, - FedGalley.cuAlreadyPresentUsers = [alice], - FedGalley.cuAction = + { FedGalley.time = addUTCTime (secondsToNominalDiffTime 5) now, + FedGalley.origUserId = qAlice, + FedGalley.convId = conv, + FedGalley.alreadyPresentUsers = [alice], + FedGalley.action = SomeConversationAction (sing @'ConversationLeaveTag) () } @@ -405,11 +402,11 @@ removeRemoteUser = do let cuRemove user = FedGalley.ConversationUpdate - { FedGalley.cuTime = addUTCTime (secondsToNominalDiffTime 5) now, - FedGalley.cuOrigUserId = qBob, - FedGalley.cuConvId = conv, - FedGalley.cuAlreadyPresentUsers = [alice, charlie, dee], - FedGalley.cuAction = + { FedGalley.time = addUTCTime (secondsToNominalDiffTime 5) now, + FedGalley.origUserId = qBob, + FedGalley.convId = conv, + FedGalley.alreadyPresentUsers = [alice, charlie, dee], + FedGalley.action = SomeConversationAction (sing @'ConversationRemoveMembersTag) (ConversationRemoveMembers (pure user) EdReasonRemoved) @@ -460,11 +457,11 @@ notifyUpdate extras action etype edata = do now <- liftIO getCurrentTime let cu = FedGalley.ConversationUpdate - { FedGalley.cuTime = now, - FedGalley.cuOrigUserId = qbob, - FedGalley.cuConvId = conv, - FedGalley.cuAlreadyPresentUsers = [alice, charlie], - FedGalley.cuAction = action + { FedGalley.time = now, + FedGalley.origUserId = qbob, + FedGalley.convId = conv, + FedGalley.alreadyPresentUsers = [alice, charlie], + FedGalley.action = action } WS.bracketR2 c alice charlie $ \(wsA, wsC) -> do void $ runFedClient @"on-conversation-updated" fedGalleyClient bdom cu @@ -502,11 +499,11 @@ notifyUpdateUnavailable extras action etype edata = do now <- liftIO getCurrentTime let cu = FedGalley.ConversationUpdate - { FedGalley.cuTime = now, - FedGalley.cuOrigUserId = qbob, - FedGalley.cuConvId = conv, - FedGalley.cuAlreadyPresentUsers = [alice, charlie], - FedGalley.cuAction = action + { FedGalley.time = now, + FedGalley.origUserId = qbob, + FedGalley.convId = conv, + FedGalley.alreadyPresentUsers = [alice, charlie], + FedGalley.action = action } WS.bracketR2 c alice charlie $ \(wsA, wsC) -> do ((), _fedRequests) <- @@ -638,11 +635,11 @@ notifyDeletedConversation = do now <- liftIO getCurrentTime let cu = FedGalley.ConversationUpdate - { FedGalley.cuTime = now, - FedGalley.cuOrigUserId = qbob, - FedGalley.cuConvId = qUnqualified qconv, - FedGalley.cuAlreadyPresentUsers = [alice], - FedGalley.cuAction = SomeConversationAction (sing @'ConversationDeleteTag) () + { FedGalley.time = now, + FedGalley.origUserId = qbob, + FedGalley.convId = qUnqualified qconv, + FedGalley.alreadyPresentUsers = [alice], + FedGalley.action = SomeConversationAction (sing @'ConversationDeleteTag) () } void $ runFedClient @"on-conversation-updated" fedGalleyClient bobDomain cu @@ -694,11 +691,11 @@ addRemoteUser = do -- The conversation owning let cu = FedGalley.ConversationUpdate - { FedGalley.cuTime = now, - FedGalley.cuOrigUserId = qbob, - FedGalley.cuConvId = qUnqualified qconv, - FedGalley.cuAlreadyPresentUsers = map qUnqualified [qalice, qcharlie], - FedGalley.cuAction = + { FedGalley.time = now, + FedGalley.origUserId = qbob, + FedGalley.convId = qUnqualified qconv, + FedGalley.alreadyPresentUsers = map qUnqualified [qalice, qcharlie], + FedGalley.action = SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (qdee :| [qeve, qflo]) roleNameWireMember) } WS.bracketRN c (map qUnqualified [qalice, qcharlie, qdee, qflo]) $ \[wsA, wsC, wsD, wsF] -> do @@ -777,11 +774,11 @@ onMessageSent = do connectWithRemoteUser alice qbob let cu = FedGalley.ConversationUpdate - { FedGalley.cuTime = now, - FedGalley.cuOrigUserId = qbob, - FedGalley.cuConvId = conv, - FedGalley.cuAlreadyPresentUsers = [], - FedGalley.cuAction = + { FedGalley.time = now, + FedGalley.origUserId = qbob, + FedGalley.convId = conv, + FedGalley.alreadyPresentUsers = [], + FedGalley.action = SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (pure qalice) roleNameWireMember) } void $ runFedClient @"on-conversation-updated" fedGalleyClient bdom cu diff --git a/services/galley/test/integration/API/Federation/Util.hs b/services/galley/test/integration/API/Federation/Util.hs index 9d15edc5ee9..9f2f052365c 100644 --- a/services/galley/test/integration/API/Federation/Util.hs +++ b/services/galley/test/integration/API/Federation/Util.hs @@ -29,6 +29,7 @@ where import Data.Kind import Data.Qualified import Data.SOP +import Data.String.Conversions import GHC.TypeLits import Imports import Servant diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index 3429d03a1bc..9c61172ec0c 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -59,7 +59,6 @@ import Wire.API.Event.Conversation import Wire.API.Federation.API.Galley import Wire.API.MLS.CipherSuite import Wire.API.MLS.Credential -import Wire.API.MLS.Keys import Wire.API.MLS.Serialisation import Wire.API.MLS.SubConversation import Wire.API.Message @@ -153,7 +152,6 @@ tests s = test s "remove users bypassing MLS" testRemoveUsersDirectly, test s "send proteus message to an MLS conversation" testProteusMessage ], - test s "public keys" testPublicKeys, testGroup "GroupInfo" [ test s "get group info for a local conversation" testGetGroupInfoOfLocalConv, @@ -880,11 +878,11 @@ testRemoteToRemoteInSub = do connectWithRemoteUser alice qbob let cu = ConversationUpdate - { cuTime = now, - cuOrigUserId = qbob, - cuConvId = conv, - cuAlreadyPresentUsers = [], - cuAction = + { time = now, + origUserId = qbob, + convId = conv, + alreadyPresentUsers = [], + action = SomeConversationAction (sing @'ConversationJoinTag) (ConversationJoin (pure qalice) roleNameWireMember) } void $ runFedClient @"on-conversation-updated" fedGalleyClient bdom cu @@ -1200,29 +1198,6 @@ testExternalAddProposalWrongUser = do const 404 === statusCode const (Just "no-conversation") === fmap Wai.label . responseJsonError --- FUTUREWORK: test processing a commit containing the external proposal -testPublicKeys :: TestM () -testPublicKeys = do - u <- randomId - g <- viewGalley - keys <- - responseJsonError - =<< get - ( g - . paths ["mls", "public-keys"] - . zUser u - ) - TestM () saveRemovalKey fp = do keys <- fromJust <$> view (tsGConf . settings . mlsPrivateKeyPaths) keysByPurpose <- liftIO $ loadAllMLSKeys keys - let (_, pub) = fromJust (mlsKeyPair_ed25519 (keysByPurpose RemovalPurpose)) - liftIO $ BS.writeFile fp (BA.convert pub) + let pub = (mlsKeysToPublic keysByPurpose.removal).ed25519 + liftIO $ BS.writeFile fp (BA.convert $ unwrapMLSPublicKey pub) data MLSState = MLSState { mlsBaseDir :: FilePath, @@ -965,11 +966,11 @@ receiveOnConvUpdated conv origUser joiner = do now <- liftIO getCurrentTime let cu = ConversationUpdate - { cuTime = now, - cuOrigUserId = origUser, - cuConvId = qUnqualified conv, - cuAlreadyPresentUsers = [qUnqualified joiner], - cuAction = + { time = now, + origUserId = origUser, + convId = qUnqualified conv, + alreadyPresentUsers = [qUnqualified joiner], + action = SomeConversationAction SConversationJoinTag ConversationJoin diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index a213949cb27..dc5fffe2731 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -427,8 +427,7 @@ testEnableTeamSearchVisibilityPerTeam = do (tid, owner, member : _) <- Util.createBindingTeamWithMembers 2 let check :: String -> Public.FeatureStatus -> TestM () check msg enabledness = do - g <- viewGalley - status :: Public.WithStatusNoLock Public.SearchVisibilityAvailableConfig <- responseJsonUnsafe <$> (Util.getTeamSearchVisibilityAvailableInternal g tid (Util.getTeamFeatureInternal @Public.SearchVisibilityAvailableConfig tid UserId -> TeamMember newTeamMember' perms uid = Member.mkTeamMember uid perms Nothing LH.defUserLegalHoldStatus -- NOTE: all client functions calling @{/i,}/teams/*/features/*@ can be replaced by --- hypothetical functions 'getTeamFeatureFlag', 'getTeamFeatureFlagInternal', --- 'putTeamFeatureFlagInternal'. Since these functions all work in slightly different monads +-- hypothetical functions 'getTeamFeature', 'getTeamFeatureInternal', +-- 'putTeamFeatureInternal'. Since these functions all work in slightly different monads -- and with different kinds of internal checks, it's quite tedious to do so. getSSOEnabledInternal :: HasCallStack => TeamId -> TestM ResponseLBS -getSSOEnabledInternal = Util.getTeamFeatureFlagInternal @Public.SSOConfig +getSSOEnabledInternal = Util.getTeamFeatureInternal @Public.SSOConfig putSSOEnabledInternal :: HasCallStack => TeamId -> Public.FeatureStatus -> TestM () putSSOEnabledInternal tid statusValue = - void $ Util.putTeamFeatureFlagInternal @Public.SSOConfig expect2xx tid (Public.WithStatusNoLock statusValue Public.SSOConfig Public.FeatureTTLUnlimited) + void $ Util.putTeamFeatureInternal @Public.SSOConfig expect2xx tid (Public.WithStatusNoLock statusValue Public.SSOConfig Public.FeatureTTLUnlimited) getSearchVisibility :: HasCallStack => (Request -> Request) -> UserId -> TeamId -> MonadHttp m => m ResponseLBS getSearchVisibility g uid tid = do diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index a3f07368c5a..4e0ccdb3cca 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -50,8 +50,8 @@ import Test.Hspec (expectationFailure) import Test.QuickCheck (Gen, generate, suchThat) import Test.Tasty import Test.Tasty.Cannon qualified as WS -import Test.Tasty.HUnit (assertBool, assertFailure, (@?=)) -import TestHelpers (eventually, test) +import Test.Tasty.HUnit (assertFailure, (@?=)) +import TestHelpers (test) import TestSetup import Wire.API.Conversation.Protocol import Wire.API.Event.FeatureConfig qualified as FeatureConfig @@ -267,10 +267,10 @@ testPatch' :: cfg -> TestM () testPatch' testLockStatusChange rndFeatureConfig defStatus defConfig = do - (_, tid) <- createBindingTeam - Just original <- responseJsonMaybe <$> getFeatureStatusInternal @cfg tid - patchFeatureStatusInternal tid rndFeatureConfig !!! statusCode === const 200 - Just actual <- responseJsonMaybe <$> getFeatureStatusInternal @cfg tid + (uid, tid) <- createBindingTeam + Just original <- responseJsonMaybe <$> getTeamFeatureInternal @cfg tid + patchTeamFeatureInternal tid rndFeatureConfig !!! statusCode === const 200 + Just actual <- responseJsonMaybe <$> getTeamFeatureInternal @cfg tid liftIO $ if wsLockStatus actual == LockStatusLocked then do @@ -281,83 +281,55 @@ testPatch' testLockStatusChange rndFeatureConfig defStatus defConfig = do when (testLockStatusChange == AssertLockStatusChange) $ wsLockStatus actual @?= fromMaybe (wsLockStatus original) (wspLockStatus rndFeatureConfig) wsConfig actual @?= fromMaybe (wsConfig original) (wspConfig rndFeatureConfig) + checkTeamFeatureAllEndpoints uid tid actual testSSO :: (TeamId -> FeatureStatus -> TestM ()) -> TestM () testSSO setSSOFeature = do (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 nonMember <- randomUser - let getSSO :: HasCallStack => FeatureStatus -> TestM () - getSSO = assertFlagNoConfig @SSOConfig $ getTeamFeatureFlag @SSOConfig member tid - getSSOFeatureConfig :: HasCallStack => FeatureStatus -> TestM () - getSSOFeatureConfig expectedStatus = do - actual <- Util.getFeatureConfig @SSOConfig member - liftIO $ wsStatus actual @?= expectedStatus - getSSOInternal :: HasCallStack => FeatureStatus -> TestM () - getSSOInternal = assertFlagNoConfig @SSOConfig $ getTeamFeatureFlagInternal @SSOConfig tid - - assertFlagForbidden $ getTeamFeatureFlag @SSOConfig nonMember tid + assertFlagForbidden $ getTeamFeature @SSOConfig nonMember tid featureSSO <- view (tsGConf . settings . featureFlags . flagSSO) case featureSSO of FeatureSSODisabledByDefault -> do -- Test default - getSSO FeatureStatusDisabled - getSSOInternal FeatureStatusDisabled - getSSOFeatureConfig FeatureStatusDisabled + checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusDisabled LockStatusUnlocked SSOConfig FeatureTTLUnlimited) -- Test override setSSOFeature tid FeatureStatusEnabled - getSSO FeatureStatusEnabled - getSSOInternal FeatureStatusEnabled - getSSOFeatureConfig FeatureStatusEnabled + checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusEnabled LockStatusUnlocked SSOConfig FeatureTTLUnlimited) FeatureSSOEnabledByDefault -> do -- since we don't allow to disable (see 'disableSsoNotImplemented'), we can't test -- much here. (disable failure is covered in "enable/disable SSO" above.) - getSSO FeatureStatusEnabled - getSSOInternal FeatureStatusEnabled - getSSOFeatureConfig FeatureStatusEnabled + checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusEnabled LockStatusUnlocked SSOConfig FeatureTTLUnlimited) putSSOInternal :: HasCallStack => TeamId -> FeatureStatus -> TestM () putSSOInternal tid = void - . putTeamFeatureFlagInternal @SSOConfig expect2xx tid + . putTeamFeatureInternal @SSOConfig expect2xx tid . (\st -> WithStatusNoLock st SSOConfig FeatureTTLUnlimited) patchSSOInternal :: HasCallStack => TeamId -> FeatureStatus -> TestM () -patchSSOInternal tid status = void $ patchFeatureStatusInternalWithMod @SSOConfig expect2xx tid (withStatus' (Just status) Nothing Nothing (Just FeatureTTLUnlimited)) +patchSSOInternal tid status = void $ patchTeamFeatureInternalWithMod @SSOConfig expect2xx tid (withStatus' (Just status) Nothing Nothing (Just FeatureTTLUnlimited)) testLegalHold :: ((Request -> Request) -> TeamId -> FeatureStatus -> TestM ()) -> TestM () testLegalHold setLegalHoldInternal = do (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 nonMember <- randomUser - let getLegalHold :: HasCallStack => FeatureStatus -> TestM () - getLegalHold = assertFlagNoConfig @LegalholdConfig $ getTeamFeatureFlag @LegalholdConfig member tid - getLegalHoldInternal :: HasCallStack => FeatureStatus -> TestM () - getLegalHoldInternal = assertFlagNoConfig @LegalholdConfig $ getTeamFeatureFlagInternal @LegalholdConfig tid - getLegalHoldFeatureConfig expectedStatus = do - actual <- Util.getFeatureConfig @LegalholdConfig member - liftIO $ wsStatus actual @?= expectedStatus - - getLegalHold FeatureStatusDisabled - getLegalHoldInternal FeatureStatusDisabled - - assertFlagForbidden $ getTeamFeatureFlag @LegalholdConfig nonMember tid + checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusDisabled LockStatusUnlocked LegalholdConfig FeatureTTLUnlimited) + assertFlagForbidden $ getTeamFeature @LegalholdConfig nonMember tid -- FUTUREWORK: run two galleys, like below for custom search visibility. featureLegalHold <- view (tsGConf . settings . featureFlags . flagLegalHold) case featureLegalHold of FeatureLegalHoldDisabledByDefault -> do -- Test default - getLegalHold FeatureStatusDisabled - getLegalHoldInternal FeatureStatusDisabled - getLegalHoldFeatureConfig FeatureStatusDisabled + checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusDisabled LockStatusUnlocked LegalholdConfig FeatureTTLUnlimited) -- Test override setLegalHoldInternal expect2xx tid FeatureStatusEnabled - getLegalHold FeatureStatusEnabled - getLegalHoldInternal FeatureStatusEnabled - getLegalHoldFeatureConfig FeatureStatusEnabled + checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusEnabled LockStatusUnlocked LegalholdConfig FeatureTTLUnlimited) -- turned off for instance FeatureLegalHoldDisabledPermanently -> do @@ -370,139 +342,65 @@ testLegalHold setLegalHoldInternal = do putLegalHoldInternal :: HasCallStack => (Request -> Request) -> TeamId -> FeatureStatus -> TestM () putLegalHoldInternal expectation tid = void - . putTeamFeatureFlagInternal @LegalholdConfig expectation tid + . putTeamFeatureInternal @LegalholdConfig expectation tid . (\st -> WithStatusNoLock st LegalholdConfig FeatureTTLUnlimited) patchLegalHoldInternal :: HasCallStack => (Request -> Request) -> TeamId -> FeatureStatus -> TestM () -patchLegalHoldInternal expectation tid status = void $ patchFeatureStatusInternalWithMod @LegalholdConfig expectation tid (withStatus' (Just status) Nothing Nothing (Just FeatureTTLUnlimited)) +patchLegalHoldInternal expectation tid status = void $ patchTeamFeatureInternalWithMod @LegalholdConfig expectation tid (withStatus' (Just status) Nothing Nothing (Just FeatureTTLUnlimited)) testSearchVisibility :: TestM () testSearchVisibility = do - let getTeamSearchVisibility :: TeamId -> UserId -> FeatureStatus -> TestM () - getTeamSearchVisibility teamid uid expected = do - g <- viewGalley - getTeamSearchVisibilityAvailable g uid teamid !!! do - statusCode === const 200 - responseJsonEither === const (Right (WithStatusNoLock expected SearchVisibilityAvailableConfig FeatureTTLUnlimited)) - - let getTeamSearchVisibilityInternal :: TeamId -> FeatureStatus -> TestM () - getTeamSearchVisibilityInternal teamid expected = do - g <- viewGalley - getTeamSearchVisibilityAvailableInternal g teamid !!! do - statusCode === const 200 - responseJsonEither === const (Right (WithStatusNoLock expected SearchVisibilityAvailableConfig FeatureTTLUnlimited)) - - let getTeamSearchVisibilityFeatureConfig :: UserId -> FeatureStatus -> TestM () - getTeamSearchVisibilityFeatureConfig uid expected = do - actual <- Util.getFeatureConfig @SearchVisibilityAvailableConfig uid - liftIO $ wsStatus actual @?= expected - let setTeamSearchVisibilityInternal :: TeamId -> FeatureStatus -> TestM () setTeamSearchVisibilityInternal teamid val = do - g <- viewGalley - putTeamSearchVisibilityAvailableInternal g teamid val + putTeamSearchVisibilityAvailableInternal teamid val - (owner, tid, [member]) <- createBindingTeamWithNMembers 1 + (_, tid, [member]) <- createBindingTeamWithNMembers 1 nonMember <- randomUser - assertFlagForbidden $ getTeamFeatureFlag @SearchVisibilityAvailableConfig nonMember tid + assertFlagForbidden $ getTeamFeature @SearchVisibilityAvailableConfig nonMember tid withCustomSearchFeature FeatureTeamSearchVisibilityUnavailableByDefault $ do - getTeamSearchVisibility tid owner FeatureStatusDisabled - getTeamSearchVisibilityInternal tid FeatureStatusDisabled - getTeamSearchVisibilityFeatureConfig member FeatureStatusDisabled + checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited) setTeamSearchVisibilityInternal tid FeatureStatusEnabled - getTeamSearchVisibility tid owner FeatureStatusEnabled - getTeamSearchVisibilityInternal tid FeatureStatusEnabled - getTeamSearchVisibilityFeatureConfig member FeatureStatusEnabled + checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusEnabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited) setTeamSearchVisibilityInternal tid FeatureStatusDisabled - getTeamSearchVisibility tid owner FeatureStatusDisabled - getTeamSearchVisibilityInternal tid FeatureStatusDisabled - getTeamSearchVisibilityFeatureConfig member FeatureStatusDisabled + checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited) - (owner2, tid2, team2member : _) <- createBindingTeamWithNMembers 1 + (_, tid2, team2member : _) <- createBindingTeamWithNMembers 1 withCustomSearchFeature FeatureTeamSearchVisibilityAvailableByDefault $ do - getTeamSearchVisibility tid2 owner2 FeatureStatusEnabled - getTeamSearchVisibilityInternal tid2 FeatureStatusEnabled - getTeamSearchVisibilityFeatureConfig team2member FeatureStatusEnabled + checkTeamFeatureAllEndpoints team2member tid2 (withStatus FeatureStatusEnabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited) setTeamSearchVisibilityInternal tid2 FeatureStatusDisabled - getTeamSearchVisibility tid2 owner2 FeatureStatusDisabled - getTeamSearchVisibilityInternal tid2 FeatureStatusDisabled - getTeamSearchVisibilityFeatureConfig team2member FeatureStatusDisabled + checkTeamFeatureAllEndpoints team2member tid2 (withStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited) setTeamSearchVisibilityInternal tid2 FeatureStatusEnabled - getTeamSearchVisibility tid2 owner2 FeatureStatusEnabled - getTeamSearchVisibilityInternal tid2 FeatureStatusEnabled - getTeamSearchVisibilityFeatureConfig team2member FeatureStatusEnabled - -getClassifiedDomains :: - (HasCallStack, HasGalley m, MonadIO m, MonadHttp m, MonadCatch m) => - UserId -> - TeamId -> - WithStatusNoLock ClassifiedDomainsConfig -> - m () -getClassifiedDomains member tid = - assertFlagWithConfig @ClassifiedDomainsConfig $ - getTeamFeatureFlag @ClassifiedDomainsConfig member tid - -getClassifiedDomainsInternal :: - (HasCallStack, HasGalley m, MonadIO m, MonadHttp m, MonadCatch m) => - TeamId -> - WithStatusNoLock ClassifiedDomainsConfig -> - m () -getClassifiedDomainsInternal tid = - assertFlagWithConfig @ClassifiedDomainsConfig $ - getTeamFeatureFlagInternal @ClassifiedDomainsConfig tid + checkTeamFeatureAllEndpoints team2member tid2 (withStatus FeatureStatusEnabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited) testClassifiedDomainsEnabled :: TestM () testClassifiedDomainsEnabled = do - (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 + (_, tid, member : _) <- createBindingTeamWithNMembers 1 let expected = - WithStatusNoLock FeatureStatusEnabled (ClassifiedDomainsConfig [Domain "example.com"]) FeatureTTLUnlimited - - let getClassifiedDomainsFeatureConfig :: - (HasCallStack, HasGalley m, MonadIO m, MonadHttp m, MonadCatch m) => - UserId -> - WithStatusNoLock ClassifiedDomainsConfig -> - m () - getClassifiedDomainsFeatureConfig uid expected' = do - result <- Util.getFeatureConfig @ClassifiedDomainsConfig uid - liftIO $ wsStatus result @?= wssStatus expected' - liftIO $ wsConfig result @?= wssConfig expected' - - getClassifiedDomains member tid expected - getClassifiedDomainsInternal tid expected - getClassifiedDomainsFeatureConfig member expected + withStatus FeatureStatusEnabled LockStatusUnlocked (ClassifiedDomainsConfig [Domain "example.com"]) FeatureTTLUnlimited + + checkTeamFeatureAllEndpoints member tid expected testClassifiedDomainsDisabled :: TestM () testClassifiedDomainsDisabled = do (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 let expected = - WithStatusNoLock FeatureStatusDisabled (ClassifiedDomainsConfig []) FeatureTTLUnlimited - - let getClassifiedDomainsFeatureConfig :: - (HasCallStack, HasGalley m, MonadIO m, MonadHttp m, MonadCatch m) => - UserId -> - WithStatusNoLock ClassifiedDomainsConfig -> - m () - getClassifiedDomainsFeatureConfig uid expected' = do - result <- Util.getFeatureConfig @ClassifiedDomainsConfig uid - liftIO $ wsStatus result @?= wssStatus expected' - liftIO $ wsConfig result @?= wssConfig expected' + withStatus FeatureStatusDisabled LockStatusUnlocked (ClassifiedDomainsConfig []) FeatureTTLUnlimited let classifiedDomainsDisabled opts = opts & over (settings . featureFlags . flagClassifiedDomains) (\(ImplicitLockStatus s) -> ImplicitLockStatus (s & setStatus FeatureStatusDisabled & setConfig (ClassifiedDomainsConfig []))) - withSettingsOverrides classifiedDomainsDisabled $ do - getClassifiedDomains member tid expected - getClassifiedDomainsInternal tid expected - getClassifiedDomainsFeatureConfig member expected + + withSettingsOverrides classifiedDomainsDisabled $ + checkTeamFeatureAllEndpoints member tid expected testSimpleFlag :: forall cfg. @@ -526,7 +424,8 @@ testSimpleFlagTTLOverride :: KnownSymbol (FeatureSymbol cfg), FeatureTrivialConfig cfg, ToSchema cfg, - FromJSON (WithStatusNoLock cfg) + Eq cfg, + Show cfg ) => FeatureStatus -> FeatureTTL -> @@ -536,23 +435,9 @@ testSimpleFlagTTLOverride defaultValue ttl ttlAfter = do (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 nonMember <- randomUser - let getFlag :: HasCallStack => FeatureStatus -> TestM () - getFlag expected = eventually $ do - flip (assertFlagNoConfig @cfg) expected $ getTeamFeatureFlag @cfg member tid - - getFeatureConfig :: HasCallStack => FeatureStatus -> FeatureTTL -> TestM () - getFeatureConfig expectedStatus expectedTtl = eventually $ do - actual <- Util.getFeatureConfig @cfg member - liftIO $ wsStatus actual @?= expectedStatus - liftIO $ checkTtl (wsTTL actual) expectedTtl - - getFlagInternal :: HasCallStack => FeatureStatus -> TestM () - getFlagInternal expected = eventually $ do - flip (assertFlagNoConfig @cfg) expected $ getTeamFeatureFlagInternal @cfg tid - - setFlagInternal :: FeatureStatus -> FeatureTTL -> TestM () + let setFlagInternal :: FeatureStatus -> FeatureTTL -> TestM () setFlagInternal statusValue ttl' = - void $ putTeamFeatureFlagInternalTTL @cfg expect2xx tid (WithStatusNoLock statusValue (trivialConfig @cfg) ttl') + void $ putTeamFeatureInternal @cfg expect2xx tid (WithStatusNoLock statusValue (trivialConfig @cfg) ttl') select :: PrepQuery R (Identity TeamId) (Identity (Maybe FeatureTTL)) select = fromString "select ttl(conference_calling) from team_features where team_id = ?" @@ -577,37 +462,21 @@ testSimpleFlagTTLOverride defaultValue ttl ttlAfter = do Just (FeatureTTLSeconds i) -> i <= upper unless check $ error ("expected ttl <= " <> show upper <> ", got " <> show storedTTL) - checkTtl :: FeatureTTL -> FeatureTTL -> IO () - checkTtl (FeatureTTLSeconds actualTtl) (FeatureTTLSeconds expectedTtl) = - assertBool - ("expected the actual TTL to be greater than 0 and equal to or no more than 2 seconds less than " <> show expectedTtl <> ", but it was " <> show actualTtl) - ( actualTtl > 0 - && actualTtl <= expectedTtl - && abs (fromIntegral @Word @Int actualTtl - fromIntegral @Word @Int expectedTtl) <= 2 - ) - checkTtl FeatureTTLUnlimited FeatureTTLUnlimited = pure () - checkTtl FeatureTTLUnlimited _ = assertFailure "expected the actual TTL to be unlimited, but it was limited" - checkTtl _ FeatureTTLUnlimited = assertFailure "expected the actual TTL to be limited, but it was unlimited" - toMicros :: Word -> Int toMicros secs = fromIntegral secs * 1000000 - assertFlagForbidden $ getTeamFeatureFlag @cfg nonMember tid + assertFlagForbidden $ getTeamFeature @cfg nonMember tid let otherValue = case defaultValue of FeatureStatusDisabled -> FeatureStatusEnabled FeatureStatusEnabled -> FeatureStatusDisabled -- Initial value should be the default value - getFlag defaultValue - getFlagInternal defaultValue - getFeatureConfig defaultValue FeatureTTLUnlimited + checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus defaultValue) -- Setting should work setFlagInternal otherValue ttl - getFlag otherValue - getFeatureConfig otherValue ttl - getFlagInternal otherValue + checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus otherValue & setTTL ttl) case (ttl, ttlAfter) of (FeatureTTLSeconds d, FeatureTTLSeconds d') -> do @@ -616,47 +485,32 @@ testSimpleFlagTTLOverride defaultValue ttl ttlAfter = do liftIO $ threadDelay (toMicros d `div` 2) -- waiting half of TTL setFlagInternal otherValue ttlAfter -- value is still correct - getFlag otherValue + checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus otherValue & setTTL ttlAfter) liftIO $ threadDelay (toMicros d') -- waiting for new TTL - getFlag defaultValue - assertUnlimited -- TTL should be NULL after expiration. + checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus defaultValue) (FeatureTTLSeconds d, FeatureTTLUnlimited) -> do assertLimited d -- TTL should be NULL after expiration. -- wait less than expiration, override and recheck. liftIO $ threadDelay (fromIntegral d `div` 2) -- waiting half of TTL setFlagInternal otherValue ttlAfter -- value is still correct - getFlag otherValue - assertUnlimited + checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus otherValue & setTTL ttlAfter) (FeatureTTLUnlimited, FeatureTTLUnlimited) -> do assertUnlimited -- overriding in this case should have no effect. setFlagInternal otherValue ttl - getFlag otherValue - getFeatureConfig otherValue ttl - getFlagInternal otherValue - - assertUnlimited + checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus otherValue & setTTL ttl) (FeatureTTLUnlimited, FeatureTTLSeconds d) -> do assertUnlimited setFlagInternal otherValue ttlAfter - getFlag otherValue - getFeatureConfig otherValue ttlAfter - getFlagInternal otherValue + checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus otherValue & setTTL ttlAfter) liftIO $ threadDelay (toMicros d) -- waiting it out -- value reverts back - getFlag defaultValue - -- TTL should be NULL inside cassandra - assertUnlimited - - -- Clean up - setFlagInternal defaultValue FeatureTTLUnlimited - assertUnlimited - getFlag defaultValue + checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus defaultValue & setTTL ttl) testSimpleFlagTTL :: forall cfg. @@ -677,7 +531,7 @@ testSimpleFlagTTL defaultValue ttl = do let getFlag :: HasCallStack => FeatureStatus -> TestM () getFlag expected = - flip (assertFlagNoConfig @cfg) expected $ getTeamFeatureFlag @cfg member tid + flip (assertFlagNoConfig @cfg) expected $ getTeamFeature @cfg member tid getFeatureConfig :: HasCallStack => FeatureStatus -> TestM () getFeatureConfig expected = do @@ -686,11 +540,11 @@ testSimpleFlagTTL defaultValue ttl = do getFlagInternal :: HasCallStack => FeatureStatus -> TestM () getFlagInternal expected = - flip (assertFlagNoConfig @cfg) expected $ getTeamFeatureFlagInternal @cfg tid + flip (assertFlagNoConfig @cfg) expected $ getTeamFeatureInternal @cfg tid setFlagInternal :: FeatureStatus -> FeatureTTL -> TestM () setFlagInternal statusValue ttl' = - void $ putTeamFeatureFlagInternalTTL @cfg expect2xx tid (WithStatusNoLock statusValue (trivialConfig @cfg) ttl') + void $ putTeamFeatureInternal @cfg expect2xx tid (WithStatusNoLock statusValue (trivialConfig @cfg) ttl') select :: PrepQuery R (Identity TeamId) (Identity (Maybe FeatureTTL)) select = fromString "select ttl(conference_calling) from team_features where team_id = ?" @@ -715,7 +569,7 @@ testSimpleFlagTTL defaultValue ttl = do Just (FeatureTTLSeconds i) -> i <= upper unless check $ error ("expected ttl <= " <> show upper <> ", got " <> show storedTTL) - assertFlagForbidden $ getTeamFeatureFlag @cfg nonMember tid + assertFlagForbidden $ getTeamFeature @cfg nonMember tid let otherValue = case defaultValue of FeatureStatusDisabled -> FeatureStatusEnabled @@ -775,7 +629,7 @@ testSimpleFlagWithLockStatus defaultStatus defaultLockStatus = do let getFlag :: HasCallStack => FeatureStatus -> LockStatus -> TestM () getFlag expectedStatus expectedLockStatus = do - let flag = getTeamFeatureFlag @cfg member tid + let flag = getTeamFeature @cfg member tid assertFlagNoConfigWithLockStatus @cfg flag expectedStatus expectedLockStatus getFeatureConfig :: HasCallStack => FeatureStatus -> LockStatus -> TestM () @@ -786,7 +640,7 @@ testSimpleFlagWithLockStatus defaultStatus defaultLockStatus = do getFlagInternal :: HasCallStack => FeatureStatus -> LockStatus -> TestM () getFlagInternal expectedStatus expectedLockStatus = do - let flag = getTeamFeatureFlagInternal @cfg tid + let flag = getTeamFeatureInternal @cfg tid assertFlagNoConfigWithLockStatus @cfg flag expectedStatus expectedLockStatus getFlags expectedStatus expectedLockStatus = do @@ -796,13 +650,13 @@ testSimpleFlagWithLockStatus defaultStatus defaultLockStatus = do setFlagWithGalley :: FeatureStatus -> TestM () setFlagWithGalley statusValue = - putTeamFeatureFlagWithGalley @cfg galley owner tid (WithStatusNoLock statusValue (trivialConfig @cfg) FeatureTTLUnlimited) + putTeamFeature @cfg owner tid (WithStatusNoLock statusValue (trivialConfig @cfg) FeatureTTLUnlimited) !!! statusCode === const 200 assertSetStatusForbidden :: FeatureStatus -> TestM () assertSetStatusForbidden statusValue = - putTeamFeatureFlagWithGalley @cfg galley owner tid (WithStatusNoLock statusValue (trivialConfig @cfg) FeatureTTLUnlimited) + putTeamFeature @cfg owner tid (WithStatusNoLock statusValue (trivialConfig @cfg) FeatureTTLUnlimited) !!! statusCode === const 409 @@ -812,7 +666,7 @@ testSimpleFlagWithLockStatus defaultStatus defaultLockStatus = do !!! statusCode === const 200 - assertFlagForbidden $ getTeamFeatureFlag @cfg nonMember tid + assertFlagForbidden $ getTeamFeature @cfg nonMember tid let otherStatus = case defaultStatus of FeatureStatusDisabled -> FeatureStatusEnabled @@ -889,7 +743,7 @@ testSelfDeletingMessages = do let checkSet :: FeatureStatus -> Int32 -> Int -> TestM () checkSet stat tout expectedStatusCode = do - putTeamFeatureFlagInternal @SelfDeletingMessagesConfig + putTeamFeatureInternal @SelfDeletingMessagesConfig galley tid (settingWithoutLockStatus stat tout) @@ -901,8 +755,8 @@ testSelfDeletingMessages = do checkGet stat tout lockStatus = do let expected = settingWithLockStatus stat tout lockStatus forM_ - [ getTeamFeatureFlagInternal @SelfDeletingMessagesConfig tid, - getTeamFeatureFlagWithGalley @SelfDeletingMessagesConfig galley owner tid + [ getTeamFeatureInternal @SelfDeletingMessagesConfig tid, + getTeamFeature @SelfDeletingMessagesConfig owner tid ] (!!! responseJsonEither === const (Right expected)) result <- Util.getFeatureConfig @SelfDeletingMessagesConfig owner @@ -954,16 +808,16 @@ testGuestLinksInternal :: TestM () testGuestLinksInternal = do galley <- viewGalley testGuestLinks - (const $ getTeamFeatureFlagInternal @GuestLinksConfig) - (const $ putTeamFeatureFlagInternal @GuestLinksConfig galley) + (const $ getTeamFeatureInternal @GuestLinksConfig) + (const $ putTeamFeatureInternal @GuestLinksConfig galley) (Util.setLockStatusInternal @GuestLinksConfig galley) testGuestLinksPublic :: TestM () testGuestLinksPublic = do galley <- viewGalley testGuestLinks - (getTeamFeatureFlagWithGalley @GuestLinksConfig galley) - (putTeamFeatureFlagWithGalley @GuestLinksConfig galley) + (getTeamFeature @GuestLinksConfig) + (putTeamFeature @GuestLinksConfig) (Util.setLockStatusInternal @GuestLinksConfig galley) testGuestLinks :: @@ -1027,19 +881,19 @@ testAllFeatures = do -- 2. there is a row for team_id in galley.team_features but the feature has a no entry (null value) galley <- viewGalley -- this sets the guest links config to its default value thereby creating a row for the team in galley.team_features - putTeamFeatureFlagInternal @GuestLinksConfig galley tid (WithStatusNoLock FeatureStatusEnabled GuestLinksConfig FeatureTTLUnlimited) + putTeamFeatureInternal @GuestLinksConfig galley tid (WithStatusNoLock FeatureStatusEnabled GuestLinksConfig FeatureTTLUnlimited) !!! statusCode === const 200 getAllTeamFeatures member tid !!! do statusCode === const 200 responseJsonMaybe === const (Just (expected FeatureStatusEnabled defLockStatus {- determined by default in galley -})) - getAllTeamFeaturesPersonal member !!! do + getAllFeatureConfigs member !!! do statusCode === const 200 responseJsonMaybe === const (Just (expected FeatureStatusEnabled defLockStatus {- determined by default in galley -})) randomPersonalUser <- randomUser - getAllTeamFeaturesPersonal randomPersonalUser !!! do + getAllFeatureConfigs randomPersonalUser !!! do statusCode === const 200 responseJsonMaybe === const (Just (expected FeatureStatusEnabled defLockStatus {- determined by 'getAfcConferenceCallingDefNew' in brig -})) where @@ -1096,11 +950,11 @@ testSearchVisibilityInbound = do let getFlagInternal :: HasCallStack => FeatureStatus -> TestM () getFlagInternal expected = - flip (assertFlagNoConfig @SearchVisibilityInboundConfig) expected $ getTeamFeatureFlagInternal @SearchVisibilityInboundConfig tid + flip (assertFlagNoConfig @SearchVisibilityInboundConfig) expected $ getTeamFeatureInternal @SearchVisibilityInboundConfig tid setFlagInternal :: FeatureStatus -> TestM () setFlagInternal statusValue = - void $ putTeamFeatureFlagInternal @SearchVisibilityInboundConfig expect2xx tid (WithStatusNoLock statusValue SearchVisibilityInboundConfig FeatureTTLUnlimited) + void $ putTeamFeatureInternal @SearchVisibilityInboundConfig expect2xx tid (WithStatusNoLock statusValue SearchVisibilityInboundConfig FeatureTTLUnlimited) let otherValue = case defaultValue of FeatureStatusDisabled -> FeatureStatusEnabled @@ -1118,7 +972,7 @@ testFeatureNoConfigMultiSearchVisibilityInbound = do let setFlagInternal :: TeamId -> FeatureStatus -> TestM () setFlagInternal tid statusValue = - void $ putTeamFeatureFlagInternal @SearchVisibilityInboundConfig expect2xx tid (WithStatusNoLock statusValue SearchVisibilityInboundConfig FeatureTTLUnlimited) + void $ putTeamFeatureInternal @SearchVisibilityInboundConfig expect2xx tid (WithStatusNoLock statusValue SearchVisibilityInboundConfig FeatureTTLUnlimited) setFlagInternal team2 FeatureStatusEnabled @@ -1159,11 +1013,11 @@ testNonTrivialConfigNoTTL defaultCfg = do let getForTeam :: HasCallStack => WithStatusNoLock cfg -> TestM () getForTeam expected = - flip assertFlagWithConfig expected $ getTeamFeatureFlag @cfg member tid + flip assertFlagWithConfig expected $ getTeamFeature @cfg member tid getForTeamInternal :: HasCallStack => WithStatusNoLock cfg -> TestM () getForTeamInternal expected = - flip assertFlagWithConfig expected $ getTeamFeatureFlagInternal @cfg tid + flip assertFlagWithConfig expected $ getTeamFeatureInternal @cfg tid getForUser :: HasCallStack => WithStatusNoLock cfg -> TestM () getForUser expected = do @@ -1179,20 +1033,20 @@ testNonTrivialConfigNoTTL defaultCfg = do setForTeam :: HasCallStack => WithStatusNoLock cfg -> TestM () setForTeam wsnl = - putTeamFeatureFlagWithGalley @cfg galley owner tid wsnl + putTeamFeature @cfg owner tid wsnl !!! statusCode === const 200 setForTeamInternal :: HasCallStack => WithStatusNoLock cfg -> TestM () setForTeamInternal wsnl = - void $ putTeamFeatureFlagInternal @cfg expect2xx tid wsnl + void $ putTeamFeatureInternal @cfg expect2xx tid wsnl setLockStatus :: LockStatus -> TestM () setLockStatus lockStatus = Util.setLockStatusInternal @cfg galley tid lockStatus !!! statusCode === const 200 - assertFlagForbidden $ getTeamFeatureFlag @cfg nonMember tid + assertFlagForbidden $ getTeamFeature @cfg nonMember tid getViaEndpoints (forgetLock defaultCfg) @@ -1216,7 +1070,7 @@ testNonTrivialConfigNoTTL defaultCfg = do config2 <- liftIO $ generate arbitrary <&> (forgetLock . setTTL FeatureTTLUnlimited) config3 <- liftIO $ generate arbitrary <&> (forgetLock . setTTL FeatureTTLUnlimited) - putTeamFeatureFlagWithGalley @MLSConfig galley owner tid defaultMLSConfig + putTeamFeature @MLSConfig owner tid defaultMLSConfig !!! statusCode === const 200 @@ -1252,11 +1106,11 @@ testMLS = do let getForTeam :: HasCallStack => WithStatusNoLock MLSConfig -> TestM () getForTeam expected = - flip assertFlagWithConfig expected $ getTeamFeatureFlag @MLSConfig member tid + flip assertFlagWithConfig expected $ getTeamFeature @MLSConfig member tid getForTeamInternal :: HasCallStack => WithStatusNoLock MLSConfig -> TestM () getForTeamInternal expected = - flip assertFlagWithConfig expected $ getTeamFeatureFlagInternal @MLSConfig tid + flip assertFlagWithConfig expected $ getTeamFeatureInternal @MLSConfig tid getForUser :: HasCallStack => WithStatusNoLock MLSConfig -> TestM () getForUser expected = do @@ -1272,7 +1126,7 @@ testMLS = do setForTeamWithStatusCode :: HasCallStack => Int -> WithStatusNoLock MLSConfig -> TestM () setForTeamWithStatusCode resStatusCode wsnl = - putTeamFeatureFlagWithGalley @MLSConfig galley owner tid wsnl + putTeamFeature @MLSConfig owner tid wsnl !!! statusCode === const resStatusCode @@ -1281,7 +1135,7 @@ testMLS = do setForTeamInternalWithStatusCode :: HasCallStack => (Request -> Request) -> WithStatusNoLock MLSConfig -> TestM () setForTeamInternalWithStatusCode expect wsnl = - void $ putTeamFeatureFlagInternal @MLSConfig expect tid wsnl + void $ putTeamFeatureInternal @MLSConfig expect tid wsnl setForTeamInternal :: HasCallStack => WithStatusNoLock MLSConfig -> TestM () setForTeamInternal = setForTeamInternalWithStatusCode expect2xx @@ -1357,11 +1211,10 @@ testExposeInvitationURLsToTeamAdminTeamIdInAllowList = do assertTeamActivate "create team" tid void $ withSettingsOverrides (\opts -> opts & settings . exposeInvitationURLsTeamAllowlist ?~ [tid]) $ do - g <- viewGalley assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled LockStatusUnlocked let enabled = WithStatusNoLock FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited void $ - putTeamFeatureFlagWithGalley @ExposeInvitationURLsToTeamAdminConfig g owner tid enabled !!! do + putTeamFeature @ExposeInvitationURLsToTeamAdminConfig owner tid enabled !!! do const 200 === statusCode assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusEnabled LockStatusUnlocked @@ -1372,11 +1225,10 @@ testExposeInvitationURLsToTeamAdminEmptyAllowList = do assertTeamActivate "create team" tid void $ withSettingsOverrides (\opts -> opts & settings . exposeInvitationURLsTeamAllowlist .~ Nothing) $ do - g <- viewGalley assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled LockStatusLocked let enabled = WithStatusNoLock FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited void $ - putTeamFeatureFlagWithGalley @ExposeInvitationURLsToTeamAdminConfig g owner tid enabled !!! do + putTeamFeature @ExposeInvitationURLsToTeamAdminConfig owner tid enabled !!! do const 409 === statusCode assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled LockStatusLocked @@ -1393,27 +1245,24 @@ testExposeInvitationURLsToTeamAdminServerConfigTakesPrecedence = do assertTeamActivate "create team" tid void $ withSettingsOverrides (\opts -> opts & settings . exposeInvitationURLsTeamAllowlist ?~ [tid]) $ do - g <- viewGalley assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled LockStatusUnlocked let enabled = WithStatusNoLock FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited void $ - putTeamFeatureFlagWithGalley @ExposeInvitationURLsToTeamAdminConfig g owner tid enabled !!! do + putTeamFeature @ExposeInvitationURLsToTeamAdminConfig owner tid enabled !!! do const 200 === statusCode assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusEnabled LockStatusUnlocked void $ withSettingsOverrides (\opts -> opts & settings . exposeInvitationURLsTeamAllowlist .~ Nothing) $ do - g <- viewGalley assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled LockStatusLocked let enabled = WithStatusNoLock FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited void $ - putTeamFeatureFlagWithGalley @ExposeInvitationURLsToTeamAdminConfig g owner tid enabled !!! do + putTeamFeature @ExposeInvitationURLsToTeamAdminConfig owner tid enabled !!! do const 409 === statusCode assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled LockStatusLocked assertExposeInvitationURLsToTeamAdminConfigStatus :: UserId -> TeamId -> FeatureStatus -> LockStatus -> TestM () assertExposeInvitationURLsToTeamAdminConfigStatus owner tid fStatus lStatus = do - g <- viewGalley - Util.getTeamFeatureFlagWithGalley @ExposeInvitationURLsToTeamAdminConfig g owner tid !!! do + getTeamFeature @ExposeInvitationURLsToTeamAdminConfig owner tid !!! do const 200 === statusCode const (Right (withStatus fStatus lStatus ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited)) === responseJsonEither diff --git a/services/galley/test/integration/API/Teams/LegalHold.hs b/services/galley/test/integration/API/Teams/LegalHold.hs index 91315aa036d..c9a3118bcf6 100644 --- a/services/galley/test/integration/API/Teams/LegalHold.hs +++ b/services/galley/test/integration/API/Teams/LegalHold.hs @@ -20,81 +20,45 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module API.Teams.LegalHold - ( tests, - ) -where +module API.Teams.LegalHold (tests) where import API.Teams.LegalHold.Util import API.Util import Bilge hiding (accept, head, timeout, trace) import Bilge.Assert -import Brig.Types.Intra (UserSet (..)) import Brig.Types.Test.Arbitrary () -import Brig.Types.User.Event qualified as Ev -import Cassandra.Exec qualified as Cql -import Control.Category ((>>>)) import Control.Concurrent.Chan import Control.Lens hiding ((#)) import Data.Id import Data.LegalHold import Data.List.NonEmpty (NonEmpty (..)) -import Data.List1 qualified as List1 -import Data.Map.Strict qualified as Map import Data.PEM import Data.Qualified (Qualified (..)) import Data.Range -import Data.Set qualified as Set import Data.Time.Clock qualified as Time -import Data.Timeout -import Galley.Cassandra.Client (lookupClients) import Galley.Cassandra.LegalHold -import Galley.Cassandra.LegalHold qualified as LegalHoldData import Galley.Env qualified as Galley -import Galley.Options (featureFlags, settings) -import Galley.Types.Clients qualified as Clients -import Galley.Types.Teams import Imports import Network.HTTP.Types.Status (status200, status404) import Network.Wai as Wai import Network.Wai.Handler.Warp qualified as Warp import Network.Wai.Utilities.Error qualified as Error -import System.IO (hPutStrLn) import Test.QuickCheck.Instances () import Test.Tasty -import Test.Tasty.Cannon qualified as WS import Test.Tasty.HUnit import TestHelpers import TestSetup -import Wire.API.Connection (UserConnection) import Wire.API.Connection qualified as Conn -import Wire.API.Conversation.Role (roleNameWireAdmin, roleNameWireMember) +import Wire.API.Conversation.Role (roleNameWireAdmin) import Wire.API.Provider.Service import Wire.API.Routes.Internal.Brig.Connection -import Wire.API.Team.Feature qualified as Public import Wire.API.Team.LegalHold -import Wire.API.Team.LegalHold.External import Wire.API.Team.Member import Wire.API.Team.Member qualified as Team import Wire.API.Team.Permission import Wire.API.Team.Role import Wire.API.User.Client -onlyIfLhWhitelisted :: TestM () -> TestM () -onlyIfLhWhitelisted action = do - featureLegalHold <- view (tsGConf . settings . featureFlags . flagLegalHold) - case featureLegalHold of - FeatureLegalHoldDisabledPermanently -> - liftIO $ hPutStrLn stderr errmsg - FeatureLegalHoldDisabledByDefault -> - liftIO $ hPutStrLn stderr errmsg - FeatureLegalHoldWhitelistTeamsAndImplicitConsent -> action - where - errmsg = - "*** skipping test. This test only works if you manually adjust the server config files\ - \(the 'withLHWhitelist' trick does not work because it does not allow \ - \brig to talk to the dynamically spawned galley)." - tests :: IO TestSetup -> TestTree tests s = testGroup "Legalhold" [testsPublic s, testsInternal s] @@ -103,22 +67,13 @@ testsPublic s = -- See also Client Tests in Brig; where behaviour around deleting/adding LH clients is tested testGroup "Teams LegalHold API (with flag whitelist-teams-and-implicit-consent)" - [ -- device handling (CRUD) - testOnlyIfLhWhitelisted s "POST /teams/{tid}/legalhold/{uid}" testRequestLegalHoldDevice, - testOnlyIfLhWhitelisted s "PUT /teams/{tid}/legalhold/approve" testApproveLegalHoldDevice, - test s "(user denies approval: nothing needs to be done in backend)" (pure ()), - testOnlyIfLhWhitelisted s "GET /teams/{tid}/legalhold/{uid}" testGetLegalHoldDeviceStatus, - testOnlyIfLhWhitelisted s "DELETE /teams/{tid}/legalhold/{uid}" testDisableLegalHoldForUser, - -- legal hold settings + [ -- legal hold settings testOnlyIfLhWhitelisted s "POST /teams/{tid}/legalhold/settings" testCreateLegalHoldTeamSettings, testOnlyIfLhWhitelisted s "GET /teams/{tid}/legalhold/settings" testGetLegalHoldTeamSettings, testOnlyIfLhWhitelisted s "Not implemented: DELETE /teams/{tid}/legalhold/settings" testRemoveLegalHoldFromTeam, - testOnlyIfLhWhitelisted s "GET [/i]?/teams/{tid}/legalhold" testEnablePerTeam, -- behavior of existing end-points testOnlyIfLhWhitelisted s "POST /clients" testCannotCreateLegalHoldDeviceOldAPI, - testOnlyIfLhWhitelisted s "GET /teams/{tid}/members" testGetTeamMembersIncludesLHStatus, testOnlyIfLhWhitelisted s "POST /register - can add team members above fanout limit when whitelisting is enabled" testAddTeamUserTooLargeWithLegalholdWhitelisted, - testOnlyIfLhWhitelisted s "GET legalhold status in user profile" testGetLegalholdStatus, {- TODO: conversations/{cnv}/otr/messages - possibly show the legal hold device (if missing) as a different device type (or show that on device level, depending on how client teams prefer) GET /team/{tid}/members - show legal hold status of all members @@ -128,39 +83,12 @@ testsPublic s = "settings.legalholdEnabledTeams" -- FUTUREWORK: ungroup this level [ testGroup -- FUTUREWORK: ungroup this level "teams listed" - [ test s "happy flow" testInWhitelist, - testGroup "no-consent" $ do - connectFirst <- ("connectFirst",) <$> [False, True] - teamPeer <- ("teamPeer",) <$> [False, True] - approveLH <- ("approveLH",) <$> [False, True] - testPendingConnection <- ("testPendingConnection",) <$> [False, True] - let name = intercalate ", " $ map (\(n, b) -> n <> "=" <> show b) [connectFirst, teamPeer, approveLH, testPendingConnection] - pure . test s name $ testNoConsentBlockOne2OneConv (snd connectFirst) (snd teamPeer) (snd approveLH) (snd testPendingConnection), - testGroup - "Legalhold is activated for user A in a group conversation" - [ testOnlyIfLhWhitelisted s "All admins are consenting: all non-consenters get removed from conversation" (testNoConsentRemoveFromGroupConv LegalholderIsAdmin), - testOnlyIfLhWhitelisted s "Some admins are consenting: all non-consenters get removed from conversation" (testNoConsentRemoveFromGroupConv BothAreAdmins), - testOnlyIfLhWhitelisted s "No admins are consenting: all LH activated/pending users get removed from conversation" (testNoConsentRemoveFromGroupConv PeerIsAdmin) - ], - testGroup + [ testGroup "Users are invited to a group conversation." [ testGroup - "At least one invited user has activated legalhold. At least one admin of the group has given consent." - [ test - s - "If all all users in the invite have given consent then the invite succeeds and all non-consenters from the group get removed" - (onlyIfLhWhitelisted (testGroupConvInvitationHandlesLHConflicts InviteOnlyConsenters)), - test - s - "If any user in the invite has not given consent then the invite fails" - (onlyIfLhWhitelisted (testGroupConvInvitationHandlesLHConflicts InviteAlsoNonConsenters)) - ], - testGroup "The group conversation contains legalhold activated users." - [ testOnlyIfLhWhitelisted s "If any user in the invite has not given consent then the invite fails" testNoConsentCannotBeInvited - ] + [testOnlyIfLhWhitelisted s "If any user in the invite has not given consent then the invite fails" testNoConsentCannotBeInvited] ], - testOnlyIfLhWhitelisted s "Cannot create conversation with both LH activated and non-consenting users" testCannotCreateGroupWithUsersInConflict, test s "bench hack" testBenchHack ] ] @@ -192,234 +120,6 @@ testWhitelistingTeams = do expectWhitelisted False tid -testRequestLegalHoldDevice :: TestM () -testRequestLegalHoldDevice = withTeam $ \owner tid -> do - member <- randomUser - addTeamMemberInternal tid member (rolePermissions RoleMember) Nothing - -- Can't request a device if team feature flag is disabled - requestLegalHoldDevice owner member tid !!! testResponse 403 (Just "legalhold-not-enabled") - cannon <- view tsCannon - -- Assert that the appropriate LegalHold Request notification is sent to the user's - -- clients - WS.bracketR2 cannon member member $ \(ws, ws') -> withDummyTestServiceForTeamNoService $ \lhPort _chan -> do - do - -- test device creation without consent - requestLegalHoldDevice member member tid !!! testResponse 403 (Just "legalhold-not-enabled") - UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped member tid - liftIO $ - assertEqual - "User with insufficient permissions should be unable to start flow" - UserLegalHoldNoConsent - userStatus - - do - requestLegalHoldDevice owner member tid !!! testResponse 403 (Just "legalhold-not-enabled") - UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped member tid - liftIO $ - assertEqual - "User with insufficient permissions should be unable to start flow" - UserLegalHoldNoConsent - userStatus - - putLHWhitelistTeam tid !!! const 200 === statusCode - newService <- newLegalHoldService lhPort - postSettings owner tid newService !!! testResponse 201 Nothing - - do - requestLegalHoldDevice member member tid !!! testResponse 403 (Just "operation-denied") - UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped member tid - liftIO $ - assertEqual - "User with insufficient permissions should be unable to start flow" - UserLegalHoldDisabled - userStatus - - do - requestLegalHoldDevice owner member tid !!! testResponse 201 Nothing - UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped member tid - liftIO $ - assertEqual - "requestLegalHoldDevice should set user status to Pending" - UserLegalHoldPending - userStatus - do - requestLegalHoldDevice owner member tid !!! testResponse 204 Nothing - UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped member tid - liftIO $ - assertEqual - "requestLegalHoldDevice when already pending should leave status as Pending" - UserLegalHoldPending - userStatus - - cassState <- view tsCass - liftIO $ do - storedPrekeys <- Cql.runClient cassState (LegalHoldData.selectPendingPrekeys member) - assertBool "user should have pending prekeys stored" (not . null $ storedPrekeys) - let pluck = \case - (Ev.LegalHoldClientRequested rdata) -> do - Ev.lhcTargetUser rdata @?= member - Ev.lhcLastPrekey rdata @?= head someLastPrekeys - Ev.lhcClientId rdata @?= someClientId - _ -> assertBool "Unexpected event" False - assertNotification ws pluck - -- all devices get notified. - assertNotification ws' pluck - -testApproveLegalHoldDevice :: TestM () -testApproveLegalHoldDevice = do - (owner, tid) <- createBindingTeam - member <- do - usr <- randomUser - addTeamMemberInternal tid usr (rolePermissions RoleMember) Nothing - pure usr - member2 <- do - usr <- randomUser - addTeamMemberInternal tid usr (rolePermissions RoleMember) Nothing - pure usr - outsideContact <- do - usr <- randomUser - connectUsers member (List1.singleton usr) - pure usr - stranger <- randomUser - putLHWhitelistTeam tid !!! const 200 === statusCode - approveLegalHoldDevice (Just defPassword) owner member tid - !!! testResponse 403 (Just "access-denied") - cannon <- view tsCannon - WS.bracketRN cannon [owner, member, member, member2, outsideContact, stranger] $ - \[ows, mws, mws', member2Ws, outsideContactWs, strangerWs] -> withDummyTestServiceForTeam owner tid $ \chan -> do - requestLegalHoldDevice owner member tid !!! testResponse 201 Nothing - liftIO . assertMatchJSON chan $ \(RequestNewLegalHoldClient userId' teamId') -> do - assertEqual "userId == member" userId' member - assertEqual "teamId == tid" teamId' tid - -- Only the user themself can approve adding a LH device - approveLegalHoldDevice (Just defPassword) owner member tid !!! testResponse 403 (Just "access-denied") - -- Requires password - approveLegalHoldDevice Nothing member member tid !!! const 403 === statusCode - approveLegalHoldDevice (Just defPassword) member member tid !!! testResponse 200 Nothing - -- checks if the cookie we give to the legalhold service is actually valid - assertMatchJSON chan $ \(LegalHoldServiceConfirm _clientId _uid _tid authToken) -> - renewToken authToken - cassState <- view tsCass - liftIO $ do - clients' <- Cql.runClient cassState $ lookupClients [member] - assertBool "Expect clientId to be saved on the user" $ - Clients.contains member someClientId clients' - UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped member tid - liftIO $ - assertEqual - "After approval user legalhold status should be Enabled" - UserLegalHoldEnabled - userStatus - let pluck = \case - Ev.ClientAdded _ eClient -> do - clientId eClient @?= someClientId - clientType eClient @?= LegalHoldClientType - clientClass eClient @?= Just LegalHoldClient - _ -> assertBool "Unexpected event" False - assertNotification mws pluck - assertNotification mws' pluck - -- Other team users should get a user.legalhold-enable event - let pluck' = \case - Ev.UserLegalHoldEnabled eUser -> eUser @?= member - _ -> assertBool "Unexpected event" False - assertNotification ows pluck' - -- We send to all members of a team. which includes the team-settings - assertNotification member2Ws pluck' - when False $ do - -- this doesn't work any more since consent (personal users cannot grant consent). - assertNotification outsideContactWs pluck' - assertNoNotification strangerWs - -testGetLegalHoldDeviceStatus :: TestM () -testGetLegalHoldDeviceStatus = do - (owner, tid) <- createBindingTeam - member <- randomUser - addTeamMemberInternal tid member (rolePermissions RoleMember) Nothing - forM_ [owner, member] $ \uid -> do - status <- getUserStatusTyped uid tid - liftIO $ - assertEqual - "unexpected status" - (UserLegalHoldStatusResponse UserLegalHoldNoConsent Nothing Nothing) - status - - putLHWhitelistTeam tid !!! const 200 === statusCode - withDummyTestServiceForTeamNoService $ \lhPort _chan -> do - do - UserLegalHoldStatusResponse userStatus lastPrekey' clientId' <- getUserStatusTyped member tid - liftIO $ - do - assertEqual "User legal hold status should start as disabled" UserLegalHoldDisabled userStatus - assertEqual "last_prekey should be Nothing when LH is disabled" Nothing lastPrekey' - assertEqual "client.id should be Nothing when LH is disabled" Nothing clientId' - - do - newService <- newLegalHoldService lhPort - postSettings owner tid newService !!! testResponse 201 Nothing - requestLegalHoldDevice owner member tid !!! testResponse 201 Nothing - assertZeroLegalHoldDevices member - UserLegalHoldStatusResponse userStatus lastPrekey' clientId' <- getUserStatusTyped member tid - liftIO $ - do - assertEqual "requestLegalHoldDevice should set user status to Pending" UserLegalHoldPending userStatus - assertEqual "last_prekey should be set when LH is pending" (Just (head someLastPrekeys)) lastPrekey' - assertEqual "client.id should be set when LH is pending" (Just someClientId) clientId' - do - requestLegalHoldDevice owner member tid !!! testResponse 204 Nothing - UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped member tid - liftIO $ - assertEqual - "requestLegalHoldDevice when already pending should leave status as Pending" - UserLegalHoldPending - userStatus - do - approveLegalHoldDevice (Just defPassword) member member tid !!! testResponse 200 Nothing - UserLegalHoldStatusResponse userStatus lastPrekey' clientId' <- getUserStatusTyped member tid - liftIO $ - do - assertEqual "approving should change status to Enabled" UserLegalHoldEnabled userStatus - assertEqual "last_prekey should be set when LH is pending" (Just (head someLastPrekeys)) lastPrekey' - assertEqual "client.id should be set when LH is pending" (Just someClientId) clientId' - assertExactlyOneLegalHoldDevice member - requestLegalHoldDevice owner member tid !!! testResponse 409 (Just "legalhold-already-enabled") - -testDisableLegalHoldForUser :: TestM () -testDisableLegalHoldForUser = withTeam $ \owner tid -> do - member <- randomUser - addTeamMemberInternal tid member (rolePermissions RoleMember) Nothing - cannon <- view tsCannon - putLHWhitelistTeam tid !!! const 200 === statusCode - WS.bracketR2 cannon owner member $ \(ows, mws) -> withDummyTestServiceForTeam owner tid $ \chan -> do - requestLegalHoldDevice owner member tid !!! testResponse 201 Nothing - approveLegalHoldDevice (Just defPassword) member member tid !!! testResponse 200 Nothing - assertNotification mws $ \case - Ev.ClientAdded _ client -> do - clientId client @?= someClientId - clientType client @?= LegalHoldClientType - clientClass client @?= Just LegalHoldClient - _ -> assertBool "Unexpected event" False - -- Only the admin can disable legal hold - disableLegalHoldForUser (Just defPassword) tid member member !!! testResponse 403 (Just "operation-denied") - assertExactlyOneLegalHoldDevice member - -- Require password to disable for usern - disableLegalHoldForUser Nothing tid owner member !!! const 403 === statusCode - assertExactlyOneLegalHoldDevice member - disableLegalHoldForUser (Just defPassword) tid owner member !!! testResponse 200 Nothing - liftIO . assertMatchChan chan $ \(req, _) -> do - assertEqual "method" "POST" (requestMethod req) - assertEqual "path" (pathInfo req) ["legalhold", "remove"] - assertNotification mws $ \case - Ev.ClientEvent (Ev.ClientRemoved _ clientId') -> clientId' @?= someClientId - _ -> assertBool "Unexpected event" False - assertNotification mws $ \case - Ev.UserEvent (Ev.UserLegalHoldDisabled uid) -> uid @?= member - _ -> assertBool "Unexpected event" False - -- Other users should also get the event - assertNotification ows $ \case - Ev.UserLegalHoldDisabled uid -> uid @?= member - _ -> assertBool "Unexpected event" False - assertZeroLegalHoldDevices member - data IsWorking = Working | NotWorking deriving (Eq, Show) @@ -534,34 +234,6 @@ testRemoveLegalHoldFromTeam = do -- fails if LH for team is disabled deleteSettings (Just defPassword) owner tid !!! testResponse 403 (Just "legalhold-disable-unimplemented") -testEnablePerTeam :: TestM () -testEnablePerTeam = withTeam $ \owner tid -> do - member <- randomUser - addTeamMemberInternal tid member (rolePermissions RoleMember) Nothing - do - status :: Public.WithStatusNoLock Public.LegalholdConfig <- responseJsonUnsafe <$> (getEnabled tid (getEnabled tid do - putLHWhitelistTeam tid !!! const 200 === statusCode - requestLegalHoldDevice owner member tid !!! const 201 === statusCode - approveLegalHoldDevice (Just defPassword) member member tid !!! testResponse 200 Nothing - do - UserLegalHoldStatusResponse status _ _ <- getUserStatusTyped member tid - liftIO $ assertEqual "User legal hold status should be enabled" UserLegalHoldEnabled status - do - putEnabled' id tid Public.FeatureStatusDisabled !!! testResponse 403 (Just "legalhold-whitelisted-only") - status :: Public.WithStatusNoLock Public.LegalholdConfig <- responseJsonUnsafe <$> (getEnabled tid TestM () testAddTeamUserTooLargeWithLegalholdWhitelisted = withTeam $ \owner tid -> do o <- view tsGConf @@ -598,352 +270,9 @@ testCannotCreateLegalHoldDeviceOldAPI = do post req !!! const 400 === statusCode assertZeroLegalHoldDevices uid -testGetTeamMembersIncludesLHStatus :: TestM () -testGetTeamMembersIncludesLHStatus = do - (owner, tid) <- createBindingTeam - member <- randomUser - addTeamMemberInternal tid member (rolePermissions RoleMember) Nothing - - let findMemberStatus :: [TeamMember] -> Maybe UserLegalHoldStatus - findMemberStatus ms = - ms ^? traversed . filtered (has $ Team.userId . only member) . legalHoldStatus - - let check :: HasCallStack => UserLegalHoldStatus -> String -> TestM () - check status msg = do - members' <- view teamMembers <$> getTeamMembers owner tid - liftIO $ - assertEqual - ("legal hold status should be " <> msg) - (Just status) - (findMemberStatus members') - - check UserLegalHoldNoConsent "disabled when it is disabled for the team" - withDummyTestServiceForTeamNoService $ \lhPort _chan -> do - check UserLegalHoldNoConsent "no_consent on new team members" - - putLHWhitelistTeam tid !!! const 200 === statusCode - newService <- newLegalHoldService lhPort - postSettings owner tid newService !!! testResponse 201 Nothing - - check UserLegalHoldDisabled "disabled on team members that have granted consent" - requestLegalHoldDevice owner member tid !!! testResponse 201 Nothing - check UserLegalHoldPending "pending after requesting device" - approveLegalHoldDevice (Just defPassword) member member tid !!! testResponse 200 Nothing - check UserLegalHoldEnabled "enabled after confirming device" - -testInWhitelist :: TestM () -testInWhitelist = do - g <- viewGalley - (owner, tid) <- createBindingTeam - member <- randomUser - addTeamMemberInternal tid member (rolePermissions RoleMember) Nothing - cannon <- view tsCannon - - putLHWhitelistTeam tid !!! const 200 === statusCode - - WS.bracketR2 cannon member member $ \(_ws, _ws') -> withDummyTestServiceForTeam owner tid $ \_chan -> do - do - -- members have granted consent (implicitly)... - lhs <- view legalHoldStatus <$> withLHWhitelist tid (getTeamMember' g member tid member) - liftIO $ assertEqual "" lhs UserLegalHoldDisabled - - -- ... and can do so again (idempotency). - _ <- withLHWhitelist tid (void $ putLHWhitelistTeam' g tid) - lhs' <- withLHWhitelist tid $ view legalHoldStatus <$> getTeamMember' g member tid member - liftIO $ assertEqual "" lhs' UserLegalHoldDisabled - - do - -- members can't request LH devices - withLHWhitelist tid (requestLegalHoldDevice' g member member tid) !!! testResponse 403 (Just "operation-denied") - UserLegalHoldStatusResponse userStatus _ _ <- withLHWhitelist tid (getUserStatusTyped' g member tid) - liftIO $ - assertEqual - "User with insufficient permissions should be unable to start flow" - UserLegalHoldDisabled - userStatus - do - -- owners can - withLHWhitelist tid (requestLegalHoldDevice' g owner member tid) !!! testResponse 201 Nothing - UserLegalHoldStatusResponse userStatus _ _ <- withLHWhitelist tid (getUserStatusTyped' g member tid) - liftIO $ - assertEqual - "requestLegalHoldDevice should set user status to Pending" - UserLegalHoldPending - userStatus - do - -- request device is idempotent - withLHWhitelist tid (requestLegalHoldDevice' g owner member tid) !!! testResponse 204 Nothing - UserLegalHoldStatusResponse userStatus _ _ <- withLHWhitelist tid (getUserStatusTyped' g member tid) - liftIO $ - assertEqual - "requestLegalHoldDevice when already pending should leave status as Pending" - UserLegalHoldPending - userStatus - do - -- owner cannot approve legalhold device - withLHWhitelist tid (approveLegalHoldDevice' g (Just defPassword) owner member tid) !!! testResponse 403 (Just "access-denied") - do - -- approve works - withLHWhitelist tid (approveLegalHoldDevice' g (Just defPassword) member member tid) !!! testResponse 200 Nothing - UserLegalHoldStatusResponse userStatus lastPrekey' clientId' <- withLHWhitelist tid (getUserStatusTyped' g member tid) - liftIO $ - do - assertEqual "approving should change status to Enabled" UserLegalHoldEnabled userStatus - assertEqual "last_prekey should be set when LH is pending" (Just (head someLastPrekeys)) lastPrekey' - assertEqual "client.id should be set when LH is pending" (Just someClientId) clientId' - --- If LH is activated for other user in 1:1 conv, 1:1 conv is blocked -testNoConsentBlockOne2OneConv :: HasCallStack => Bool -> Bool -> Bool -> Bool -> TestM () -testNoConsentBlockOne2OneConv connectFirst teamPeer approveLH testPendingConnection = do - -- FUTUREWORK: maybe regular user for legalholder? - (legalholder :: UserId, tid) <- createBindingTeam - regularClient <- randomClient legalholder (head someLastPrekeys) - - peer :: UserId <- if teamPeer then fst <$> createBindingTeam else randomUser - galley <- viewGalley - - putLHWhitelistTeam tid !!! const 200 === statusCode - - let doEnableLH :: HasCallStack => TestM (Maybe ClientId) - doEnableLH = do - -- register & (possibly) approve LH device for legalholder - withLHWhitelist tid (requestLegalHoldDevice' galley legalholder legalholder tid) !!! testResponse 201 Nothing - when approveLH $ - withLHWhitelist tid (approveLegalHoldDevice' galley (Just defPassword) legalholder legalholder tid) !!! testResponse 200 Nothing - UserLegalHoldStatusResponse userStatus _ _ <- withLHWhitelist tid (getUserStatusTyped' galley legalholder tid) - liftIO $ assertEqual "approving should change status" (if approveLH then UserLegalHoldEnabled else UserLegalHoldPending) userStatus - if approveLH - then - getInternalClientsFull (UserSet $ Set.singleton legalholder) - <&> do - userClientsFull - >>> Map.elems - >>> Set.unions - >>> Set.toList - >>> listToMaybe - >>> fmap clientId - else pure Nothing - - doDisableLH :: HasCallStack => TestM () - doDisableLH = do - -- remove (only) LH device again - withLHWhitelist tid (disableLegalHoldForUser' galley (Just defPassword) tid legalholder legalholder) - !!! testResponse 200 Nothing - - cannon <- view tsCannon - - WS.bracketR2 cannon legalholder peer $ \(legalholderWs, peerWs) -> withDummyTestServiceForTeam legalholder tid $ \_chan -> do - if not connectFirst - then do - void doEnableLH - postConnection legalholder peer !!! do testResponse 403 (Just "missing-legalhold-consent") - postConnection peer legalholder !!! do testResponse 403 (Just "missing-legalhold-consent") - else do - postConnection legalholder peer !!! const 201 === statusCode - - mbConn :: Maybe UserConnection <- - if testPendingConnection - then pure Nothing - else do - res <- putConnection peer legalholder Conn.Accepted do - assertNotification ws $ - \case - (Ev.ConnectionEvent (Ev.ConnectionUpdated (Conn.ucStatus -> rel) _prev _name)) -> do - rel @?= Conn.MissingLegalholdConsent - _ -> assertBool "wrong event type" False - - forM_ [(legalholder, peer), (peer, legalholder)] $ \(one, two) -> do - putConnection one two Conn.Accepted - !!! testResponse 403 (Just "bad-conn-update") - - assertConnections legalholder [ConnectionStatus legalholder peer Conn.MissingLegalholdConsent] - assertConnections peer [ConnectionStatus peer legalholder Conn.MissingLegalholdConsent] - - -- peer can't send message to legalhodler. the conversation appears gone. - peerClient <- randomClient peer (someLastPrekeys !! 2) - for_ ((,) <$> (mbConn >>= Conn.ucConvId) <*> mbLegalholderLHDevice) $ \(convId, legalholderLHDevice) -> do - postOtrMessage - id - peer - peerClient - (qUnqualified convId) - [ (legalholder, legalholderLHDevice, "cipher"), - (legalholder, regularClient, "cipher") - ] - !!! do - const 404 === statusCode - const (Right "no-conversation") === fmap Error.label . responseJsonEither - - do - doDisableLH - - when approveLH $ do - legalholderLHDevice <- assertJust mbLegalholderLHDevice - WS.assertMatch_ (5 # Second) legalholderWs $ - wsAssertClientRemoved legalholderLHDevice - - assertConnections - legalholder - [ ConnectionStatus legalholder peer $ - if testPendingConnection then Conn.Sent else Conn.Accepted - ] - assertConnections - peer - [ ConnectionStatus peer legalholder $ - if testPendingConnection then Conn.Pending else Conn.Accepted - ] - - forM_ [legalholderWs, peerWs] $ \ws -> do - assertNotification ws $ - \case - (Ev.ConnectionEvent (Ev.ConnectionUpdated (Conn.ucStatus -> rel) _prev _name)) -> do - assertBool "" (rel `elem` [Conn.Sent, Conn.Pending, Conn.Accepted]) - _ -> assertBool "wrong event type" False - - -- conversation reappears. peer can send message to legalholder again - for_ ((,) <$> (mbConn >>= Conn.ucConvId) <*> mbLegalholderLHDevice) $ \(convId, legalholderLHDevice) -> do - postOtrMessage - id - peer - peerClient - (qUnqualified convId) - [ (legalholder, legalholderLHDevice, "cipher"), - (legalholder, regularClient, "cipher") - ] - !!! do - const 201 === statusCode - assertMismatchWithMessage - (Just "legalholderLHDevice is deleted") - [] - [] - [(legalholder, Set.singleton legalholderLHDevice)] - -data GroupConvAdmin - = LegalholderIsAdmin - | PeerIsAdmin - | BothAreAdmins - deriving (Show, Eq, Ord, Bounded, Enum) - -testNoConsentRemoveFromGroupConv :: GroupConvAdmin -> HasCallStack => TestM () -testNoConsentRemoveFromGroupConv whoIsAdmin = do - (legalholder :: UserId, tid) <- createBindingTeam - qLegalHolder <- Qualified legalholder <$> viewFederationDomain - (peer :: UserId, teamPeer) <- createBindingTeam - qPeer <- Qualified peer <$> viewFederationDomain - galley <- viewGalley - - let enableLHForLegalholder :: HasCallStack => TestM () - enableLHForLegalholder = do - requestLegalHoldDevice legalholder legalholder tid !!! testResponse 201 Nothing - approveLegalHoldDevice (Just defPassword) legalholder legalholder tid !!! testResponse 200 Nothing - UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped' galley legalholder tid - liftIO $ assertEqual "approving should change status" UserLegalHoldEnabled userStatus - - cannon <- view tsCannon - - putLHWhitelistTeam tid !!! const 200 === statusCode - WS.bracketR2 cannon legalholder peer $ \(legalholderWs, peerWs) -> withDummyTestServiceForTeam legalholder tid $ \_chan -> do - postConnection legalholder peer !!! const 201 === statusCode - void $ putConnection peer legalholder Conn.Accepted (qLegalHolder, tid, qPeer, roleNameWireMember) - PeerIsAdmin -> (qPeer, teamPeer, qLegalHolder, roleNameWireMember) - BothAreAdmins -> (qLegalHolder, tid, qPeer, roleNameWireAdmin) - - convId <- createTeamConvWithRole (qUnqualified inviter) tidInviter [qUnqualified invitee] (Just "group chat with external peer") Nothing Nothing inviteeRole - mapM_ (assertConvMemberWithRole roleNameWireAdmin convId) ([inviter] <> [invitee | whoIsAdmin == BothAreAdmins]) - mapM_ (assertConvMemberWithRole roleNameWireMember convId) [invitee | whoIsAdmin /= BothAreAdmins] - pure convId - qconvId <- Qualified convId <$> viewFederationDomain - - checkConvCreateEvent convId legalholderWs - checkConvCreateEvent convId peerWs - - assertConvMember qLegalHolder convId - assertConvMember qPeer convId - - void enableLHForLegalholder - - case whoIsAdmin of - LegalholderIsAdmin -> do - assertConvMember qLegalHolder convId - assertNotConvMember peer convId - checkConvMemberLeaveEvent qconvId qPeer legalholderWs - checkConvMemberLeaveEvent qconvId qPeer peerWs - PeerIsAdmin -> do - assertConvMember qPeer convId - assertNotConvMember legalholder convId - checkConvMemberLeaveEvent qconvId qLegalHolder legalholderWs - checkConvMemberLeaveEvent qconvId qLegalHolder peerWs - BothAreAdmins -> do - assertConvMember qLegalHolder convId - assertNotConvMember peer convId - checkConvMemberLeaveEvent qconvId qPeer legalholderWs - checkConvMemberLeaveEvent qconvId qPeer peerWs - data GroupConvInvCase = InviteOnlyConsenters | InviteAlsoNonConsenters deriving (Show, Eq, Ord, Bounded, Enum) -testGroupConvInvitationHandlesLHConflicts :: HasCallStack => GroupConvInvCase -> TestM () -testGroupConvInvitationHandlesLHConflicts inviteCase = do - localDomain <- viewFederationDomain - -- team that is legalhold whitelisted - (legalholder :: UserId, tid) <- createBindingTeam - let qLegalHolder = Qualified legalholder localDomain - userWithConsent <- (^. Team.userId) <$> addUserToTeam legalholder tid - userWithConsent2 <- do - uid <- (^. Team.userId) <$> addUserToTeam legalholder tid - pure $ Qualified uid localDomain - putLHWhitelistTeam tid !!! const 200 === statusCode - - -- team without legalhold - (peer :: UserId, teamPeer) <- createBindingTeam - peer2 <- (^. Team.userId) <$> addUserToTeam peer teamPeer - let qpeer2 = Qualified peer2 localDomain - - do - postConnection userWithConsent peer !!! const 201 === statusCode - void $ putConnection peer userWithConsent Conn.Accepted do - -- conversation with 1) userWithConsent and 2) peer - convId <- createTeamConvWithRole userWithConsent tid [peer] (Just "corp + us") Nothing Nothing roleNameWireAdmin - let qconvId = Qualified convId localDomain - - -- activate legalhold for legalholder - do - galley <- viewGalley - requestLegalHoldDevice legalholder legalholder tid !!! testResponse 201 Nothing - approveLegalHoldDevice (Just defPassword) legalholder legalholder tid !!! testResponse 200 Nothing - UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped' galley legalholder tid - liftIO $ assertEqual "approving should change status" UserLegalHoldEnabled userStatus - - case inviteCase of - InviteOnlyConsenters -> do - API.Util.postMembers userWithConsent (qLegalHolder :| [userWithConsent2]) qconvId - !!! const 200 === statusCode - - assertConvMember qLegalHolder convId - assertConvMember userWithConsent2 convId - assertNotConvMember peer convId - InviteAlsoNonConsenters -> do - API.Util.postMembers userWithConsent (qLegalHolder :| [qpeer2]) qconvId - >>= errWith 403 (\err -> Error.label err == "missing-legalhold-consent") - testNoConsentCannotBeInvited :: HasCallStack => TestM () testNoConsentCannotBeInvited = do localDomain <- viewFederationDomain @@ -987,39 +316,6 @@ testNoConsentCannotBeInvited = do API.Util.postQualifiedMembers userLHNotActivated (Qualified peer2 localdomain :| []) qconvId >>= errWith 403 (\err -> Error.label err == "missing-legalhold-consent") -testCannotCreateGroupWithUsersInConflict :: HasCallStack => TestM () -testCannotCreateGroupWithUsersInConflict = do - -- team that is legalhold whitelisted - (legalholder :: UserId, tid) <- createBindingTeam - userLHNotActivated <- (^. Team.userId) <$> addUserToTeam legalholder tid - putLHWhitelistTeam tid !!! const 200 === statusCode - - -- team without legalhold - (peer :: UserId, teamPeer) <- createBindingTeam - peer2 <- (^. Team.userId) <$> addUserToTeam peer teamPeer - - do - postConnection userLHNotActivated peer !!! const 201 === statusCode - void $ putConnection peer userLHNotActivated Conn.Accepted do - createTeamConvAccessRaw userLHNotActivated tid [peer, legalholder] (Just "corp + us") Nothing Nothing Nothing (Just roleNameWireMember) - !!! const 201 === statusCode - - -- activate legalhold for legalholder - do - galley <- viewGalley - requestLegalHoldDevice legalholder legalholder tid !!! testResponse 201 Nothing - approveLegalHoldDevice (Just defPassword) legalholder legalholder tid !!! testResponse 200 Nothing - UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped' galley legalholder tid - liftIO $ assertEqual "approving should change status" UserLegalHoldEnabled userStatus - - createTeamConvAccessRaw userLHNotActivated tid [peer2, legalholder] (Just "corp + us") Nothing Nothing Nothing (Just roleNameWireMember) - >>= errWith 403 (\err -> Error.label err == "missing-legalhold-consent") - testBenchHack :: HasCallStack => TestM () testBenchHack = do {- representative sample run on an old laptop: diff --git a/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs b/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs index 8be3b158517..a9315929573 100644 --- a/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs +++ b/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs @@ -31,7 +31,6 @@ import Bilge hiding (accept, head, timeout, trace) import Bilge.Assert import Brig.Types.Intra (UserSet (..)) import Brig.Types.Test.Arbitrary () -import Brig.Types.User.Event qualified as Ev import Cassandra.Exec qualified as Cql import Control.Category ((>>>)) import Control.Concurrent.Chan @@ -48,7 +47,6 @@ import Galley.Cassandra.LegalHold import Galley.Cassandra.LegalHold qualified as LegalHoldData import Galley.Env qualified as Galley import Galley.Types.Clients qualified as Clients -import Galley.Types.Teams import Imports import Network.HTTP.Types.Status (status200, status404) import Network.Wai as Wai @@ -71,6 +69,7 @@ import Wire.API.Team.Permission import Wire.API.Team.Role import Wire.API.User.Client import Wire.API.User.Client qualified as Client +import Wire.API.UserEvent qualified as Ev tests :: IO TestSetup -> TestTree tests s = @@ -93,7 +92,6 @@ tests s = testOnlyIfLhEnabled s "POST /clients" testCannotCreateLegalHoldDeviceOldAPI, testOnlyIfLhEnabled s "GET /teams/{tid}/members" testGetTeamMembersIncludesLHStatus, testOnlyIfLhEnabled s "POST /register - cannot add team members above fanout limit" testAddTeamUserTooLargeWithLegalhold, - testOnlyIfLhEnabled s "GET legalhold status in user profile" testGetLegalholdStatus, {- TODO: conversations/{cnv}/otr/messages - possibly show the legal hold device (if missing) as a different device type (or show that on device level, depending on how client teams prefer) GET /team/{tid}/members - show legal hold status of all members @@ -237,7 +235,7 @@ testApproveLegalHoldDevice = do UserLegalHoldEnabled userStatus let pluck = \case - Ev.ClientAdded _ eClient -> do + Ev.ClientAdded eClient -> do clientId eClient @?= someClientId clientType eClient @?= LegalHoldClientType clientClass eClient @?= Just LegalHoldClient @@ -316,7 +314,7 @@ testDisableLegalHoldForUser = do requestLegalHoldDevice owner member tid !!! testResponse 201 Nothing approveLegalHoldDevice (Just defPassword) member member tid !!! testResponse 200 Nothing assertNotification mws $ \case - Ev.ClientAdded _ client -> do + Ev.ClientAdded client -> do clientId client @?= someClientId clientType client @?= LegalHoldClientType clientClass client @?= Just LegalHoldClient @@ -332,7 +330,7 @@ testDisableLegalHoldForUser = do assertEqual "method" "POST" (requestMethod req) assertEqual "path" (pathInfo req) ["legalhold", "remove"] assertNotification mws $ \case - Ev.ClientEvent (Ev.ClientRemoved _ clientId') -> clientId' @?= someClientId + Ev.ClientEvent (Ev.ClientRemoved clientId') -> clientId' @?= someClientId _ -> assertBool "Unexpected event" False assertNotification mws $ \case Ev.UserEvent (Ev.UserLegalHoldDisabled uid) -> uid @?= member diff --git a/services/galley/test/integration/API/Teams/LegalHold/Util.hs b/services/galley/test/integration/API/Teams/LegalHold/Util.hs index f4362f81507..85e2e37d195 100644 --- a/services/galley/test/integration/API/Teams/LegalHold/Util.hs +++ b/services/galley/test/integration/API/Teams/LegalHold/Util.hs @@ -11,7 +11,6 @@ import API.Util import Bilge hiding (accept, head, timeout, trace) import Bilge.Assert import Brig.Types.Test.Arbitrary () -import Brig.Types.User.Event qualified as Ev import Control.Concurrent.Async qualified as Async import Control.Concurrent.Chan import Control.Concurrent.Timeout hiding (threadDelay) @@ -26,12 +25,12 @@ import Data.ByteString.Char8 qualified as BS import Data.ByteString.Conversion import Data.CallStack import Data.Id -import Data.LegalHold import Data.List.NonEmpty qualified as NonEmpty import Data.List1 qualified as List1 import Data.Misc (PlainTextPassword6) import Data.PEM import Data.Streaming.Network (bindRandomPortTCP) +import Data.String.Conversions import Data.Tagged import Data.Text.Encoding (encodeUtf8) import Galley.Options @@ -58,9 +57,8 @@ import Wire.API.Provider.Service import Wire.API.Team.Feature qualified as Public import Wire.API.Team.LegalHold import Wire.API.Team.LegalHold.External -import Wire.API.Team.Member qualified as Team -import Wire.API.User (UserProfile (..)) import Wire.API.User.Client +import Wire.API.UserEvent qualified as Ev -------------------------------------------------------------------- -- setup helpers @@ -221,60 +219,6 @@ publicKeyNotMatchingService = ] in k -testGetLegalholdStatus :: TestM () -testGetLegalholdStatus = do - (owner1, tid1) <- createBindingTeam - member1 <- view Team.userId <$> addUserToTeam owner1 tid1 - - (owner2, tid2) <- createBindingTeam - member2 <- view Team.userId <$> addUserToTeam owner2 tid2 - - personal <- randomUser - - let check :: HasCallStack => UserId -> UserId -> Maybe TeamId -> UserLegalHoldStatus -> TestM () - check getter targetUser targetTeam stat = do - profile <- getUserProfile getter targetUser - when (profileLegalholdStatus profile /= stat) $ do - meminfo <- getUserStatusTyped targetUser `mapM` targetTeam - - liftIO . forM_ meminfo $ \mem -> do - assertEqual "member LH status" stat (ulhsrStatus mem) - assertEqual "team id in brig user record" targetTeam (profileTeam profile) - - liftIO $ assertEqual "user profile status info" stat (profileLegalholdStatus profile) - - requestDev :: HasCallStack => UserId -> UserId -> TeamId -> TestM () - requestDev requestor target tid = do - requestLegalHoldDevice requestor target tid !!! testResponse 201 Nothing - - approveDev :: HasCallStack => UserId -> TeamId -> TestM () - approveDev target tid = do - approveLegalHoldDevice (Just defPassword) target target tid !!! testResponse 200 Nothing - - check owner1 member1 (Just tid1) UserLegalHoldNoConsent - check member1 member1 (Just tid1) UserLegalHoldNoConsent - check owner2 member1 (Just tid1) UserLegalHoldNoConsent - check member2 member1 (Just tid1) UserLegalHoldNoConsent - check personal member1 (Just tid1) UserLegalHoldNoConsent - check owner1 personal Nothing UserLegalHoldNoConsent - check member1 personal Nothing UserLegalHoldNoConsent - check owner2 personal Nothing UserLegalHoldNoConsent - check member2 personal Nothing UserLegalHoldNoConsent - check personal personal Nothing UserLegalHoldNoConsent - - putLHWhitelistTeam tid1 !!! const 200 === statusCode - - withDummyTestServiceForTeam owner1 tid1 $ \_chan -> do - check owner1 member1 (Just tid1) UserLegalHoldDisabled - check member2 member1 (Just tid1) UserLegalHoldDisabled - check personal member1 (Just tid1) UserLegalHoldDisabled - - requestDev owner1 member1 tid1 - check personal member1 (Just tid1) UserLegalHoldPending - - approveDev member1 tid1 - check personal member1 (Just tid1) UserLegalHoldEnabled - ---------------------------------------------------------------------- -- API helpers @@ -487,26 +431,6 @@ requestLegalHoldDevice' g zusr uid tid = do ---------------------------------------------------------------------- -- test helpers -deriving instance Show Ev.Event - -deriving instance Show Ev.UserEvent - -deriving instance Show Ev.ClientEvent - -deriving instance Show Ev.PropertyEvent - -deriving instance Show Ev.ConnectionEvent - --- (partial implementation, just good enough to make the tests work) -instance FromJSON Ev.Event where - parseJSON ev = flip (withObject "Ev.Event") ev $ \o -> do - typ :: Text <- o .: "type" - if - | typ `elem` ["user.legalhold-request", "user.legalhold-enable", "user.legalhold-disable"] -> Ev.UserEvent <$> Aeson.parseJSON ev - | typ `elem` ["user.client-add", "user.client-remove"] -> Ev.ClientEvent <$> Aeson.parseJSON ev - | typ == "user.connection" -> Ev.ConnectionEvent <$> Aeson.parseJSON ev - | otherwise -> fail $ "Ev.Event: unsupported event type: " <> show typ - -- (partial implementation, just good enough to make the tests work) instance FromJSON Ev.UserEvent where parseJSON = withObject "Ev.UserEvent" $ \o -> do @@ -528,11 +452,9 @@ instance FromJSON Ev.ClientEvent where parseJSON = withObject "Ev.ClientEvent" $ \o -> do tag :: Text <- o .: "type" case tag of - "user.client-add" -> Ev.ClientAdded fakeuid <$> o .: "client" - "user.client-remove" -> Ev.ClientRemoved fakeuid <$> (o .: "client" >>= withObject "id" (.: "id")) + "user.client-add" -> Ev.ClientAdded <$> o .: "client" + "user.client-remove" -> Ev.ClientRemoved <$> (o .: "client" >>= withObject "id" (.: "id")) x -> fail $ "Ev.ClientEvent: unsupported event type: " ++ show x - where - fakeuid = read @UserId "6980fb5e-ba64-11eb-a339-0b3625bf01be" instance FromJSON Ev.ConnectionEvent where parseJSON = Aeson.withObject "ConnectionEvent" $ \o -> do @@ -542,7 +464,6 @@ instance FromJSON Ev.ConnectionEvent where Ev.ConnectionUpdated <$> o .: "connection" <*> pure Nothing - <*> pure Nothing x -> fail $ "unspported event type: " ++ show x assertNotification :: (HasCallStack, FromJSON a, MonadIO m) => WS.WebSocket -> (a -> Assertion) -> m () diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index e9ca4a544c8..5f80a490368 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -65,6 +65,7 @@ import Data.Range import Data.Serialize (runPut) import Data.Set qualified as Set import Data.Singletons +import Data.String.Conversions import Data.Text qualified as Text import Data.Text.Encoding qualified as T import Data.Text.Encoding qualified as Text @@ -81,7 +82,6 @@ import Galley.Intra.User (chunkify) import Galley.Options qualified as Opts import Galley.Run qualified as Run import Galley.Types.Conversations.One2One -import Galley.Types.Teams qualified as Team import Galley.Types.UserList import Imports import Network.HTTP.Client qualified as HTTP @@ -145,7 +145,7 @@ import Wire.API.Team.Member hiding (userId) import Wire.API.Team.Member qualified as Team import Wire.API.Team.Permission hiding (self) import Wire.API.Team.Role -import Wire.API.User hiding (AccountStatus (..)) +import Wire.API.User as User hiding (AccountStatus (..)) import Wire.API.User.Auth hiding (Access) import Wire.API.User.Client import Wire.API.User.Client qualified as Client @@ -194,12 +194,12 @@ symmPermissions p = let s = Set.fromList p in fromJust (newPermissions s s) createBindingTeam :: HasCallStack => TestM (UserId, TeamId) createBindingTeam = do - first Wire.API.User.userId <$> createBindingTeam' + first User.userId <$> createBindingTeam' createBindingTeam' :: HasCallStack => TestM (User, TeamId) createBindingTeam' = do owner <- randomTeamCreator' - teams <- getTeams owner.userId [] + teams <- getTeams (User.userId owner) [] team <- assertOne $ view teamListTeams teams let tid = view teamId team SQS.assertTeamActivate "create team" tid @@ -457,7 +457,7 @@ addUserToTeamWithRole :: HasCallStack => Maybe Role -> UserId -> TeamId -> TestM addUserToTeamWithRole role inviter tid = do (inv, rsp2) <- addUserToTeamWithRole' role inviter tid let invitee :: User = responseJsonUnsafe rsp2 - inviteeId = invitee.userId + inviteeId = User.userId invitee let invmeta = Just (inviter, inCreatedAt inv) mem <- getTeamMember inviter tid inviteeId liftIO $ assertEqual "Member has no/wrong invitation metadata" invmeta (mem ^. Team.invitation) @@ -485,7 +485,7 @@ addUserToTeamWithRole' role inviter tid = do addUserToTeamWithSSO :: HasCallStack => Bool -> TeamId -> TestM TeamMember addUserToTeamWithSSO hasEmail tid = do let ssoid = UserSSOId mkSimpleSampleUref - uid <- fmap (\(u :: User) -> u.userId) $ responseJsonError =<< postSSOUser "SSO User" hasEmail ssoid tid + uid <- fmap (\(u :: User) -> User.userId u) $ responseJsonError =<< postSSOUser "SSO User" hasEmail ssoid tid getTeamMember uid tid uid makeOwner :: HasCallStack => UserId -> TeamMember -> TeamId -> TestM () @@ -2175,7 +2175,7 @@ ephemeralUser = do let p = object ["name" .= name] r <- post (b . path "/register" . json p) UserId -> LastPrekey -> TestM ClientId randomClient uid lk = randomClientWithCaps uid lk Nothing @@ -2676,11 +2676,13 @@ withTempMockFederator' :: m b -> m (b, [FederatedRequest]) withTempMockFederator' resp action = do - let mock = runMock (assertFailure . Text.unpack) $ do - r <- resp - pure ("application" // "json", r) + let mock = + def + { handler = runMock (assertFailure . Text.unpack) $ do + r <- resp + pure ("application" // "json", r) + } Mock.withTempMockFederator - [("Content-Type", "application/json")] mock $ \mockPort -> do withSettingsOverrides (\opts -> opts & Opts.federator ?~ Endpoint "127.0.0.1" (fromIntegral mockPort)) action @@ -2895,23 +2897,18 @@ iUpsertOne2OneConversation req = do createOne2OneConvWithRemote :: HasCallStack => Local UserId -> Remote UserId -> TestM () createOne2OneConvWithRemote localUser remoteUser = do - let mkRequest actor mConvId = + let convId = one2OneConvId BaseProtocolProteusTag (tUntagged localUser) (tUntagged remoteUser) + mkRequest actor = UpsertOne2OneConversationRequest { uooLocalUser = localUser, uooRemoteUser = remoteUser, uooActor = actor, uooActorDesiredMembership = Included, - uooConvId = mConvId + uooConvId = convId } - ooConvId <- - fmap uuorConvId - . responseJsonError - =<< iUpsertOne2OneConversation (mkRequest LocalActor Nothing) - Local UserId -> TestM (Remote UserId, Qualified ConvId) generateRemoteAndConvId = generateRemoteAndConvIdWithDomain (Domain "far-away.example.com") diff --git a/services/galley/test/integration/API/Util/TeamFeature.hs b/services/galley/test/integration/API/Util/TeamFeature.hs index cb98a9aa9c4..3191a4849ce 100644 --- a/services/galley/test/integration/API/Util/TeamFeature.hs +++ b/services/galley/test/integration/API/Util/TeamFeature.hs @@ -36,64 +36,51 @@ import GHC.TypeLits (KnownSymbol) import Galley.Options (featureFlags, settings) import Galley.Types.Teams import Imports +import Test.Tasty.HUnit (assertBool, assertFailure, (@?=)) import TestSetup +import Wire.API.Team.Feature import Wire.API.Team.Feature qualified as Public withCustomSearchFeature :: FeatureTeamSearchVisibilityAvailability -> TestM () -> TestM () withCustomSearchFeature flag action = do Util.withSettingsOverrides (\opts -> opts & settings . featureFlags . flagTeamSearchVisibility .~ flag) action -getTeamSearchVisibilityAvailable :: HasCallStack => (Request -> Request) -> UserId -> TeamId -> MonadHttp m => m ResponseLBS -getTeamSearchVisibilityAvailable = getTeamFeatureFlagWithGalley @Public.SearchVisibilityAvailableConfig - -getTeamSearchVisibilityAvailableInternal :: HasCallStack => (Request -> Request) -> TeamId -> MonadHttp m => m ResponseLBS -getTeamSearchVisibilityAvailableInternal = - getTeamFeatureFlagInternalWithGalley @Public.SearchVisibilityAvailableConfig - putTeamSearchVisibilityAvailableInternal :: HasCallStack => - (Request -> Request) -> TeamId -> Public.FeatureStatus -> - (MonadIO m, MonadHttp m) => m () -putTeamSearchVisibilityAvailableInternal g tid statusValue = + (MonadIO m, MonadHttp m, HasGalley m) => m () +putTeamSearchVisibilityAvailableInternal tid statusValue = void $ - putTeamFeatureFlagInternalWithGalleyAndMod + putTeamFeatureInternal @Public.SearchVisibilityAvailableConfig - g expect2xx tid (Public.WithStatusNoLock statusValue Public.SearchVisibilityAvailableConfig Public.FeatureTTLUnlimited) -getTeamFeatureFlagInternal :: +getTeamFeatureInternal :: forall cfg m. (HasGalley m, MonadIO m, MonadHttp m, KnownSymbol (Public.FeatureSymbol cfg)) => TeamId -> m ResponseLBS -getTeamFeatureFlagInternal tid = do +getTeamFeatureInternal tid = do g <- viewGalley - getTeamFeatureFlagInternalWithGalley @cfg g tid - -getTeamFeatureFlagInternalWithGalley :: - forall cfg m. - (MonadHttp m, HasCallStack, KnownSymbol (Public.FeatureSymbol cfg)) => - (Request -> Request) -> - TeamId -> - m ResponseLBS -getTeamFeatureFlagInternalWithGalley g tid = do get $ g . paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg] -getTeamFeatureFlag :: +getTeamFeature :: forall cfg m. (HasGalley m, MonadIO m, MonadHttp m, HasCallStack, KnownSymbol (Public.FeatureSymbol cfg)) => UserId -> TeamId -> m ResponseLBS -getTeamFeatureFlag uid tid = do - g <- viewGalley - getTeamFeatureFlagWithGalley @cfg g uid tid +getTeamFeature uid tid = do + galley <- viewGalley + get $ + galley + . paths ["teams", toByteString' tid, "features", Public.featureNameBS @cfg] + . zUser uid getAllTeamFeatures :: (HasCallStack, HasGalley m, MonadIO m, MonadHttp m) => @@ -107,107 +94,92 @@ getAllTeamFeatures uid tid = do . paths ["teams", toByteString' tid, "features"] . zUser uid -getAllTeamFeaturesPersonal :: - (HasCallStack, HasGalley m, MonadIO m, MonadHttp m) => +getTeamFeatureFromAll :: + forall cfg m. + ( HasCallStack, + MonadThrow m, + HasGalley m, + MonadIO m, + MonadHttp m, + KnownSymbol (Public.FeatureSymbol cfg), + FromJSON (Public.WithStatus cfg) + ) => + UserId -> + TeamId -> + m (Public.WithStatus cfg) +getTeamFeatureFromAll uid tid = do + response :: Value <- responseJsonError =<< getAllTeamFeatures uid tid + let status = response ^? key (Key.fromText (Public.featureName @cfg)) + maybe (error "getting all features failed") pure (status >>= fromResult . fromJSON) + where + fromResult :: Result a -> Maybe a + fromResult (Success b) = Just b + fromResult _ = Nothing + +getAllFeatureConfigs :: + (HasCallStack, HasGalley m, Monad m, MonadHttp m) => UserId -> m ResponseLBS -getAllTeamFeaturesPersonal uid = do +getAllFeatureConfigs uid = do g <- viewGalley get $ g . paths ["feature-configs"] . zUser uid -getTeamFeatureFlagWithGalley :: forall cfg m. (MonadHttp m, HasCallStack, KnownSymbol (Public.FeatureSymbol cfg)) => (Request -> Request) -> UserId -> TeamId -> m ResponseLBS -getTeamFeatureFlagWithGalley galley uid tid = do - get $ - galley - . paths ["teams", toByteString' tid, "features", Public.featureNameBS @cfg] - . zUser uid - -getFeatureConfig :: forall cfg m. (HasCallStack, MonadThrow m, HasGalley m, MonadHttp m, KnownSymbol (Public.FeatureSymbol cfg), FromJSON (Public.WithStatus cfg)) => UserId -> m (Public.WithStatus cfg) +getFeatureConfig :: + forall cfg m. + ( HasCallStack, + MonadThrow m, + HasGalley m, + MonadHttp m, + KnownSymbol (Public.FeatureSymbol cfg), + FromJSON (Public.WithStatus cfg) + ) => + UserId -> + m (Public.WithStatus cfg) getFeatureConfig uid = do - galley <- viewGalley - response :: Value <- responseJsonError =<< getAllFeatureConfigsWithGalley galley uid + response :: Value <- responseJsonError =<< getAllFeatureConfigs uid let status = response ^? key (Key.fromText (Public.featureName @cfg)) - maybe (error "getting all features failed") pure (status >>= fromResult . fromJSON) + maybe (error "getting all feature configs failed") pure (status >>= fromResult . fromJSON) where fromResult :: Result a -> Maybe a fromResult (Success b) = Just b fromResult _ = Nothing -getAllFeatureConfigs :: HasCallStack => UserId -> TestM ResponseLBS -getAllFeatureConfigs uid = do - g <- viewGalley - getAllFeatureConfigsWithGalley g uid - -getAllFeatureConfigsWithGalley :: (MonadHttp m, HasCallStack) => (Request -> Request) -> UserId -> m ResponseLBS -getAllFeatureConfigsWithGalley galley uid = do - get $ - galley - . paths ["feature-configs"] - . zUser uid - -putTeamFeatureFlagWithGalley :: +putTeamFeature :: forall cfg. ( HasCallStack, KnownSymbol (Public.FeatureSymbol cfg), ToJSON (Public.WithStatusNoLock cfg) ) => - (Request -> Request) -> UserId -> TeamId -> Public.WithStatusNoLock cfg -> TestM ResponseLBS -putTeamFeatureFlagWithGalley galley uid tid status = +putTeamFeature uid tid status = do + galley <- viewGalley put $ galley . paths ["teams", toByteString' tid, "features", Public.featureNameBS @cfg] . json status . zUser uid -putTeamFeatureFlagInternalTTL :: - forall cfg. - ( HasCallStack, - Public.IsFeatureConfig cfg, - KnownSymbol (Public.FeatureSymbol cfg), - ToSchema cfg - ) => - (Request -> Request) -> - TeamId -> - Public.WithStatusNoLock cfg -> - TestM ResponseLBS -putTeamFeatureFlagInternalTTL reqmod tid status = do - g <- viewGalley - putTeamFeatureFlagInternalWithGalleyAndMod @cfg g reqmod tid status - -putTeamFeatureFlagInternal :: - forall cfg. - ( HasCallStack, - KnownSymbol (Public.FeatureSymbol cfg), - ToJSON (Public.WithStatusNoLock cfg) - ) => - (Request -> Request) -> - TeamId -> - Public.WithStatusNoLock cfg -> - TestM ResponseLBS -putTeamFeatureFlagInternal reqmod tid status = do - g <- viewGalley - putTeamFeatureFlagInternalWithGalleyAndMod @cfg g reqmod tid status - -putTeamFeatureFlagInternalWithGalleyAndMod :: +putTeamFeatureInternal :: forall cfg m. - ( MonadHttp m, + ( Monad m, + HasGalley m, + MonadHttp m, HasCallStack, KnownSymbol (Public.FeatureSymbol cfg), ToJSON (Public.WithStatusNoLock cfg) ) => (Request -> Request) -> - (Request -> Request) -> TeamId -> Public.WithStatusNoLock cfg -> m ResponseLBS -putTeamFeatureFlagInternalWithGalleyAndMod galley reqmod tid status = +putTeamFeatureInternal reqmod tid status = do + galley <- viewGalley put $ galley . paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg] @@ -230,20 +202,7 @@ setLockStatusInternal reqmod tid lockStatus = do . paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg, toByteString' lockStatus] . reqmod -getFeatureStatusInternal :: - forall cfg. - ( HasCallStack, - KnownSymbol (Public.FeatureSymbol cfg) - ) => - TeamId -> - TestM ResponseLBS -getFeatureStatusInternal tid = do - galley <- viewGalley - get $ - galley - . paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg] - -patchFeatureStatusInternal :: +patchTeamFeatureInternal :: forall cfg. ( HasCallStack, KnownSymbol (Public.FeatureSymbol cfg), @@ -252,14 +211,9 @@ patchFeatureStatusInternal :: TeamId -> Public.WithStatusPatch cfg -> TestM ResponseLBS -patchFeatureStatusInternal tid reqBody = do - galley <- viewGalley - patch $ - galley - . paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg] - . json reqBody +patchTeamFeatureInternal = patchTeamFeatureInternalWithMod id -patchFeatureStatusInternalWithMod :: +patchTeamFeatureInternalWithMod :: forall cfg. ( HasCallStack, KnownSymbol (Public.FeatureSymbol cfg), @@ -269,7 +223,7 @@ patchFeatureStatusInternalWithMod :: TeamId -> Public.WithStatusPatch cfg -> TestM ResponseLBS -patchFeatureStatusInternalWithMod reqmod tid reqBody = do +patchTeamFeatureInternalWithMod reqmod tid reqBody = do galley <- viewGalley patch $ galley @@ -288,3 +242,44 @@ getGuestLinkStatus galley u cid = galley . paths ["conversations", toByteString' cid, "features", Public.featureNameBS @Public.GuestLinksConfig] . zUser u + +checkTeamFeatureAllEndpoints :: + forall cfg. + ( HasCallStack, + IsFeatureConfig cfg, + ToSchema cfg, + Typeable cfg, + Eq cfg, + Show cfg, + KnownSymbol (FeatureSymbol cfg) + ) => + UserId -> + TeamId -> + WithStatus cfg -> + TestM () +checkTeamFeatureAllEndpoints uid tid expected = do + compareLeniently $ responseJsonUnsafe <$> getTeamFeatureInternal @cfg tid + compareLeniently $ responseJsonUnsafe <$> getTeamFeature @cfg uid tid + compareLeniently $ getTeamFeatureFromAll @cfg uid tid + compareLeniently $ getFeatureConfig uid + where + compareLeniently :: TestM (WithStatus cfg) -> TestM () + compareLeniently receive = do + received <- receive + liftIO $ do + wsStatus received @?= wsStatus expected + wsLockStatus received @?= wsLockStatus expected + wsConfig received @?= wsConfig expected + checkTtl (wsTTL received) (wsTTL expected) + + checkTtl :: FeatureTTL -> FeatureTTL -> IO () + checkTtl (FeatureTTLSeconds actualTtl) (FeatureTTLSeconds expectedTtl) = + assertBool + ("expected the actual TTL to be greater than 0 and equal to or no more than 2 seconds less than " <> show expectedTtl <> ", but it was " <> show actualTtl) + ( actualTtl > 0 + && actualTtl <= expectedTtl + && abs (fromIntegral @Word @Int actualTtl - fromIntegral @Word @Int expectedTtl) <= 2 + ) + checkTtl FeatureTTLUnlimited FeatureTTLUnlimited = pure () + checkTtl FeatureTTLUnlimited _ = assertFailure "expected the actual TTL to be unlimited, but it was limited" + checkTtl _ FeatureTTLUnlimited = assertFailure "expected the actual TTL to be limited, but it was unlimited" diff --git a/services/galley/test/integration/TestSetup.hs b/services/galley/test/integration/TestSetup.hs index 2cdb594af24..d4d8c7151b0 100644 --- a/services/galley/test/integration/TestSetup.hs +++ b/services/galley/test/integration/TestSetup.hs @@ -55,7 +55,6 @@ import Data.ByteString.Conversion import Data.Domain import Data.Proxy import Data.Text qualified as Text -import GHC.TypeLits import Galley.Aws qualified as Aws import Galley.Options (Opts) import Imports @@ -141,7 +140,7 @@ instance VersionedMonad v ClientM where guardVersion _ = pure () runFedClient :: - forall (name :: Symbol) comp m api. + forall name comp m api. ( HasUnsafeFedEndpoint comp api name, Servant.HasClient Servant.ClientM api, MonadIO m, diff --git a/services/galley/test/resources/ecdsa_secp256r1_sha256.pem b/services/galley/test/resources/ecdsa_secp256r1_sha256.pem new file mode 100644 index 00000000000..69450327af3 --- /dev/null +++ b/services/galley/test/resources/ecdsa_secp256r1_sha256.pem @@ -0,0 +1,5 @@ +-----BEGIN PRIVATE KEY----- +MIGHAgEAMBMGByqGSM49AgEGCCqGSM49AwEHBG0wawIBAQQg3qjgQ9U+/rTBObn9 +tXSVi2UtHksRDXmQ1VOszFZfjryhRANCAATNkLmZZLyORf5D3PUOxt+rkJTE5vuD +aCqZ7sE5NSN8InRRwuQ1kv0oblDVeQA89ZlHqyxx75JPK+/air7Z1n5I +-----END PRIVATE KEY----- diff --git a/services/galley/test/resources/ecdsa_secp384r1_sha384.pem b/services/galley/test/resources/ecdsa_secp384r1_sha384.pem new file mode 100644 index 00000000000..28b7a630d33 --- /dev/null +++ b/services/galley/test/resources/ecdsa_secp384r1_sha384.pem @@ -0,0 +1,6 @@ +-----BEGIN PRIVATE KEY----- +MIG2AgEAMBAGByqGSM49AgEGBSuBBAAiBIGeMIGbAgEBBDBLwv3i5LDz9b++O0iw +QAit/Uq7L5PWPgKN99wCm8xkZnuyqWujXW4wvlVUVlZWgh2hZANiAAT0+RXKE31c +VxdYazaVopY50/nV9c18uRdqoENBvtxuD6oDtJtU6oCS/Htkd8JEArTQ9ZHqq144 +yRjuc3d2CqvJmEA/lzIBk9wnz+lghFhvB4TkSHvvLyEBc9DZvhb4EEQ= +-----END PRIVATE KEY----- diff --git a/services/galley/test/resources/ecdsa_secp521r1_sha512.pem b/services/galley/test/resources/ecdsa_secp521r1_sha512.pem new file mode 100644 index 00000000000..6634ae5251f --- /dev/null +++ b/services/galley/test/resources/ecdsa_secp521r1_sha512.pem @@ -0,0 +1,8 @@ +-----BEGIN PRIVATE KEY----- +MIHuAgEAMBAGByqGSM49AgEGBSuBBAAjBIHWMIHTAgEBBEIBiaEARm5BMaRct1xj +MlemUHijWGAoHtNMhSttSr4jo0WxMwfMnvnDQJSlO2Zs4Tzum2j5eO34EHu6MUrv +qquZYwyhgYkDgYYABAHuvCV/+gJitvAbDwgrBHZJ41oy8Lc+wPIM7Yp6s/vTzTsG +Klo7aMdkx6DUjv/56tVD9bZNulFAjwS8xoIyWg8NSAE1ofo8CBvN1XGZOWuMYjEh +zLrZADduEnOvayw5sEvm135WC0vWjPJaYwKZPdDIXUz9ILJPgNe3gEUvHsDEXvdX +lw== +-----END PRIVATE KEY----- diff --git a/services/gundeck/default.nix b/services/gundeck/default.nix index 3dad13b4224..a1c3759ede2 100644 --- a/services/gundeck/default.nix +++ b/services/gundeck/default.nix @@ -24,6 +24,7 @@ , exceptions , extended , extra +, foldl , gitignoreSource , gundeck-types , hedis @@ -56,6 +57,7 @@ , safe-exceptions , scientific , servant-server +, string-conversions , tagged , tasty , tasty-ant-xml @@ -105,6 +107,7 @@ mkDerivation { exceptions extended extra + foldl gundeck-types hedis http-client @@ -184,6 +187,7 @@ mkDerivation { aeson aeson-pretty amazonka + amazonka-core async base bytestring-conversion @@ -202,6 +206,7 @@ mkDerivation { quickcheck-instances quickcheck-state-machine scientific + string-conversions tasty tasty-hunit tasty-quickcheck diff --git a/services/gundeck/gundeck.cabal b/services/gundeck/gundeck.cabal index ce1b2c82ac4..45b786e9ca2 100644 --- a/services/gundeck/gundeck.cabal +++ b/services/gundeck/gundeck.cabal @@ -128,6 +128,7 @@ library , exceptions >=0.4 , extended , extra >=1.1 + , foldl , gundeck-types >=1.0 , hedis >=0.14.0 , http-client >=0.7 @@ -391,6 +392,7 @@ test-suite gundeck-tests type: exitcode-stdio-1.0 main-is: Main.hs other-modules: + Aws.Arn DelayQueue Json MockGundeck @@ -452,6 +454,7 @@ test-suite gundeck-tests aeson , aeson-pretty , amazonka + , amazonka-core , async , base , bytestring-conversion @@ -471,6 +474,7 @@ test-suite gundeck-tests , quickcheck-instances , quickcheck-state-machine , scientific + , string-conversions , tasty , tasty-hunit , tasty-quickcheck diff --git a/services/gundeck/src/Gundeck/Aws.hs b/services/gundeck/src/Gundeck/Aws.hs index ea5fe968866..b1636f33b7c 100644 --- a/services/gundeck/src/Gundeck/Aws.hs +++ b/services/gundeck/src/Gundeck/Aws.hs @@ -369,17 +369,12 @@ newtype Attributes = Attributes -- Note [VoIP TTLs] -- ~~~~~~~~~~~~~~~~ --- The TTL message attributes for APNS_VOIP and APNS_VOIP_SANDBOX are not --- documented but appear to work. The reason might be that TTLs were --- introduced before support for VoIP notifications. There is a catch, --- however. For GCM, APNS and APNS_SANDBOX, SNS treats the TTL "0" +-- For GCM, APNS and APNS_SANDBOX, SNS treats the TTL "0" -- specially, i.e. it forwards it to the provider where it has a special --- meaning. That does not appear to be the case for APNS_VOIP and --- APNS_VOIP_SANDBOX, for which the TTL is interpreted normally, which means --- if the TTL is lower than the "dwell time" in SNS, the notification is --- never sent to the provider. So we must specify a reasonably large TTL --- for transient VoIP notifications, so that they are not discarded --- already by SNS. +-- meaning. Which means if the TTL is lower than the "dwell time" in SNS, +-- the notification is never sent to the provider. So we must specify a +-- reasonably large TTL for transient VoIP notifications, so that they are +-- not discarded already by SNS. -- -- cf. http://docs.aws.amazon.com/sns/latest/dg/sns-ttl.html @@ -395,13 +390,9 @@ timeToLive t s = Attributes (Endo (ttlAttr s)) ttlNow GCM = "0" ttlNow APNS = "0" ttlNow APNSSandbox = "0" - ttlNow APNSVoIP = "15" -- See note [VoIP TTLs] - ttlNow APNSVoIPSandbox = "15" -- See note [VoIP TTLs] ttlKey GCM = "AWS.SNS.MOBILE.GCM.TTL" ttlKey APNS = "AWS.SNS.MOBILE.APNS.TTL" ttlKey APNSSandbox = "AWS.SNS.MOBILE.APNS_SANDBOX.TTL" - ttlKey APNSVoIP = "AWS.SNS.MOBILE.APNS_VOIP.TTL" - ttlKey APNSVoIPSandbox = "AWS.SNS.MOBILE.APNS_VOIP_SANDBOX.TTL" publish :: EndpointArn -> LT.Text -> Attributes -> Amazon (Either PublishError ()) publish arn txt attrs = do diff --git a/services/gundeck/src/Gundeck/Aws/Arn.hs b/services/gundeck/src/Gundeck/Aws/Arn.hs index c0be6380d7d..6c09b4bf362 100644 --- a/services/gundeck/src/Gundeck/Aws/Arn.hs +++ b/services/gundeck/src/Gundeck/Aws/Arn.hs @@ -53,6 +53,7 @@ where import Amazonka (Region (..)) import Amazonka.Data +import Control.Foldl qualified as Foldl import Control.Lens import Data.Attoparsec.Text import Data.Text qualified as Text @@ -134,8 +135,6 @@ arnTransportText :: Transport -> Text arnTransportText GCM = "GCM" arnTransportText APNS = "APNS" arnTransportText APNSSandbox = "APNS_SANDBOX" -arnTransportText APNSVoIP = "APNS_VOIP" -arnTransportText APNSVoIPSandbox = "APNS_VOIP_SANDBOX" -- Parsers -------------------------------------------------------------------- @@ -151,15 +150,18 @@ endpointTopicParser :: Parser EndpointTopic endpointTopicParser = do _ <- string "endpoint" t <- char '/' *> transportParser - e <- char '/' *> takeTill (== '-') - a <- char '-' *> takeTill (== '/') + envAndName <- char '/' *> takeTill (== '/') i <- char '/' *> takeWhile1 (not . isSpace) + let xs = Text.split (== '-') envAndName + e = Text.intercalate (Text.pack "-") (init xs) + a <- case Foldl.fold Foldl.last xs of + Just x -> pure x + Nothing -> fail ("Cannot parse appName in " ++ show xs) + pure $ mkEndpointTopic (ArnEnv e) t (AppName a) (EndpointId i) transportParser :: Parser Transport transportParser = string "GCM" $> GCM - <|> string "APNS_VOIP_SANDBOX" $> APNSVoIPSandbox - <|> string "APNS_VOIP" $> APNSVoIP <|> string "APNS_SANDBOX" $> APNSSandbox <|> string "APNS" $> APNS diff --git a/services/gundeck/src/Gundeck/Env.hs b/services/gundeck/src/Gundeck/Env.hs index fdc67f2f223..c9e8a4d286b 100644 --- a/services/gundeck/src/Gundeck/Env.hs +++ b/services/gundeck/src/Gundeck/Env.hs @@ -26,6 +26,7 @@ import Control.AutoUpdate import Control.Concurrent.Async (Async) import Control.Lens (makeLenses, (^.)) import Control.Retry (capDelay, exponentialBackoff) +import Data.ByteString.Char8 qualified as BSChar8 import Data.Metrics.Middleware (Metrics) import Data.Misc (Milliseconds (..)) import Data.Text (unpack) @@ -74,12 +75,16 @@ createEnv m o = do managerResponseTimeout = responseTimeoutMicro 5000000 } - (rThread, r) <- createRedisPool l (o ^. redis) "main-redis" + redisUsername <- BSChar8.pack <$$> lookupEnv "REDIS_USERNAME" + redisPassword <- BSChar8.pack <$$> lookupEnv "REDIS_PASSWORD" + (rThread, r) <- createRedisPool l (o ^. redis) redisUsername redisPassword "main-redis" (rAdditionalThreads, rAdditional) <- case o ^. redisAdditionalWrite of Nothing -> pure ([], Nothing) Just additionalRedis -> do - (rAddThread, rAdd) <- createRedisPool l additionalRedis "additional-write-redis" + additionalRedisUsername <- BSChar8.pack <$$> lookupEnv "REDIS_ADDITIONAL_WRITE_USERNAME" + addtionalRedisPassword <- BSChar8.pack <$$> lookupEnv "REDIS_ADDITIONAL_WRITE_PASSWORD" + (rAddThread, rAdd) <- createRedisPool l additionalRedis additionalRedisUsername addtionalRedisPassword "additional-write-redis" pure ([rAddThread], Just rAdd) p <- @@ -103,12 +108,14 @@ reqIdMsg :: RequestId -> Logger.Msg -> Logger.Msg reqIdMsg = ("request" Logger..=) . unRequestId {-# INLINE reqIdMsg #-} -createRedisPool :: Logger.Logger -> RedisEndpoint -> ByteString -> IO (Async (), Redis.RobustConnection) -createRedisPool l ep identifier = do +createRedisPool :: Logger.Logger -> RedisEndpoint -> Maybe ByteString -> Maybe ByteString -> ByteString -> IO (Async (), Redis.RobustConnection) +createRedisPool l ep username password identifier = do let redisConnInfo = Redis.defaultConnectInfo { Redis.connectHost = unpack $ ep ^. O.host, Redis.connectPort = Redis.PortNumber (fromIntegral $ ep ^. O.port), + Redis.connectUsername = username, + Redis.connectAuth = password, Redis.connectTimeout = Just (secondsToNominalDiffTime 5), Redis.connectMaxConnections = 100 } @@ -116,10 +123,13 @@ createRedisPool l ep identifier = do Log.info l $ Log.msg (Log.val $ "starting connection to " <> identifier <> "...") . Log.field "connectionMode" (show $ ep ^. O.connectionMode) - . Log.field "connInfo" (show redisConnInfo) + . Log.field "connInfo" (safeShowConnInfo redisConnInfo) let connectWithRetry = Redis.connectRobust l (capDelay 1000000 (exponentialBackoff 50000)) r <- case ep ^. O.connectionMode of Master -> connectWithRetry $ Redis.checkedConnect redisConnInfo Cluster -> connectWithRetry $ Redis.checkedConnectCluster redisConnInfo Log.info l $ Log.msg (Log.val $ "Established connection to " <> identifier <> ".") pure r + +safeShowConnInfo :: Redis.ConnectInfo -> String +safeShowConnInfo connInfo = show $ connInfo {Redis.connectAuth = "[REDACTED]" <$ Redis.connectAuth connInfo} diff --git a/services/gundeck/src/Gundeck/Instances.hs b/services/gundeck/src/Gundeck/Instances.hs index 83ab2a692b4..8b5b334f15f 100644 --- a/services/gundeck/src/Gundeck/Instances.hs +++ b/services/gundeck/src/Gundeck/Instances.hs @@ -34,21 +34,22 @@ import Gundeck.Aws.Arn (EndpointArn) import Gundeck.Types import Imports -instance Cql Transport where +-- | We provide a instance for `Either Int Transport` so we can handle (ie., gracefully ignore +-- rather than crash on) deprecated values in cassandra. See "Gundeck.Push.Data". +instance Cql (Either Int32 Transport) where ctype = Tagged IntColumn - toCql GCM = CqlInt 0 - toCql APNS = CqlInt 1 - toCql APNSSandbox = CqlInt 2 - toCql APNSVoIP = CqlInt 3 - toCql APNSVoIPSandbox = CqlInt 4 + toCql (Right GCM) = CqlInt 0 + toCql (Right APNS) = CqlInt 1 + toCql (Right APNSSandbox) = CqlInt 2 + toCql (Left i) = CqlInt i -- (this is weird, but it's helpful for cleaning up deprecated tokens.) fromCql (CqlInt i) = case i of - 0 -> pure GCM - 1 -> pure APNS - 2 -> pure APNSSandbox - 3 -> pure APNSVoIP - 4 -> pure APNSVoIPSandbox + 0 -> pure $ Right GCM + 1 -> pure $ Right APNS + 2 -> pure $ Right APNSSandbox + 3 -> pure (Left 3) -- `APNSVoIPV1` tokens are deprecated and will be ignored + 4 -> pure (Left 4) -- `APNSVoIPSandboxV1` tokens are deprecated and will be ignored n -> Left $ "unexpected transport: " ++ show n fromCql _ = Left "transport: int expected" diff --git a/services/gundeck/src/Gundeck/Monad.hs b/services/gundeck/src/Gundeck/Monad.hs index 809c7192d1d..66b234569d3 100644 --- a/services/gundeck/src/Gundeck/Monad.hs +++ b/services/gundeck/src/Gundeck/Monad.hs @@ -187,7 +187,7 @@ lookupReqId :: Logger -> Request -> IO RequestId lookupReqId l r = case lookup requestIdName (requestHeaders r) of Just rid -> pure $ RequestId rid Nothing -> do - localRid <- RequestId . cs . UUID.toText <$> UUID.nextRandom + localRid <- RequestId . UUID.toASCIIBytes <$> UUID.nextRandom Log.info l $ "request-id" .= localRid ~~ "method" .= requestMethod r diff --git a/services/gundeck/src/Gundeck/Notification/Data.hs b/services/gundeck/src/Gundeck/Notification/Data.hs index d680e68f2c4..de18c7f5eaf 100644 --- a/services/gundeck/src/Gundeck/Notification/Data.hs +++ b/services/gundeck/src/Gundeck/Notification/Data.hs @@ -39,7 +39,7 @@ import Data.Sequence qualified as Seq import Gundeck.Env import Gundeck.Options (NotificationTTL (..), internalPageSize, maxPayloadLoadSize, settings) import Gundeck.Push.Native.Serialise () -import Imports hiding (cs) +import Imports import UnliftIO (pooledForConcurrentlyN_) import UnliftIO.Async (pooledMapConcurrentlyN) import Wire.API.Internal.Notification diff --git a/services/gundeck/src/Gundeck/Presence/Data.hs b/services/gundeck/src/Gundeck/Presence/Data.hs index 1536dab9ea6..158e8982217 100644 --- a/services/gundeck/src/Gundeck/Presence/Data.hs +++ b/services/gundeck/src/Gundeck/Presence/Data.hs @@ -25,13 +25,14 @@ where import Control.Monad.Catch import Control.Monad.Except -import Data.Aeson +import Data.Aeson as Aeson import Data.ByteString qualified as Strict import Data.ByteString.Builder (byteString) import Data.ByteString.Char8 qualified as StrictChars import Data.ByteString.Conversion hiding (fromList) import Data.ByteString.Lazy qualified as Lazy import Data.Id +import Data.List.NonEmpty qualified as NonEmpty import Data.Misc (Milliseconds) import Database.Redis import Gundeck.Monad (Gundeck, posixTime, runWithAdditionalRedis) @@ -61,10 +62,10 @@ add p = do now <- posixTime let k = toKey (userId p) let v = toField (connId p) - let d = Lazy.toStrict $ encode $ PresenceData (resource p) (clientId p) now + let d = Lazy.toStrict $ Aeson.encode $ PresenceData p.resource p.clientId now runWithAdditionalRedis . retry x3 $ do void . fromTxResult <=< (liftRedis . multiExec) $ do - void $ hset k v d + void $ hset k (NonEmpty.singleton (v, d)) -- nb. All presences of a user are expired 'maxIdleTime' after the -- last presence was registered. A client who keeps a presence -- (i.e. websocket) connected for longer than 'maxIdleTime' will be diff --git a/services/gundeck/src/Gundeck/Push.hs b/services/gundeck/src/Gundeck/Push.hs index 02c6984873b..3e6fa5c05c6 100644 --- a/services/gundeck/src/Gundeck/Push.hs +++ b/services/gundeck/src/Gundeck/Push.hs @@ -34,7 +34,7 @@ where import Control.Arrow ((&&&)) import Control.Error import Control.Exception (ErrorCall (ErrorCall)) -import Control.Lens (view, (.~), (^.)) +import Control.Lens (to, view, (.~), (^.)) import Control.Monad.Catch import Data.Aeson as Aeson (Object) import Data.Id @@ -62,7 +62,7 @@ import Gundeck.ThreadBudget import Gundeck.Types import Gundeck.Types.Presence qualified as Presence import Gundeck.Util -import Imports hiding (cs) +import Imports import Network.HTTP.Types import Network.Wai.Utilities import System.Logger.Class (msg, val, (+++), (.=), (~~)) @@ -374,31 +374,16 @@ nativeTargets psh rcps' alreadySent = null (psh ^. pushConnections) || a ^. addrConn `elem` psh ^. pushConnections -- Apply transport preference in case of alternative transports for the - -- same client (currently only APNS vs APNS VoIP). If no explicit - -- preference is given, the default preference depends on the priority. + -- same client. If no explicit preference is given, the default preference depends on the priority. preference as = let pref = psh ^. pushNativeAps >>= view apsPreference in filter (pick (fromMaybe defPreference pref)) as where pick pr a = case a ^. addrTransport of GCM -> True - APNS -> pr == ApsStdPreference || notAny a APNSVoIP - APNSSandbox -> pr == ApsStdPreference || notAny a APNSVoIPSandbox - APNSVoIP -> pr == ApsVoIPPreference || notAny a APNS - APNSVoIPSandbox -> pr == ApsVoIPPreference || notAny a APNSSandbox - notAny a t = - not - ( any - ( \a' -> - addrEqualClient a a' - && a ^. addrApp == a' ^. addrApp - && a' ^. addrTransport == t - ) - as - ) - defPreference = case psh ^. pushNativePriority of - LowPriority -> ApsStdPreference - HighPriority -> ApsVoIPPreference + APNS -> pr == ApsStdPreference + APNSSandbox -> pr == ApsStdPreference + defPreference = ApsStdPreference check :: Either SomeException [a] -> m [a] check (Left e) = mntgtLogErr e >> pure [] check (Right r) = pure r @@ -525,22 +510,35 @@ addToken uid cid newtok = mpaRunWithBudget 1 (Left Public.AddTokenErrorNoBudget) updateEndpoint :: UserId -> PushToken -> EndpointArn -> Aws.SNSEndpoint -> Gundeck () updateEndpoint uid t arn e = do env <- view awsEnv + requestId <- view reqId + unless (equalTransport && equalApp) $ do - Log.err $ logMessage uid arn (t ^. token) "Transport or app mismatch" + Log.err $ logMessage requestId "PushToken does not fit to user_push data: Transport or app mismatch" throwM $ mkError status500 "server-error" "Server Error" - Log.info $ logMessage uid arn (t ^. token) "Upserting push token." + + Log.info $ logMessage requestId "Upserting push token." let users = Set.insert uid (e ^. endpointUsers) Aws.execute env $ Aws.updateEndpoint users (t ^. token) arn where equalTransport = t ^. tokenTransport == arn ^. snsTopic . endpointTransport equalApp = t ^. tokenApp == arn ^. snsTopic . endpointAppName - logMessage a r tk m = + logMessage requestId m = "user" - .= UUID.toASCIIBytes (toUUID a) + .= UUID.toASCIIBytes (toUUID uid) ~~ "token" - .= Text.take 16 (tokenText tk) + .= Text.take 16 (t ^. token . to tokenText) + ~~ "tokenTransport" + .= show (t ^. tokenTransport) + ~~ "tokenApp" + .= (t ^. tokenApp . to appNameText) ~~ "arn" - .= toText r + .= toText arn + ~~ "endpointTransport" + .= show (arn ^. snsTopic . endpointTransport) + ~~ "endpointAppName" + .= (arn ^. snsTopic . endpointAppName . to appNameText) + ~~ "request" + .= unRequestId requestId ~~ msg (val m) deleteToken :: UserId -> Token -> Gundeck (Maybe ()) diff --git a/services/gundeck/src/Gundeck/Push/Data.hs b/services/gundeck/src/Gundeck/Push/Data.hs index c688f64f4db..fa495b0e1fe 100644 --- a/services/gundeck/src/Gundeck/Push/Data.hs +++ b/services/gundeck/src/Gundeck/Push/Data.hs @@ -38,26 +38,29 @@ import System.Logger.Class qualified as Log lookup :: (MonadClient m, MonadLogger m) => UserId -> Consistency -> m [Address] lookup u c = foldM mk [] =<< retry x1 (query q (params c (Identity u))) where - q :: PrepQuery R (Identity UserId) (UserId, Transport, AppName, Token, Maybe EndpointArn, ConnId, Maybe ClientId) + q :: PrepQuery R (Identity UserId) (UserId, Either Int32 Transport, AppName, Token, Maybe EndpointArn, ConnId, Maybe ClientId) q = "select usr, transport, app, ptoken, arn, connection, client from user_push where usr = ?" mk as r = maybe as (: as) <$> mkAddr r insert :: MonadClient m => UserId -> Transport -> AppName -> Token -> EndpointArn -> ConnId -> ClientId -> m () -insert u t a p e o c = retry x5 $ write q (params LocalQuorum (u, t, a, p, e, o, c)) +insert u t a p e o c = retry x5 $ write q (params LocalQuorum (u, Right t, a, p, e, o, c)) where - q :: PrepQuery W (UserId, Transport, AppName, Token, EndpointArn, ConnId, ClientId) () + q :: PrepQuery W (UserId, Either Int32 Transport, AppName, Token, EndpointArn, ConnId, ClientId) () q = "insert into user_push (usr, transport, app, ptoken, arn, connection, client) values (?, ?, ?, ?, ?, ?, ?)" updateArn :: MonadClient m => UserId -> Transport -> AppName -> Token -> EndpointArn -> m () -updateArn uid transport app token arn = retry x5 $ write q (params LocalQuorum (arn, uid, transport, app, token)) +updateArn uid transport app token arn = retry x5 $ write q (params LocalQuorum (arn, uid, Right transport, app, token)) where - q :: PrepQuery W (EndpointArn, UserId, Transport, AppName, Token) () + q :: PrepQuery W (EndpointArn, UserId, Either Int32 Transport, AppName, Token) () q = {- `IF EXISTS`, but that requires benchmarking -} "update user_push set arn = ? where usr = ? and transport = ? and app = ? and ptoken = ?" delete :: MonadClient m => UserId -> Transport -> AppName -> Token -> m () -delete u t a p = retry x5 $ write q (params LocalQuorum (u, t, a, p)) +delete u t = deleteAux u (Right t) + +deleteAux :: MonadClient m => UserId -> Either Int32 Transport -> AppName -> Token -> m () +deleteAux u t a p = retry x5 $ write q (params LocalQuorum (u, t, a, p)) where - q :: PrepQuery W (UserId, Transport, AppName, Token) () + q :: PrepQuery W (UserId, Either Int32 Transport, AppName, Token) () q = "delete from user_push where usr = ? and transport = ? and app = ? and ptoken = ?" erase :: MonadClient m => UserId -> m () @@ -68,16 +71,20 @@ erase u = retry x5 $ write q (params LocalQuorum (Identity u)) mkAddr :: (MonadClient m, MonadLogger m) => - (UserId, Transport, AppName, Token, Maybe EndpointArn, ConnId, Maybe ClientId) -> + (UserId, Either Int32 Transport, AppName, Token, Maybe EndpointArn, ConnId, Maybe ClientId) -> m (Maybe Address) -mkAddr (usr, trp, app, tok, arn, con, clt) = case (clt, arn) of - (Just c, Just a) -> pure $! Just $! Address usr a con (pushToken trp app tok c) +mkAddr (usr, trp, app, tok, arn, con, clt) = case (trp, clt, arn) of + (Right t, Just c, Just a) -> pure $! Just $! Address usr a con (pushToken t app tok c) _ -> do Log.info $ field "user" (toByteString usr) ~~ field "transport" (show trp) ~~ field "app" (appNameText app) ~~ field "token" (tokenText tok) - ~~ msg (val "Deleting legacy push token without a client or ARN.") - delete usr trp app tok + ~~ msg + ( val + "Deleting legacy push token without a client or ARN, or with deprecated \ + \APNSVoIP* transports (transport type not shown in this message)." + ) + deleteAux usr trp app tok pure Nothing diff --git a/services/gundeck/src/Gundeck/Push/Native/Serialise.hs b/services/gundeck/src/Gundeck/Push/Native/Serialise.hs index bf9e0e491cc..07f783c36d9 100644 --- a/services/gundeck/src/Gundeck/Push/Native/Serialise.hs +++ b/services/gundeck/src/Gundeck/Push/Native/Serialise.hs @@ -54,8 +54,6 @@ renderText t prio x = case t of GCM -> trim "GCM" (jsonString gcmJson) APNS -> trim "APNS" (jsonString stdApnsJson) APNSSandbox -> trim "APNS_SANDBOX" (jsonString stdApnsJson) - APNSVoIP -> trim "APNS_VOIP" (jsonString voipApnsJson) - APNSVoIPSandbox -> trim "APNS_VOIP_SANDBOX" (jsonString voipApnsJson) where gcmJson = object @@ -67,11 +65,6 @@ renderText t prio x = case t of [ "aps" .= apsDict, "data" .= x ] - voipApnsJson = - object - [ "aps" .= object [], - "data" .= x - ] -- https://developer.apple.com/documentation/usernotifications/modifying_content_in_newly_delivered_notifications -- Must contain `mutable-content: 1` and include an alert dictionary with title, subtitle, or body information. -- Since we have no useful data here, we send a default payload that gets overridden by the client @@ -94,8 +87,6 @@ maxPayloadSize :: Transport -> Int64 maxPayloadSize GCM = 4096 maxPayloadSize APNS = 4096 maxPayloadSize APNSSandbox = 4096 -maxPayloadSize APNSVoIP = 5120 -maxPayloadSize APNSVoIPSandbox = 5120 gcmPriority :: Priority -> Text gcmPriority LowPriority = "normal" diff --git a/services/gundeck/src/Gundeck/Push/Websocket.hs b/services/gundeck/src/Gundeck/Push/Websocket.hs index c6a9190aba0..64a51c5f9d9 100644 --- a/services/gundeck/src/Gundeck/Push/Websocket.hs +++ b/services/gundeck/src/Gundeck/Push/Websocket.hs @@ -44,7 +44,7 @@ import Gundeck.Monad import Gundeck.Presence.Data qualified as Presence import Gundeck.Types.Presence import Gundeck.Util -import Imports hiding (cs) +import Imports import Network.HTTP.Client (HttpExceptionContent (..)) import Network.HTTP.Client.Internal qualified as Http import Network.HTTP.Types (StdMethod (POST), status200, status410) diff --git a/services/gundeck/src/Gundeck/Redis.hs b/services/gundeck/src/Gundeck/Redis.hs index 721106bdbd1..a4784349db2 100644 --- a/services/gundeck/src/Gundeck/Redis.hs +++ b/services/gundeck/src/Gundeck/Redis.hs @@ -61,7 +61,7 @@ connectRobust :: connectRobust l retryStrategy connectLowLevel = do robustConnection <- newEmptyMVar @IO @Connection thread <- - async $ safeForever $ do + async $ safeForever l $ do Log.info l $ Log.msg (Log.val "connecting to Redis") conn <- retry connectLowLevel Log.info l $ Log.msg (Log.val "successfully connected to Redis") @@ -117,9 +117,11 @@ instance Exception PingException safeForever :: forall m. (MonadUnliftIO m) => + Logger -> m () -> m () -safeForever action = +safeForever l action = forever $ - action `catchAny` \_ -> do + action `catchAny` \e -> do + Log.err l $ Log.msg (Log.val "Uncaught exception while connecting to redis") . Log.field "error" (displayException e) threadDelay 1e6 -- pause to keep worst-case noise in logs manageable diff --git a/services/gundeck/src/Gundeck/Run.hs b/services/gundeck/src/Gundeck/Run.hs index 55487f84c98..4a919bd0ba7 100644 --- a/services/gundeck/src/Gundeck/Run.hs +++ b/services/gundeck/src/Gundeck/Run.hs @@ -24,14 +24,17 @@ import Cassandra (runClient, shutdown) import Cassandra.Schema (versionCheck) import Control.Error (ExceptT (ExceptT)) import Control.Exception (finally) -import Control.Lens hiding (enum) +import Control.Lens ((.~), (^.)) import Control.Monad.Extra +import Data.Id (RequestId (..)) import Data.Metrics (Metrics) import Data.Metrics.AWS (gaugeTokenRemaing) import Data.Metrics.Middleware (metrics) import Data.Metrics.Middleware.Prometheus (waiPrometheusMiddleware) import Data.Proxy (Proxy (Proxy)) import Data.Text (unpack) +import Data.UUID qualified as UUID +import Data.UUID.V4 qualified as UUID import Database.Redis qualified as Redis import Gundeck.API (sitemap) import Gundeck.API.Public (servantSitemap) @@ -46,9 +49,11 @@ import Imports hiding (head) import Network.Wai as Wai import Network.Wai.Middleware.Gunzip qualified as GZip import Network.Wai.Middleware.Gzip qualified as GZip +import Network.Wai.Utilities (lookupRequestId) import Network.Wai.Utilities.Server hiding (serverPort) import Servant (Handler (Handler), (:<|>) (..)) import Servant qualified +import System.Logger ((.=), (~~)) import System.Logger qualified as Log import UnliftIO.Async qualified as Async import Util.Options @@ -69,7 +74,9 @@ run o = do lst <- Async.async $ Aws.execute (e ^. awsEnv) (Aws.listen throttleMillis (runDirect e . onEvent)) wtbs <- forM (e ^. threadBudgetState) $ \tbs -> Async.async $ runDirect e $ watchThreadBudgetState m tbs 10 wCollectAuth <- Async.async (collectAuthMetrics m (Aws._awsEnv (Env._awsEnv e))) - runSettingsWithShutdown s (middleware e $ mkApp e) Nothing `finally` do + + let app = middleware e (\requestId -> mkApp (e & reqId .~ requestId)) + runSettingsWithShutdown s app Nothing `finally` do Log.info l $ Log.msg (Log.val "Shutting down ...") shutdown (e ^. cstate) Async.cancel lst @@ -80,13 +87,28 @@ run o = do whenJust (e ^. rstateAdditionalWrite) $ (=<<) Redis.disconnect . takeMVar Log.close (e ^. applog) where - middleware :: Env -> Wai.Middleware + middleware :: Env -> (RequestId -> Wai.Application) -> Wai.Application middleware e = versionMiddleware (foldMap expandVersionExp (o ^. settings . disabledAPIVersions)) . waiPrometheusMiddleware sitemap . GZip.gunzip . GZip.gzip GZip.def . catchErrors (e ^. applog) [Right $ e ^. monitor] + . lookupRequestIdMiddleware (e ^. applog) + + lookupRequestIdMiddleware :: Log.Logger -> (RequestId -> Wai.Application) -> Wai.Application + lookupRequestIdMiddleware logger mkapp req cont = do + case lookupRequestId req of + Just rid -> do + mkapp (RequestId rid) req cont + Nothing -> do + localRid <- RequestId . UUID.toASCIIBytes <$> UUID.nextRandom + Log.info logger $ + "request-id" .= localRid + ~~ "method" .= Wai.requestMethod req + ~~ "path" .= Wai.rawPathInfo req + ~~ Log.msg (Log.val "generated a new request id for local request") + mkapp localRid req cont type CombinedAPI = GundeckAPI :<|> Servant.Raw diff --git a/services/gundeck/test/integration/API.hs b/services/gundeck/test/integration/API.hs index b0c3a63186f..0d9f128b4ae 100644 --- a/services/gundeck/test/integration/API.hs +++ b/services/gundeck/test/integration/API.hs @@ -64,7 +64,7 @@ import System.Timeout (timeout) import Test.Tasty import Test.Tasty.HUnit import TestSetup -import Util (runRedisProxy, withSettingsOverrides) +import Util (runRedisProxy, withEnvOverrides, withSettingsOverrides) import Wire.API.Internal.Notification import Prelude qualified @@ -838,9 +838,8 @@ testSharePushToken = do gcmTok <- Token . T.decodeUtf8 . toByteString' <$> randomId apsTok <- Token . T.decodeUtf8 . B16.encode <$> randomBytes 32 let tok1 = pushToken GCM "test" gcmTok - let tok2 = pushToken APNSVoIP "com.wire.dev.ent" apsTok - let tok3 = pushToken APNS "com.wire.int.ent" apsTok - forM_ [tok1, tok2, tok3] $ \tk -> do + let tok2 = pushToken APNS "com.wire.int.ent" apsTok + forM_ [tok1, tok2] $ \tk -> do u1 <- randomUser u2 <- randomUser c1 <- randomClientId @@ -922,7 +921,12 @@ testRedisMigration = do map resource . decodePresence <$> (getPresence g (toByteString' uid) lookupEnv "REDIS_ADDITIONAL_WRITE_USERNAME" + password <- ("REDIS_PASSWORD",) <$$> lookupEnv "REDIS_ADDITIONAL_WRITE_PASSWORD" + pure $ catMaybes [username, password] + + withEnvOverrides redis2CredsAsRedis1Creds $ withSettingsOverrides (redis .~ redis2) $ do g <- view tsGundeck retrievedPresence <- map resource . decodePresence <$> (getPresence g (toByteString' uid) [(String, String)] -> m a -> m a +withEnvOverrides envOverrides action = do + bracket (setEnvVars envOverrides) (resetEnvVars) $ const action + where + setEnvVars :: [(String, String)] -> m [(String, Maybe String)] + setEnvVars newVars = liftIO $ do + oldVars <- mapM (\(k, _) -> (k,) <$> lookupEnv k) newVars + mapM_ (uncurry setEnv) newVars + pure oldVars + + resetEnvVars :: [(String, Maybe String)] -> m () + resetEnvVars = + mapM_ (\(k, mV) -> maybe (unsetEnv k) (setEnv k) mV) + runRedisProxy :: Text -> Word16 -> Word16 -> IO () runRedisProxy redisHost redisPort proxyPort = do (servAddr : _) <- getAddrInfo Nothing (Just $ Text.unpack redisHost) (Just $ show redisPort) diff --git a/services/gundeck/test/unit/Aws/Arn.hs b/services/gundeck/test/unit/Aws/Arn.hs new file mode 100644 index 00000000000..ca661c8d0de --- /dev/null +++ b/services/gundeck/test/unit/Aws/Arn.hs @@ -0,0 +1,57 @@ +module Aws.Arn where + +import Amazonka.Data.Text +import Control.Lens +import Gundeck.Aws.Arn +import Gundeck.Types +import Imports +import Test.Tasty +import Test.Tasty.HUnit + +tests :: TestTree +tests = + testGroup + "Aws.Arn" + [ testGroup + "Parser" + [ testGroup + "EndpointArn" + [ testCaseSteps "real world round-trip" realWorldArnTest, + testCaseSteps "made-up round-trip" madeUpArnTest + ] + ] + ] + +realWorldArnTest :: HasCallStack => (String -> IO ()) -> Assertion +realWorldArnTest step = do + step "Given an ARN from a test environment" + let arnText :: Text = "arn:aws:sns:eu-central-1:091205192927:endpoint/GCM/sven-test-782078216207/ded226c7-45b8-3f6c-9e89-f253340bbb60" + arnData <- + either (\e -> assertFailure ("Arn cannot be parsed: " ++ e)) pure (fromText @EndpointArn arnText) + + step "Check that values were parsed correctly" + (arnData ^. snsRegion) @?= "eu-central-1" + (arnData ^. snsAccount . to fromAccount) @?= "091205192927" + (arnData ^. snsTopic . endpointTransport) @?= GCM + (arnData ^. snsTopic . endpointAppName) @?= "782078216207" + (arnData ^. snsTopic . endpointId . to (\(EndpointId eId) -> eId)) @?= "ded226c7-45b8-3f6c-9e89-f253340bbb60" + + step "Expect values to be de-serialized correctly" + (toText arnData) @?= arnText + +madeUpArnTest :: HasCallStack => (String -> IO ()) -> Assertion +madeUpArnTest step = do + step "Given an ARN with data to cover untested cases" + let arnText :: Text = "arn:aws:sns:us-east-2:000000000001:endpoint/APNS/nodash-000000000002/8ffd8d14-db06-4f3a-a3bb-08264b9dbfb0" + arnData <- + either (\e -> assertFailure ("Arn cannot be parsed: " ++ e)) pure (fromText @EndpointArn arnText) + + step "Check that values were parsed correctly" + (arnData ^. snsRegion) @?= "us-east-2" + (arnData ^. snsAccount . to fromAccount) @?= "000000000001" + (arnData ^. snsTopic . endpointTransport) @?= APNS + (arnData ^. snsTopic . endpointAppName) @?= "000000000002" + (arnData ^. snsTopic . endpointId . to (\(EndpointId eId) -> eId)) @?= "8ffd8d14-db06-4f3a-a3bb-08264b9dbfb0" + + step "Expect values to be de-serialized correctly" + (toText arnData) @?= arnText diff --git a/services/gundeck/test/unit/Main.hs b/services/gundeck/test/unit/Main.hs index a2d76732e63..332418beb38 100644 --- a/services/gundeck/test/unit/Main.hs +++ b/services/gundeck/test/unit/Main.hs @@ -20,6 +20,7 @@ module Main ) where +import Aws.Arn qualified import Data.Metrics.Test (pathsConsistencyCheck) import Data.Metrics.WaiRoute (treeToPaths) import DelayQueue qualified @@ -50,5 +51,6 @@ main = Native.tests, Push.tests, ThreadBudget.tests, - ParseExistsError.tests + ParseExistsError.tests, + Aws.Arn.tests ] diff --git a/services/gundeck/test/unit/MockGundeck.hs b/services/gundeck/test/unit/MockGundeck.hs index 0dacd4e378f..19d35241dbd 100644 --- a/services/gundeck/test/unit/MockGundeck.hs +++ b/services/gundeck/test/unit/MockGundeck.hs @@ -61,6 +61,7 @@ import Data.Misc (Milliseconds (Ms)) import Data.Range import Data.Scientific qualified as Scientific import Data.Set qualified as Set +import Data.String.Conversions import Gundeck.Aws.Arn as Aws import Gundeck.Options import Gundeck.Push diff --git a/services/gundeck/test/unit/Native.hs b/services/gundeck/test/unit/Native.hs index 2e525f7cf1f..500ec668ff6 100644 --- a/services/gundeck/test/unit/Native.hs +++ b/services/gundeck/test/unit/Native.hs @@ -73,8 +73,6 @@ instance FromJSON SnsNotification where [("GCM", String n)] -> parseGcm n [("APNS", String n)] -> parseApns APNS n [("APNS_SANDBOX", String n)] -> parseApns APNSSandbox n - [("APNS_VOIP", String n)] -> parseApns APNSVoIP n - [("APNS_VOIP_SANDBOX", String n)] -> parseApns APNSVoIPSandbox n _ -> mempty where parseApns t n = diff --git a/services/gundeck/test/unit/ThreadBudget.hs b/services/gundeck/test/unit/ThreadBudget.hs index bd06c866dea..f9f21656aa3 100644 --- a/services/gundeck/test/unit/ThreadBudget.hs +++ b/services/gundeck/test/unit/ThreadBudget.hs @@ -30,6 +30,7 @@ import Control.Concurrent.Async import Control.Lens import Control.Monad.Catch (MonadCatch, catch) import Data.Metrics.Middleware (metrics) +import Data.String.Conversions import Data.Time import GHC.Generics import Gundeck.Options diff --git a/services/integration.yaml b/services/integration.yaml index 65543e45f10..dbfc516bf87 100644 --- a/services/integration.yaml +++ b/services/integration.yaml @@ -61,7 +61,7 @@ federatorExternal: host: 127.0.0.1 port: 8098 -# This domain is configured using coredns runing along with the rest of +# This domain is configured using coredns running along with the rest of # docker-ephemeral setup. There is only an SRV record for # _wire-server-federator._tcp.example.com originDomain: example.com @@ -118,7 +118,6 @@ backendTwo: originDomain: b.example.com - redis2: host: 127.0.0.1 port: 6379 @@ -142,3 +141,44 @@ rabbitmq: cassandra: host: 127.0.0.1 port: 9042 + +federation-v0: + originDomain: federation-v0.example.com + brig: + host: 127.0.0.1 + port: 21082 + cannon: + host: 127.0.0.1 + port: 21083 + cargohold: + host: 127.0.0.1 + port: 21084 + federatorInternal: + host: 127.0.0.1 + port: 21097 + federatorExternal: + host: 127.0.0.1 + port: 21098 + galley: + host: 127.0.0.1 + port: 21085 + gundeck: + host: 127.0.0.1 + port: 21086 + nginz: + host: 127.0.0.1 + port: 21080 + spar: + host: 127.0.0.1 + port: 21088 + proxy: + host: 127.0.0.1 + port: 21087 + backgroundWorker: + host: 127.0.0.1 + port: 21089 + stern: + host: 127.0.0.1 + port: 21091 + +integrationTestHostName: "localhost" diff --git a/services/nginz/integration-test/conf/nginz/integration-ca-key.pem b/services/nginz/integration-test/conf/nginz/integration-ca-key.pem index c92a5f13598..0bd38214cc7 100644 --- a/services/nginz/integration-test/conf/nginz/integration-ca-key.pem +++ b/services/nginz/integration-test/conf/nginz/integration-ca-key.pem @@ -1,27 +1,27 @@ -----BEGIN RSA PRIVATE KEY----- -MIIEpAIBAAKCAQEAxxSgxLUyMcwQHhE3ziEbPgn+m9L8EkXscvsWA6Ma4n5owK2m -Y7aG3n2ZRYlW+3VMBi0StrPh+lmXZWzgyw+bxHkaNYFTpK70xUGTx3lHfyu6EpKB -O0El1SNExnrx8ONUbLyY/LwnjlC5dWOB9l4PNylUf4DUr7eAlFrMIP2v2/FWVz9b -ffm5fWry4fW7iRcLGQRKNYrv/B798dVxEj9xoh2OiW6p8/tuEND6NMkJiGstHTJY -tmhwmF74WAxo7EQHD6iNgpr5errAQwrZheSGYNlbj078lA9mpE7BcPwEdDYgnI4R -Lblp0vcXvI3uw4Ne4+EMCDxJhXX+SvacAtBPMQIDAQABAoIBAQCCfuwPZTLc34Wl -H+YzsRHZbdW+sONY2wruJ9Y7VhwWYYQq4OkTrZ7kkvH4WdlxhWbrGXqN1oYHg9iw -vFjx4m5ZsIRUlEyOw7xg3OaQt9f87V3QNMaPX9n7x12auRaEr480o7+o03EeYZ3f -6/VR2EAjCW2BEqLX9/JJzObHrWMsSPMaXIV60V8K7kou1Ol3gdERG/+vAKhqzjFv -xdGQ0J6UHuYsZ5GP+xc1VLmE4WFQBAxcGbm+KWIHPeR/cq40JSsv5iRY5wBYRERK -szqDtwYAObf6DK4qSe8KKHMCfXP1RjWm5cvSebwyIjIqCnFXXUXpE0UNBkiUTVx6 -9xFpaJSRAoGBANuF2ucn0QwPNlyWdkAy9ItVmtwO+Rq8nlFai8KOt/Dauw5IqNye -xy6I8oEHCVrl7rHU6XRXqo3rJHrskcSJhYbiV+dYwusUnkqB27X/qv+CYJ/MQRC6 -v++ceNu/ybAF4UXxbIkEKR5BYaUAjXIN8kGp6Y1hF/wkUmjHQMQiwJP1AoGBAOgp -MOukoVDUQpu8Izzt9ff++S2531LUL66BCmxPQR3vhdxnYLFqs216uTevDrGTgLRS -mXwddVHLKW+zJiGZ0QssnCHmPzzg+USLQzCqJLUKCOoT9s3sDq/TsJwVuZy6sPcr -qWJ/sC9Ge+ZB6CRDrvZGdMSFvRkGT0cpT/mW4gTNAoGAX8ZxsCJmCV3luNWIeBAD -M3tA2jvKIQkkBZh8m4DK7dFwhRXcXo0Dl+D19KdORJNG5d1fkXviFJL/0oW+P0JE -uImuEmheelP/j8BCTJBkWZ/XakCiLptbvD3HWRC+/QZDt9FSKiFfkyyxXlz0WUuO -Y2mvVRiEb2Slc8NjFW+YF7UCgYAG2Pgtaxyq8qfISiNL78TafLXCyIGywrlpTzsM -eMX16ROsrYvnj7sdFoqR/uLTEAOyzeDjDUdhkzl0pvcP9KZ6yuUMBuuEkyonAGiJ -7erJQDOFG/OinTzNqNPDtsxTuBnyIGKNmjCLJGwRHY6IS0rEzs0w4rTyIQKDmc9X -EEE4XQKBgQDWr+hrUDfMa0JeiiB+mFCebNZptDMe0WN5oh+l1FkNlhSauaIb19Fu -qNtrC/F7ZihJW7i4xzEeakaZLpTEMjhdDLD4aQ+RiqW8iR7qmLKDYKWd8g2sanL1 -Tspko3Sj2Oq00BAU5tlNvVvxIaGraQ+HfNRi7p1HEPm7CeLg4ucmTg== +MIIEogIBAAKCAQEAlq2bCpvwVptvslD3Xq/tAjm58wQHGEpVSyefl+vGQAD30ukV +FiqzjJw9ZCTbS1to2k7YTukabQAu4pHlhHk4/r2JHr7olmUf5zjyKvJUBekFl788 +ZXW9lEOw5x7lgBLSYI20sSHbUVX7pC2dB2AQZt15sGF1DmVU39/yF2RII92bnqPY +r8tS7A6JslhHLnPAnCOaHC4VK6tMU3Zjh/p/sBgKBqbarXAPl2TckXxFEHK8l0lD +yU2a5ltK0YuAxOv4iXwK76G4VQJwbF0NCMzjAovBLcOA7BVRd8ywVjFpzQjhn+gy +yATdZUOlOpMXIEa7Hmc5TMB4KjiJYwocjKl66QIDAQABAoIBAFYPolZU6tkMvqdi +h2eVpBF5VzPuQP8mtcDPSOBE0l8MLoBQkLKwgQz20Dm6s2Y/N4w5LGMl0OohCKZw +Hl+jvWICb6cX81CzQZ2XcPoGnuchSQh7OcvZjAZ7Azd+9iZImdB8H5Bsfg/exHPp +eZ8Ux0l5hl+vymQGjIuyJVwm8u1IbZbW3+yTJ/oFqa/j91Yw7Llsa7VaLs+NiJkY +Ng7AtAd/zz6BN4x93AMCbs6KgLQcKK1WyIkCqoUsZG5orzIKlpmBnmv4EeQwvem9 +/rt3LlKFzHXBPG47BECQsyPYli1Z3Gnp/XTNMteeqDicj4CI9icU1QRxTyUmIMFB +Wd81qAECgYEAxClEt4tteo1kPuiiajHSR1PApPG40Zlc9GovQl/JQnr+MSaexD/M +gMtZlhQYrdThmGYcdzmpWaS5YCKesB82ca3QwaJK3+q3/MclvNt7hoIQoWm53eAK +J4CabtUiyzmG1iaYulEkqFtlg8nK0SwFNr8UEGHyerSHFtTiUXw47mECgYEAxKRy +1Z16pcesupUXzdET6ZdwN70oJT+3D+s98ZBtn2pBW7RQKEe9pvlbTrClTkFxUhXu +jPyNama8KvON57ekgb3nanlyp2sX8AtydEb+BZtRDp3PMF+J6nl828Mt2LHtivul +iacBM4dCM3IsEXMvlJElxm0ILgAUb9LqKl6giYkCgYAbqNoIq39XbYJ6IGFuafIF +nrimSXNPErn5uNNLH6iIWEFpetGeSIS0kHfkYpcMQ90/mP5gjV/kxQZimN8ZZH1P +0DuEYjb+leE1onsewzAKymI/8GGF+KZV5ZthD2qlj0oE/lJAy1pI5wJMb/LKRdPC +YXUZzkXbqYL25DO5W7PHYQKBgFz/9XuHziCnjc50gtyJPGSmhaEm6dysBJUXyaT8 +jIvvgdewMJTMUSquFfviWVvoYYLT8o1lSDCBRA8APyXO2ZOuz8qwg4QghyK1Fz1c +8fiO20gRZJLZLG3jZSS+a2lnxRONLl4qyMuo9atFHQhntKIL/5SXrl2rFf9I/gxp +0n0ZAoGAf3Om0O1td3EfemGzJs3YJOKiwltDZNtwF5G4VG9c9YjlevaLJoNhgBw9 +u16e/mQNU/yr/qqRp+aE6HGcXXBp0ckJcKqKFQ2pUVhMb/T8OfPpT2n7RF1k0Xss +5vrEUSfif9VPCEnjMI7AtZcXQT1yqMQuTW+IhP15dGuofWdDsHQ= -----END RSA PRIVATE KEY----- diff --git a/services/nginz/integration-test/conf/nginz/integration-ca.pem b/services/nginz/integration-test/conf/nginz/integration-ca.pem index 2315c7c7404..10a906c111b 100644 --- a/services/nginz/integration-test/conf/nginz/integration-ca.pem +++ b/services/nginz/integration-test/conf/nginz/integration-ca.pem @@ -1,19 +1,19 @@ -----BEGIN CERTIFICATE----- -MIIDAjCCAeqgAwIBAgIULBRPt7tLLvsw7kciIdjbXB8tddQwDQYJKoZIhvcNAQEL -BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjMxMTIxMTM1ODAwWhcN -MjgxMTE5MTM1ODAwWjAZMRcwFQYDVQQDEw5jYS5leGFtcGxlLmNvbTCCASIwDQYJ -KoZIhvcNAQEBBQADggEPADCCAQoCggEBAMcUoMS1MjHMEB4RN84hGz4J/pvS/BJF -7HL7FgOjGuJ+aMCtpmO2ht59mUWJVvt1TAYtEraz4fpZl2Vs4MsPm8R5GjWBU6Su -9MVBk8d5R38ruhKSgTtBJdUjRMZ68fDjVGy8mPy8J45QuXVjgfZeDzcpVH+A1K+3 -gJRazCD9r9vxVlc/W335uX1q8uH1u4kXCxkESjWK7/we/fHVcRI/caIdjoluqfP7 -bhDQ+jTJCYhrLR0yWLZocJhe+FgMaOxEBw+ojYKa+Xq6wEMK2YXkhmDZW49O/JQP -ZqROwXD8BHQ2IJyOES25adL3F7yN7sODXuPhDAg8SYV1/kr2nALQTzECAwEAAaNC -MEAwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFJO6 -JJpzdazNjXtum3zX8UYWaQIJMA0GCSqGSIb3DQEBCwUAA4IBAQCoV7sw9CgICo9O -JacaB+P0Uk0dnISjsrKpcAKnuVdh1rN94+beXyttSBgQtDgVBehlESN+/B9fefLb -lhVxgCYq8inx4wZs22h8ZkjpJiOmBDjvHwgkCQOoh/Kog9gkmDr4qbFahU5GpaTp -x1rlNF3qaNRvZSVoxIVwYYiexKS5/KYMedII2EoBMHcFj0qKMhdDIT1Uw2PJZwiA -qjGDsSnLS+VeA8Zluc3m/os0ynjR6BEFQF1sn/OGO0eFaSMxXz0+Z4vT3J+c08Be -z2uZWQBgCiV/bL8F5xgokbHx+Vl0lz+1PEoFre8IJihmcnT8ZPWv/8eWPAr0gavH -+R0lNAyw +MIIDAjCCAeqgAwIBAgIUdsGG4S0KMPKYzS6UNoDuNpvkRFcwDQYJKoZIhvcNAQEL +BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjQwNDIyMTIwNDAwWhcN +MjkwNDIxMTIwNDAwWjAZMRcwFQYDVQQDEw5jYS5leGFtcGxlLmNvbTCCASIwDQYJ +KoZIhvcNAQEBBQADggEPADCCAQoCggEBAJatmwqb8Fabb7JQ916v7QI5ufMEBxhK +VUsnn5frxkAA99LpFRYqs4ycPWQk20tbaNpO2E7pGm0ALuKR5YR5OP69iR6+6JZl +H+c48iryVAXpBZe/PGV1vZRDsOce5YAS0mCNtLEh21FV+6QtnQdgEGbdebBhdQ5l +VN/f8hdkSCPdm56j2K/LUuwOibJYRy5zwJwjmhwuFSurTFN2Y4f6f7AYCgam2q1w +D5dk3JF8RRByvJdJQ8lNmuZbStGLgMTr+Il8Cu+huFUCcGxdDQjM4wKLwS3DgOwV +UXfMsFYxac0I4Z/oMsgE3WVDpTqTFyBGux5nOUzAeCo4iWMKHIypeukCAwEAAaNC +MEAwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFDnH +CL3yIYkqK51ynDHRQcc6Xc/rMA0GCSqGSIb3DQEBCwUAA4IBAQCUzI4edToGsBTp +qnV2MtXwhoBFnmAa4O8RMsbRZqE+DCzBhPSIl9UMaeIEMoIvXL2KOO+rEw2M1uQc +D4r+dAdUhLbIFEyMNIA5EZfJfimEE0qaLGJqI5X1FFVeCvlvI1UDoSj0KQD9GEsg +VidDnhzg712cGdBY2K4U/BmpLMn8+WZ7+TSVIX8fGylzDCRtCQ36vrD5pkQzblqU +sjO8Apwej/t+BI/Y+T1MFvZhstbJ3mSQpHhnmARXLOrwjcOmLzWVlQa1IJxtxaf9 +gRxVchzH7fQxNlR6/zWtd2av07pFR9k2o9WUn/A5lpoUcVrokvCsOooqqG3UwALU +fZm6IO1I -----END CERTIFICATE----- diff --git a/services/nginz/integration-test/conf/nginz/integration-leaf-key.pem b/services/nginz/integration-test/conf/nginz/integration-leaf-key.pem index 8ed90523cd3..1a45ba1ea46 100644 --- a/services/nginz/integration-test/conf/nginz/integration-leaf-key.pem +++ b/services/nginz/integration-test/conf/nginz/integration-leaf-key.pem @@ -1,27 +1,27 @@ -----BEGIN RSA PRIVATE KEY----- -MIIEpAIBAAKCAQEA1ueRV5jCjz+AWOmFzKkkjqPrCj1GGz8VDm5HLm4e7EO/LGXk -+RAYeKupGF9eqGBkiYfw9eZrjbf+uf5mpe7qKGrP67iCEzyjkbMMB8I89dcLwp7Y -uXYWfHw4NdFkSZoE0gmZ6Jh7EK+G2n+PZUaS9T43QoqMv0pFQ1roZpVMKkjnkW5J -4cU3JfXQQzdNCMiXlpGAIL0cKee6cwkPpGC1X3/6XQDyW7Q9nOjSw0mPmiZuK4iR -qwdy4edjKhcvJxuxHw215hVi0QVqbUcNzffS0mO+VIXz2IEbdzUwhSZJISsHQEOa -27UrBdRSg+Wb3FDQ+J8IeS6PR5JwjBcwt+DAjQIDAQABAoIBAHXZSS/TOqZZeWXI -sbH4824xX7weu+pHHqHqQaiphNWllRmgyv72H6VU5YbTDdKiAaAV50LB2CtAQjT2 -2I2YRdpiMKEgblxkPYKxwCAlGU7rXayddVXG9y/O4vhIWomuJ4SS9U7DB4Gv7/C0 -UQuFtyM7ugwIdISWEwOLv7Q5nSn2DYYXapNSmCUYv2FJEd57MJFtZ+CTHPu+ALxY -/qCGga8WBQ9Io/4A6UWN76m5IREeGh/pBwwhestpvUB9hXXe037Z11G3j/mNjqmz -SoUdEXnXpqJMA4c73hrryZR7TRPjRQx2P7YTyMwwOaJenhCS2F7ohJrwXNEtfbXt -Tb4mAQECgYEA8Qc4YqbF+xDmav1Mw7tpQ34EW7U1BF6RW+zpaRVVYXc+hZq8Rscl -yhzvYI2F4b9qOXw73Vdj3Hbd3f3BRC2ayMUk82pmbFEhZjQR9cGaLH1JfNXBdgz+ -wenmdczUAhmDiIseXTYdXL0FFgc9F/UFzmAYmD/kkMHTO2wnfeAci00CgYEA5EDv -UJzW/hWUtawWfg0Bw+H5RR2W/28dGG+680zazZwVHtDF7sEiThmR8AlLu74tWUMg -PBREdxOui5qRhmZO3y3JLJ8mjmEUQqC4x1NWReZCAcWGTNXn/PHsWPlK82qp/Q98 -lYJLShtbOOgo1hUPYeQ3hFnDi8HM3QssEeYB6kECgYA0kdSUf7dyuQ7oivKxRjEB -TXz5254Co/WkTRnjl4mVxoJWdZdXAJyXZpQ3RObMhAlRHG2aKzNWpH5jqrL6gc/e -tlEG3lAUk+Vq+zRnm6Baz8C1f5HAg7kU5kUjsFcVVidAIseuoNzqmzd+xHlovkJT -7tWub1EU2ZGOxloetEDFiQKBgQCfPrp4OGQ6cp4EvaIXoUV4/0Aku0cswL3A3brF -ofoJdvq5PBjLwQ0JBgfuOt4OhtkmrJFhuRYnKaEeHuGmrdwbEtuG+SYyMYKsFWu1 -DOxk6gdlKwTOuHIY5EPrs0laWDFur45Q1M1oT3uuUTKkYZ8QweMFwIaQC8687N17 -Q0hUwQKBgQDu55deAXAAS9FCqT4qidyxmvjdpkn8BKZhetss+t0m7Rum9OJCiMI5 -90exbnlRtUP4soNOccS3w3ie2HPspdlIsllYnd4/KaHQbdEoGtvrF5rM77X+81N1 -xPgNsMJM167VEWWJJCE+rkeWiF+irrjiHj7QlLmKkK4bmEzp5XuLyg== +MIIEowIBAAKCAQEAukRPdjUjKs7P2TgP4VDpb77Rb7KjMMBtcRP525qEnUQzFHPk +Va4cqh6xacgh2NJCyFyDEWDI9pQ03i0HISIldoBngDVvM6kwvbs+kjZ+/t/Jx3aH +zC9dmsLqmCqU+OmofpD1pt8hZWwOtYj58pfqdhrP+M6qQ92/tgmkk9njLFwsAjxY +gMXZCo0IiSIE9BE9NGvR9bp6hvEekCqREPdHi44iFca/5V4A8fSZwBlTHod5Z83r +MpHLnR1ReVVOQgzbIBGcLdmtH8IA9ZgUHy1/HOmf9e0MYOYOKbKvH3cry7WSscPL +47x+JQyFLimidfsJQCY+022rdPg9CdrCWFGxgQIDAQABAoIBAGjeBqK1fewe7XQN +FRu0cwh/tOge+bN70uHj7jrN/rWP7PYp3TbDxM2eZCH7E9s/XWvycbQ5+kqg3Dbt +wOLNl6vk1OCgtM+wBIn9PlgRKGSUV8Tdncy+KgP0kyFCcAbHfh5rvHHLk8DHGmzo +BlinYNBHfilFKST2VnXFbgvzkuuorS1BRAzlVpyJnaen04emBJ+KPIwNyguPQrlv +5duBIO1bzlEjFVufrLkI0IumWqBAPOvHcRy1geSz/MG7LssB9r25k5LA5OEDxqwx +ykSzuniaLL6BGMSCAMpTM3/hF1ijrkTd74cI4cp7k2ufcYT74ZU2lyDKEjBukG/p +H0/1Q8ECgYEAwL7VWIpySGtrJEPZH1FxtpJYg8SE0F4lUxIbIQcc6rzLJfLOLQO5 +ruTVONPTlue6PHrRO8pQTbW9AnjZvHMIiwxidY/RwUVKFuxzfrYZ9ZbKXyVOh48a +WXe5OnpuVodPEHQrKzkl93YWMgMCXNPri1h0jr0fMGXy9jZzoKK5f1kCgYEA92Uw +P4WyBL2hm/5BNUoxCiLyd1dDdQt1h6VByxYM7OXDhXq1iHnhX+NbjMT0QfOFyXBP +uQQCB9IQElmMmWsoEv6uEQCeuCvOxq+Evoz+3fP2te89HjZ1C5SXUMfG7qKfFzbt +WP6e/CqAeQPnnqI89ghw/IerQkeVMoVvHbSXZmkCgYBZPgJ6JGAVt+a7u85j+cm0 +xr3FBNCZyX1uoQt+l1SEOzW0NF/R58+pcrpmvW1SiahpKFSIYnwb/vGsm1f1MS3b +c7iCxjxQSEytoH05Rgdu9ops01Ew4slIc26H7Pf5iFzLOX5jXOp/UWWlck89u8Fr +m2EcVeSC/DEqXrvavH02wQKBgBzVKDhfBo5S44DgswzY5ro9tHCANRZxDXOPqQlY +Oo1pgc4OrRWIzuF0B/lyAt2k2hTOCBySAQKUUtcwpJhEytjb4cGNhvID+Qdi8V+b +4yBPDJPLnB3nTuDYooIBpoetYEk+V48lrbXJ5ks0T0xHsD8kYLatwSHqYdMPhhG6 +OGLxAoGBALZQSuO4fHew4ksMcBy891ZSOFUV9xAtR490EdEQdOiPrQj5vmnSpxEx +QsSVbn+49OYwzjBP+sHtpiTMF4ZlafHvjcNZ5dFIImqyuEugEdnD5UnFd92AQ9Gv +ufa7BMs99BRdkkolCXBZC+Dq4t4Z/+MDSMtjO5mh9V0boDakdJPb -----END RSA PRIVATE KEY----- diff --git a/services/nginz/integration-test/conf/nginz/integration-leaf.pem b/services/nginz/integration-test/conf/nginz/integration-leaf.pem index d8e7ee0955c..2247758aafd 100644 --- a/services/nginz/integration-test/conf/nginz/integration-leaf.pem +++ b/services/nginz/integration-test/conf/nginz/integration-leaf.pem @@ -1,21 +1,21 @@ -----BEGIN CERTIFICATE----- -MIIDcjCCAlqgAwIBAgIUXlJ06fjgHbzEvIRscFvEwxpsioMwDQYJKoZIhvcNAQEL -BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjMxMTIxMTM1ODAwWhcN -MjQxMTIwMTM1ODAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA -1ueRV5jCjz+AWOmFzKkkjqPrCj1GGz8VDm5HLm4e7EO/LGXk+RAYeKupGF9eqGBk -iYfw9eZrjbf+uf5mpe7qKGrP67iCEzyjkbMMB8I89dcLwp7YuXYWfHw4NdFkSZoE -0gmZ6Jh7EK+G2n+PZUaS9T43QoqMv0pFQ1roZpVMKkjnkW5J4cU3JfXQQzdNCMiX -lpGAIL0cKee6cwkPpGC1X3/6XQDyW7Q9nOjSw0mPmiZuK4iRqwdy4edjKhcvJxux -Hw215hVi0QVqbUcNzffS0mO+VIXz2IEbdzUwhSZJISsHQEOa27UrBdRSg+Wb3FDQ -+J8IeS6PR5JwjBcwt+DAjQIDAQABo4HKMIHHMA4GA1UdDwEB/wQEAwIFoDAdBgNV +MIIDcjCCAlqgAwIBAgIUK9Dix5VZpBYOby63cdmjtfg6RpwwDQYJKoZIhvcNAQEL +BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjQwNDIyMTIwNDAwWhcN +MjUwNDIyMTIwNDAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA +ukRPdjUjKs7P2TgP4VDpb77Rb7KjMMBtcRP525qEnUQzFHPkVa4cqh6xacgh2NJC +yFyDEWDI9pQ03i0HISIldoBngDVvM6kwvbs+kjZ+/t/Jx3aHzC9dmsLqmCqU+Omo +fpD1pt8hZWwOtYj58pfqdhrP+M6qQ92/tgmkk9njLFwsAjxYgMXZCo0IiSIE9BE9 +NGvR9bp6hvEekCqREPdHi44iFca/5V4A8fSZwBlTHod5Z83rMpHLnR1ReVVOQgzb +IBGcLdmtH8IA9ZgUHy1/HOmf9e0MYOYOKbKvH3cry7WSscPL47x+JQyFLimidfsJ +QCY+022rdPg9CdrCWFGxgQIDAQABo4HKMIHHMA4GA1UdDwEB/wQEAwIFoDAdBgNV HSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAdBgNVHQ4E -FgQUWm43ORCCQGlDu3JaPIm15lsr5swwHwYDVR0jBBgwFoAUk7okmnN1rM2Ne26b -fNfxRhZpAgkwSAYDVR0RAQH/BD4wPIIZKi5pbnRlZ3JhdGlvbi5leGFtcGxlLmNv +FgQUaJdzHC5JsdIEKTYxqAWoSHvFCNgwHwYDVR0jBBgwFoAUOccIvfIhiSornXKc +MdFBxzpdz+swSAYDVR0RAQH/BD4wPIIZKi5pbnRlZ3JhdGlvbi5leGFtcGxlLmNv bYIUaG9zdC5kb2NrZXIuaW50ZXJuYWyCCWxvY2FsaG9zdDANBgkqhkiG9w0BAQsF -AAOCAQEAfrlC1maUJMg5n61YEpBwIS9O0LLhNidZ6dBEPwDiBwskzkTKoWksSR+n -7OytNFQvrdclejxIyvoOvBhLqNY4pFYdNRUu42GESUpCA6cQlW3a9QchTEuNASWR -AdrmGmjXYwPFGjnVUVPR+Abs9lG7/8eDYoq1B1AdBkW1EJ7+0/DrLOLDtloxYmBF -bydmLcesdPvgBLkHfBlOG54jH/ILXHAHxskWmGqixY6L1svhrcnwsindxRcfT4QB -fAtNDfAfiftUdb96QJfpwN1/N1oEHFl2D0ynE8sFOuVFm0gQ6mblH+Vahune6cSK -7SDUwM9Ia1OAO/r2cdEAvCrQqaeDZQ== +AAOCAQEAcoUcdwgoAiFJcoS/t1IU2axEJeWncctYyVHt/ZfoZ8y/23XDA+kIfgSt +DZEqteGyVDSBbI/B45IzrKQuJzdT8B+9iDcOzLrA2R1432ASlMhHC5l3STBru0jl +oL9M8fJU6BwciCqY0Y2wFcCfVthN1rC8vNNSpwSwF74q87MMLZ/65Mi3hAB4177s +uNL6MXGta9fBK9MQxM3S/Kr7fmxOTQBlQtcA2Ha3Yog2+dkMXosoapjoMwWj36DS +j9v25/dFmS3dnCfhRHBSh9iUSnbOVZ/M+5Bv5hBPYbeSw24DXD1w9soEYL941D+c +enXV719UPw5bpBxhXjl9Hu0TQ2uoIw== -----END CERTIFICATE----- diff --git a/services/proxy/default.nix b/services/proxy/default.nix index 8c5360ccdca..b6205a6acee 100644 --- a/services/proxy/default.nix +++ b/services/proxy/default.nix @@ -27,6 +27,7 @@ , unliftio-core , uuid , wai +, wai-middleware-gunzip , wai-predicates , wai-routing , wai-utilities @@ -61,6 +62,7 @@ mkDerivation { unliftio-core uuid wai + wai-middleware-gunzip wai-predicates wai-routing wai-utilities diff --git a/services/proxy/proxy.cabal b/services/proxy/proxy.cabal index 79da68ca4e9..e92831949f6 100644 --- a/services/proxy/proxy.cabal +++ b/services/proxy/proxy.cabal @@ -74,31 +74,32 @@ library -funbox-strict-fields -Wredundant-constraints -Wunused-packages build-depends: - aeson >=2.0.1.0 - , base >=4.6 && <5 - , bilge >=0.21 - , bytestring >=0.10 - , case-insensitive >=1.2 - , configurator >=0.3 - , exceptions >=0.8 + aeson >=2.0.1.0 + , base >=4.6 && <5 + , bilge >=0.21 + , bytestring >=0.10 + , case-insensitive >=1.2 + , configurator >=0.3 + , exceptions >=0.8 , extended - , http-client >=0.7 - , http-client-tls >=0.3 - , http-reverse-proxy >=0.4 - , http-types >=0.9 + , http-client >=0.7 + , http-client-tls >=0.3 + , http-reverse-proxy >=0.4 + , http-types >=0.9 , imports - , lens >=4.11 - , metrics-wai >=0.5 - , retry >=0.7 - , text >=1.2 - , tinylog >=0.12 - , types-common >=0.8 + , lens >=4.11 + , metrics-wai >=0.5 + , retry >=0.7 + , text >=1.2 + , tinylog >=0.12 + , types-common >=0.8 , unliftio-core , uuid - , wai >=3.2 - , wai-predicates >=0.8 - , wai-routing >=0.12 - , wai-utilities >=0.14.3 + , wai >=3.2 + , wai-middleware-gunzip + , wai-predicates >=0.8 + , wai-routing >=0.12 + , wai-utilities >=0.14.3 , wire-api default-language: GHC2021 diff --git a/services/proxy/src/Proxy/Proxy.hs b/services/proxy/src/Proxy/Proxy.hs index 9cbb5d20899..cc7f6c5f8fc 100644 --- a/services/proxy/src/Proxy/Proxy.hs +++ b/services/proxy/src/Proxy/Proxy.hs @@ -17,11 +17,7 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Proxy.Proxy - ( Proxy, - runProxy, - ) -where +module Proxy.Proxy (Proxy, runProxy) where import Bilge.Request (requestIdName) import Control.Lens hiding ((.=)) @@ -40,7 +36,7 @@ import System.Logger.Class hiding (Error, info) newtype Proxy a = Proxy { unProxy :: ReaderT Env IO a } - deriving + deriving newtype ( Functor, Applicative, Monad, @@ -68,7 +64,7 @@ lookupReqId :: Logger -> Request -> IO RequestId lookupReqId l r = case lookup requestIdName (requestHeaders r) of Just rid -> pure $ RequestId rid Nothing -> do - localRid <- RequestId . cs . UUID.toText <$> UUID.nextRandom + localRid <- RequestId . UUID.toASCIIBytes <$> UUID.nextRandom Log.info l $ "request-id" .= localRid ~~ "method" .= requestMethod r diff --git a/services/proxy/src/Proxy/Run.hs b/services/proxy/src/Proxy/Run.hs index b0d37b5e454..7a32829f5d5 100644 --- a/services/proxy/src/Proxy/Run.hs +++ b/services/proxy/src/Proxy/Run.hs @@ -25,6 +25,7 @@ import Control.Monad.Catch import Data.Metrics.Middleware hiding (path) import Data.Metrics.Middleware.Prometheus (waiPrometheusMiddleware) import Imports hiding (head) +import Network.Wai.Middleware.Gunzip qualified as GZip import Network.Wai.Utilities.Server hiding (serverPort) import Proxy.API (sitemap) import Proxy.Env @@ -43,5 +44,6 @@ run o = do let middleware = versionMiddleware (foldMap expandVersionExp (o ^. disabledAPIVersions)) . waiPrometheusMiddleware (sitemap e) + . GZip.gunzip . catchErrors (e ^. applog) [Right m] runSettingsWithShutdown s (middleware app) Nothing `finally` destroyEnv e diff --git a/services/spar/default.nix b/services/spar/default.nix index daebe1a84f6..afbe67eb872 100644 --- a/services/spar/default.nix +++ b/services/spar/default.nix @@ -23,7 +23,6 @@ , email-validate , exceptions , extended -, galley-types , gitignoreSource , hscim , HsOpenSSL @@ -60,6 +59,7 @@ , servant-openapi3 , servant-server , silently +, string-conversions , tasty-hunit , text , text-latin1 @@ -68,10 +68,12 @@ , transformers , types-common , uri-bytestring +, utf8-string , uuid , vector , wai , wai-extra +, wai-middleware-gunzip , wai-utilities , warp , wire-api @@ -101,7 +103,6 @@ mkDerivation { crypton-x509 exceptions extended - galley-types hscim hspec http-types @@ -127,8 +128,10 @@ mkDerivation { transformers types-common uri-bytestring + utf8-string uuid wai + wai-middleware-gunzip wai-utilities warp wire-api @@ -154,7 +157,6 @@ mkDerivation { email-validate exceptions extended - galley-types hscim HsOpenSSL hspec @@ -182,6 +184,7 @@ mkDerivation { servant servant-server silently + string-conversions tasty-hunit text time @@ -189,6 +192,7 @@ mkDerivation { transformers types-common uri-bytestring + utf8-string uuid vector wai-extra @@ -223,6 +227,7 @@ mkDerivation { saml2-web-sso servant servant-openapi3 + string-conversions time tinylog types-common diff --git a/services/spar/migrate-data/src/Spar/DataMigration/V2_UserV2.hs b/services/spar/migrate-data/src/Spar/DataMigration/V2_UserV2.hs index ae532696d8d..ac7d49efca6 100644 --- a/services/spar/migrate-data/src/Spar/DataMigration/V2_UserV2.hs +++ b/services/spar/migrate-data/src/Spar/DataMigration/V2_UserV2.hs @@ -21,12 +21,14 @@ module Spar.DataMigration.V2_UserV2 (migration) where import Cassandra import qualified Conduit as C +import qualified Data.ByteString.UTF8 as UTF8 import Data.Conduit import qualified Data.Conduit.Combinators as CC import Data.Conduit.Internal (zipSources) import qualified Data.Conduit.List as CL import Data.Id import qualified Data.Map.Strict as Map +import qualified Data.Text as T import Data.Time (UTCTime) import Imports import qualified SAML2.WebSSO as SAML @@ -173,16 +175,16 @@ filterResolved resolver migMapInv = mbAssoc <- await for_ mbAssoc $ \(new@(issuer, nid), olds) -> do let yieldOld (nameId, uid) = yield (issuer, nid, nameId, uid) - let issuerURI = cs . serializeURIRef' . _fromIssuer $ issuer + let issuerURI = UTF8.toString . serializeURIRef' . _fromIssuer $ issuer case olds of [] -> pure () [old] -> yieldOld old (old1 : old2 : rest) -> lift (resolver new (List2 old1 old2 rest)) >>= \case Left _ -> - lift $ logError $ unwords ["Couldnt resolve collisision of", issuerURI, cs (unNormalizedUNameID nid), show olds] + lift $ logError $ unwords ["Couldnt resolve collisision of", issuerURI, T.unpack (unNormalizedUNameID nid), show olds] Right old -> do - lift $ logInfo $ unwords ["Resolved collision", issuerURI, cs (unNormalizedUNameID nid), show (fmap snd olds), "to", show (snd old)] + lift $ logInfo $ unwords ["Resolved collision", issuerURI, T.unpack (unNormalizedUNameID nid), show (fmap snd olds), "to", show (snd old)] yieldOld old go diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index 548c1f2ceff..87b8fe0c455 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -39,6 +39,7 @@ library Spar.Schema.V15 Spar.Schema.V16 Spar.Schema.V17 + Spar.Schema.V18 Spar.Schema.V2 Spar.Schema.V3 Spar.Schema.V4 @@ -101,6 +102,7 @@ library default-extensions: AllowAmbiguousTypes BangPatterns + BlockArguments ConstraintKinds DataKinds DefaultSignatures @@ -162,7 +164,6 @@ library , crypton-x509 , exceptions , extended - , galley-types , hscim , hspec , http-types @@ -178,7 +179,7 @@ library , polysemy-wire-zoo , QuickCheck , raw-strings-qq - , saml2-web-sso >=0.19 + , saml2-web-sso >=0.20 , servant-multipart , servant-server , text @@ -188,8 +189,10 @@ library , transformers , types-common , uri-bytestring + , utf8-string , uuid , wai + , wai-middleware-gunzip , wai-utilities , warp , wire-api @@ -204,6 +207,7 @@ executable spar default-extensions: AllowAmbiguousTypes BangPatterns + BlockArguments ConstraintKinds DataKinds DefaultSignatures @@ -282,6 +286,7 @@ executable spar-integration default-extensions: AllowAmbiguousTypes BangPatterns + BlockArguments ConstraintKinds DataKinds DefaultSignatures @@ -346,7 +351,6 @@ executable spar-integration , email-validate , exceptions , extended - , galley-types , hscim , HsOpenSSL , hspec @@ -370,11 +374,12 @@ executable spar-integration , random , raw-strings-qq , retry - , saml2-web-sso >=0.19 + , saml2-web-sso >=0.20 , servant , servant-server , silently , spar + , string-conversions , tasty-hunit , text , time @@ -408,6 +413,7 @@ executable spar-migrate-data default-extensions: AllowAmbiguousTypes BangPatterns + BlockArguments ConstraintKinds DataKinds DefaultSignatures @@ -462,13 +468,14 @@ executable spar-migrate-data , imports , lens , optparse-applicative - , saml2-web-sso >=0.19 + , saml2-web-sso >=0.20 , spar , text , time , tinylog , types-common , uri-bytestring + , utf8-string default-language: Haskell2010 @@ -478,6 +485,7 @@ executable spar-schema default-extensions: AllowAmbiguousTypes BangPatterns + BlockArguments ConstraintKinds DataKinds DefaultSignatures @@ -551,6 +559,7 @@ test-suite spec default-extensions: AllowAmbiguousTypes BangPatterns + BlockArguments ConstraintKinds DataKinds DefaultSignatures @@ -617,10 +626,11 @@ test-suite spec , polysemy-plugin , polysemy-wire-zoo , QuickCheck - , saml2-web-sso >=0.19 + , saml2-web-sso >=0.20 , servant , servant-openapi3 , spar + , string-conversions , time , tinylog , types-common diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 2060030f9e3..ae3a3d94d90 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -55,8 +55,10 @@ import Data.Id import Data.Proxy import Data.Range import qualified Data.Set as Set +import Data.Text.Encoding.Error +import qualified Data.Text.Lazy as T +import Data.Text.Lazy.Encoding import Data.Time -import Galley.Types.Teams (HiddenPerm (CreateUpdateDeleteIdp, ReadIdp)) import Imports import Polysemy import Polysemy.Error @@ -101,6 +103,7 @@ import System.Logger (Msg) import qualified URI.ByteString as URI import Wire.API.Routes.Internal.Spar import Wire.API.Routes.Public.Spar +import Wire.API.Team.Member (HiddenPerm (CreateUpdateDeleteIdp, ReadIdp)) import Wire.API.User import Wire.API.User.IdentityProvider import Wire.API.User.Saml @@ -193,12 +196,12 @@ apiIDP :: ) => ServerT APIIDP (Sem r) apiIDP = - idpGet - :<|> idpGetRaw - :<|> idpGetAll - :<|> idpCreate - :<|> idpUpdate - :<|> idpDelete + idpGet -- get, json, captures idp id + :<|> idpGetRaw -- get, raw xml, capture idp id + :<|> idpGetAll -- get, json + :<|> idpCreate -- post, created + :<|> idpUpdate -- put, okay + :<|> idpDelete -- delete, no content apiINTERNAL :: ( Member ScimTokenStore r, @@ -356,7 +359,7 @@ idpGetRaw zusr idpid = do _ <- authorizeIdP zusr idp IdPRawMetadataStore.get idpid >>= \case Just txt -> pure $ RawIdPMetadata txt - Nothing -> throwSparSem $ SparIdPNotFound (cs $ show idpid) + Nothing -> throwSparSem $ SparIdPNotFound (T.pack $ show idpid) idpGetAll :: ( Member Random r, @@ -476,6 +479,18 @@ idpCreate :: idpCreate zusr (IdPMetadataValue raw xml) = idpCreateXML zusr raw xml -- | We generate a new UUID for each IdP used as IdPConfig's path, thereby ensuring uniqueness. +-- +-- NOTE(mangoiv): currently registering an IdP and scim token works as follows: +-- - an owner creates a team with some teamId +-- - the owner registers and IdP +-- - the owner registers a scim token and passes the idp id along to associate +-- the scim token with the IdP +-- +-- This doesn't support some flows we may want to support, like: (1) register +-- a scim token and then associate an IdP with it; (2) have scim token and +-- create an idp that is *not* associated with it; ... +-- +-- Related internal docs: https://wearezeta.atlassian.net/wiki/spaces/PAD/pages/1107001440/2024-03-27+scim+user+provisioning+and+saml2+sso+associating+scim+peers+and+saml2+idps idpCreateXML :: ( Member Random r, Member (Logger String) r, @@ -493,14 +508,14 @@ idpCreateXML :: Maybe WireIdPAPIVersion -> Maybe (Range 1 32 Text) -> Sem r IdP -idpCreateXML zusr raw idpmeta mReplaces (fromMaybe defWireIdPAPIVersion -> apiversion) mHandle = withDebugLog "idpCreateXML" (Just . show . (^. SAML.idpId)) $ do +idpCreateXML zusr rawIdpMetadata idpmeta mReplaces (fromMaybe defWireIdPAPIVersion -> apiversion) mHandle = withDebugLog "idpCreateXML" (Just . show . (^. SAML.idpId)) $ do teamid <- Brig.getZUsrCheckPerm zusr CreateUpdateDeleteIdp GalleyAccess.assertSSOEnabled teamid assertNoScimOrNoIdP teamid idp <- maybe (IdPConfigStore.newHandle teamid) (pure . IdPHandle . fromRange) mHandle >>= validateNewIdP apiversion idpmeta teamid mReplaces - IdPRawMetadataStore.store (idp ^. SAML.idpId) raw + IdPRawMetadataStore.store (idp ^. SAML.idpId) rawIdpMetadata IdPConfigStore.insertConfig idp forM_ mReplaces $ \replaces -> IdPConfigStore.setReplacedBy (Replaced replaces) (Replacing (idp ^. SAML.idpId)) @@ -522,8 +537,7 @@ assertNoScimOrNoIdP teamid = do numIdps <- length <$> IdPConfigStore.getConfigsByTeam teamid when (numTokens > 0 && numIdps > 0) $ throwSparSem $ - SparProvisioningMoreThanOneIdP - "Teams with SCIM tokens can only have at most one IdP" + SparProvisioningMoreThanOneIdP ScimTokenAndSecondIdpForbidden -- | Check that issuer is not used anywhere in the system ('WireIdPAPIV1', here it is a -- database key for finding IdPs), or anywhere in this team ('WireIdPAPIV2'), that request @@ -690,7 +704,10 @@ validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateIdPUpdate" (J where errUnknownIdP = SAML.UnknownIdP $ enc uri where - enc = cs . toLazyByteString . URI.serializeURIRef + enc = + decodeUtf8With lenientDecode + . toLazyByteString + . URI.serializeURIRef uri = _idpMetadata ^. SAML.edIssuer . SAML.fromIssuer withDebugLog :: Member (Logger String) r => String -> (a -> Maybe String) -> Sem r a -> Sem r a @@ -711,7 +728,11 @@ authorizeIdP :: Maybe UserId -> IdP -> Sem r (UserId, TeamId) -authorizeIdP Nothing _ = throw (SAML.CustomError $ SparNoPermission (cs $ show CreateUpdateDeleteIdp)) +authorizeIdP Nothing _ = + throw + ( SAML.CustomError $ + SparNoPermission (T.pack $ show CreateUpdateDeleteIdp) + ) authorizeIdP (Just zusr) idp = do let teamid = idp ^. SAML.idpExtraInfo . team GalleyAccess.assertHasPermission teamid CreateUpdateDeleteIdp zusr @@ -720,7 +741,7 @@ authorizeIdP (Just zusr) idp = do enforceHttps :: Member (Error SparError) r => URI.URI -> Sem r () enforceHttps uri = unless ((uri ^. URI.uriSchemeL . URI.schemeBSL) == "https") $ do - throwSparSem . SparNewIdPWantHttps . cs . SAML.renderURI $ uri + throwSparSem . SparNewIdPWantHttps . T.fromStrict . SAML.renderURI $ uri ---------------------------------------------------------------------------- -- Internal API diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index eb51bd4232c..722b65ab91c 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -43,11 +43,17 @@ import Control.Lens hiding ((.=)) import Control.Monad.Except import Data.Aeson as Aeson (encode, object, (.=)) import Data.Aeson.Text as Aeson (encodeToLazyText) +import Data.ByteString (toStrict) import qualified Data.ByteString.Builder as Builder +import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.CaseInsensitive as CI import Data.Id +import qualified Data.Text as Text import Data.Text.Ascii (encodeBase64, toText) +import qualified Data.Text.Encoding as Text +import Data.Text.Encoding.Error import qualified Data.Text.Lazy as LText +import qualified Data.Text.Lazy.Encoding as LText import Imports hiding (MonadReader, asks, log) import qualified Network.HTTP.Types.Status as Http import qualified Network.Wai.Utilities.Error as Wai @@ -182,7 +188,9 @@ createSamlUserWithId :: Role -> Sem r () createSamlUserWithId teamid buid suid role = do - uname <- either (throwSparSem . SparBadUserName . cs) pure $ Intra.mkUserName Nothing (UrefOnly suid) + uname <- + either (throwSparSem . SparBadUserName . LText.pack) pure $ + Intra.mkUserName Nothing (UrefOnly suid) buid' <- BrigAccess.createSAML suid buid teamid uname ManagedByWire Nothing Nothing Nothing role assert (buid == buid') $ pure () SAMLUserStore.insert suid buid @@ -212,7 +220,7 @@ autoprovisionSamlUser idp buid suid = do guardReplacedIdP :: Sem r () guardReplacedIdP = do unless (isNothing $ idp ^. idpExtraInfo . replacedBy) $ do - throwSparSem $ SparCannotCreateUsersOnReplacedIdP (cs . SAML.idPIdToST $ idp ^. idpId) + throwSparSem $ SparCannotCreateUsersOnReplacedIdP (LText.fromStrict . SAML.idPIdToST $ idp ^. idpId) -- IdPs in teams with scim tokens are not allowed to auto-provision. guardScimTokens :: Sem r () @@ -284,7 +292,7 @@ verdictHandler aresp verdict idp = do -- [...] If the containing message is in response to an , then -- the InResponseTo attribute MUST match the request's ID. Logger.log Logger.Debug $ "entering verdictHandler: " <> show (aresp, verdict) - reqid <- either (throwSparSem . SparNoRequestRefInResponse . cs) pure $ SAML.rspInResponseTo aresp + reqid <- either (throwSparSem . SparNoRequestRefInResponse . LText.pack) pure $ SAML.rspInResponseTo aresp format :: Maybe VerdictFormat <- VerdictFormatStore.get reqid resp <- case format of Just VerdictFormatWeb -> @@ -337,8 +345,17 @@ catchVerdictErrors = (`catch` hndlr) hndlr err = do waiErr <- renderSparErrorWithLogging err pure $ case waiErr of - Right (werr :: Wai.Error) -> VerifyHandlerError (cs $ Wai.label werr) (cs $ Wai.message werr) - Left (serr :: ServerError) -> VerifyHandlerError "unknown-error" (cs (errReasonPhrase serr) <> " " <> cs (errBody serr)) + Right (werr :: Wai.Error) -> + VerifyHandlerError + (LText.toStrict $ Wai.label werr) + (LText.toStrict $ Wai.message werr) + Left (serr :: ServerError) -> + VerifyHandlerError + "unknown-error" + ( Text.pack (errReasonPhrase serr) + <> " " + <> (Text.decodeUtf8With lenientDecode . toStrict . errBody $ serr) + ) -- | If a user attempts to login presenting a new IdP issuer, but there is no entry in -- @"spar.user"@ for her: lookup @"old_issuers"@ from @"spar.idp"@ for the new IdP, and @@ -397,7 +414,7 @@ verdictHandlerResultCore idp = \case SAML.AccessGranted uref -> do uid :: UserId <- do let team' = idp ^. idpExtraInfo . team - err = SparUserRefInNoOrMultipleTeams . cs . show $ uref + err = SparUserRefInNoOrMultipleTeams . LText.pack . show $ uref getUserByUrefUnsafe uref >>= \case Just usr -> do if userTeam usr == Just team' @@ -438,12 +455,12 @@ verdictHandlerWeb = forbiddenPage errlbl reasons = ServerError { errHTTPCode = 200, - errReasonPhrase = cs errlbl, -- (not sure what this is used for) + errReasonPhrase = Text.unpack errlbl, -- (not sure what this is used for) errBody = easyHtml $ "" <> " wire:sso:error:" - <> cs errlbl + <> LText.fromStrict errlbl <> "" <> "