diff --git a/CHANGELOG.md b/CHANGELOG.md index dbfc9d778c3..d4d097147f1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,68 @@ +# [2026-01-26] (Chart Release 5.26.0) + +## Release notes + + +* User search provides information about user type (regular, app, legacy bot) now. Also, Elasticsearch re-indexing requires postgres access now. If you run `brig-index` directly anywhere, make sure to add the relevant settings. The Elasticsearch index must be refilled from Cassandra in order for the changes to the search results to take effect. See https://docs.wire.com/latest/developer/reference/elastic-search.html?h=index#refill-es-documents-from-cassandra (#4913, #4957) + +* Conversation codes can now be migrated to PostgreSQL. For existing installations: + - Set `postgresMigration.conversationCodes: migration-to-postgresql` in both `galley` and `background-worker`. + - Run the backfill with `migrateConversationCodes: true`. + - Wait for `wire_conv_codes_migration_finished` to reach `1.0`. + - Switch to `postgresMigration.conversationCodes: postgresql` and disable `migrateConversationCodes`. (#4961) + +* The background-worker defaults for the postgres migration now match galley and point to cassandra (previously postgres). This currenlty only affects the background job, which is not expected to run before postgres is in use. However, if you relied on the defaults after migrating to postgres, please update your config to keep using postgres. (#4965) + +* Drop support for kubernetes versions below 1.27 (#4969) + + +## API changes + + +* New end-point `GET /teams/:tid/apps` listing all team apps. (#4960) + +* Add `type` field to search results received from `GET /search/contacts` (#4913) + + +## Features + + +* nginx-ingress-services: Add `federator.tls.issuer` option to use a separate ClusterIssuer for federation mTLS certificates. (#4964) + +* Log changes to IdP configurations made via the IdP REST API to syslog. (#4935) + +* Allow commit bundles to contain one application message. The message must be for the epoch *after* the commit, and it gets sent after the commit has been accepted. (#4929) + + +## Bug fixes and other updates + + +* `background-worker`'s default settings for `postgresMigration` have been correctly set to `cassandra`. (#4965) + + +## Internal changes + + +* Circumvent potential performance issue with `TVar (Map ...)` (#4948) + +* Migration of conversation codes from cassandra to postgres (#4959, #4961) + +* - Test for team and user email templates added + - Refactoring to make email rendering testable + - Removed SMS and call templates (#4699) + +* Drop `cryptobox`, handle prekey in pure Haskell. (#4719) + +* Move Feature Flags read to `wire-subsystems`. (#4918, #4974) + +* Federator: Replace Linux-only hinotify with cross-platform fsnotify library + for certificate file monitoring. This enables native file system watching + on both Linux and macOS, removing the need for platform-specific stubs. (#4955) + +* Simplify and modernize the Nix setup of `rusty-jwt-tools`. This includes + updating to version `0.14.0`. (#4952) + + # [2026-01-13] (Chart Release 5.25.0) ## Release notes diff --git a/Makefile b/Makefile index af09b6ce006..556e1056df4 100644 --- a/Makefile +++ b/Makefile @@ -21,7 +21,6 @@ ingress-nginx-controller nginx-ingress-services reaper restund \ k8ssandra-test-cluster ldap-scim-bridge wire-server-enterprise KIND_CLUSTER_NAME := wire-server HELM_PARALLELISM ?= 1 # 1 for sequential tests; 6 for all-parallel tests -# (run `psql -h localhost -p 5432 -d backendA -U wire-server -w` for the list of options for PSQL_DB) PSQL_DB ?= backendA export PSQL_DB @@ -339,7 +338,7 @@ cassandra-schema: db-migrate cassandra-schema-impl cassandra-schema-impl: ./hack/bin/cassandra_dump_schema > ./cassandra-schema.cql -.PHONY: postgres-reset postgres-schema-impl +.PHONY: postgres-schema postgres-schema: postgres-reset postgres-schema-impl .PHONY: postgres-schema-impl @@ -355,8 +354,8 @@ cqlsh: .PHONY: psql psql: @grep -q wire-server:wire-server ~/.pgpass || \ - echo "consider running 'echo localhost:5432:wire-server:wire-server:posty-the-gres > ~/.pgpass ; chmod 600 ~/.pgpass '" - pg_dump -h localhost -p 5432 $(PSQL_DB) -U wire-server -w --schema-only || \ + echo "consider running 'echo localhost:5432:$(PSQL_DB):wire-server:posty-the-gres > ~/.pgpass ; chmod 600 ~/.pgpass '" + psql -h localhost -p 5432 $(PSQL_DB) -U wire-server -w || \ echo 'if the database is missing, consider running "make postgres-reset", or setting $$PSQL_DB to the correct table space.' .PHONY: db-reset-package @@ -394,21 +393,43 @@ postgres-reset: c ./dist/brig -c ./services/brig/brig.integration.yaml migrate-postgres --reset --dbname dyn-2 ./dist/brig -c ./services/brig/brig.integration.yaml migrate-postgres --reset --dbname dyn-3 +.PHONY: postgres-migrate +postgres-migrate: c + ./dist/brig -c ./services/brig/brig.integration.yaml migrate-postgres --dbname backendA + ./dist/brig -c ./services/brig/brig.integration.yaml migrate-postgres --dbname backendB + ./dist/brig -c ./services/brig/brig.integration.yaml migrate-postgres --dbname dyn-1 + ./dist/brig -c ./services/brig/brig.integration.yaml migrate-postgres --dbname dyn-2 + ./dist/brig -c ./services/brig/brig.integration.yaml migrate-postgres --dbname dyn-3 + .PHONY: es-reset es-reset: c ./dist/brig-index reset \ --elasticsearch-index-prefix directory \ --elasticsearch-server https://localhost:9200 \ - --elasticsearch-ca-cert ./libs/wire-subsystems/test/resources/elasticsearch-ca.pem \ + --elasticsearch-ca-cert ./libs/wire-subsystems/test/resources/elasticsearch-ca.pem \ --elasticsearch-credentials ./libs/wire-subsystems/test/resources/elasticsearch-credentials.yaml > /dev/null ./dist/brig-index reset \ --elasticsearch-index-prefix directory2 \ --elasticsearch-server https://localhost:9200 \ - --elasticsearch-ca-cert ./libs/wire-subsystems/test/resources/elasticsearch-ca.pem \ + --elasticsearch-ca-cert ./libs/wire-subsystems/test/resources/elasticsearch-ca.pem \ --elasticsearch-credentials ./libs/wire-subsystems/test/resources/elasticsearch-credentials.yaml > /dev/null ./integration/scripts/integration-dynamic-backends-brig-index.sh \ --elasticsearch-server https://localhost:9200 \ - --elasticsearch-ca-cert ./libs/wire-subsystems/test/resources/elasticsearch-ca.pem \ + --elasticsearch-ca-cert ./libs/wire-subsystems/test/resources/elasticsearch-ca.pem \ + --elasticsearch-credentials ./libs/wire-subsystems/test/resources/elasticsearch-credentials.yaml > /dev/null + @echo -e "\n'brig-index reset' only deletes the index and regenerates the mapping, but doesn't generate or populate a new index, so you need to call 'make es-reindex explicitly now!\n" + +.PHONY: es-reindex +es-reindex: c + ./dist/brig-index reindex \ + --pg-pool-size 10 \ + --pg-pool-acquisition-timeout 10s \ + --pg-pool-aging-timeout 1d \ + --pg-pool-idleness-timeout 1h \ + --pg-settings '{"host":"127.0.0.1","port":"5432","user":"wire-server","dbname":"backendA"}' \ + --pg-password-file ./libs/wire-subsystems/test/resources/postgres-credentials.yaml \ + --elasticsearch-server https://localhost:9200 \ + --elasticsearch-ca-cert ./libs/wire-subsystems/test/resources/elasticsearch-ca.pem \ --elasticsearch-credentials ./libs/wire-subsystems/test/resources/elasticsearch-credentials.yaml > /dev/null .PHONY: rabbitmq-reset @@ -417,7 +438,7 @@ rabbitmq-reset: rabbit-clean # Migrate all keyspaces and reset the ES index # Does not migrate postgres as brig does that on startup. .PHONY: db-migrate -db-migrate: c +db-migrate: c postgres-migrate ./dist/brig-schema --keyspace brig_test --replication-factor 1 > /dev/null ./dist/galley-schema --keyspace galley_test --replication-factor 1 > /dev/null ./dist/gundeck-schema --keyspace gundeck_test --replication-factor 1 > /dev/null @@ -427,20 +448,7 @@ 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 https://localhost:9200 \ - --elasticsearch-ca-cert ./libs/wire-subsystems/test/resources/elasticsearch-ca.pem \ - --elasticsearch-credentials ./libs/wire-subsystems/test/resources/elasticsearch-credentials.yaml > /dev/null - ./dist/brig-index reset \ - --elasticsearch-index-prefix directory2 \ - --elasticsearch-server https://localhost:9200 \ - --elasticsearch-ca-cert ./libs/wire-subsystems/test/resources/elasticsearch-ca.pem \ - --elasticsearch-credentials ./libs/wire-subsystems/test/resources/elasticsearch-credentials.yaml > /dev/null - ./integration/scripts/integration-dynamic-backends-brig-index.sh \ - --elasticsearch-server https://localhost:9200 \ - --elasticsearch-ca-cert ./libs/wire-subsystems/test/resources/elasticsearch-ca.pem \ - --elasticsearch-credentials ./libs/wire-subsystems/test/resources/elasticsearch-credentials.yaml > /dev/null + make es-reset ################################# ## dependencies diff --git a/charts/background-worker/templates/configmap.yaml b/charts/background-worker/templates/configmap.yaml index 81e78f5ca77..6c84d808767 100644 --- a/charts/background-worker/templates/configmap.yaml +++ b/charts/background-worker/templates/configmap.yaml @@ -90,6 +90,7 @@ data: {{- end }} migrateConversations: {{ .migrateConversations }} + migrateConversationCodes: {{ .migrateConversationCodes }} migrateConversationsOptions: {{toYaml .migrateConversationsOptions | indent 6 }} diff --git a/charts/background-worker/values.yaml b/charts/background-worker/values.yaml index 57f3ce00706..2896d749e89 100644 --- a/charts/background-worker/values.yaml +++ b/charts/background-worker/values.yaml @@ -69,6 +69,10 @@ config: migrateConversationsOptions: pageSize: 10000 parallelism: 2 + # This will start the migration of conversation codes. + # It's important to set `settings.postgresMigration.conversationCodes` to `migration-to-postgresql` + # before starting the migration. + migrateConversationCodes: false backendNotificationPusher: pushBackoffMinWait: 10000 # in microseconds, so 10ms @@ -86,7 +90,8 @@ config: # Controls where conversation data is stored/accessed postgresMigration: - conversation: postgresql + conversation: cassandra + conversationCodes: cassandra secrets: {} diff --git a/charts/galley/values.yaml b/charts/galley/values.yaml index a8ac5e2b3b9..f4ac3331c59 100644 --- a/charts/galley/values.yaml +++ b/charts/galley/values.yaml @@ -71,6 +71,7 @@ config: postgresMigration: conversation: cassandra + conversationCodes: cassandra settings: httpPoolSize: 128 maxTeamSize: 10000 diff --git a/charts/integration/templates/_helpers.tpl b/charts/integration/templates/_helpers.tpl index 68e9c251380..e3a33787bf9 100644 --- a/charts/integration/templates/_helpers.tpl +++ b/charts/integration/templates/_helpers.tpl @@ -8,32 +8,6 @@ {{- (semverCompare ">= 1.24-0" (include "kubeVersion" .)) -}} {{- 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 -}} - {{- define "integrationTestHelperNewLabels" -}} {{- (semverCompare ">= 1.23-0" (include "kubeVersion" .)) -}} {{- end -}} diff --git a/charts/integration/templates/ingress.yaml b/charts/integration/templates/ingress.yaml index 7d2748022f0..362b7b0d8f9 100644 --- a/charts/integration/templates/ingress.yaml +++ b/charts/integration/templates/ingress.yaml @@ -1,18 +1,10 @@ -{{- $apiIsStable := eq (include "ingress.isStable" .) "true" -}} -{{- $ingressFieldNotAnnotation := eq (include "ingress.FieldNotAnnotation" .) "true" -}} -{{- $ingressSupportsPathType := eq (include "ingress.supportsPathType" .) "true" -}} -{{- $ingressAPIVersion := include "ingress.apiVersion" . }} - {{- range $name, $dynamicBackend := .Values.config.dynamicBackends }} --- -apiVersion: {{ $ingressAPIVersion }} +apiVersion: networking.k8s.io/v1 kind: Ingress metadata: name: integration-federator-{{ $name }} annotations: - {{- if not $ingressFieldNotAnnotation }} - kubernetes.io/ingress.class: "{{ $.Values.ingress.class }}" - {{- end }} nginx.ingress.kubernetes.io/ssl-redirect: "true" nginx.ingress.kubernetes.io/backend-protocol: "HTTP" nginx.ingress.kubernetes.io/auth-tls-verify-client: "on" @@ -21,9 +13,7 @@ metadata: nginx.ingress.kubernetes.io/configuration-snippet: | proxy_set_header "X-SSL-Certificate" $ssl_client_escaped_cert; spec: - {{- if $ingressFieldNotAnnotation }} ingressClassName: "{{ $.Values.ingress.class }}" - {{- end }} tls: - hosts: - {{ $dynamicBackend.federatorExternalHostPrefix }}.{{ $.Release.Namespace }}.svc.cluster.local @@ -33,17 +23,10 @@ spec: http: paths: - path: / - {{- if $ingressSupportsPathType }} pathType: Prefix - {{- end }} backend: - {{- if $apiIsStable }} service: name: integration port: number: {{ $dynamicBackend.federatorExternalPort }} - {{- else }} - serviceName: integration - servicePort: {{ $dynamicBackend.federatorExternalPort }} - {{- end }} {{- end }} diff --git a/charts/legalhold/templates/_helpers.tpl b/charts/legalhold/templates/_helpers.tpl deleted file mode 100644 index c0e9c954982..00000000000 --- a/charts/legalhold/templates/_helpers.tpl +++ /dev/null @@ -1,26 +0,0 @@ -{{/* 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 -}} diff --git a/charts/legalhold/templates/ingress.yaml b/charts/legalhold/templates/ingress.yaml index 24cfcd98135..b1a530f0f1d 100644 --- a/charts/legalhold/templates/ingress.yaml +++ b/charts/legalhold/templates/ingress.yaml @@ -1,12 +1,11 @@ -{{- $apiIsStable := eq (include "ingress.isStable" .) "true" -}} -{{- $ingressSupportsPathType := eq (include "ingress.supportsPathType" .) "true" -}} -apiVersion: {{ include "ingress.apiVersion" . }} +apiVersion: networking.k8s.io/v1 kind: Ingress metadata: name: hold annotations: kubernetes.io/ingress.class: nginx spec: + ingressClassName: nginx # This assumes you have created the given cert # https://github.com/kubernetes/ingress-nginx/blob/master/docs/examples/PREREQUISITES.md#tls-certificates tls: @@ -18,16 +17,9 @@ spec: http: paths: - path: / - {{- if $ingressSupportsPathType }} pathType: Prefix - {{- end }} backend: - {{- if $apiIsStable }} service: name: "{{ .Release.Name }}-hold" port: number: 8080 - {{- else }} - serviceName: "{{ .Release.Name }}-hold" - servicePort: 8080 - {{- end }} diff --git a/charts/nginx-ingress-services/templates/_helpers.tpl b/charts/nginx-ingress-services/templates/_helpers.tpl index 71c2eab6782..63095902b4c 100644 --- a/charts/nginx-ingress-services/templates/_helpers.tpl +++ b/charts/nginx-ingress-services/templates/_helpers.tpl @@ -62,39 +62,13 @@ Returns the Letsencrypt API server URL based on whether testMode is enabled or d {{/* 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" .))) -}} +{{- default .Capabilities.KubeVersion.Version .Values.kubeVersionOverride -}} {{- end -}} {{- define "integrationTestHelperNewLabels" -}} {{- (semverCompare ">= 1.23-0" (include "kubeVersion" .)) -}} {{- end -}} -{{- define "ingress.FieldNotAnnotation" -}} - {{- (semverCompare ">= 1.27-0" (include "kubeVersion" .)) -}} -{{- end -}} - {{/* Name of the ingress. Extracted as helper to reduce the complexity in the template itself. The default name is 'nginx-ingress' for backwards compatibility (it has diff --git a/charts/nginx-ingress-services/templates/certificate_federator.yaml b/charts/nginx-ingress-services/templates/certificate_federator.yaml index 1361ea386b5..59d06d56270 100644 --- a/charts/nginx-ingress-services/templates/certificate_federator.yaml +++ b/charts/nginx-ingress-services/templates/certificate_federator.yaml @@ -16,8 +16,13 @@ metadata: heritage: "{{ .Release.Service }}" spec: issuerRef: + {{- if .Values.federator.tls.issuer.name }} + name: {{ .Values.federator.tls.issuer.name | quote }} + kind: {{ .Values.federator.tls.issuer.kind | default .Values.tls.issuer.kind }} + {{- else }} name: {{ include "nginx-ingress-services.getIssuerName" . | quote }} kind: {{ .Values.tls.issuer.kind }} + {{- end }} usages: - server auth - client auth diff --git a/charts/nginx-ingress-services/templates/ingress.yaml b/charts/nginx-ingress-services/templates/ingress.yaml index 428fe88c8bc..acca141ae0c 100644 --- a/charts/nginx-ingress-services/templates/ingress.yaml +++ b/charts/nginx-ingress-services/templates/ingress.yaml @@ -1,18 +1,12 @@ -{{- $apiIsStable := eq (include "ingress.isStable" .) "true" -}} -{{- $ingressFieldNotAnnotation := eq (include "ingress.FieldNotAnnotation" .) "true" -}} -{{- $ingressSupportsPathType := eq (include "ingress.supportsPathType" .) "true" -}} -apiVersion: {{ include "ingress.apiVersion" . }} +apiVersion: networking.k8s.io/v1 kind: Ingress metadata: name: {{ include "nginx-ingress-services.getIngressName" . | quote }} + {{- if .Values.config.renderCSPInIngress }} annotations: - {{- if not $ingressFieldNotAnnotation }} - kubernetes.io/ingress.class: "{{ .Values.config.ingressClass }}" - {{- end }} - {{ if .Values.config.renderCSPInIngress }} - {{ if not (contains .Values.config.ingressClass "nginx") }} + {{- if not (contains .Values.config.ingressClass "nginx") }} {{ fail "In ingress CSP header setting only works with a 'nginx' controller. (Rename it to 'nginx-*' if it is one.)" }} - {{ end }} + {{- end }} {{/* We need to add CSP headers here for webapp, team-settings and account-pages requests, because they cannot do it on their own in the multi-ingress case. @@ -44,11 +38,9 @@ metadata: set $CSP "${CSP} upgrade-insecure-requests"; more_set_headers "content-security-policy: $CSP"; } - {{ end }} + {{- end }} spec: - {{- if $ingressFieldNotAnnotation }} ingressClassName: "{{ .Values.config.ingressClass }}" - {{- end }} # This assumes you have created the given cert (see secret.yaml) # https://github.com/kubernetes/ingress-nginx/blob/master/docs/examples/PREREQUISITES.md#tls-certificates tls: @@ -72,92 +64,57 @@ spec: http: paths: - path: / - {{- if $ingressSupportsPathType }} pathType: Prefix - {{- end }} backend: - {{- if $apiIsStable }} service: name: nginz port: name: http - {{- else }} - serviceName: nginz - servicePort: http - {{- end }} {{- if .Values.websockets.enabled }} - host: {{ .Values.config.dns.ssl }} http: paths: - path: / - {{- if $ingressSupportsPathType }} pathType: Prefix - {{- end }} backend: - {{- if $apiIsStable }} service: name: nginz port: name: ws - {{- else }} - serviceName: nginz - servicePort: ws - {{- end }} {{- end }} {{- if .Values.webapp.enabled }} - host: {{ .Values.config.dns.webapp }} http: paths: - path: / - {{- if $ingressSupportsPathType }} pathType: Prefix - {{- end }} backend: - {{- if $apiIsStable }} service: name: webapp-http port: number: {{ .Values.service.webapp.externalPort }} - {{- else }} - serviceName: webapp-http - servicePort: {{ .Values.service.webapp.externalPort }} - {{- end }} {{- end }} {{- if .Values.teamSettings.enabled }} - host: {{ .Values.config.dns.teamSettings }} http: paths: - path: / - {{- if $ingressSupportsPathType }} pathType: Prefix - {{- end }} backend: - {{- if $apiIsStable }} service: name: team-settings-http port: number: {{ .Values.service.teamSettings.externalPort }} - {{- else }} - serviceName: team-settings-http - servicePort: {{ .Values.service.teamSettings.externalPort }} - {{- end }} {{- end }} {{- if .Values.accountPages.enabled }} - host: {{ .Values.config.dns.accountPages }} http: paths: - path: / - {{- if $ingressSupportsPathType }} pathType: Prefix - {{- end }} backend: - {{- if $apiIsStable }} service: name: account-pages-http port: number: {{ .Values.service.accountPages.externalPort }} - {{- else }} - serviceName: account-pages-http - servicePort: {{ .Values.service.accountPages.externalPort }} - {{- end }} {{- end }} diff --git a/charts/nginx-ingress-services/templates/ingress_federator.yaml b/charts/nginx-ingress-services/templates/ingress_federator.yaml index fa76aae8d95..4602fe98112 100644 --- a/charts/nginx-ingress-services/templates/ingress_federator.yaml +++ b/charts/nginx-ingress-services/templates/ingress_federator.yaml @@ -1,20 +1,14 @@ -{{- $apiIsStable := eq (include "ingress.isStable" .) "true" -}} -{{- $ingressFieldNotAnnotation := eq (include "ingress.FieldNotAnnotation" .) "true" -}} -{{- $ingressSupportsPathType := eq (include "ingress.supportsPathType" .) "true" -}} {{- if .Values.federator.enabled }} {{- if .Values.config.isAdditionalIngress -}} {{ fail "Federation and multi-backend-domain (multi-ingress) cannot be configured together." }} {{- end -}} # We use a separate ingress for federator so that we can require client # certificates only for federation requests -apiVersion: {{ include "ingress.apiVersion" . }} +apiVersion: networking.k8s.io/v1 kind: Ingress metadata: name: federator-ingress annotations: - {{- if not $ingressFieldNotAnnotation }} - kubernetes.io/ingress.class: "{{ .Values.config.ingressClass }}" - {{- end }} nginx.ingress.kubernetes.io/ssl-redirect: "true" nginx.ingress.kubernetes.io/backend-protocol: "HTTP" nginx.ingress.kubernetes.io/auth-tls-verify-client: "on" @@ -23,9 +17,7 @@ metadata: nginx.ingress.kubernetes.io/configuration-snippet: | proxy_set_header "X-SSL-Certificate" $ssl_client_escaped_cert; spec: - {{- if $ingressFieldNotAnnotation }} ingressClassName: "{{ .Values.config.ingressClass }}" - {{- end }} tls: - hosts: - {{ .Values.config.dns.federator }} @@ -35,17 +27,10 @@ spec: http: paths: - path: / - {{- if $ingressSupportsPathType }} pathType: Prefix - {{- end }} backend: - {{- if $apiIsStable }} service: name: federator port: name: federator-ext - {{- else }} - serviceName: federator - servicePort: federator-ext # name must be below 15 chars - {{- end }} {{- end }} diff --git a/charts/nginx-ingress-services/templates/ingress_minio.yaml b/charts/nginx-ingress-services/templates/ingress_minio.yaml index 6c225925ead..fed523e9e99 100644 --- a/charts/nginx-ingress-services/templates/ingress_minio.yaml +++ b/charts/nginx-ingress-services/templates/ingress_minio.yaml @@ -1,25 +1,17 @@ -{{- $apiIsStable := eq (include "ingress.isStable" .) "true" -}} -{{- $ingressFieldNotAnnotation := eq (include "ingress.FieldNotAnnotation" .) "true" -}} -{{- $ingressSupportsPathType := eq (include "ingress.supportsPathType" .) "true" -}} {{- if .Values.fakeS3.enabled }} # We use a separate ingress for minio because we want to restrict access to /minio/ path # for security reasons -apiVersion: {{ include "ingress.apiVersion" . }} +apiVersion: networking.k8s.io/v1 kind: Ingress metadata: name: {{ include "nginx-ingress-services.getMinioIngressName" . | quote }} annotations: - {{- if not $ingressFieldNotAnnotation }} - kubernetes.io/ingress.class: "{{ .Values.config.ingressClass }}" - {{- end }} nginx.ingress.kubernetes.io/server-snippet: | location /minio/ { return 403; } spec: - {{- if $ingressFieldNotAnnotation }} ingressClassName: "{{ .Values.config.ingressClass }}" - {{- end }} tls: - hosts: - {{ .Values.config.dns.fakeS3 }} @@ -29,17 +21,10 @@ spec: http: paths: - path: / - {{- if $ingressSupportsPathType }} pathType: Prefix - {{- end }} backend: - {{- if $apiIsStable }} service: name: {{ .Values.service.s3.serviceName }} port: number: {{ .Values.service.s3.externalPort }} - {{- else }} - serviceName: {{ .Values.service.s3.serviceName }} - servicePort: {{ .Values.service.s3.externalPort }} - {{- end }} {{- end }} diff --git a/charts/nginx-ingress-services/values.yaml b/charts/nginx-ingress-services/values.yaml index 8dc8608bb5e..8870f71af98 100644 --- a/charts/nginx-ingress-services/values.yaml +++ b/charts/nginx-ingress-services/values.yaml @@ -20,6 +20,9 @@ federator: # rotationPolicy: Always (default) regenerates key on each renewal # rotationPolicy: Never preserves key across renewals (for key pinning) rotationPolicy: Always + # Issuer for federator certificate (for mTLS with Client Auth EKU). + # If not set, uses global tls.issuer configuration. + issuer: {} # If you want to use TLS termination on the ingress, # then set this variable to true and ensure that there # is a valid wildcard TLS certificate diff --git a/charts/outlook-addin/templates/_helpers.tpl b/charts/outlook-addin/templates/_helpers.tpl index c2f40c04c95..3d27c4ba754 100644 --- a/charts/outlook-addin/templates/_helpers.tpl +++ b/charts/outlook-addin/templates/_helpers.tpl @@ -49,34 +49,3 @@ Selector labels app.kubernetes.io/name: {{ include "outlook.name" . }} 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/outlook-addin/templates/ingress.yaml b/charts/outlook-addin/templates/ingress.yaml index f006d3dc0e6..aedc8885fea 100644 --- a/charts/outlook-addin/templates/ingress.yaml +++ b/charts/outlook-addin/templates/ingress.yaml @@ -1,22 +1,14 @@ -{{- $apiIsStable := eq (include "ingress.isStable" .) "true" -}} -{{- $ingressFieldNotAnnotation := eq (include "ingress.FieldNotAnnotation" .) "true" -}} -{{- $ingressSupportsPathType := eq (include "ingress.supportsPathType" .) "true" -}} -apiVersion: {{ include "ingress.apiVersion" . }} +apiVersion: networking.k8s.io/v1 kind: Ingress metadata: name: "{{ include "outlook.fullname" . }}" labels: {{- include "outlook.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: - "{{ .Values.host }}" diff --git a/docs/src/developer/reference/config-options.md b/docs/src/developer/reference/config-options.md index d72b8158faa..92f52cbf46b 100644 --- a/docs/src/developer/reference/config-options.md +++ b/docs/src/developer/reference/config-options.md @@ -1811,79 +1811,94 @@ galley: config: postgresMigration: conversation: postgresql + conversationCodes: postgresql background-worker: config: postgresMigration: conversation: postgresql + conversationCodes: postgresql migrateConversations: false ``` #### Migration for existing installations -Existing installations should migrate the conversation data to PostgreSQL from +Existing installations should migrate conversation data to PostgreSQL from Cassandra. This is necessary for channel search and management of channels from the team-management UI. It is highly recommended to take a backup of the Galley Cassandra before triggering the migration. -The migration needs to happen in 3 steps: +Migrations are independent and can be run separately, in batches, or all at +once. This is expected, because migrations will be released over time. The +pattern below applies per store. Use it for `conversation` and +`conversationCodes` now, and for future stores as they are added. -1. Prepare wire-server for migration. +**Migration pattern per store(s)** - This step make sure that wire-server keep working as expected during the - migration. To do this deploy wire-server with this config change: - - Configure both `galley` and `background-worker` so that newly created - conversations are written to PostgreSQL while existing data still reads from - Cassandra: +1. Prepare the selected store(s) for migration by setting + `postgresMigration.` to `migration-to-postgresql`. This enables the + migration interpreter for that store, which ensures data is written to + PostgreSQL (store-specific details are handled internally). + The configuration must be consistent across `galley` and + `background-worker`. ```yaml galley: config: postgresMigration: conversation: migration-to-postgresql + conversationCodes: migration-to-postgresql background-worker: config: postgresMigration: conversation: migration-to-postgresql + conversationCodes: migration-to-postgresql migrateConversations: false + migrateConversationCodes: false ``` - This change should restart all the galley pods, any new conversations will - now be written to PostgreSQL. - -2. Trigger the migration and wait. + This change should restart all the galley pods, and new writes will follow + the migration interpreter. - This step will actually carry out the migration. To do this deploy - wire-server with this config change: +2. Run the backfill for the selected store(s) via background-worker. ```yaml background-worker: config: migrateConversations: true + migrateConversationCodes: true ``` - This change should restart the background-worker pods. It is recommended to - watch the logs and wait for both of these two metrics to report `1.0`: - `wire_local_convs_migration_finished` and `wire_user_remote_convs_migration_finished`. - This can take a long time depending on number of conversations in the DB. - -3. Configure wire-server to only use PostgreSQL for conversations. + Wait for the store-specific migration metrics to reach `1.0`. For + conversations: `wire_local_convs_migration_finished` and + `wire_user_remote_convs_migration_finished`. For conversation codes: + `wire_conv_codes_migration_finished`. - This will be the configuration which must be used from now on for every new - release. +3. Cut over reads and writes to PostgreSQL for the selected store(s). This + configuration must be used from now on for every new release. ```yaml galley: config: postgresMigration: conversation: postgresql + conversationCodes: postgresql background-worker: config: postgresMigration: conversation: postgresql + conversationCodes: postgresql migrateConversations: false + migrateConversationCodes: false ``` +**How to run migrations independently or in batches** + +- To migrate a single store, set only that store’s `postgresMigration.` + and `migrate` flags; leave others unchanged. +- To migrate a batch, set multiple stores to `migration-to-postgresql` and + enable only the matching `migrate` flags together. +- To reduce load, run large stores alone and group small stores together. + ## Configure Cells If Cells integration is enabled, gundeck must be configured with the name of diff --git a/flake.lock b/flake.lock index 68686e15d11..aa065d4c194 100644 --- a/flake.lock +++ b/flake.lock @@ -68,23 +68,6 @@ "type": "github" } }, - "cryptobox-haskell": { - "flake": false, - "locked": { - "lastModified": 1728557781, - "narHash": "sha256-LROqEzzvKiJ7YoF8SdKUkEgGXKBRW6Wdtd4EBY3LYOk=", - "owner": "wireapp", - "repo": "cryptobox-haskell", - "rev": "05560b2cfae13aac54414952638dadd62204f361", - "type": "github" - }, - "original": { - "owner": "wireapp", - "ref": "master", - "repo": "cryptobox-haskell", - "type": "github" - } - }, "flake-utils": { "inputs": { "systems": "systems" @@ -226,7 +209,6 @@ "bloodhound": "bloodhound", "cql": "cql", "cql-io": "cql-io", - "cryptobox-haskell": "cryptobox-haskell", "flake-utils": "flake-utils", "hedis": "hedis", "hsaml2": "hsaml2", @@ -354,14 +336,17 @@ ] }, "locked": { - "lastModified": 1767870783, - "narHash": "sha256-0QStp+uH05bnGltPnOJM2FdeTJdgVIWkVM5wSFYVceM=", - "path": "/home/axeman/workspace/tom-bombadil", - "type": "path" + "lastModified": 1739181719, + "narHash": "sha256-W4g0e9u5CagGY8qqsHIZbP28iVkvvmz+hCkNz3b5GkE=", + "owner": "wireapp", + "repo": "tom-bombadil", + "rev": "53842ffb11e8d357b7d7bdf21b800c71a414ed06", + "type": "github" }, "original": { - "path": "/home/axeman/workspace/tom-bombadil", - "type": "path" + "owner": "wireapp", + "repo": "tom-bombadil", + "type": "github" } }, "wai-predicates": { diff --git a/flake.nix b/flake.nix index 698c5b23d25..242b5774b03 100644 --- a/flake.nix +++ b/flake.nix @@ -7,15 +7,11 @@ nixpkgs_24_11.url = "github:nixos/nixpkgs?ref=nixos-24.11"; flake-utils.url = "github:numtide/flake-utils"; tom-bombadil = { - url = "path:/home/axeman/workspace/tom-bombadil"; + url = "github:wireapp/tom-bombadil"; inputs.nixpkgs.follows = "nixpkgs"; inputs.flake-utils.follows = "flake-utils"; }; - cryptobox-haskell = { - url = "github:wireapp/cryptobox-haskell?ref=master"; - flake = false; - }; bloodhound = { url = "github:wireapp/bloodhound?ref=wire-fork"; flake = false; diff --git a/hack/bin/integration-setup-federation.sh b/hack/bin/integration-setup-federation.sh index 17be6acfc9d..355abb417ab 100755 --- a/hack/bin/integration-setup-federation.sh +++ b/hack/bin/integration-setup-federation.sh @@ -26,13 +26,6 @@ charts=(fake-aws databases-ephemeral rabbitmq wire-server ingress-nginx-controll mkdir -p ~/.parallel && touch ~/.parallel/will-cite printf '%s\n' "${charts[@]}" | parallel -P "${HELM_PARALLELISM}" "$DIR/update.sh" "$CHARTS_DIR/{}" -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. -export KUBERNETES_VERSION="$KUBERNETES_VERSION_MAJOR.$KUBERNETES_VERSION_MINOR" -export INGRESS_CHART="ingress-nginx-controller" - -echo "kubeVersion: $KUBERNETES_VERSION and ingress controller=$INGRESS_CHART" export NAMESPACE_1="$NAMESPACE" export FEDERATION_DOMAIN_BASE_1="$NAMESPACE_1.svc.cluster.local" export FEDERATION_DOMAIN_1="federation-test-helper.$FEDERATION_DOMAIN_BASE_1" diff --git a/hack/bin/integration-teardown-federation.sh b/hack/bin/integration-teardown-federation.sh index 9b97eed327e..7f5fdacd671 100755 --- a/hack/bin/integration-teardown-federation.sh +++ b/hack/bin/integration-teardown-federation.sh @@ -16,7 +16,6 @@ export FEDERATION_DOMAIN_BASE_1="." export FEDERATION_DOMAIN_BASE_2="." export FEDERATION_CA_CERTIFICATE="." export ENTERPRISE_IMAGE_PULL_SECRET="." -export INGRESS_CHART="ingress-nginx-controller" # shellcheck disable=SC1091 . "$DIR/helm_overrides.sh" diff --git a/hack/helm_vars/common.yaml.gotmpl b/hack/helm_vars/common.yaml.gotmpl index 083e689e10b..e1974ced474 100644 --- a/hack/helm_vars/common.yaml.gotmpl +++ b/hack/helm_vars/common.yaml.gotmpl @@ -5,7 +5,7 @@ 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" }} +ingressChart: ingress-nginx-controller rabbitmqUsername: guest rabbitmqPassword: guest @@ -13,11 +13,9 @@ dynBackendDomain1: dynamic-backend-1.{{ requiredEnv "NAMESPACE_1" }}.svc.cluster dynBackendDomain2: dynamic-backend-2.{{ requiredEnv "NAMESPACE_1" }}.svc.cluster.local dynBackendDomain3: dynamic-backend-3.{{ requiredEnv "NAMESPACE_1" }}.svc.cluster.local -{{- if (eq (env "CONVERSATION_STORE") "") }} -conversationStore: cassandra -{{- else }} -conversationStore: {{ env "CONVERSATION_STORE" }} -{{- end }} +{{- $preferredStore := default "cassandra" (env "PREFERRED_STORE") }} +conversationStore: {{ $preferredStore }} +conversationCodesStore: {{ $preferredStore }} {{- if (eq (env "UPLOAD_XML_S3_BASE_URL") "") }} uploadXml: {} @@ -26,4 +24,4 @@ uploadXml: awsAccessKeyId: {{ env "UPLOAD_XML_AWS_ACCESS_KEY_ID" }} awsSecretAccessKey: {{ env "UPLOAD_XML_AWS_SECRET_ACCESS_KEY" }} baseUrl: {{ env "UPLOAD_XML_S3_BASE_URL" }} -{{- end }} \ No newline at end of file +{{- end }} diff --git a/hack/helm_vars/wire-server/values.yaml.gotmpl b/hack/helm_vars/wire-server/values.yaml.gotmpl index 490c70deb6b..5efdf49dbdc 100644 --- a/hack/helm_vars/wire-server/values.yaml.gotmpl +++ b/hack/helm_vars/wire-server/values.yaml.gotmpl @@ -164,6 +164,17 @@ brig: general: emailSender: backend-integrationk8s@wire.com smsSender: dummy + user: + activationUrl: https://example.com/verify/?key=${key}&code=${code} + smsActivationUrl: https://example.com/v/${code} + passwordResetUrl: https://example.com/reset/?key=${key}&code=${code} + deletionUrl: https://example.com/d/?key=${key}&code=${code} + team: + tInvitationUrl: https://example.com/join/?team-code=${code} + tExistingUserInvitationUrl: https://example.com/accept-invitation/?team-code=${code} + tActivationUrl: https://example.com/verify/?key=${key}&code=${code} + tCreatorWelcomeUrl: https://example.com/login + tMemberWelcomeUrl: https://example.com/download test: elasticsearch: additionalHost: {{ .Values.elasticsearch.additionalHost }} @@ -295,6 +306,7 @@ galley: enableFederation: true # keep in sync with brig.config.enableFederation, cargohold.config.enableFederation and tags.federator! postgresMigration: conversation: {{ .Values.conversationStore }} + conversationCodes: {{ .Values.conversationCodesStore }} settings: maxConvAndTeamSize: 16 maxTeamSize: 32 @@ -662,6 +674,7 @@ background-worker: federationDomain: integration.example.com postgresMigration: conversation: {{ .Values.conversationStore }} + conversationCodes: {{ .Values.conversationCodesStore }} rabbitmq: port: 5671 adminPort: 15671 diff --git a/integration/default.nix b/integration/default.nix index 04163fc5074..871bf6ae879 100644 --- a/integration/default.nix +++ b/integration/default.nix @@ -24,7 +24,6 @@ , cql , cql-io , criterion -, cryptobox-haskell , crypton , crypton-x509 , cryptostore @@ -132,7 +131,6 @@ mkDerivation { cql cql-io criterion - cryptobox-haskell crypton crypton-x509 cryptostore diff --git a/integration/integration.cabal b/integration/integration.cabal index 555ca6a7f1b..fae812e6f52 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -126,7 +126,6 @@ library Test.Client Test.Connection Test.Conversation - Test.Conversation.Migration Test.Demo Test.DNSMock Test.DomainVerification @@ -174,8 +173,12 @@ library Test.LegalHold Test.Login Test.MessageTimer + Test.Migration.Conversation + Test.Migration.ConversationCodes + Test.Migration.Util Test.MLS Test.MLS.Clients + Test.MLS.History Test.MLS.KeyPackage Test.MLS.Keys Test.MLS.Message @@ -255,7 +258,6 @@ library , cql , cql-io , criterion - , cryptobox-haskell , crypton , crypton-x509 , cryptostore diff --git a/integration/test/API/Brig.hs b/integration/test/API/Brig.hs index 5c7fee6fed2..a49b6127789 100644 --- a/integration/test/API/Brig.hs +++ b/integration/test/API/Brig.hs @@ -1240,11 +1240,18 @@ createApp creator tid new = do "password" .= defPassword ] +-- | https://staging-nginz-https.zinfra.io/v14/api/swagger-ui/#/default/get-app getApp :: (MakesValue self) => self -> String -> String -> App Response getApp self tid uid = do req <- baseRequest self Brig Versioned $ joinHttpPath ["teams", tid, "apps", uid] submit "GET" req +-- | https://staging-nginz-https.zinfra.io/v14/api/swagger-ui/#/default/get-apps +getApps :: (MakesValue self) => self -> String -> App Response +getApps self tid = do + req <- baseRequest self Brig Versioned $ joinHttpPath ["teams", tid, "apps"] + submit "GET" req + refreshAppCookie :: (MakesValue u) => u -> String -> String -> App Response refreshAppCookie u tid appId = do req <- baseRequest u Brig Versioned $ joinHttpPath ["teams", tid, "apps", appId, "cookies"] diff --git a/integration/test/MLS/Util.hs b/integration/test/MLS/Util.hs index 54971aa8e13..3ecc464c519 100644 --- a/integration/test/MLS/Util.hs +++ b/integration/test/MLS/Util.hs @@ -74,7 +74,8 @@ data MessagePackage = MessagePackage convId :: ConvId, message :: ByteString, welcome :: Maybe ByteString, - groupInfo :: Maybe ByteString + groupInfo :: Maybe ByteString, + appMessage :: Maybe ByteString } toRandomFile :: ByteString -> App FilePath @@ -445,7 +446,8 @@ createAddCommitWithKeyPackages cid convId clientsAndKeyPackages = do convId = convId, message = commit, welcome = Just welcome, - groupInfo = Just gi + groupInfo = Just gi, + appMessage = Nothing } createRemoveCommit :: (HasCallStack) => ClientIdentity -> ConvId -> [ClientIdentity] -> App MessagePackage @@ -502,7 +504,8 @@ createRemoveCommit cid convId targets = do convId = convId, message = commit, welcome = Just welcome, - groupInfo = Just gi + groupInfo = Just gi, + appMessage = Nothing } createAddProposals :: (HasCallStack) => ConvId -> ClientIdentity -> [Value] -> App [MessagePackage] @@ -528,7 +531,8 @@ createReInitProposal convId cid = do convId = convId, message = prop, welcome = Nothing, - groupInfo = Nothing + groupInfo = Nothing, + appMessage = Nothing } createAddProposalWithKeyPackage :: @@ -551,7 +555,8 @@ createAddProposalWithKeyPackage convId cid (_, kp) = do convId = convId, message = prop, welcome = Nothing, - groupInfo = Nothing + groupInfo = Nothing, + appMessage = Nothing } createPendingProposalCommit :: (HasCallStack) => ConvId -> ClientIdentity -> App MessagePackage @@ -585,7 +590,8 @@ createPendingProposalCommit convId cid = do convId = convId, message = commit, welcome = welcome, - groupInfo = Just pgs + groupInfo = Just pgs, + appMessage = Nothing } createExternalCommit :: @@ -630,7 +636,8 @@ createExternalCommit convId cid mgi = do convId = convId, message = commit, welcome = Nothing, - groupInfo = Just newPgs + groupInfo = Just newPgs, + appMessage = Nothing } data MLSNotificationTag = MLSNotificationMessageTag | MLSNotificationWelcomeTag @@ -721,7 +728,7 @@ consumeMessageNoExternal cs cid mp = consumeMessageWithPredicate isNewMLSMessage else pure False mlsCliConsume :: (HasCallStack) => ConvId -> Ciphersuite -> ClientIdentity -> ByteString -> App ByteString -mlsCliConsume convId cs cid msgData = +mlsCliConsume convId cs cid msgData = do mlscli (Just convId) cs @@ -834,7 +841,11 @@ readWelcome fp = runMaybeT $ do liftIO $ BS.readFile fp mkBundle :: MessagePackage -> ByteString -mkBundle mp = mp.message <> foldMap mkGroupInfoMessage mp.groupInfo <> fold mp.welcome +mkBundle mp = + mp.message + <> foldMap mkGroupInfoMessage mp.groupInfo + <> fold mp.welcome + <> fold mp.appMessage mkGroupInfoMessage :: ByteString -> ByteString mkGroupInfoMessage gi = BS.pack [0x00, 0x01, 0x00, 0x04] <> gi @@ -913,7 +924,8 @@ createApplicationMessage convId cid messageContent = do convId = convId, message = message, welcome = Nothing, - groupInfo = Nothing + groupInfo = Nothing, + appMessage = Nothing } leaveConv :: diff --git a/integration/test/Test/Apps.hs b/integration/test/Test/Apps.hs index 4af7b903b36..8bb314a771f 100644 --- a/integration/test/Test/Apps.hs +++ b/integration/test/Test/Apps.hs @@ -54,6 +54,19 @@ testCreateApp = do resp.status `shouldMatchInt` 200 resp.json %. "type" `shouldMatch` "app" + -- getApp, getApps + bindResponse (getApp owner tid appId) $ \resp -> do + resp.status `shouldMatchInt` 200 + bindResponse (getApps owner tid) $ \resp -> do + resp.status `shouldMatchInt` 200 + void $ resp.json >>= asList >>= assertOne + bindResponse (createApp owner tid (new {name = "fmappie"})) $ \resp -> do + resp.status `shouldMatchInt` 200 + bindResponse (getApps owner tid) $ \resp -> do + resp.status `shouldMatchInt` 200 + apps <- resp.json >>= asList + (sort <$> ((%. "name") `mapM` apps)) `shouldMatch` ["chappie", "fmappie"] + -- Creator should have type "regular" bindResponse (getUser owner owner) $ \resp -> do resp.status `shouldMatchInt` 200 @@ -73,7 +86,7 @@ testCreateApp = do (resp.json %. "category") `shouldMatch` "ai" -- A teamless user can't get the app - outsideUser <- randomUser OwnDomain def + outsideUser <- randomUser domain def bindResponse (getApp outsideUser tid appId) $ \resp -> do resp.status `shouldMatchInt` 403 resp.json %. "label" `shouldMatch` "app-no-permission" @@ -88,13 +101,25 @@ testCreateApp = do void $ bindResponse (createApp owner tid new {category = "notinenum"}) $ \resp -> do resp.status `shouldMatchInt` 400 + let foundUserType :: (HasCallStack) => Value -> String -> [String] -> App () + foundUserType searcher exactMatchTerm aTypes = + searchContacts searcher exactMatchTerm OwnDomain `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + foundDoc <- resp.json %. "documents" >>= asList + (%. "type") `mapM` foundDoc `shouldMatch` aTypes + -- App's user is findable from /search/contacts - BrigI.refreshIndex OwnDomain - searchContacts owner new.name OwnDomain `bindResponse` \resp -> do - resp.status `shouldMatchInt` 200 - docs <- resp.json %. "documents" >>= asList - foundUids <- for docs objId - foundUids `shouldMatch` [appId] + BrigI.refreshIndex domain + foundUserType owner new.name ["app"] + foundUserType regularMember new.name ["app"] + + -- App's user is *not* findable from other team. + BrigI.refreshIndex domain + foundUserType owner2 new.name [] + + -- Regular members still have the type "regular" + memberName <- regularMember %. "name" & asString + foundUserType owner memberName ["regular"] testRefreshAppCookie :: (HasCallStack) => App () testRefreshAppCookie = do diff --git a/integration/test/Test/MLS/History.hs b/integration/test/Test/MLS/History.hs new file mode 100644 index 00000000000..36dea41908e --- /dev/null +++ b/integration/test/Test/MLS/History.hs @@ -0,0 +1,57 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2025 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Test.MLS.History where + +import qualified Data.ByteString.Base64 as Base64 +import qualified Data.Text.Encoding as T +import MLS.Util +import Notifications +import SetupHelpers +import Testlib.Prelude + +testExtraAppMessage :: App () +testExtraAppMessage = do + [alice, bob, charlie] <- createAndConnectUsers (replicate 3 OwnDomain) + [alice1, bob1, charlie1] <- traverse (createMLSClient def) [alice, bob, charlie] + traverse_ (uploadNewKeyPackage def) [bob1, charlie1] + convId <- createNewGroup def alice1 + + -- normal commit + void $ createAddCommit alice1 convId [bob] >>= sendAndConsumeCommitBundle + + -- make a commit with an extra application message + mp <- createAddCommit alice1 convId [charlie] + appPackage <- createApplicationMessage convId alice1 "hello" + let mp' = mp {appMessage = Just appPackage.message} + + withWebSockets [bob1, charlie1] $ \wss -> do + void $ sendAndConsumeCommitBundle mp' + + let isAppMessage :: Value -> App Bool + isAppMessage n = + isNewMLSMessageNotif n + &&~ isNotifConvId mp.convId n + &&~ ( do + msg <- n %. "payload.0.data" & asByteString >>= showMessage def alice1 + ty <- msg %. "type" & asString + pure $ ty == "private_message" + ) + + for_ wss $ \ws -> do + n <- awaitMatch isAppMessage ws + nPayload n %. "data" `shouldMatch` T.decodeUtf8 (Base64.encode appPackage.message) diff --git a/integration/test/Test/Conversation/Migration.hs b/integration/test/Test/Migration/Conversation.hs similarity index 93% rename from integration/test/Test/Conversation/Migration.hs rename to integration/test/Test/Migration/Conversation.hs index 97472960d46..dfb80e91a7a 100644 --- a/integration/test/Test/Conversation/Migration.hs +++ b/integration/test/Test/Migration/Conversation.hs @@ -10,26 +10,22 @@ -- The tests are from the perspective of mel, a user on the dynamic backend, -- called backendM (migrating backend). There are also users called mark and mia -- on this backend. -module Test.Conversation.Migration where +module Test.Migration.Conversation where import API.Galley import Control.Applicative -import Control.Concurrent (threadDelay) import Control.Monad.Codensity import Control.Monad.Reader import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap import qualified Data.IntSet as IntSet -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text import GHC.Stack import MLS.Util import Notifications import SetupHelpers hiding (deleteUser) +import Test.Migration.Util import Testlib.Prelude import Testlib.ResourcePool -import Text.Regex.TDFA ((=~)) import UnliftIO -- | Our test setup cannot process updates to many MLS convs concurrently, so we @@ -84,7 +80,9 @@ testMigrationToPostgresMLS = do actualConvs `shouldMatchSet` ((convIdToQidObject <$> expectedConvs) <> otherMelConvs) - when (phase == 3) $ waitForMigration domainM + when (phase == 3) $ do + waitForMigration domainM convMigrationFinishedCounterName + waitForMigration domainM userMigrationFinishedCounterName runPhase 1 runPhase 2 runPhase 3 @@ -191,7 +189,9 @@ testMigrationToPostgresProteus = do actualConvs `shouldMatchSet` ((convIdToQidObject <$> expectedConvs) <> otherMelConvs) - when (phase == 3) $ waitForMigration domainM + when (phase == 3) $ do + waitForMigration domainM convMigrationFinishedCounterName + waitForMigration domainM userMigrationFinishedCounterName runPhase 1 runPhase 2 runPhase 3 @@ -292,17 +292,11 @@ instance Semigroup TestConvList where addMelConvs = IntMap.unionWith (<>) l1.addMelConvs l2.addMelConvs } -waitForMigration :: (HasCallStack) => String -> App () -waitForMigration domainM = do - metrics <- - getMetrics domainM BackgroundWorker `bindResponse` \resp -> do - resp.status `shouldMatchInt` 200 - pure $ Text.decodeUtf8 resp.body - let (_, _, _, convFinishedMatches) :: (Text, Text, Text, [Text]) = (metrics =~ Text.pack "^wire_local_convs_migration_finished\\ ([0-9]+\\.[0-9]+)$") - let (_, _, _, userFinishedMatches) :: (Text, Text, Text, [Text]) = (metrics =~ Text.pack "^wire_user_remote_convs_migration_finished\\ ([0-9]+\\.[0-9]+)$") - when (convFinishedMatches /= [Text.pack "1.0"] || userFinishedMatches /= [Text.pack "1.0"]) $ do - liftIO $ threadDelay 100_000 - waitForMigration domainM +convMigrationFinishedCounterName :: String +convMigrationFinishedCounterName = "^wire_local_convs_migration_finished" + +userMigrationFinishedCounterName :: String +userMigrationFinishedCounterName = "^wire_user_remote_convs_migration_finished" phase1Overrides, phase2Overrides, phase3Overrides, phase4Overrides, phase5Overrides :: ServiceOverrides phase1Overrides = diff --git a/integration/test/Test/Migration/ConversationCodes.hs b/integration/test/Test/Migration/ConversationCodes.hs new file mode 100644 index 00000000000..c56fd73c9a8 --- /dev/null +++ b/integration/test/Test/Migration/ConversationCodes.hs @@ -0,0 +1,183 @@ +module Test.Migration.ConversationCodes where + +import API.Galley +import Control.Applicative +import Control.Concurrent.Timeout +import Control.Monad.Codensity +import Control.Monad.Reader +import SetupHelpers +import Test.Migration.Util (waitForMigration) +import Testlib.Prelude +import Testlib.ResourcePool + +testConversationCodesMigration :: (HasCallStack) => TaggedBool "has-password" -> App () +testConversationCodesMigration (TaggedBool hasPassword) = do + resourcePool <- asks (.resourcePool) + let pw = if hasPassword then Just "funky password" else Nothing + + runCodensity (acquireResources 1 resourcePool) $ \[backend] -> do + let domain = backend.berDomain + + (admin, code1, codeA, convs, members) <- runCodensity (startDynamicBackend backend (conf "cassandra" False)) $ \_ -> do + (admin, _, members) <- createTeam domain 6 + convs1@(conv1 : _) <- replicateM 5 $ postConversation admin (allowGuests defProteus) >>= getJSON 201 + convs2@(convA : _) <- replicateM 4 $ postConversation admin (allowGuests defProteus) >>= getJSON 201 + code1 <- genCode admin conv1 pw + codeA <- genCode admin convA pw + pure (admin, code1, codeA, convs1 <> convs2, members) + + [conv1, conv2, conv3, conv4, conv5, convA, convB, convC, convD] <- pure convs + m1 : m2 : m3 : m4 : _ <- pure members + + (code2, codeB) <- runCodensity (startDynamicBackend backend (conf "migration-to-postgresql" False)) $ \_ -> do + -- code generation works + code2 <- genCode admin conv2 pw + codeB <- genCode admin convB pw + -- joining works + checkJoinAndGet admin m1 conv1 code1 pw + checkJoinAndGet admin m1 conv2 code2 pw + -- deletion works + checkDelete admin m1 convA codeA pw + pure (code2, codeB) + + (code3, codeC) <- runCodensity (startDynamicBackend backend (conf "migration-to-postgresql" True)) $ \_ -> do + -- code generation works + code3 <- genCode admin conv3 pw + codeC <- genCode admin convC pw + -- joining works + checkJoinAndGet admin m2 conv1 code1 pw + checkJoinAndGet admin m2 conv2 code2 pw + checkJoinAndGet admin m2 conv3 code3 pw + -- deletion works + checkNoCode admin m1 convA codeA pw + checkDelete admin m1 convB codeB pw + waitForMigration domain counterName + pure (code3, codeC) + + (code4, codeD) <- runCodensity (startDynamicBackend backend (conf "migration-to-postgresql" False)) $ \_ -> do + -- code generation works + code4 <- genCode admin conv4 pw + codeD <- genCode admin convD pw + -- joining works + checkJoinAndGet admin m3 conv1 code1 pw + checkJoinAndGet admin m3 conv2 code2 pw + checkJoinAndGet admin m3 conv3 code3 pw + checkJoinAndGet admin m3 conv4 code4 pw + -- deletion works + checkNoCode admin m1 convA codeA pw + checkNoCode admin m1 convB codeB pw + checkDelete admin m1 convC codeC pw + pure (code4, codeD) + + runCodensity (startDynamicBackend backend (conf "postgresql" False)) $ \_ -> do + -- code generation works + code5 <- genCode admin conv5 pw + -- joining works + checkJoinAndGet admin m4 conv1 code1 pw + checkJoinAndGet admin m4 conv2 code2 pw + checkJoinAndGet admin m4 conv3 code3 pw + checkJoinAndGet admin m4 conv4 code4 pw + checkJoinAndGet admin m4 conv5 code5 pw + -- deletion works + checkNoCode admin m1 convA codeA pw + checkNoCode admin m1 convB codeB pw + checkNoCode admin m1 convC codeC pw + checkDelete admin m1 convD codeD pw + checkDelete admin m1 conv5 code5 pw + where + checkJoinAndGet admin user conv code pw = do + joinWithCode user conv code + getCode admin conv pw `shouldMatch` code + checkDelete admin user conv (k, v) pw = do + assertSuccess =<< deleteConversationCode admin conv + checkNoCode admin user conv (k, v) pw + checkNoCode admin user conv (k, v) pw = do + assertStatus 404 =<< getConversationCode admin conv pw + bindResponse (getJoinCodeConv user k v) $ \res -> do + res.status `shouldMatchInt` 404 + res.json %. "label" `shouldMatch` "no-conversation-code" + +testConversationCodesMigrationExpiration :: (HasCallStack) => App () +testConversationCodesMigrationExpiration = do + resourcePool <- asks (.resourcePool) + let pw = Nothing + + runCodensity (acquireResources 1 resourcePool) $ \[backend] -> do + let domain = backend.berDomain + + (admin, code1, conv, mem) <- runCodensity (startDynamicBackend backend (confWithExpiry "cassandra" False 2)) $ \_ -> do + (admin, _, mem : _) <- createTeam domain 2 + conv <- postConversation admin (allowGuests defProteus) >>= getJSON 201 + code1 <- genCode admin conv pw + pure (admin, code1, conv, mem) + + code2 <- runCodensity (startDynamicBackend backend (confWithExpiry "migration-to-postgresql" False 2)) $ \_ -> do + waitForCodeToExpire admin conv pw + checkCantJoin mem code1 + genCode admin conv pw + + code3 <- runCodensity (startDynamicBackend backend (confWithExpiry "migration-to-postgresql" True 2)) $ \_ -> do + waitForCodeToExpire admin conv pw + checkCantJoin mem code2 + genCode admin conv pw + + code4 <- runCodensity (startDynamicBackend backend (confWithExpiry "migration-to-postgresql" False 2)) $ \_ -> do + waitForCodeToExpire admin conv pw + checkCantJoin mem code3 + genCode admin conv pw + runCodensity (startDynamicBackend backend (confWithExpiry "postgresql" False 2)) $ \_ -> do + waitForCodeToExpire admin conv pw + checkCantJoin mem code4 + where + checkCantJoin user (k, v) = do + bindResponse (getJoinCodeConv user k v) $ \res -> do + res.status `shouldMatchInt` 404 + res.json %. "label" `shouldMatch` "no-conversation-code" + +-- HELPER + +genCode :: (HasCallStack, MakesValue user, MakesValue conv) => user -> conv -> Maybe String -> App (String, String) +genCode user conv pw = + bindResponse (postConversationCode user conv pw Nothing) $ \res -> do + payload <- getJSON 201 res + k <- payload %. "data.key" & asString + v <- payload %. "data.code" & asString + pure (k, v) + +getCode :: (HasCallStack, MakesValue user, MakesValue conv) => user -> conv -> Maybe String -> App (String, String) +getCode user conv pw = + bindResponse (getConversationCode user conv pw) $ \res -> do + payload <- getJSON 200 res + k <- payload %. "key" & asString + v <- payload %. "code" & asString + pure (k, v) + +waitForCodeToExpire :: (MakesValue user, MakesValue conv) => user -> conv -> Maybe String -> App () +waitForCodeToExpire user conv pw = do + res <- getConversationCode user conv pw + if res.status == 404 + then pure () + else do + liftIO $ threadDelay 100_000 + waitForCodeToExpire user conv pw + +joinWithCode :: (HasCallStack, MakesValue user) => user -> Value -> (String, String) -> App () +joinWithCode user conv (k, v) = + bindResponse (getJoinCodeConv user k v) $ \res -> do + res.status `shouldMatchInt` 200 + res.json %. "id" `shouldMatch` (objQidObject conv & objId) + +conf :: String -> Bool -> ServiceOverrides +conf db runMigration = confWithExpiry db runMigration 604800 + +confWithExpiry :: String -> Bool -> Int -> ServiceOverrides +confWithExpiry db runMigration expiry = + def + { galleyCfg = + setField "postgresMigration.conversationCodes" db + >=> setField "settings.guestLinkTTLSeconds" expiry, + backgroundWorkerCfg = setField "migrateConversationCodes" runMigration + } + +counterName :: String +counterName = "^wire_conv_codes_migration_finished" diff --git a/integration/test/Test/Migration/Util.hs b/integration/test/Test/Migration/Util.hs new file mode 100644 index 00000000000..f55db0c58f9 --- /dev/null +++ b/integration/test/Test/Migration/Util.hs @@ -0,0 +1,23 @@ +module Test.Migration.Util where + +import Control.Applicative +import Control.Concurrent (threadDelay) +import Control.Monad.Reader +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import GHC.Stack +import SetupHelpers hiding (deleteUser) +import Testlib.Prelude +import Text.Regex.TDFA ((=~)) + +waitForMigration :: (HasCallStack) => String -> String -> App () +waitForMigration domain name = do + metrics <- + getMetrics domain BackgroundWorker `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + pure $ Text.decodeUtf8 resp.body + let (_, _, _, finishedMatches) :: (Text, Text, Text, [Text]) = (metrics =~ Text.pack (name <> "\\ ([0-9]+\\.[0-9]+)$")) + when (finishedMatches /= [Text.pack "1.0"]) $ do + liftIO $ threadDelay 100_000 + waitForMigration domain name diff --git a/integration/test/Test/Teams.hs b/integration/test/Test/Teams.hs index 0066ef70170..f8e91c5b8a2 100644 --- a/integration/test/Test/Teams.hs +++ b/integration/test/Test/Teams.hs @@ -141,7 +141,7 @@ testInvitePersonalUserToTeam = do -- personal user invitations have a different invitation URL than non-existing user invitations newUserInv <- invitations & findM (\i -> (i %. "email" >>= asString) <&> (== newUserEmail)) newUserInvUrl <- newUserInv %. "url" & asString - newUserInvUrl `shouldContainString` "/register" + newUserInvUrl `shouldContainString` "/join" personalUserInv <- invitations & findM (\i -> (i %. "email" >>= asString) <&> (== email)) personalUserInvUrl <- personalUserInv %. "url" & asString diff --git a/libs/extended/default.nix b/libs/extended/default.nix index 4090a02a779..3ec398e8d14 100644 --- a/libs/extended/default.nix +++ b/libs/extended/default.nix @@ -5,11 +5,15 @@ { mkDerivation , aeson , amqp +, asn1-types , base , bytestring , cassandra-util , containers +, crypton , crypton-connection +, crypton-pem +, crypton-x509 , crypton-x509-store , data-default , errors @@ -24,6 +28,7 @@ , http-types , imports , lib +, memory , metrics-wai , monad-control , prometheus-client @@ -52,11 +57,14 @@ mkDerivation { libraryHaskellDepends = [ aeson amqp + asn1-types base bytestring cassandra-util containers + crypton crypton-connection + crypton-x509 crypton-x509-store data-default errors @@ -67,6 +75,7 @@ mkDerivation { http-client-tls http-types imports + memory metrics-wai monad-control prometheus-client @@ -89,6 +98,9 @@ mkDerivation { testHaskellDepends = [ aeson base + bytestring + crypton-pem + crypton-x509 hspec imports string-conversions diff --git a/libs/extended/extended.cabal b/libs/extended/extended.cabal index 3828324caa2..980338c38a7 100644 --- a/libs/extended/extended.cabal +++ b/libs/extended/extended.cabal @@ -28,6 +28,7 @@ library -- cabal-fmt: expand src exposed-modules: Data.Time.Clock.DiffTime + Data.X509.Extended Hasql.Pool.Extended Network.AMQP.Extended Network.RabbitMqAdmin @@ -88,11 +89,14 @@ library build-depends: aeson , amqp + , asn1-types , base , bytestring , cassandra-util , containers + , crypton , crypton-connection + , crypton-x509 , crypton-x509-store , data-default , errors @@ -103,6 +107,7 @@ library , http-client-tls , http-types , imports + , memory , metrics-wai , monad-control , prometheus-client @@ -129,6 +134,7 @@ test-suite extended-tests main-is: Spec.hs other-modules: Paths_extended + Test.Data.X509.ExtendedSpec Test.System.Logger.ExtendedSpec hs-source-dirs: test @@ -186,6 +192,9 @@ test-suite extended-tests build-depends: aeson , base + , bytestring + , crypton-pem + , crypton-x509 , extended , hspec , imports diff --git a/libs/extended/src/Data/X509/Extended.hs b/libs/extended/src/Data/X509/Extended.hs new file mode 100644 index 00000000000..964c2ee3028 --- /dev/null +++ b/libs/extended/src/Data/X509/Extended.hs @@ -0,0 +1,53 @@ +module Data.X509.Extended (certToString) where + +import Crypto.Hash +import Data.ASN1.OID +import Data.ASN1.Types +import Data.ByteArray.Encoding qualified as BAE +import Data.Map qualified as Map +import Data.Text qualified as T +import Data.Text.Encoding qualified as T +import Data.X509 +import Imports + +certToString :: SignedCertificate -> String +certToString signedCert = + let cert = getCertificate signedCert + issuer = dnToString $ certIssuerDN cert + subject = dnToString $ certSubjectDN cert + der = encodeSignedObject signedCert + fingerprint :: ByteString = BAE.convertToBase BAE.Base16 (hash der :: Digest SHA1) + -- Split into pairs and join with ':' + fingerprintStr = + let hex = (T.decodeUtf8 fingerprint) + pairs = T.unpack <$> T.chunksOf 2 hex + in map toUpper (intercalate ":" pairs) + in mconcat . intersperse "; " $ + [ "Issuer: " <> issuer, + "Subject: " <> subject, + "SHA1 Fingerprint: " <> fingerprintStr + ] + +dnToString :: DistinguishedName -> String +dnToString (getDistinguishedElements -> es) = + let dess :: [String] = mapMaybe distinguishedElementString es + in mconcat $ intersperse "," dess + where + distinguishedElementString :: (OID, ASN1CharacterString) -> Maybe String + distinguishedElementString (oid, aSN1CharacterString) = do + (_element, desc) <- Map.lookup oid dnElementMap + val <- asn1CharacterToString aSN1CharacterString + pure $ desc <> "=" <> val + + dnElementMap :: Map OID (DnElement, String) + dnElementMap = + Map.fromList + [ (mkEntry DnCommonName "CN"), + (mkEntry DnCountry "Country"), + (mkEntry DnOrganization "O"), + (mkEntry DnOrganizationUnit "OU"), + (mkEntry DnEmailAddress "Email Address") + ] + where + mkEntry :: DnElement -> String -> (OID, (DnElement, String)) + mkEntry e s = (getObjectID e, (e, s)) diff --git a/libs/extended/test/Test/Data/X509/ExtendedSpec.hs b/libs/extended/test/Test/Data/X509/ExtendedSpec.hs new file mode 100644 index 00000000000..21d5316799e --- /dev/null +++ b/libs/extended/test/Test/Data/X509/ExtendedSpec.hs @@ -0,0 +1,36 @@ +module Test.Data.X509.ExtendedSpec where + +import Data.ByteString qualified as BS +import Data.PEM +import Data.String.Conversions +import Data.X509 +import Data.X509.Extended +import Imports +import Test.Hspec + +spec :: Spec +spec = + describe "Data.X509.Extended" $ do + describe "certToString" $ do + it "should render a representative string of a certificate from stars' Keycloak" $ do + let pemFilePath = "test/data/" <> "sven-test.pem" + expected = "Issuer: CN=sven-test; Subject: CN=sven-test; SHA1 Fingerprint: F4:A2:73:D7:B7:2E:EA:66:E1:CB:81:E9:58:BC:1A:E9:CF:3C:95:C4" + checkDecodingWithPEMFile pemFilePath expected + + it "should render a representative string of a certificate from unit test data (saml2-web-sso)" $ do + let pemFilePath = "test/data/" <> "test-cert.pem" + expected = "Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + checkDecodingWithPEMFile pemFilePath expected + +checkDecodingWithPEMFile :: FilePath -> String -> IO () +checkDecodingWithPEMFile pemFilePath expected = do + -- sanity check if the file even exists + exists <- doesFileExist pemFilePath + exists `shouldBe` True + + file <- BS.readFile pemFilePath + let decoded :: SignedCertificate = either error id $ do + pemBS <- pemContent . fromMaybe (error "Empty PEM list") . listToMaybe <$> pemParseBS file + decodeSignedCertificate pemBS + + certToString decoded `shouldBe` expected diff --git a/libs/extended/test/data/sven-test.pem b/libs/extended/test/data/sven-test.pem new file mode 100644 index 00000000000..cabff319600 --- /dev/null +++ b/libs/extended/test/data/sven-test.pem @@ -0,0 +1,3 @@ +-----BEGIN CERTIFICATE----- +MIICoTCCAYkCBgGaxY9gbjANBgkqhkiG9w0BAQsFADAUMRIwEAYDVQQDDAlzdmVuLXRlc3QwHhcNMjUxMTI3MTM0MzE5WhcNMzUxMTI3MTM0NDU5WjAUMRIwEAYDVQQDDAlzdmVuLXRlc3QwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCVkM30EqGkdEIjF6ZDzS7mEMtsHmEXXT6bzkrOddzz8fKmle2tb6Rn7uI/pkfbTdMXKlaPQohDSed5907xn3v8TAHc/FA9lf3Mo+o7pl/aQlEHm9RedNnm1DRiuH/zZx60e6ctVFqYu4sTwJxGnM81ojrrQRXU+u4FEnAh0p1aUvXG+3iCz0NHRErYxzYLvnLSziQg70yO1qlxy/K+M04gNKe7ZGxeZbu56ysllWUhrysvGg4/rp3iu4OTb8N5U+iH0ZSDcrUUeOJP2sSNRVYr4cgkcLDI+npr8WmqfqWgc+yRQ9iPAuNYi+nE9aB4ZXf7SyAGs5gmJtT6Cm4hoUa5AgMBAAEwDQYJKoZIhvcNAQELBQADggEBAGfKx/PeiFgLStaPlN+9n7+hW/iy50qhLDtEPuXA3m1XnBLO8sB7ebyJVL1QvO33A3MQdJi1E8R1uQd7ompuQ0+62vAe/bX/EZEzbwMHyM26F+r18BJKf3Dla6ot1CKnVIJuocc9qbuhkeTaeCkFF1HyvnlN/i/oMa+KwK0OP6GRkFG/m53biq9p+jbdKK2/fVvDklt5Vma6sp6KG1HhFJQMaeL/hGGelzS84qL7H9+eSBu5krCZBLfx4L88poDiY3JudM0tS6Kzj8IFDNspXRxHy8sacWn/8ulMVXGEQhw3+u5jN/yCxkxogFg7bE9uR5JhbkZ4J7X6J9uEaU/Sobo= +-----END CERTIFICATE----- diff --git a/libs/extended/test/data/test-cert.pem b/libs/extended/test/data/test-cert.pem new file mode 100644 index 00000000000..ff32fa80286 --- /dev/null +++ b/libs/extended/test/data/test-cert.pem @@ -0,0 +1,4 @@ +-----BEGIN CERTIFICATE----- +MIIDBTCCAe2gAwIBAgIQev76BWqjWZxChmKkGqoAfDANBgkqhkiG9w0BAQsFADAtMSswKQYDVQQDEyJhY2NvdW50cy5hY2Nlc3Njb250cm9sLndpbmRvd3MubmV0MB4XDTE4MDIxODAwMDAwMFoXDTIwMDIxOTAwMDAwMFowLTErMCkGA1UEAxMiYWNjb3VudHMuYWNjZXNzY29udHJvbC53aW5kb3dzLm5ldDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMgmGiRfLh6Fdi99XI2VA3XKHStWNRLEy5Aw/gxFxchnh2kPdk/bejFOs2swcx7yUWqxujjCNRsLBcWfaKUlTnrkY7i9x9noZlMrijgJy/Lk+HH5HX24PQCDf+twjnHHxZ9G6/8VLM2e5ZBeZm+t7M3vhuumEHG3UwloLF6cUeuPdW+exnOB1U1fHBIFOG8ns4SSIoq6zw5rdt0CSI6+l7b1DEjVvPLtJF+zyjlJ1Qp7NgBvAwdiPiRMU4l8IRVbuSVKoKYJoyJ4L3eXsjczoBSTJ6VjV2mygz96DC70MY3avccFrk7tCEC6ZlMRBfY1XPLyldT7tsR3EuzjecSa1M8CAwEAAaMhMB8wHQYDVR0OBBYEFIks1srixjpSLXeiR8zES5cTY6fBMA0GCSqGSIb3DQEBCwUAA4IBAQCKthfK4C31DMuDyQZVS3F7+4Evld3hjiwqu2uGDK+qFZas/D/eDunxsFpiwqC01RIMFFN8yvmMjHphLHiBHWxcBTS+tm7AhmAvWMdxO5lzJLS+UWAyPF5ICROe8Mu9iNJiO5JlCo0Wpui9RbB1C81Xhax1gWHK245ESL6k7YWvyMYWrGqr1NuQcNS0B/AIT1Nsj1WY7efMJQOmnMHkPUTWryVZlthijYyd7P2Gz6rY5a81DAFqhDNJl2pGIAE6HWtSzeUEh3jCsHEkoglKfm4VrGJEuXcALmfCMbdfTvtu4rlsaP2hQad+MG/KJFlenoTK34EMHeBPDCpqNDz8UVNk +-----END CERTIFICATE----- + diff --git a/libs/http2-manager/default.nix b/libs/http2-manager/default.nix index 782b3605f14..1a41e8ebacf 100644 --- a/libs/http2-manager/default.nix +++ b/libs/http2-manager/default.nix @@ -17,6 +17,7 @@ , network , random , stm +, stm-containers , streaming-commons , text , time-manager @@ -34,6 +35,7 @@ mkDerivation { http2 network stm + stm-containers streaming-commons text time-manager @@ -50,6 +52,7 @@ mkDerivation { network random stm + stm-containers streaming-commons time-manager ]; diff --git a/libs/http2-manager/http2-manager.cabal b/libs/http2-manager/http2-manager.cabal index 87d6d58241e..28b03b783bd 100644 --- a/libs/http2-manager/http2-manager.cabal +++ b/libs/http2-manager/http2-manager.cabal @@ -50,6 +50,7 @@ library , http2 , network , stm + , stm-containers , streaming-commons , text , time-manager @@ -95,5 +96,6 @@ test-suite http2-manager-tests , network , random , stm + , stm-containers , streaming-commons , time-manager diff --git a/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs b/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs index 5de12d91da9..a892452026c 100644 --- a/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs +++ b/libs/http2-manager/src/HTTP2/Client/Manager/Internal.hs @@ -48,6 +48,7 @@ import qualified Network.HTTP2.Client as HTTP2 import qualified Network.HTTP2.Client.Internal as HTTP2 import qualified Network.Socket as NS import qualified OpenSSL.Session as SSL +import qualified StmContainers.Map as StmMap import System.IO.Error import qualified System.TimeManager import System.Timeout @@ -95,7 +96,7 @@ data Request = Request -- HTTP1. I think HTTP1 vs HTTP2 can not be negotated without TLS, so perhaps -- this manager will default to HTTP2. data Http2Manager = Http2Manager - { connections :: TVar (Map Target HTTP2Conn), + { connections :: StmMap.Map Target HTTP2Conn, cacheLimit :: Int, -- | In microseconds, defaults to 30s tcpConnectionTimeout :: Int, @@ -118,7 +119,7 @@ defaultHttp2Manager = do http2ManagerWithSSLCtx :: SSL.SSLContext -> IO Http2Manager http2ManagerWithSSLCtx sslContext = do - connections <- newTVarIO mempty + connections <- StmMap.newIO let cacheLimit = 20 tcpConnectionTimeout = 30_000_000 sslRemoveTrailingDot = False @@ -234,10 +235,11 @@ getOrMakeConnection mgr@Http2Manager {..} target = do -- leak. insertNewConn :: HTTP2Conn -> STM (Bool, HTTP2Conn) insertNewConn newConn = do - stateTVar connections $ \conns -> - case Map.lookup target conns of - Nothing -> ((True, newConn), Map.insert target newConn conns) - Just alreadyEstablishedConn -> ((False, alreadyEstablishedConn), conns) + StmMap.lookup target connections >>= \case + Just existing -> pure (False, existing) + Nothing -> do + StmMap.insert newConn target connections + pure (True, newConn) connect :: IO HTTP2Conn connect = do @@ -256,8 +258,7 @@ getOrMakeConnection mgr@Http2Manager {..} target = do -- | Removes connection from map if it is not alive anymore getConnection :: Http2Manager -> Target -> STM (Maybe HTTP2Conn) getConnection mgr target = do - conns <- readTVar (connections mgr) - case Map.lookup target conns of + StmMap.lookup target (connections mgr) >>= \case Nothing -> pure Nothing Just conn -> -- If there is a connection for the target, ensure that it is alive @@ -269,7 +270,7 @@ getConnection mgr target = do -- recieve here. But logging in STM will be tricky, and the threads -- running requests on the connection which got an exception would've -- anyway recieved the exception, so maybe it is not as valueable. - writeTVar (connections mgr) $ Map.delete target conns + StmMap.delete target (connections mgr) pure Nothing -- | Disconnects HTTP2 connection if there exists one. Will hang around until @@ -284,7 +285,7 @@ disconnectTarget mgr target = do Just conn -> do disconnect conn wait (backgroundThread conn) - `finally` (atomically . modifyTVar' (connections mgr) $ Map.delete target) + `finally` atomically (StmMap.delete target (connections mgr)) -- | Disconnects HTTP2 connection if there exists one. If the background thread -- running the connection does not finish within 1 second, it is canceled. @@ -313,7 +314,7 @@ disconnectTargetWithTimeout mgr target microSeconds = do void $ waitAnyCatchCancel [waitOneSec, backgroundThread conn] waitWithTimeout - `finally` (atomically . modifyTVar' (connections mgr) $ Map.delete target) + `finally` atomically (StmMap.delete target (connections mgr)) startPersistentHTTP2Connection :: SSL.SSLContext -> diff --git a/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs b/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs index 15b99661f20..ceb17810129 100644 --- a/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs +++ b/libs/http2-manager/test/Test/HTTP2/Client/ManagerSpec.hs @@ -56,6 +56,7 @@ import qualified Network.HTTP2.Server.Internal as Server import Network.Socket import qualified Network.Socket as NS import qualified OpenSSL.Session as SSL +import qualified StmContainers.Map as StmMap import System.Random (randomRIO) import qualified System.TimeManager import Test.Hspec @@ -201,7 +202,7 @@ specTemplate mCtx = do Just deadConn <- withTestServer mCtx $ \TestServer {..} -> do echoTest mgr (isJust mCtx) serverPort readIORef acceptedConns `shouldReturn` 1 - Map.lookup (isJust mCtx, "localhost", serverPort) <$> readTVarIO (connections mgr) + atomically $ StmMap.lookup (isJust mCtx, "localhost", serverPort) (connections mgr) let brokenRequest = sendRequestWithConnection deadConn (Client.requestBuilder "GET" "/echo" [] "some body") $ \_ -> do expectationFailure "Expected no response when request is made to a dead server" @@ -222,7 +223,8 @@ specTemplate mCtx = do -- See "should fail with appropriate error when a dead connection is used" -- to know what happens when we don't wait for the background thread to go -- away. - Just deadConn <- Map.lookup (isJust mCtx, "localhost", port) <$> readTVarIO (connections mgr) + Just deadConn <- + atomically $ StmMap.lookup (isJust mCtx, "localhost", port) (connections mgr) void $ waitCatch $ backgroundThread deadConn withTestServerOnPort mCtx port $ \TestServer {..} -> do diff --git a/libs/jwt-tools/default.nix b/libs/jwt-tools/default.nix index 26a5f5f455d..2a8caa3f5aa 100644 --- a/libs/jwt-tools/default.nix +++ b/libs/jwt-tools/default.nix @@ -28,7 +28,12 @@ mkDerivation { utf8-string ]; librarySystemDepends = [ rusty_jwt_tools_ffi ]; - testHaskellDepends = [ hspec imports string-conversions ]; + testHaskellDepends = [ + 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 4cc7800ef9d..5e98d6fe329 100644 --- a/libs/jwt-tools/jwt-tools.cabal +++ b/libs/jwt-tools/jwt-tools.cabal @@ -84,6 +84,7 @@ test-suite jwt-tools-tests , imports , jwt-tools , string-conversions + , transformers hs-source-dirs: test default-language: GHC2021 diff --git a/libs/jwt-tools/src/Data/Jwt/Tools.hs b/libs/jwt-tools/src/Data/Jwt/Tools.hs index 777485f6426..4ffc885320f 100644 --- a/libs/jwt-tools/src/Data/Jwt/Tools.hs +++ b/libs/jwt-tools/src/Data/Jwt/Tools.hs @@ -72,8 +72,6 @@ type MaxSkewSecsWord16 = Word16 type ExpiryEpochWord64 = Word64 -type EpochWord64 = Word64 - type BackendBundleCStr = CString type DisplayNameCStr = CString @@ -92,7 +90,6 @@ foreign import ccall unsafe "generate_dpop_access_token" MethodCStr -> MaxSkewSecsWord16 -> ExpiryEpochWord64 -> - EpochWord64 -> BackendBundleCStr -> IO (Ptr HsResult) @@ -115,11 +112,10 @@ generateDpopAccessTokenFfi :: MethodCStr -> MaxSkewSecsWord16 -> ExpiryEpochWord64 -> - EpochWord64 -> BackendBundleCStr -> IO (Maybe (Ptr HsResult)) -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 +generateDpopAccessTokenFfi dpopProof user client handle displayName tid domain nonce uri method maxSkewSecs expiration backendKeys = do + ptr <- generate_dpop_access_token dpopProof user client handle displayName tid domain nonce uri method maxSkewSecs expiration backendKeys if ptr /= nullPtr then pure $ Just ptr else pure Nothing @@ -152,10 +148,9 @@ generateDpopToken :: StdMethod -> MaxSkewSecs -> ExpiryEpoch -> - NowEpoch -> PemBundle -> ExceptT DPoPTokenGenerationError m ByteString -generateDpopToken dpopProof uid cid handle displayName tid domain nonce uri method maxSkewSecs maxExpiration now backendPubkeyBundle = do +generateDpopToken dpopProof uid cid handle displayName tid domain nonce uri method maxSkewSecs maxExpiration backendPubkeyBundle = do dpopProofCStr <- toCStr dpopProof uidCStr <- toCStr uid handleCStr <- toCStr handle @@ -181,7 +176,6 @@ generateDpopToken dpopProof uid cid handle displayName tid domain nonce uri meth methodCStr (_unMaxSkewSecs maxSkewSecs) (_unExpiryEpoch maxExpiration) - (_unNowEpoch now) backendPubkeyBundleCStr let mkAccessToken response = do diff --git a/libs/jwt-tools/test/Spec.hs b/libs/jwt-tools/test/Spec.hs index 03c9e53ba79..4e28225cbf4 100644 --- a/libs/jwt-tools/test/Spec.hs +++ b/libs/jwt-tools/test/Spec.hs @@ -15,6 +15,7 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . +import Control.Monad.Trans.Except import Data.Jwt.Tools import Data.String.Conversions import Imports @@ -24,68 +25,130 @@ main :: IO () main = hspec $ do describe "toResult" $ do it "should convert to correct error" $ do - toResult Nothing (Just token) `shouldBe` Right (cs token) + toResult Nothing (Just emptyToken) `shouldBe` Right (cs emptyToken) toResult (Just 1) Nothing `shouldBe` Left UnknownError - toResult (Just 1) (Just token) `shouldBe` Left UnknownError + toResult (Just 1) (Just emptyToken) `shouldBe` Left UnknownError toResult (Just 2) Nothing `shouldBe` Left FfiError - toResult (Just 2) (Just token) `shouldBe` Left FfiError + toResult (Just 2) (Just emptyToken) `shouldBe` Left FfiError toResult (Just 3) Nothing `shouldBe` Left ImplementationError - toResult (Just 3) (Just token) `shouldBe` Left ImplementationError + toResult (Just 3) (Just emptyToken) `shouldBe` Left ImplementationError toResult (Just 4) Nothing `shouldBe` Left DpopSyntaxError - toResult (Just 4) (Just token) `shouldBe` Left DpopSyntaxError + toResult (Just 4) (Just emptyToken) `shouldBe` Left DpopSyntaxError toResult (Just 5) Nothing `shouldBe` Left DpopTypError - toResult (Just 5) (Just token) `shouldBe` Left DpopTypError + toResult (Just 5) (Just emptyToken) `shouldBe` Left DpopTypError toResult (Just 6) Nothing `shouldBe` Left DpopUnsupportedAlgorithmError - toResult (Just 6) (Just token) `shouldBe` Left DpopUnsupportedAlgorithmError + toResult (Just 6) (Just emptyToken) `shouldBe` Left DpopUnsupportedAlgorithmError toResult (Just 7) Nothing `shouldBe` Left DpopInvalidSignatureError - toResult (Just 7) (Just token) `shouldBe` Left DpopInvalidSignatureError + toResult (Just 7) (Just emptyToken) `shouldBe` Left DpopInvalidSignatureError toResult (Just 8) Nothing `shouldBe` Left ClientIdMismatchError - toResult (Just 8) (Just token) `shouldBe` Left ClientIdMismatchError + toResult (Just 8) (Just emptyToken) `shouldBe` Left ClientIdMismatchError toResult (Just 9) Nothing `shouldBe` Left BackendNonceMismatchError - toResult (Just 9) (Just token) `shouldBe` Left BackendNonceMismatchError + toResult (Just 9) (Just emptyToken) `shouldBe` Left BackendNonceMismatchError toResult (Just 10) Nothing `shouldBe` Left HtuMismatchError - toResult (Just 10) (Just token) `shouldBe` Left HtuMismatchError + toResult (Just 10) (Just emptyToken) `shouldBe` Left HtuMismatchError toResult (Just 11) Nothing `shouldBe` Left HtmMismatchError - toResult (Just 11) (Just token) `shouldBe` Left HtmMismatchError + toResult (Just 11) (Just emptyToken) `shouldBe` Left HtmMismatchError toResult (Just 12) Nothing `shouldBe` Left MissingJtiError - toResult (Just 12) (Just token) `shouldBe` Left MissingJtiError + toResult (Just 12) (Just emptyToken) `shouldBe` Left MissingJtiError toResult (Just 13) Nothing `shouldBe` Left MissingChallengeError - toResult (Just 13) (Just token) `shouldBe` Left MissingChallengeError + toResult (Just 13) (Just emptyToken) `shouldBe` Left MissingChallengeError toResult (Just 14) Nothing `shouldBe` Left MissingIatError - toResult (Just 14) (Just token) `shouldBe` Left MissingIatError + toResult (Just 14) (Just emptyToken) `shouldBe` Left MissingIatError toResult (Just 15) Nothing `shouldBe` Left IatError - toResult (Just 15) (Just token) `shouldBe` Left IatError + toResult (Just 15) (Just emptyToken) `shouldBe` Left IatError toResult (Just 16) Nothing `shouldBe` Left MissingExpError - toResult (Just 16) (Just token) `shouldBe` Left MissingExpError + toResult (Just 16) (Just emptyToken) `shouldBe` Left MissingExpError toResult (Just 17) Nothing `shouldBe` Left ExpMismatchError - toResult (Just 17) (Just token) `shouldBe` Left ExpMismatchError + toResult (Just 17) (Just emptyToken) `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 (Just 18) (Just emptyToken) `shouldBe` Left Expired + toResult (Just 19) (Just emptyToken) `shouldBe` Left InvalidUserId + toResult (Just 20) (Just emptyToken) `shouldBe` Left NotYetValid + toResult (Just 21) (Just emptyToken) `shouldBe` Left JwtSimpleError + toResult (Just 22) (Just emptyToken) `shouldBe` Left RandError + toResult (Just 23) (Just emptyToken) `shouldBe` Left Sec1Error + toResult (Just 24) (Just emptyToken) `shouldBe` Left UrlParseError + toResult (Just 25) (Just emptyToken) `shouldBe` Left UuidError + toResult (Just 26) (Just emptyToken) `shouldBe` Left Utf8Error + toResult (Just 27) (Just emptyToken) `shouldBe` Left Base64DecodeError + toResult (Just 28) (Just emptyToken) `shouldBe` Left JsonError + toResult (Just 29) (Just emptyToken) `shouldBe` Left InvalidJsonPath + toResult (Just 30) (Just emptyToken) `shouldBe` Left JsonPathError + toResult (Just 31) (Just emptyToken) `shouldBe` Left InvalidJwkThumbprint + toResult (Just 32) (Just emptyToken) `shouldBe` Left MissingDpopHeader + toResult (Just 33) (Just emptyToken) `shouldBe` Left MissingIssuer + toResult (Just 34) (Just emptyToken) `shouldBe` Left DpopChallengeMismatch + toResult (Just 35) (Just emptyToken) `shouldBe` Left DpopHtuMismatch + toResult (Just 36) (Just emptyToken) `shouldBe` Left DpopHtmMismatch + toResult (Just 37) (Just emptyToken) `shouldBe` Left InvalidBackendKeys + toResult (Just 38) (Just emptyToken) `shouldBe` Left InvalidClientId + toResult (Just 39) (Just emptyToken) `shouldBe` Left UnsupportedApiVersion + toResult (Just 40) (Just emptyToken) `shouldBe` Left UnsupportedScope + toResult (Just 41) (Just emptyToken) `shouldBe` Left DpopHandleMismatch + toResult (Just 42) (Just emptyToken) `shouldBe` Left DpopTeamMismatch + toResult (Just 43) (Just emptyToken) `shouldBe` Left DpopDisplayNameMismatch toResult Nothing Nothing `shouldBe` Left UnknownError + describe "generateDpopToken" $ do + -- These two tests are ported from `rusty-jwt-tools` because they were + -- dropped there. See: + -- https://github.com/wireapp/rusty-jwt-tools/commit/e86242e8c4faf7dd77319254e2c5e2c79345a46d + it "should return an error when given wrong nonce" $ do + actual <- + runExceptT + $ generateDpopToken + proof + uid + clientId + handle + displayName + teamId + domain + (Nonce "foobar") + url + method + maxSkewSeconds + expiration + pubKeyBundle + + actual `shouldBe` Left BackendNonceMismatchError + + it "should return a valid access token" $ do + actual <- + runExceptT + $ generateDpopToken + proof + uid + clientId + handle + displayName + teamId + domain + nonce + url + method + maxSkewSeconds + expiration + pubKeyBundle + + isRight actual `shouldBe` True where - token = "" + pubKeyBundle = + PemBundle + "-----BEGIN PRIVATE KEY-----\n\ + \MIGHAgEAMBMGByqGSM49AgEGCCqGSM49AwEHBG0wawIBAQQg5i88D4XpjBudqAkS\n\ + \3r4zMK0hEXT7i+xR3PyGfrPHcqahRANCAAQ84mdGFohHioIhOG/s8S2mHNXiKzdV\n\ + \ZTvpq663q4ErPGj7OP0P7Ef1QrXvHmTDOTx5YwUJ3OAxDXDOdSkD0zPt\n\ + \-----END PRIVATE KEY-----" + clientId = ClientId 1223 + domain = Domain "example.com" + url = Uri "https://wire.example.com/client/token" + method = POST + maxSkewSeconds = MaxSkewSecs 1 + proof = Proof "eyJhbGciOiJFUzI1NiIsInR5cCI6ImRwb3Arand0IiwiandrIjp7Imt0eSI6IkVDIiwiY3J2IjoiUC0yNTYiLCJ4IjoiLUE2T3ZqNFVzRmFrbFZMUHZhZDhYNF80MXRBTW55ZnR3aGVXbnNSMzVvbyIsInkiOiI3S3E3UzQxUjh4NUVzTnVjY1J4Y3ItcjN2SWhYVmloR3BLUFAweThIczBvIn19.eyJpYXQiOjE3MjcyMTI5NDIsImV4cCI6MjA0MjU3NjU0MiwibmJmIjoxNzI3MjEyOTQyLCJzdWIiOiJ3aXJlYXBwOi8vU3ZQZkxsd0JRaS02b2RkVlJya3FwdyE0YzdAZXhhbXBsZS5jb20iLCJhdWQiOiJodHRwczovL3N0ZXBjYS9hY21lL3dpcmUvY2hhbGxlbmdlL2FhYS9iYmIiLCJqdGkiOiJlNzg1MGYxNy1jYzc3LTQ0ZmYtYThiNi0wODMyYjA1NTdkNmUiLCJub25jZSI6IldFODhFdk9CemJxR2Vyem5NKzJQL0FhZFZmNzM3NHkwY0gxOXNEU1pBMkEiLCJodG0iOiJQT1NUIiwiaHR1IjoiaHR0cHM6Ly93aXJlLmV4YW1wbGUuY29tL2NsaWVudC90b2tlbiIsImNoYWwiOiJva0FKMzNZbS9YUzJxbW1oaGg3YVdTYkJsWXk0VHRtMUV5c3FXOEkvOW5nIiwiaGFuZGxlIjoid2lyZWFwcDovLyU0MGpvaG5fZG9lQGV4YW1wbGUuY29tIiwidGVhbSI6IjZlODVlMDUzLTUzNmYtNDU4NS04ZmM4LWNhZGE4NzZlNWVjNyIsIm5hbWUiOiJKb2huIERvZSJ9.M7Zc0FIHazWbWg6PeFK1DVJoLiLeqx09Y9KQSLPgrp5DzGnvj2Gxo4z0ELwzpIUv9pfuw4f-tImRQSS7_RKmww" + uid = UserId "4af3df2e-5c01-422f-baa1-d75546b92aa7" + nonce = Nonce "WE88EvOBzbqGerznM+2P/AadVf7374y0cH19sDSZA2A" + expiration = ExpiryEpoch 2042742401 + handle = Handle "john_doe" + displayName = DisplayName "John Doe" + teamId = TeamId "6e85e053-536f-4585-8fc8-cada876e5ec7" + emptyToken = "" diff --git a/libs/types-common/src/Data/Misc.hs b/libs/types-common/src/Data/Misc.hs index 4fa162f3bf3..0bbc6d01ad4 100644 --- a/libs/types-common/src/Data/Misc.hs +++ b/libs/types-common/src/Data/Misc.hs @@ -43,6 +43,7 @@ module Data.Misc Duration (..), diffTimeParser, parseDuration, + unsafeParseDuration, durationToMicros, -- * HttpsUrl @@ -284,6 +285,13 @@ diffTimeParser = do parseDuration :: Text -> Either String Duration parseDuration = fmap Duration . Atto.parseOnly (diffTimeParser <* Atto.endOfInput) +unsafeParseDuration :: Text -> Duration +unsafeParseDuration txt = + either + (\err -> error $ "Malformed duration: " <> show txt <> " " <> err) + id + (parseDuration txt) + -- | Useful for threadDelay, timeout, etc. durationToMicros :: Duration -> Int durationToMicros = diff --git a/libs/wire-api/default.nix b/libs/wire-api/default.nix index 64df657ba5c..f0e9150c672 100644 --- a/libs/wire-api/default.nix +++ b/libs/wire-api/default.nix @@ -22,6 +22,7 @@ , case-insensitive , cassandra-util , cassava +, cborg , cereal , comonad , conduit @@ -144,6 +145,7 @@ mkDerivation { case-insensitive cassandra-util cassava + cborg cereal comonad conduit diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index d10ad9c6f0d..ff83fd26029 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -592,7 +592,7 @@ instance C.Cql Access where fromCql (C.CqlInt i) = mapLeft Text.unpack $ accessFromInt32 i fromCql _ = Left "Access value: int expected" -instance PostgresMarshall Access Int32 where +instance PostgresMarshall Int32 Access where postgresMarshall = accessToInt32 instance PostgresUnmarshall Int32 Access where @@ -677,7 +677,7 @@ instance C.Cql AccessRole where fromCql (C.CqlInt i) = mapLeft Text.unpack $ accessRoleFromInt32 i fromCql _ = Left "AccessRoleV2 value: int expected" -instance PostgresMarshall AccessRole Int32 where +instance PostgresMarshall Int32 AccessRole where postgresMarshall = accessRoleToInt32 instance PostgresUnmarshall Int32 AccessRole where @@ -792,7 +792,7 @@ instance C.Cql ConvType where fromCql (C.CqlInt i) = mapLeft Text.unpack $ convTypeFromInt32 i fromCql _ = Left "conv-type: int expected" -instance PostgresMarshall ConvType Int32 where +instance PostgresMarshall Int32 ConvType where postgresMarshall = convTypeToInt32 instance PostgresUnmarshall Int32 ConvType where @@ -834,7 +834,7 @@ instance ToSchema ReceiptMode where (S.schema . description ?~ "Conversation receipt mode") $ ReceiptMode <$> unReceiptMode .= schema -instance PostgresMarshall ReceiptMode Int32 where +instance PostgresMarshall Int32 ReceiptMode where postgresMarshall = unReceiptMode -------------------------------------------------------------------------------- @@ -859,7 +859,7 @@ instance C.Cql GroupConvType where fromCql (C.CqlInt i) = Right . toEnum . fromIntegral $ i fromCql _ = Left "GroupConvType: int expected" -instance PostgresMarshall GroupConvType Int32 where +instance PostgresMarshall Int32 GroupConvType where postgresMarshall = fromIntegral . fromEnum instance PostgresUnmarshall Int32 GroupConvType where @@ -1294,7 +1294,7 @@ instance C.Cql AddPermission where fromCql (C.CqlInt i) = Right . toEnum . fromIntegral $ i fromCql _ = Left "AddPermission: int expected" -instance PostgresMarshall AddPermission Int32 where +instance PostgresMarshall Int32 AddPermission where postgresMarshall = fromIntegral . fromEnum instance PostgresUnmarshall Int32 AddPermission where diff --git a/libs/wire-api/src/Wire/API/Conversation/Bot.hs b/libs/wire-api/src/Wire/API/Conversation/Bot.hs index aea518cfc92..a6878f3835d 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Bot.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Bot.hs @@ -33,7 +33,7 @@ import Data.Schema import Imports import Wire.API.Event.Conversation (Event) import Wire.API.Locale (Locale) -import Wire.API.User.Client.Prekey (Prekey) +import Wire.API.User.Client.Prekey (UncheckedPrekeyBundle) import Wire.API.User.Profile (Asset, ColourId, Name) import Wire.Arbitrary (Arbitrary, GenericUniform (..)) @@ -103,7 +103,7 @@ instance ToSchema RemoveBotResponse where -- UpdateBotPrekeys newtype UpdateBotPrekeys = UpdateBotPrekeys - { updateBotPrekeyList :: [Prekey] + { updateBotPrekeyList :: [UncheckedPrekeyBundle] } deriving stock (Eq, Show) deriving newtype (Arbitrary) diff --git a/libs/wire-api/src/Wire/API/Conversation/CellsState.hs b/libs/wire-api/src/Wire/API/Conversation/CellsState.hs index 63b73576ab4..b6084cb440d 100644 --- a/libs/wire-api/src/Wire/API/Conversation/CellsState.hs +++ b/libs/wire-api/src/Wire/API/Conversation/CellsState.hs @@ -58,7 +58,7 @@ instance Cql CellsState where fromCql (CqlInt i) = mapLeft Text.unpack $ cellsStateFromInt32 i fromCql _ = Left "cells_state: int expected" -instance PostgresMarshall CellsState Int32 where +instance PostgresMarshall Int32 CellsState where postgresMarshall = cellsStateToInt32 instance PostgresUnmarshall Int32 CellsState where diff --git a/libs/wire-api/src/Wire/API/Conversation/Member.hs b/libs/wire-api/src/Wire/API/Conversation/Member.hs index 22a01c38b2c..e496b1708e0 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Member.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Member.hs @@ -163,12 +163,9 @@ instance ToSchema Member where -- the server will not interpret this value in any way. newtype MutedStatus = MutedStatus {fromMutedStatus :: Int32} deriving stock (Eq, Ord, Show, Generic) - deriving newtype (Num, ToSchema, Arbitrary, C.Cql, PostgresUnmarshall Int32) + deriving newtype (Num, ToSchema, Arbitrary, C.Cql, PostgresUnmarshall Int32, PostgresMarshall Int32) deriving (FromJSON, ToJSON, S.ToSchema) via Schema MutedStatus -instance PostgresMarshall MutedStatus Int32 where - postgresMarshall = fromMutedStatus - data OtherMember = OtherMember { omQualifiedId :: Qualified UserId, omService :: Maybe ServiceRef, diff --git a/libs/wire-api/src/Wire/API/Conversation/Protocol.hs b/libs/wire-api/src/Wire/API/Conversation/Protocol.hs index aa32728e926..e41ad2f7207 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Protocol.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Protocol.hs @@ -73,7 +73,7 @@ instance C.Cql ProtocolTag where fromCql (C.CqlInt i) = mapLeft Text.unpack $ protocolTagFromInt32 i fromCql _ = Left "protocol: int expected" -instance PostgresMarshall ProtocolTag Int32 where +instance PostgresMarshall Int32 ProtocolTag where postgresMarshall = fromIntegral . fromEnum instance PostgresUnmarshall Int32 ProtocolTag where diff --git a/libs/wire-api/src/Wire/API/Conversation/Role.hs b/libs/wire-api/src/Wire/API/Conversation/Role.hs index 074dd2e742b..e6b54d5b791 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Role.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Role.hs @@ -226,7 +226,7 @@ instance FromJSON ConversationRolesList where -- expose this constructor outside of this module. newtype RoleName = RoleName {fromRoleName :: Text} deriving stock (Eq, Ord, Show, Generic) - deriving newtype (ToByteString, Hashable, Cql, PostgresUnmarshall Text) + deriving newtype (ToByteString, Hashable, Cql, PostgresUnmarshall Text, PostgresMarshall Text) deriving (FromJSON, ToJSON, S.ToSchema) via Schema RoleName instance ToSchema RoleName where @@ -242,9 +242,6 @@ instance ToSchema RoleName where instance FromByteString RoleName where parser = parser >>= maybe (fail "Invalid RoleName") pure . parseRoleName -instance PostgresMarshall RoleName Text where - postgresMarshall = fromRoleName - instance Arbitrary RoleName where arbitrary = RoleName . fromRange diff --git a/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs b/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs index 71574971db5..f4914b00652 100644 --- a/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs +++ b/libs/wire-api/src/Wire/API/MLS/CipherSuite.hs @@ -157,7 +157,7 @@ instance C.Cql CipherSuiteTag where fromCql (CqlInt index) = first Text.unpack $ cipherSuiteTagFromInt32 index fromCql _ = Left "CipherSuiteTag: int expected" -instance PostgresMarshall CipherSuiteTag Int32 where +instance PostgresMarshall Int32 CipherSuiteTag where postgresMarshall = cipherSuitTagToInt32 instance PostgresUnmarshall Int32 CipherSuiteTag where diff --git a/libs/wire-api/src/Wire/API/MLS/CommitBundle.hs b/libs/wire-api/src/Wire/API/MLS/CommitBundle.hs index 2307f8ac38b..699321022d9 100644 --- a/libs/wire-api/src/Wire/API/MLS/CommitBundle.hs +++ b/libs/wire-api/src/Wire/API/MLS/CommitBundle.hs @@ -29,14 +29,16 @@ import Wire.API.MLS.Welcome data CommitBundle = CommitBundle { commitMsg :: RawMLS Message, welcome :: Maybe (RawMLS Welcome), - groupInfo :: RawMLS GroupInfo + groupInfo :: RawMLS GroupInfo, + appMessage :: Maybe (RawMLS Message) } deriving stock (Eq, Show, Generic) data CommitBundleF f = CommitBundleF { commitMsg :: f (RawMLS Message), welcome :: f (RawMLS Welcome), - groupInfo :: f (RawMLS GroupInfo) + groupInfo :: f (RawMLS GroupInfo), + appMessage :: f (RawMLS Message) } deriving instance Show (CommitBundleF []) @@ -47,9 +49,10 @@ instance (Alternative f) => Semigroup (CommitBundleF f) where (cb1.commitMsg <|> cb2.commitMsg) (cb1.welcome <|> cb2.welcome) (cb1.groupInfo <|> cb2.groupInfo) + (cb1.appMessage <|> cb2.appMessage) instance (Alternative f) => Monoid (CommitBundleF f) where - mempty = CommitBundleF empty empty empty + mempty = CommitBundleF empty empty empty empty checkCommitBundleF :: CommitBundleF [] -> Either Text CommitBundle checkCommitBundleF cb = @@ -57,6 +60,7 @@ checkCommitBundleF cb = <$> check "commit" cb.commitMsg <*> checkOpt "welcome" cb.welcome <*> check "group info" cb.groupInfo + <*> checkOpt "application message" cb.appMessage where check :: Text -> [a] -> Either Text a check _ [x] = pure x @@ -71,10 +75,11 @@ checkCommitBundleF cb = findMessageInStream :: (Alternative f) => RawMLS Message -> Either Text (CommitBundleF f) findMessageInStream msg = case msg.value.content of MessagePublic mp -> case mp.content.value.content of - FramedContentCommit _ -> pure (CommitBundleF (pure msg) empty empty) - _ -> Left "unexpected public message" - MessageWelcome w -> pure (CommitBundleF empty (pure w) empty) - MessageGroupInfo gi -> pure (CommitBundleF empty empty (pure gi)) + FramedContentCommit _ -> pure (CommitBundleF (pure msg) empty empty empty) + _ -> Left "unexpected proposal" + MessageWelcome w -> pure (CommitBundleF empty (pure w) empty empty) + MessageGroupInfo gi -> pure (CommitBundleF empty empty (pure gi) empty) + MessagePrivate _ -> pure (CommitBundleF empty empty empty (pure msg)) _ -> Left "unexpected message type" findMessagesInStream :: (Alternative f) => [RawMLS Message] -> Either Text (CommitBundleF f) @@ -91,6 +96,7 @@ instance SerialiseMLS CommitBundle where serialiseMLS cb.commitMsg traverse_ (serialiseMLS . mkMessage . MessageWelcome) cb.welcome serialiseMLS $ mkMessage (MessageGroupInfo cb.groupInfo) + traverse_ serialiseMLS cb.appMessage instance S.ToSchema CommitBundle where declareNamedSchema _ = pure (mlsSwagger "CommitBundle") diff --git a/libs/wire-api/src/Wire/API/MLS/Epoch.hs b/libs/wire-api/src/Wire/API/MLS/Epoch.hs index 68430c6e4e6..364fd2337c9 100644 --- a/libs/wire-api/src/Wire/API/MLS/Epoch.hs +++ b/libs/wire-api/src/Wire/API/MLS/Epoch.hs @@ -51,7 +51,7 @@ instance C.Cql Epoch where fromCql (C.CqlBigInt n) = pure (Epoch (fromIntegral n)) fromCql _ = Left "epoch: bigint expected" -instance PostgresMarshall Epoch Int64 where +instance PostgresMarshall Int64 Epoch where postgresMarshall = fromIntegral . epochNumber instance PostgresUnmarshall Int64 Epoch where diff --git a/libs/wire-api/src/Wire/API/MLS/Group.hs b/libs/wire-api/src/Wire/API/MLS/Group.hs index 26e01397faf..050b203630a 100644 --- a/libs/wire-api/src/Wire/API/MLS/Group.hs +++ b/libs/wire-api/src/Wire/API/MLS/Group.hs @@ -32,7 +32,7 @@ import Wire.Arbitrary newtype GroupId = GroupId {unGroupId :: ByteString} deriving (Eq, Show, Generic, Ord) - deriving newtype (PostgresUnmarshall ByteString) + deriving newtype (PostgresUnmarshall ByteString, PostgresMarshall ByteString) deriving (Arbitrary) via (GenericUniform GroupId) deriving (FromHttpApiData, ToHttpApiData, S.ToParamSchema) via Base64ByteString deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema GroupId) @@ -60,9 +60,6 @@ instance C.Cql GroupId where fromCql (C.CqlBlob b) = Right . GroupId . LBS.toStrict $ b fromCql _ = Left "group_id: blob expected" -instance PostgresMarshall GroupId ByteString where - postgresMarshall = unGroupId - newtype GroupIdGen = GroupIdGen {unGroupIdGen :: Word32} deriving (Eq, Show, Generic, Ord) deriving (Arbitrary) via (GenericUniform GroupIdGen) diff --git a/libs/wire-api/src/Wire/API/MLS/GroupInfo.hs b/libs/wire-api/src/Wire/API/MLS/GroupInfo.hs index edba7c2650a..57b73842f3a 100644 --- a/libs/wire-api/src/Wire/API/MLS/GroupInfo.hs +++ b/libs/wire-api/src/Wire/API/MLS/GroupInfo.hs @@ -131,7 +131,7 @@ instance HasField "signer" GroupInfo Word32 where newtype GroupInfoData = GroupInfoData {unGroupInfoData :: ByteString} deriving stock (Eq, Ord, Show) - deriving newtype (Arbitrary) + deriving newtype (Arbitrary, PostgresMarshall ByteString, PostgresUnmarshall ByteString) instance ParseMLS GroupInfoData where parseMLS = GroupInfoData . LBS.toStrict <$> getRemainingLazyByteString @@ -148,9 +148,3 @@ instance C.Cql GroupInfoData where toCql = C.CqlBlob . LBS.fromStrict . unGroupInfoData fromCql (C.CqlBlob b) = Right $ GroupInfoData (LBS.toStrict b) fromCql _ = Left "GroupInfoData: blob expected" - -instance PostgresMarshall GroupInfoData ByteString where - postgresMarshall = unGroupInfoData - -instance PostgresUnmarshall ByteString GroupInfoData where - postgresUnmarshall = Right . GroupInfoData diff --git a/libs/wire-api/src/Wire/API/MLS/Message.hs b/libs/wire-api/src/Wire/API/MLS/Message.hs index cb1003ab8fe..644e2743d45 100644 --- a/libs/wire-api/src/Wire/API/MLS/Message.hs +++ b/libs/wire-api/src/Wire/API/MLS/Message.hs @@ -76,7 +76,8 @@ data Message = Message { protocolVersion :: ProtocolVersion, content :: MessageContent } - deriving (Eq, Show) + deriving (Eq, Show, Generic) + deriving (Arbitrary) via GenericUniform Message mkMessage :: MessageContent -> Message mkMessage = Message defaultProtocolVersion @@ -102,7 +103,8 @@ data MessageContent | MessageWelcome (RawMLS Welcome) | MessageGroupInfo (RawMLS GroupInfo) | MessageKeyPackage (RawMLS KeyPackage) - deriving (Eq, Show) + deriving (Eq, Show, Generic) + deriving (Arbitrary) via GenericUniform MessageContent instance HasField "wireFormat" MessageContent WireFormatTag where getField (MessagePrivate _) = WireFormatPrivateTag @@ -148,7 +150,8 @@ data PublicMessage = PublicMessage -- https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-6.2-4 membershipTag :: Maybe ByteString } - deriving (Eq, Show) + deriving (Eq, Show, Generic) + deriving (Arbitrary) via GenericUniform PublicMessage instance ParseMLS PublicMessage where parseMLS = do @@ -179,7 +182,8 @@ data PrivateMessage = PrivateMessage encryptedSenderData :: ByteString, ciphertext :: ByteString } - deriving (Eq, Show) + deriving (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform PrivateMessage) instance ParseMLS PrivateMessage where parseMLS = @@ -191,6 +195,15 @@ instance ParseMLS PrivateMessage where <*> parseMLSBytes @VarInt <*> parseMLSBytes @VarInt +instance SerialiseMLS PrivateMessage where + serialiseMLS msg = do + serialiseMLS msg.groupId + serialiseMLS msg.epoch + serialiseMLS msg.tag + serialiseMLSBytes @VarInt msg.authenticatedData + serialiseMLSBytes @VarInt msg.encryptedSenderData + serialiseMLSBytes @VarInt msg.ciphertext + -- | https://messaginglayersecurity.rocks/mls-protocol/draft-ietf-mls-protocol-20/draft-ietf-mls-protocol.html#section-6-4 data SenderTag = SenderMemberTag @@ -242,7 +255,8 @@ data FramedContent = FramedContent authenticatedData :: ByteString, content :: FramedContentData } - deriving (Eq, Show) + deriving (Eq, Show, Generic) + deriving (Arbitrary) via GenericUniform FramedContent instance ParseMLS FramedContent where parseMLS = @@ -265,7 +279,8 @@ data FramedContentDataTag = FramedContentApplicationDataTag | FramedContentProposalTag | FramedContentCommitTag - deriving (Enum, Bounded, Eq, Ord, Show) + deriving (Enum, Bounded, Eq, Ord, Show, Generic) + deriving (Arbitrary) via (GenericUniform FramedContentDataTag) instance ParseMLS FramedContentDataTag where parseMLS = parseMLSEnum @Word8 "ContentType" @@ -278,7 +293,8 @@ data FramedContentData = FramedContentApplicationData ByteString | FramedContentProposal (RawMLS Proposal) | FramedContentCommit (RawMLS Commit) - deriving (Eq, Show) + deriving (Eq, Show, Generic) + deriving (Arbitrary) via GenericUniform FramedContentData framedContentDataTag :: FramedContentData -> FramedContentDataTag framedContentDataTag (FramedContentApplicationData _) = FramedContentApplicationDataTag @@ -326,7 +342,8 @@ data FramedContentAuthData = FramedContentAuthData -- Present iff it is part of a commit. confirmationTag :: Maybe ByteString } - deriving (Eq, Show) + deriving (Eq, Show, Generic) + deriving (Arbitrary) via GenericUniform FramedContentAuthData parseFramedContentAuthData :: FramedContentDataTag -> Get FramedContentAuthData parseFramedContentAuthData t = do diff --git a/libs/wire-api/src/Wire/API/MLS/SubConversation.hs b/libs/wire-api/src/Wire/API/MLS/SubConversation.hs index d0d8f8833b0..be1199c8193 100644 --- a/libs/wire-api/src/Wire/API/MLS/SubConversation.hs +++ b/libs/wire-api/src/Wire/API/MLS/SubConversation.hs @@ -49,7 +49,8 @@ import Wire.Arbitrary -- conversation. The pair of a qualified conversation ID and a subconversation -- ID identifies globally. newtype SubConvId = SubConvId {unSubConvId :: Text} - deriving newtype (Eq, ToSchema, Ord, S.ToParamSchema, ToByteString, ToJSON, FromJSON, S.ToSchema, PostgresUnmarshall Text) + deriving newtype (Eq, ToSchema, Ord, S.ToParamSchema, ToByteString) + deriving newtype (ToJSON, FromJSON, S.ToSchema, PostgresUnmarshall Text, PostgresMarshall Text) deriving stock (Generic) deriving stock (Show) @@ -69,9 +70,6 @@ instance Arbitrary SubConvId where cs <- replicateM n (arbitrary `suchThat` isValidSubConvChar) pure $ SubConvId (T.pack cs) -instance PostgresMarshall SubConvId Text where - postgresMarshall = unSubConvId - isValidSubConvChar :: Char -> Bool isValidSubConvChar c = isPrint c && isAscii c && not (isSpace c) diff --git a/libs/wire-api/src/Wire/API/Password.hs b/libs/wire-api/src/Wire/API/Password.hs index dc5cb9b9df9..dfb16d1d250 100644 --- a/libs/wire-api/src/Wire/API/Password.hs +++ b/libs/wire-api/src/Wire/API/Password.hs @@ -36,11 +36,13 @@ import Data.ByteString.Lazy (fromStrict, toStrict) import Data.Misc import Data.OpenApi qualified as S import Data.Schema +import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Imports import OpenSSL.Random (randBytes) import Wire.API.Password.Argon2id import Wire.API.Password.Scrypt +import Wire.API.PostgresMarshall -- | A derived, stretched password that can be safely stored. data Password @@ -50,6 +52,22 @@ data Password instance Show Password where show _ = "" +------------------------------------------------------------------------------- +-- PSQL + +instance PostgresMarshall ByteString Password where + postgresMarshall = + Text.encodeUtf8 . \case + Argon2Password p -> encodeArgon2HashedPassword p + ScryptPassword p -> encodeScryptPassword p + +instance PostgresUnmarshall ByteString Password where + postgresUnmarshall = + mapLeft Text.pack . parsePassword . Text.decodeUtf8 + +------------------------------------------------------------------------------- +-- CQL + instance Cql Password where ctype = Tagged BlobColumn diff --git a/libs/wire-api/src/Wire/API/PostgresMarshall.hs b/libs/wire-api/src/Wire/API/PostgresMarshall.hs index 7b6a059b014..666b5b78c40 100644 --- a/libs/wire-api/src/Wire/API/PostgresMarshall.hs +++ b/libs/wire-api/src/Wire/API/PostgresMarshall.hs @@ -27,7 +27,9 @@ where import Data.Aeson import Data.Bifunctor (first) import Data.ByteString qualified as BS +import Data.ByteString.Conversion (toByteString') import Data.ByteString.Conversion qualified as BSC +import Data.Code qualified as Code import Data.Domain import Data.Id import Data.Misc @@ -41,8 +43,8 @@ import Data.Vector qualified as V import Hasql.Statement import Imports -class PostgresMarshall a b where - postgresMarshall :: a -> b +class PostgresMarshall db domain where + postgresMarshall :: domain -> db instance {-# OVERLAPPABLE #-} (a ~ b) => PostgresMarshall a b where postgresMarshall = id @@ -500,40 +502,46 @@ instance (PostgresMarshall a1 b1, PostgresMarshall a2 b2, PostgresMarshall a3 b3 postgresMarshall a20 ) -instance PostgresMarshall (Id a) UUID where +instance PostgresMarshall UUID (Id a) where postgresMarshall = toUUID -instance PostgresMarshall BotId UUID where +instance PostgresMarshall UUID BotId where postgresMarshall = toUUID . botUserId -instance PostgresMarshall ClientId Text where +instance PostgresMarshall Text ClientId where postgresMarshall = clientToText -instance PostgresMarshall Object Value where +instance PostgresMarshall Value Object where postgresMarshall = Object -instance PostgresMarshall Milliseconds Int64 where +instance PostgresMarshall Int64 Milliseconds where postgresMarshall = msToInt64 -instance PostgresMarshall Domain Text where +instance PostgresMarshall Text Domain where postgresMarshall = domainText instance (PostgresMarshall a b) => PostgresMarshall (Maybe a) (Maybe b) where postgresMarshall = fmap postgresMarshall -instance (PostgresMarshall a b) => PostgresMarshall [a] (Vector b) where +instance (PostgresMarshall b a) => PostgresMarshall (Vector b) [a] where postgresMarshall = V.fromList . map postgresMarshall -instance (PostgresMarshall a b) => PostgresMarshall (Set a) (Vector b) where +instance (PostgresMarshall b a) => PostgresMarshall (Vector b) (Set a) where postgresMarshall = V.fromList . map postgresMarshall . Set.toList instance (PostgresMarshall a b) => PostgresMarshall (Vector a) (Vector b) where postgresMarshall = V.map postgresMarshall +instance PostgresMarshall Text Code.Key where + postgresMarshall = Text.decodeUtf8 . toByteString' + +instance PostgresMarshall Text Code.Value where + postgresMarshall = Text.decodeUtf8 . toByteString' + --- -class PostgresUnmarshall a b where - postgresUnmarshall :: a -> Either Text b +class PostgresUnmarshall db domain where + postgresUnmarshall :: db -> Either Text domain instance {-# OVERLAPPABLE #-} (a ~ b) => PostgresUnmarshall a b where postgresUnmarshall = Right @@ -855,16 +863,22 @@ instance (PostgresUnmarshall a b, Ord b) => PostgresUnmarshall (Vector a) (Set b instance PostgresUnmarshall Int64 Milliseconds where postgresUnmarshall = Right . int64ToMs +instance PostgresUnmarshall Text Code.Key where + postgresUnmarshall = mapLeft Text.pack . BSC.runParser BSC.parser . Text.encodeUtf8 + +instance PostgresUnmarshall Text Code.Value where + postgresUnmarshall = mapLeft Text.pack . BSC.runParser BSC.parser . Text.encodeUtf8 + --- -lmapPG :: (PostgresMarshall a b, Profunctor p) => p b x -> p a x +lmapPG :: (PostgresMarshall db domain, Profunctor p) => p db x -> p domain x lmapPG = lmap postgresMarshall -rmapPG :: (PostgresUnmarshall x y) => Statement a x -> Statement a y +rmapPG :: (PostgresUnmarshall db domain) => Statement x db -> Statement x domain rmapPG = refineResult postgresUnmarshall dimapPG :: - (PostgresMarshall a b, PostgresUnmarshall x y) => - Statement b x -> - Statement a y + (PostgresMarshall dbIn domainIn, PostgresUnmarshall dbOut domainOut) => + Statement dbIn dbOut -> + Statement domainIn domainOut dimapPG = refineResult postgresUnmarshall . lmapPG diff --git a/libs/wire-api/src/Wire/API/Provider/External.hs b/libs/wire-api/src/Wire/API/Provider/External.hs index aebbd8f38e3..f9f7ca0a35b 100644 --- a/libs/wire-api/src/Wire/API/Provider/External.hs +++ b/libs/wire-api/src/Wire/API/Provider/External.hs @@ -29,7 +29,7 @@ import Data.Json.Util ((#)) import Imports import Wire.API.Locale (Locale) import Wire.API.Provider.Bot (BotConvView, BotUserView) -import Wire.API.User.Client.Prekey (LastPrekey, Prekey) +import Wire.API.User.Client.Prekey (LastPrekey, UncheckedPrekeyBundle) import Wire.API.User.Profile (Asset, ColourId, Name) import Wire.Arbitrary (Arbitrary, GenericUniform (..)) @@ -89,7 +89,7 @@ instance ToJSON NewBotRequest where -- The returned optional data overrides the defaults taken from -- the 'Service' definition. data NewBotResponse = NewBotResponse - { rsNewBotPrekeys :: [Prekey], + { rsNewBotPrekeys :: [UncheckedPrekeyBundle], rsNewBotLastPrekey :: LastPrekey, rsNewBotName :: Maybe Name, rsNewBotColour :: Maybe ColourId, 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 313a12fe372..80ae80db1b4 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -2125,6 +2125,15 @@ type AppsAPI = :> Capture "uid" UserId :> Get '[JSON] GetApp ) + :<|> Named + "get-apps" + ( Summary "Get all apps in a team" + :> ZLocalUser + :> "teams" + :> Capture "tid" TeamId + :> "apps" + :> Get '[JSON] [GetApp] + ) :<|> Named "refresh-app-cookie" ( Summary "Get a new app authentication token" diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs b/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs index 642b9dc5225..5390149a7c5 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs @@ -135,8 +135,8 @@ type APIIDP = Named "idp-get" (ZOptUser :> IdpGet) :<|> Named "idp-get-raw" (ZOptUser :> IdpGetRaw) :<|> Named "idp-get-all" (ZOptUser :> IdpGetAll) - :<|> Named "idp-create@v7" (Until 'V8 :> AuthProtect "TeamAdmin" :> IdpCreate) -- (change is semantic, see handler) - :<|> Named "idp-create" (From 'V8 :> AuthProtect "TeamAdmin" :> ZHostOpt :> IdpCreate) + :<|> Named "idp-create@v7" (Until 'V8 :> AuthProtect "TeamAdmin" :> ZOptUser :> IdpCreate) -- (change is semantic, see handler) + :<|> Named "idp-create" (From 'V8 :> AuthProtect "TeamAdmin" :> ZOptUser :> ZHostOpt :> IdpCreate) :<|> Named "idp-update" (ZOptUser :> ZHostOpt :> IdpUpdate) :<|> Named "idp-delete" (ZOptUser :> IdpDelete) diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 5f560380d29..37d226b9b16 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -1,6 +1,7 @@ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StrictData #-} {-# OPTIONS_GHC -Wno-ambiguous-fields #-} @@ -37,6 +38,8 @@ module Wire.API.Team.Feature LockableFeature (..), defUnlockedFeature, defLockedFeature, + setLockableFeatureLockStatus, + setLockableFeatureStatus, LockableFeaturePatch (..), Feature (..), forgetLock, @@ -368,6 +371,12 @@ data LockableFeature cfg = LockableFeature instance (Default (LockableFeature cfg)) => Default (Feature cfg) where def = forgetLock def +setLockableFeatureLockStatus :: LockableFeature cfg -> LockStatus -> LockableFeature cfg +setLockableFeatureLockStatus LockableFeature {..} s = LockableFeature {lockStatus = s, ..} + +setLockableFeatureStatus :: LockableFeature cfg -> FeatureStatus -> LockableFeature cfg +setLockableFeatureStatus LockableFeature {..} s = LockableFeature {status = s, ..} + -- | A feature that is disabled and locked. defLockedFeature :: (Default cfg) => LockableFeature cfg defLockedFeature = diff --git a/libs/wire-api/src/Wire/API/Team/LegalHold/External.hs b/libs/wire-api/src/Wire/API/Team/LegalHold/External.hs index 1cb233020fd..c49b6b196fc 100644 --- a/libs/wire-api/src/Wire/API/Team/LegalHold/External.hs +++ b/libs/wire-api/src/Wire/API/Team/LegalHold/External.hs @@ -82,7 +82,7 @@ instance ToSchema RequestNewLegalHoldClient where -- | Response payload that the LH service returns upon calling @/initiate@ data NewLegalHoldClient = NewLegalHoldClient - { newLegalHoldClientPrekeys :: [Prekey], + { newLegalHoldClientPrekeys :: [UncheckedPrekeyBundle], newLegalHoldClientLastKey :: LastPrekey } deriving stock (Eq, Show, Generic) diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index 138ded43563..defa322a590 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -472,6 +472,7 @@ instance (1 <= max) => ToJSON (LimitedQualifiedUserIdList max) where data UserType = UserTypeRegular | UserTypeApp | UserTypeBot deriving (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform UserType) + deriving (A.FromJSON, A.ToJSON) via (Schema UserType) instance Default UserType where def = UserTypeRegular @@ -714,34 +715,32 @@ instance FromJSON (EmailVisibility ()) where "visible_to_self" -> pure EmailVisibleToSelf _ -> fail "unexpected value for EmailVisibility settings" -mkUserProfileWithEmail :: Maybe EmailAddress -> User -> UserLegalHoldStatus -> UserProfile -mkUserProfileWithEmail memail u legalHoldStatus = - let ty = case userService u of - Nothing -> UserTypeRegular - Just _ -> UserTypeBot - 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, - profileTextStatus = userTextStatus u, - profilePict = userPict u, - profileAssets = userAssets u, - profileAccentId = userAccentId u, - profileService = userService u, - profileDeleted = userDeleted u, - profileExpire = userExpire u, - profileTeam = userTeam u, - profileEmail = memail, - profileLegalholdStatus = legalHoldStatus, - profileSupportedProtocols = userSupportedProtocols u, - profileType = ty, - profileSearchable = userSearchable u - } +-- | Create profile, overwriting the email field. Called `mkUserProfile`. +mkUserProfileWithEmail :: Maybe EmailAddress -> UserType -> User -> UserLegalHoldStatus -> UserProfile +mkUserProfileWithEmail memail userType u legalHoldStatus = + -- 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, + profileTextStatus = userTextStatus u, + profilePict = userPict u, + profileAssets = userAssets u, + profileAccentId = userAccentId u, + profileService = userService u, + profileDeleted = userDeleted u, + profileExpire = userExpire u, + profileTeam = userTeam u, + profileEmail = memail, + profileLegalholdStatus = legalHoldStatus, + profileSupportedProtocols = userSupportedProtocols u, + profileType = userType, + profileSearchable = userSearchable u + } -mkUserProfile :: EmailVisibilityConfigWithViewer -> User -> UserLegalHoldStatus -> UserProfile -mkUserProfile emailVisibilityConfigAndViewer u legalHoldStatus = +mkUserProfile :: EmailVisibilityConfigWithViewer -> UserType -> User -> UserLegalHoldStatus -> UserProfile +mkUserProfile emailVisibilityConfigAndViewer userType u legalHoldStatus = let isEmailVisible = case emailVisibilityConfigAndViewer of EmailVisibleToSelf -> False EmailVisibleIfOnTeam -> isJust (userTeam u) @@ -749,7 +748,7 @@ mkUserProfile emailVisibilityConfigAndViewer u legalHoldStatus = EmailVisibleIfOnSameTeam (Just (viewerTeamId, viewerMembership)) -> Just viewerTeamId == userTeam u && TeamMember.hasPermission viewerMembership TeamMember.ViewSameTeamEmails - in mkUserProfileWithEmail (if isEmailVisible then userEmail u else Nothing) u legalHoldStatus + in mkUserProfileWithEmail (if isEmailVisible then userEmail u else Nothing) userType u legalHoldStatus -------------------------------------------------------------------------------- -- NewUser diff --git a/libs/wire-api/src/Wire/API/User/Client.hs b/libs/wire-api/src/Wire/API/User/Client.hs index d020d8c850d..50986d499d6 100644 --- a/libs/wire-api/src/Wire/API/User/Client.hs +++ b/libs/wire-api/src/Wire/API/User/Client.hs @@ -254,12 +254,12 @@ userClientMapSchema sch = UserClientMap <$> userClientMap .= map_ (map_ sch) newtype UserClientPrekeyMap = UserClientPrekeyMap - {getUserClientPrekeyMap :: UserClientMap (Maybe Prekey)} + {getUserClientPrekeyMap :: UserClientMap (Maybe UncheckedPrekeyBundle)} deriving stock (Eq, Show) deriving newtype (Arbitrary, Semigroup, Monoid) deriving (FromJSON, ToJSON, Swagger.ToSchema) via Schema UserClientPrekeyMap -mkUserClientPrekeyMap :: Map UserId (Map ClientId (Maybe Prekey)) -> UserClientPrekeyMap +mkUserClientPrekeyMap :: Map UserId (Map ClientId (Maybe UncheckedPrekeyBundle)) -> UserClientPrekeyMap mkUserClientPrekeyMap = coerce instance ToSchema UserClientPrekeyMap where @@ -275,7 +275,7 @@ instance ToSchema UserClientPrekeyMap where (generateExample @UserId) ( Map.singleton (ClientId 4940483633899001999) - (Just (Prekey (PrekeyId 1) "pQABAQECoQBYIOjl7hw0D8YRNq...")) + (Just (UncheckedPrekeyBundle (PrekeyId 1) "pQABAQECoQBYIOjl7hw0D8YRNq...")) ) ) @@ -319,7 +319,7 @@ qualifiedUserClientMapSchema sch = ) data QualifiedUserClientPrekeyMapV4 = QualifiedUserClientPrekeyMapV4 - { qualifiedUserClientPrekeys :: QualifiedUserClientMap (Maybe Prekey), + { qualifiedUserClientPrekeys :: QualifiedUserClientMap (Maybe UncheckedPrekeyBundle), failedToList :: Maybe [Qualified UserId] } deriving stock (Eq, Show) @@ -340,16 +340,16 @@ instance ToSchema QualifiedUserClientPrekeyMapV4 where where from' :: QualifiedUserClientPrekeyMapV4 -> Map Domain UserClientPrekeyMap from' = coerce . qualifiedUserClientPrekeys - to' :: Map Domain UserClientPrekeyMap -> QualifiedUserClientMap (Maybe Prekey) + to' :: Map Domain UserClientPrekeyMap -> QualifiedUserClientMap (Maybe UncheckedPrekeyBundle) to' = coerce newtype QualifiedUserClientPrekeyMap = QualifiedUserClientPrekeyMap - { getQualifiedUserClientPrekeyMap :: QualifiedUserClientMap (Maybe Prekey) + { getQualifiedUserClientPrekeyMap :: QualifiedUserClientMap (Maybe UncheckedPrekeyBundle) } deriving stock (Eq, Show) deriving newtype (Arbitrary) deriving (FromJSON, ToJSON, Swagger.ToSchema) via Schema QualifiedUserClientPrekeyMap - deriving (Semigroup, Monoid) via (QualifiedUserClientMap (Alt Maybe Prekey)) + deriving (Semigroup, Monoid) via (QualifiedUserClientMap (Alt Maybe UncheckedPrekeyBundle)) instance ToSchema QualifiedUserClientPrekeyMap where schema = @@ -709,7 +709,7 @@ instance C.Cql ClientClass where -- NewClient data NewClient = NewClient - { newClientPrekeys :: [Prekey], + { newClientPrekeys :: [UncheckedPrekeyBundle], newClientLastKey :: LastPrekey, newClientType :: ClientType, newClientLabel :: Maybe Text, @@ -823,7 +823,7 @@ newClient t k = -- UpdateClient data UpdateClient = UpdateClient - { updateClientPrekeys :: [Prekey], + { updateClientPrekeys :: [UncheckedPrekeyBundle], updateClientLastKey :: Maybe LastPrekey, updateClientLabel :: Maybe Text, -- | see haddocks for 'ClientCapability' diff --git a/libs/wire-api/src/Wire/API/User/Client/Prekey.hs b/libs/wire-api/src/Wire/API/User/Client/Prekey.hs index e2f8eb04087..1261508f7ef 100644 --- a/libs/wire-api/src/Wire/API/User/Client/Prekey.hs +++ b/libs/wire-api/src/Wire/API/User/Client/Prekey.hs @@ -20,8 +20,11 @@ module Wire.API.User.Client.Prekey ( PrekeyId (..), - Prekey (..), + UncheckedPrekeyBundle (..), clientIdFromPrekey, + parsePrekeyBundlePrekeyId, + PrekeyBundlePrekeyPayload (..), + PrekeyParseError (..), LastPrekey, lastPrekey, unpackLastPrekey, @@ -33,18 +36,28 @@ module Wire.API.User.Client.Prekey where import Cassandra (ColumnType (IntColumn), Cql (ctype, fromCql, toCql), Tagged (..), Value (CqlInt)) +import Codec.CBOR.Decoding qualified as CBOR +import Codec.CBOR.Read qualified as CBOR +import Codec.CBOR.Term qualified as CBOR import Crypto.Hash (SHA256, hash) -import Data.Aeson (FromJSON (..), ToJSON (..)) +import Data.Aeson (FromJSON (..), ToJSON (..), withText) +import Data.Aeson qualified as A +import Data.Bifunctor (first) import Data.Bits import Data.ByteArray (convert) import Data.ByteString qualified as BS +import Data.ByteString.Base64 qualified as B64 +import Data.ByteString.Conversion qualified as B +import Data.ByteString.Lazy qualified as LBS import Data.Id +import Data.Json.Util (base64Schema) import Data.OpenApi qualified as S -import Data.Schema +import Data.Schema (Schema (..), ToSchema (..), array, field, named, object, withParser, (.=)) import Data.Text.Encoding (encodeUtf8) import Imports import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..)) +-- | We define PrekeyId as Word16, but it dismisses to 32-bits unsigned standard IDs. newtype PrekeyId = PrekeyId {keyId :: Word16} deriving stock (Eq, Ord, Show, Generic) deriving newtype (ToJSON, FromJSON, Arbitrary, S.ToSchema, ToSchema) @@ -56,20 +69,85 @@ instance Cql PrekeyId where fromCql _ = Left "PrekeyId: Int expected" -------------------------------------------------------------------------------- --- Prekey +-- PrekeyBundle Specific Types +newtype PrekeyBundlePublicKey = PrekeyBundlePublicKey {unPrekeyBundlePublicKey :: ByteString} + deriving stock (Eq, Show, Generic) + +instance ToJSON PrekeyBundlePublicKey where + toJSON = A.toJSON . B.fromByteString @Text . B64.encode . unPrekeyBundlePublicKey + +instance FromJSON PrekeyBundlePublicKey where + parseJSON = withText "PrekeyBundlePublicKey" $ \t -> + either (const $ fail "Not base 64-encoded") (pure . PrekeyBundlePublicKey) $ + B64.decode (B.toByteString' t) + +instance ToSchema PrekeyBundlePublicKey where + schema = named "PrekeyBundlePublicKey" $ PrekeyBundlePublicKey <$> unPrekeyBundlePublicKey .= base64Schema + +newtype PrekeyBundleIdentityKey = PrekeyBundleIdentityKey {unPrekeyBundleIdentityKey :: ByteString} + deriving stock (Eq, Show, Generic) + +instance ToJSON PrekeyBundleIdentityKey where + toJSON = A.toJSON . B.fromByteString @Text . B64.encode . unPrekeyBundleIdentityKey + +instance FromJSON PrekeyBundleIdentityKey where + parseJSON = withText "PrekeyBundleIdentityKey" $ \t -> + either (const $ fail "Not base 64-encoded") (pure . PrekeyBundleIdentityKey) $ + B64.decode (B.toByteString' t) + +instance ToSchema PrekeyBundleIdentityKey where + schema = named "PrekeyBundleIdentityKey" $ PrekeyBundleIdentityKey <$> unPrekeyBundleIdentityKey .= base64Schema + +newtype PrekeyBundleSignature = PrekeyBundleSignature {unPrekeyBundleSignature :: ByteString} + deriving stock (Eq, Show, Generic) + +instance ToJSON PrekeyBundleSignature where + toJSON = A.toJSON . B.fromByteString @Text . B64.encode . unPrekeyBundleSignature + +instance FromJSON PrekeyBundleSignature where + parseJSON = withText "PrekeyBundleSignature" $ \t -> + either (const $ fail "Not base 64-encoded") (pure . PrekeyBundleSignature) $ + B64.decode (B.toByteString' t) + +instance ToSchema PrekeyBundleSignature where + schema = named "PrekeyBundleSignature" $ PrekeyBundleSignature <$> unPrekeyBundleSignature .= base64Schema -data Prekey = Prekey +-- Decoders for new types + +decodePrekeyBundlePublicKey :: CBOR.Decoder s PrekeyBundlePublicKey +decodePrekeyBundlePublicKey = do + decodeUnfoldSingletonMap + decodeUnfoldSingletonMap + PrekeyBundlePublicKey <$> CBOR.decodeBytes + +decodePrekeyBundleIdentityKey :: CBOR.Decoder s PrekeyBundleIdentityKey +decodePrekeyBundleIdentityKey = do + decodeUnfoldSingletonMap + PrekeyBundleIdentityKey <$> CBOR.decodeBytes + +decodeUnfoldSingletonMap :: CBOR.Decoder s () +decodeUnfoldSingletonMap = do + n <- CBOR.decodeMapLen + unless (n == 1) $ fail $ "Schema Mismatch: Expected Map of 1 element, found " <> show n + k <- CBOR.decodeInt + unless (k == 0) $ fail $ "Unknown Key: Expected 0, found " <> show k + +-------------------------------------------------------------------------------- +-- UncheckedPrekeyBundle + +data UncheckedPrekeyBundle = UncheckedPrekeyBundle { prekeyId :: PrekeyId, + -- | Prekey bundle prekeyKey :: Text } deriving stock (Eq, Show, Generic) - deriving (Arbitrary) via (GenericUniform Prekey) - deriving (FromJSON, ToJSON, S.ToSchema) via Schema Prekey + deriving (Arbitrary) via (GenericUniform UncheckedPrekeyBundle) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema UncheckedPrekeyBundle -instance ToSchema Prekey where +instance ToSchema UncheckedPrekeyBundle where schema = - object "Prekey" $ - Prekey + object "UncheckedPrekeyBundle" $ + UncheckedPrekeyBundle <$> prekeyId .= field "id" schema <*> prekeyKey .= field "key" schema @@ -78,7 +156,7 @@ instance ToSchema Prekey where -- This works by taking the SHA256 hash of the prekey, truncating it to its -- first 8 bytes, and interpreting the resulting bytestring as a big endian -- Word64. -clientIdFromPrekey :: Prekey -> ClientId +clientIdFromPrekey :: UncheckedPrekeyBundle -> ClientId clientIdFromPrekey = ClientId . foldl' (\w d -> (w `shiftL` 8) .|. fromIntegral d) 0 @@ -89,11 +167,81 @@ clientIdFromPrekey = . encodeUtf8 . prekeyKey +data PrekeyParseError + = PrekeyParseBase64Error String + | -- | Byte offset and error message + PrekeyParseCborError Int64 String + | PrekeyParseTrailingBytes + deriving stock (Eq, Show, Generic) + +-- | Represents the Prekey Bundle payload. +-- +-- Structure based on `PrekyBundle` from proteus +data PrekeyBundlePrekeyPayload = PrekeyBundlePrekeyPayload + { -- | Key 0 + prekeyBundleProtocolVersion :: Word, + -- | Key 1 + prekeyBundlePrekeyId :: PrekeyId, + -- | Key 2 + prekeyBundleIdentityKey :: PrekeyBundleIdentityKey, + -- | Key 3 + prekeyBundleSignedPrekey :: PrekeyBundlePublicKey, + -- | Key 4 + prekeyBundleOneTimePrekey :: Maybe PrekeyBundleSignature + } + deriving stock (Eq, Show, Generic) + +-- | Parses a Base64 CBOR-encoded payload to extract the 'PrekeyId'. +parsePrekeyBundlePrekeyId :: UncheckedPrekeyBundle -> Either PrekeyParseError PrekeyId +parsePrekeyBundlePrekeyId pk = do + bs <- first (PrekeyParseBase64Error . ("Base64 decoding error: " <>)) $ B64.decode $ B.toByteString' $ prekeyKey pk + case CBOR.deserialiseFromBytes decodePrekeyBundlePrekeyPayload (LBS.fromStrict bs) of + Left (CBOR.DeserialiseFailure off msg) -> Left $ PrekeyParseCborError off msg + Right (rest, payload) + | LBS.null rest -> Right (prekeyBundlePrekeyId payload) + | otherwise -> Left PrekeyParseTrailingBytes + +decodePrekeyBundlePrekeyPayload :: CBOR.Decoder s PrekeyBundlePrekeyPayload +decodePrekeyBundlePrekeyPayload = do + n <- CBOR.decodeMapLen + (m0, m1, m2, m3, m4) <- go n (Nothing, Nothing, Nothing, Nothing, Nothing) + PrekeyBundlePrekeyPayload + <$> maybe (fail "Missing Key 0") pure m0 + <*> maybe (fail "Missing Key 1") pure m1 + <*> maybe (fail "Missing Key 2") pure m2 + <*> maybe (fail "Missing Key 3") pure m3 + <*> pure m4 -- Key 4 is optional + where + go 0 acc = pure acc + go i (m0, m1, m2, m3, m4) = do + k <- CBOR.decodeInt + case k of + 0 -> do + v <- CBOR.decodeWord + go (i - 1) (Just v, m1, m2, m3, m4) + 1 -> do + v <- CBOR.decodeInt + when (v < 0) $ fail "Value Error: Prekey ID cannot be negative" + go (i - 1) (m0, Just (PrekeyId (fromIntegral v)), m2, m3, m4) + 2 -> do + v <- decodePrekeyBundleIdentityKey + go (i - 1) (m0, m1, Just v, m3, m4) + 3 -> do + v <- decodePrekeyBundlePublicKey + go (i - 1) (m0, m1, m2, Just v, m4) + 4 -> do + term <- CBOR.decodeTerm + case term of + CBOR.TNull -> go (i - 1) (m0, m1, m2, m3, Nothing) + CBOR.TMap [(CBOR.TInt 0, CBOR.TBytes bs)] -> go (i - 1) (m0, m1, m2, m3, Just $ PrekeyBundleSignature bs) + _ -> fail "Invalid onetime prekey component parsing" + other -> fail $ "Unknown Key: " <> show other + -------------------------------------------------------------------------------- -- LastPrekey newtype LastPrekey = LastPrekey - {unpackLastPrekey :: Prekey} + {unpackLastPrekey :: UncheckedPrekeyBundle} deriving stock (Eq, Show, Generic) deriving (FromJSON, ToJSON, S.ToSchema) via Schema LastPrekey @@ -112,12 +260,12 @@ lastPrekeyId :: PrekeyId lastPrekeyId = PrekeyId maxBound lastPrekey :: Text -> LastPrekey -lastPrekey = LastPrekey . Prekey lastPrekeyId +lastPrekey = LastPrekey . UncheckedPrekeyBundle lastPrekeyId -- for tests only -- This fake last prekey has the wrong prekeyId fakeLastPrekey :: LastPrekey -fakeLastPrekey = LastPrekey $ Prekey (PrekeyId 7) "pQABAQcCoQBYIDXdN8VlKb5lbgPmoDPLPyqNIEyShG4oT/DlW0peRRZUA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=" +fakeLastPrekey = LastPrekey $ UncheckedPrekeyBundle (PrekeyId 7) "pQABAQcCoQBYIDXdN8VlKb5lbgPmoDPLPyqNIEyShG4oT/DlW0peRRZUA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=" -------------------------------------------------------------------------------- -- PrekeyBundle @@ -142,7 +290,7 @@ instance ToSchema PrekeyBundle where data ClientPrekey = ClientPrekey { prekeyClient :: ClientId, - prekeyData :: Prekey + prekeyData :: UncheckedPrekeyBundle } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform ClientPrekey) diff --git a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs index b6ffbd71299..441d5dc1a3b 100644 --- a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs +++ b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs @@ -164,7 +164,10 @@ deriveJSON (defaultOptsDropChar '_') ''IdPList -- implement @{"uri": , "cert": }@. check both the certificate we get -- from the server against the pinned one and the metadata url in the metadata against the one -- we fetched the xml from, but it's unclear what the benefit would be.) -data IdPMetadataInfo = IdPMetadataValue Text SAML.IdPMetadata +data IdPMetadataInfo = IdPMetadataValue + { _rawIdpMetadataText :: Text, + _idpMetadataRecord :: SAML.IdPMetadata + } deriving (Eq, Show, Generic) -- | We want to store the raw xml text from the registration request in the database for diff --git a/libs/wire-api/src/Wire/API/User/Search.hs b/libs/wire-api/src/Wire/API/User/Search.hs index bddf084994a..96e01c24fe3 100644 --- a/libs/wire-api/src/Wire/API/User/Search.hs +++ b/libs/wire-api/src/Wire/API/User/Search.hs @@ -42,8 +42,7 @@ import Data.Aeson hiding (object, (.=)) import Data.Aeson qualified as Aeson import Data.Attoparsec.ByteString.Char8 (string) import Data.ByteString.Char8 qualified as C8 -import Data.ByteString.Conversion -import Data.ByteString.Conversion qualified as BS +import Data.ByteString.Conversion as BS import Data.Id (TeamId, UserGroupId, UserId) import Data.Json.Util (UTCTimeMillis) import Data.OpenApi (ToParamSchema (..)) @@ -59,7 +58,7 @@ import Imports import Servant.API (FromHttpApiData, ToHttpApiData (..)) import Web.Internal.HttpApiData (parseQueryParam) import Wire.API.Team.Role (Role) -import Wire.API.User (ManagedBy) +import Wire.API.User (ManagedBy, UserType) import Wire.API.User.Identity (EmailAddress) import Wire.Arbitrary (Arbitrary, GenericUniform (..)) @@ -138,14 +137,15 @@ deriving via (Schema (SearchResult TeamContact)) instance S.ToSchema (SearchResu -------------------------------------------------------------------------------- -- Contact --- | Returned by 'searchIndex' under @/contacts/search@. +-- | Returned by 'searchIndex' under @/search/contacts@. -- This is a subset of 'User' and json instances should reflect that. data Contact = Contact { contactQualifiedId :: Qualified UserId, contactName :: Text, contactColorId :: Maybe Int, contactHandle :: Maybe Text, - contactTeam :: Maybe TeamId + contactTeam :: Maybe TeamId, + contactType :: UserType } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform Contact) @@ -161,6 +161,7 @@ instance ToSchema Contact where <*> contactColorId .= optField "accent_id" (maybeWithDefault Aeson.Null schema) <*> contactHandle .= optField "handle" (maybeWithDefault Aeson.Null schema) <*> contactTeam .= optField "team" (maybeWithDefault Aeson.Null schema) + <*> contactType .= field "type" schema -------------------------------------------------------------------------------- -- TeamContact diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/ClientPrekey_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/ClientPrekey_user.hs index f11ccb868c2..4e15d78a746 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/ClientPrekey_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/ClientPrekey_user.hs @@ -18,144 +18,144 @@ module Test.Wire.API.Golden.Generated.ClientPrekey_user where import Data.Id -import Wire.API.User.Client.Prekey (ClientPrekey (..), Prekey (Prekey, prekeyId, prekeyKey), PrekeyId (PrekeyId, keyId)) +import Wire.API.User.Client.Prekey (ClientPrekey (..), PrekeyId (PrekeyId, keyId), UncheckedPrekeyBundle (UncheckedPrekeyBundle, prekeyId, prekeyKey)) testObject_ClientPrekey_user_1 :: ClientPrekey testObject_ClientPrekey_user_1 = ClientPrekey { prekeyClient = ClientId 0xf22, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 7}, prekeyKey = ""} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 7}, prekeyKey = ""} } testObject_ClientPrekey_user_2 :: ClientPrekey testObject_ClientPrekey_user_2 = ClientPrekey { prekeyClient = ClientId 0x1f7, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "\b\21129\169584\r;"} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "\b\21129\169584\r;"} } testObject_ClientPrekey_user_3 :: ClientPrekey testObject_ClientPrekey_user_3 = ClientPrekey { prekeyClient = ClientId 0xfd8, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 4}, prekeyKey = "KA"} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 4}, prekeyKey = "KA"} } testObject_ClientPrekey_user_4 :: ClientPrekey testObject_ClientPrekey_user_4 = ClientPrekey { prekeyClient = ClientId 0x83d, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 8}, prekeyKey = "OeYn"} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 8}, prekeyKey = "OeYn"} } testObject_ClientPrekey_user_5 :: ClientPrekey testObject_ClientPrekey_user_5 = ClientPrekey { prekeyClient = ClientId 0xa69, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 3}, prekeyKey = "\131643\&3\ENQN]5~"} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 3}, prekeyKey = "\131643\&3\ENQN]5~"} } testObject_ClientPrekey_user_6 :: ClientPrekey testObject_ClientPrekey_user_6 = ClientPrekey { prekeyClient = ClientId 0x05b4, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "\DEL\1053826("} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "\DEL\1053826("} } testObject_ClientPrekey_user_7 :: ClientPrekey testObject_ClientPrekey_user_7 = ClientPrekey { prekeyClient = ClientId 0x7b4, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 5}, prekeyKey = "\1072578P!+"} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 5}, prekeyKey = "\1072578P!+"} } testObject_ClientPrekey_user_8 :: ClientPrekey testObject_ClientPrekey_user_8 = ClientPrekey { prekeyClient = ClientId 0x4e8, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 4}, prekeyKey = "AZrl"} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 4}, prekeyKey = "AZrl"} } testObject_ClientPrekey_user_9 :: ClientPrekey testObject_ClientPrekey_user_9 = ClientPrekey { prekeyClient = ClientId 0x324, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 5}, prekeyKey = "\v>h"} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 5}, prekeyKey = "\v>h"} } testObject_ClientPrekey_user_10 :: ClientPrekey testObject_ClientPrekey_user_10 = ClientPrekey { prekeyClient = ClientId 0x252, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 2}, prekeyKey = "0\EOT\DC2\RS\SI\1082579f"} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 2}, prekeyKey = "0\EOT\DC2\RS\SI\1082579f"} } testObject_ClientPrekey_user_11 :: ClientPrekey testObject_ClientPrekey_user_11 = ClientPrekey { prekeyClient = ClientId 0xb99, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 6}, prekeyKey = "2\1025445\DEL"} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 6}, prekeyKey = "2\1025445\DEL"} } testObject_ClientPrekey_user_12 :: ClientPrekey testObject_ClientPrekey_user_12 = ClientPrekey { prekeyClient = ClientId 0xbe3, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 4}, prekeyKey = "\US#\1040242M\120180\ETB?"} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 4}, prekeyKey = "\US#\1040242M\120180\ETB?"} } testObject_ClientPrekey_user_13 :: ClientPrekey testObject_ClientPrekey_user_13 = ClientPrekey { prekeyClient = ClientId 0x1cf, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 7}, prekeyKey = "O,-%\150104o"} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 7}, prekeyKey = "O,-%\150104o"} } testObject_ClientPrekey_user_14 :: ClientPrekey testObject_ClientPrekey_user_14 = ClientPrekey { prekeyClient = ClientId 0x710, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "\DC2\135043\96744\DEL\156322x\1009249"} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "\DC2\135043\96744\DEL\156322x\1009249"} } testObject_ClientPrekey_user_15 :: ClientPrekey testObject_ClientPrekey_user_15 = ClientPrekey { prekeyClient = ClientId 0x97e, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = "\fk\1100893\NUL\ETX"} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = "\fk\1100893\NUL\ETX"} } testObject_ClientPrekey_user_16 :: ClientPrekey testObject_ClientPrekey_user_16 = ClientPrekey { prekeyClient = ClientId 0x2b2, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 2}, prekeyKey = "\39095"} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 2}, prekeyKey = "\39095"} } testObject_ClientPrekey_user_17 :: ClientPrekey testObject_ClientPrekey_user_17 = ClientPrekey { prekeyClient = ClientId 0x81c, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 2}, prekeyKey = "\1079390\987156h9\1060117"} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 2}, prekeyKey = "\1079390\987156h9\1060117"} } testObject_ClientPrekey_user_18 :: ClientPrekey testObject_ClientPrekey_user_18 = ClientPrekey { prekeyClient = ClientId 0x895, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 8}, prekeyKey = ","} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 8}, prekeyKey = ","} } testObject_ClientPrekey_user_19 :: ClientPrekey testObject_ClientPrekey_user_19 = ClientPrekey { prekeyClient = ClientId 0x792, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 4}, prekeyKey = "g\60021\23060i\ETX"} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 4}, prekeyKey = "g\60021\23060i\ETX"} } testObject_ClientPrekey_user_20 :: ClientPrekey testObject_ClientPrekey_user_20 = ClientPrekey { prekeyClient = ClientId 0xb02, - prekeyData = Prekey {prekeyId = PrekeyId {keyId = 4}, prekeyKey = "D){H"} + prekeyData = UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 4}, prekeyKey = "D){H"} } diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Contact_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Contact_user.hs index b3f7c67e29a..88b04796f6a 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Contact_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/Contact_user.hs @@ -22,6 +22,7 @@ import Data.Id (Id (Id)) import Data.Qualified (Qualified (Qualified, qDomain, qUnqualified)) import Data.UUID qualified as UUID (fromString) import Imports (Maybe (Just, Nothing), fromJust) +import Wire.API.User import Wire.API.User.Search (Contact (..)) testObject_Contact_user_1 :: Contact @@ -35,7 +36,8 @@ testObject_Contact_user_1 = contactName = "", contactColorId = Just 6, contactHandle = Just "\1089530\NUL|\SO", - contactTeam = Nothing + contactTeam = Nothing, + contactType = UserTypeRegular } testObject_Contact_user_2 :: Contact @@ -49,7 +51,8 @@ testObject_Contact_user_2 = contactName = "\SYND", contactColorId = Just (-5), contactHandle = Just "", - contactTeam = Just (Id (fromJust (UUID.fromString "00000002-0000-0008-0000-000400000002"))) + contactTeam = Just (Id (fromJust (UUID.fromString "00000002-0000-0008-0000-000400000002"))), + contactType = UserTypeApp } testObject_Contact_user_3 :: Contact @@ -63,7 +66,8 @@ testObject_Contact_user_3 = contactName = "S\1037187D\GS", contactColorId = Just (-4), contactHandle = Just "\175177~\35955c", - contactTeam = Just (Id (fromJust (UUID.fromString "00000006-0000-0005-0000-000700000008"))) + contactTeam = Just (Id (fromJust (UUID.fromString "00000006-0000-0005-0000-000700000008"))), + contactType = UserTypeBot } testObject_Contact_user_4 :: Contact @@ -77,7 +81,8 @@ testObject_Contact_user_4 = contactName = "@=\ETX", contactColorId = Nothing, contactHandle = Just "6", - contactTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000500000004"))) + contactTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000500000004"))), + contactType = UserTypeRegular } testObject_Contact_user_5 :: Contact @@ -91,7 +96,8 @@ testObject_Contact_user_5 = contactName = "5m~\DC4`", contactColorId = Nothing, contactHandle = Nothing, - contactTeam = Nothing + contactTeam = Nothing, + contactType = UserTypeRegular } testObject_Contact_user_6 :: Contact @@ -105,7 +111,8 @@ testObject_Contact_user_6 = contactName = "Cst\995547U", contactColorId = Nothing, contactHandle = Just "qI", - contactTeam = Just (Id (fromJust (UUID.fromString "00000005-0000-0004-0000-000600000000"))) + contactTeam = Just (Id (fromJust (UUID.fromString "00000005-0000-0004-0000-000600000000"))), + contactType = UserTypeRegular } testObject_Contact_user_7 :: Contact @@ -119,7 +126,8 @@ testObject_Contact_user_7 = contactName = "\b74\ENQ", contactColorId = Just 5, contactHandle = Just "", - contactTeam = Just (Id (fromJust (UUID.fromString "00000008-0000-0001-0000-000400000008"))) + contactTeam = Just (Id (fromJust (UUID.fromString "00000008-0000-0001-0000-000400000008"))), + contactType = UserTypeRegular } testObject_Contact_user_8 :: Contact @@ -133,7 +141,8 @@ testObject_Contact_user_8 = contactName = "w\1050194\993461#\\", contactColorId = Just (-2), contactHandle = Nothing, - contactTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0007-0000-000500000002"))) + contactTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0007-0000-000500000002"))), + contactType = UserTypeRegular } testObject_Contact_user_9 :: Contact @@ -147,7 +156,8 @@ testObject_Contact_user_9 = contactName = ",\1041199 \v\1077257", contactColorId = Just 5, contactHandle = Nothing, - contactTeam = Just (Id (fromJust (UUID.fromString "00000005-0000-0002-0000-000500000000"))) + contactTeam = Just (Id (fromJust (UUID.fromString "00000005-0000-0002-0000-000500000000"))), + contactType = UserTypeRegular } testObject_Contact_user_10 :: Contact @@ -161,7 +171,8 @@ testObject_Contact_user_10 = contactName = "(\1103086\1105553H/", contactColorId = Just 0, contactHandle = Nothing, - contactTeam = Just (Id (fromJust (UUID.fromString "00000005-0000-0006-0000-000700000000"))) + contactTeam = Just (Id (fromJust (UUID.fromString "00000005-0000-0006-0000-000700000000"))), + contactType = UserTypeRegular } testObject_Contact_user_11 :: Contact @@ -175,7 +186,8 @@ testObject_Contact_user_11 = contactName = "+\DC4\1063683<", contactColorId = Just 6, contactHandle = Nothing, - contactTeam = Just (Id (fromJust (UUID.fromString "00000007-0000-0008-0000-000600000004"))) + contactTeam = Just (Id (fromJust (UUID.fromString "00000007-0000-0008-0000-000600000004"))), + contactType = UserTypeRegular } testObject_Contact_user_12 :: Contact @@ -189,7 +201,8 @@ testObject_Contact_user_12 = contactName = "l\DC1\ETB`\ETX", contactColorId = Just (-4), contactHandle = Just "", - contactTeam = Nothing + contactTeam = Nothing, + contactType = UserTypeRegular } testObject_Contact_user_13 :: Contact @@ -203,7 +216,8 @@ testObject_Contact_user_13 = contactName = "\SYN\1030541\v8z", contactColorId = Just (-3), contactHandle = Just "E\EM\US[58", - contactTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0003-0000-000000000005"))) + contactTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0003-0000-000000000005"))), + contactType = UserTypeRegular } testObject_Contact_user_14 :: Contact @@ -217,7 +231,8 @@ testObject_Contact_user_14 = contactName = "7", contactColorId = Just (-2), contactHandle = Just "h\CAN", - contactTeam = Just (Id (fromJust (UUID.fromString "00000005-0000-0008-0000-000700000008"))) + contactTeam = Just (Id (fromJust (UUID.fromString "00000005-0000-0008-0000-000700000008"))), + contactType = UserTypeRegular } testObject_Contact_user_15 :: Contact @@ -231,7 +246,8 @@ testObject_Contact_user_15 = contactName = "U6\ESC*\SO", contactColorId = Nothing, contactHandle = Nothing, - contactTeam = Just (Id (fromJust (UUID.fromString "00000006-0000-0006-0000-000800000006"))) + contactTeam = Just (Id (fromJust (UUID.fromString "00000006-0000-0006-0000-000800000006"))), + contactType = UserTypeRegular } testObject_Contact_user_16 :: Contact @@ -245,7 +261,8 @@ testObject_Contact_user_16 = contactName = "l", contactColorId = Nothing, contactHandle = Nothing, - contactTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0006-0000-000200000007"))) + contactTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0006-0000-000200000007"))), + contactType = UserTypeRegular } testObject_Contact_user_17 :: Contact @@ -259,7 +276,8 @@ testObject_Contact_user_17 = contactName = "fI\8868\&3z", contactColorId = Nothing, contactHandle = Just "3", - contactTeam = Just (Id (fromJust (UUID.fromString "00000004-0000-0007-0000-000000000001"))) + contactTeam = Just (Id (fromJust (UUID.fromString "00000004-0000-0007-0000-000000000001"))), + contactType = UserTypeRegular } testObject_Contact_user_18 :: Contact @@ -273,7 +291,8 @@ testObject_Contact_user_18 = contactName = "\"jC\74801\144577\DC2", contactColorId = Nothing, contactHandle = Nothing, - contactTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0002-0000-000000000007"))) + contactTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0002-0000-000000000007"))), + contactType = UserTypeRegular } testObject_Contact_user_19 :: Contact @@ -287,7 +306,8 @@ testObject_Contact_user_19 = contactName = "I", contactColorId = Just (-1), contactHandle = Just "\"7\ACK!", - contactTeam = Just (Id (fromJust (UUID.fromString "00000006-0000-0004-0000-000000000003"))) + contactTeam = Just (Id (fromJust (UUID.fromString "00000006-0000-0004-0000-000000000003"))), + contactType = UserTypeRegular } testObject_Contact_user_20 :: Contact @@ -301,5 +321,6 @@ testObject_Contact_user_20 = contactName = "|K\n\n\t", contactColorId = Nothing, contactHandle = Nothing, - contactTeam = Nothing + contactTeam = Nothing, + contactType = UserTypeRegular } diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewBotResponse_provider.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewBotResponse_provider.hs index db3279d839a..d03b6cc00a9 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewBotResponse_provider.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewBotResponse_provider.hs @@ -24,7 +24,7 @@ import Data.UUID qualified as UUID (fromString) import Imports (Maybe (Just, Nothing), fromJust) import Wire.API.Asset import Wire.API.Provider.External (NewBotResponse (..)) -import Wire.API.User.Client.Prekey (Prekey (Prekey, prekeyId, prekeyKey), PrekeyId (PrekeyId, keyId), lastPrekey) +import Wire.API.User.Client.Prekey (PrekeyId (PrekeyId, keyId), UncheckedPrekeyBundle (UncheckedPrekeyBundle, prekeyId, prekeyKey), lastPrekey) import Wire.API.User.Profile ( Asset (ImageAsset), AssetSize (AssetComplete, AssetPreview), @@ -36,8 +36,8 @@ testObject_NewBotResponse_provider_1 :: NewBotResponse testObject_NewBotResponse_provider_1 = NewBotResponse { rsNewBotPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = "\1079194"}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = "\1079194"}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""} ], rsNewBotLastPrekey = lastPrekey "+\1035266\ENQ", rsNewBotName = @@ -55,19 +55,19 @@ testObject_NewBotResponse_provider_2 :: NewBotResponse testObject_NewBotResponse_provider_2 = NewBotResponse { rsNewBotPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""} ], rsNewBotLastPrekey = lastPrekey "\158260S\1013700\1033003\997116", rsNewBotName = Just (Name {fromName = "\185552}nqW\t\179361\&7f"}), @@ -85,11 +85,11 @@ testObject_NewBotResponse_provider_3 :: NewBotResponse testObject_NewBotResponse_provider_3 = NewBotResponse { rsNewBotPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} ], rsNewBotLastPrekey = lastPrekey "I", rsNewBotName = @@ -123,8 +123,8 @@ testObject_NewBotResponse_provider_5 :: NewBotResponse testObject_NewBotResponse_provider_5 = NewBotResponse { rsNewBotPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "U"}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "U"}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} ], rsNewBotLastPrekey = lastPrekey "\fC\NULL\\\EOT", rsNewBotName = Nothing, @@ -136,9 +136,9 @@ testObject_NewBotResponse_provider_6 :: NewBotResponse testObject_NewBotResponse_provider_6 = NewBotResponse { rsNewBotPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = "\29859"} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = "\29859"} ], rsNewBotLastPrekey = lastPrekey "", rsNewBotName = @@ -194,9 +194,9 @@ testObject_NewBotResponse_provider_9 :: NewBotResponse testObject_NewBotResponse_provider_9 = NewBotResponse { rsNewBotPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "\NAK"}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "\NAK"}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""} ], rsNewBotLastPrekey = lastPrekey "]4\68421\&8\\", rsNewBotName = @@ -214,11 +214,11 @@ testObject_NewBotResponse_provider_10 :: NewBotResponse testObject_NewBotResponse_provider_10 = NewBotResponse { rsNewBotPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""} ], rsNewBotLastPrekey = lastPrekey "R\165465", rsNewBotName = Nothing, @@ -230,8 +230,8 @@ testObject_NewBotResponse_provider_11 :: NewBotResponse testObject_NewBotResponse_provider_11 = NewBotResponse { rsNewBotPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "8"} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "8"} ], rsNewBotLastPrekey = lastPrekey "U\STX\ETB\1112642x", rsNewBotName = Nothing, @@ -252,7 +252,7 @@ testObject_NewBotResponse_provider_12 = testObject_NewBotResponse_provider_13 :: NewBotResponse testObject_NewBotResponse_provider_13 = NewBotResponse - { rsNewBotPrekeys = [Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "h\131368I"}], + { rsNewBotPrekeys = [UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "h\131368I"}], rsNewBotLastPrekey = lastPrekey "\1000435eP'X", rsNewBotName = Just @@ -276,14 +276,14 @@ testObject_NewBotResponse_provider_14 :: NewBotResponse testObject_NewBotResponse_provider_14 = NewBotResponse { rsNewBotPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""} ], rsNewBotLastPrekey = lastPrekey "Q\1012726\39031U", rsNewBotName = @@ -301,15 +301,15 @@ testObject_NewBotResponse_provider_15 :: NewBotResponse testObject_NewBotResponse_provider_15 = NewBotResponse { rsNewBotPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""} ], rsNewBotLastPrekey = lastPrekey "KuA\172666\1084633", rsNewBotName = @@ -327,11 +327,11 @@ testObject_NewBotResponse_provider_16 :: NewBotResponse testObject_NewBotResponse_provider_16 = NewBotResponse { rsNewBotPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} ], rsNewBotLastPrekey = lastPrekey "e!D*j", rsNewBotName = Just (Name {fromName = "\174414\&4?rvqg%\DC2\167142\DC1t\CAN\62298\SI_\92287F"}), @@ -343,8 +343,8 @@ testObject_NewBotResponse_provider_17 :: NewBotResponse testObject_NewBotResponse_provider_17 = NewBotResponse { rsNewBotPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "b"} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "b"} ], rsNewBotLastPrekey = lastPrekey "\1064414\f\1024452\12105", rsNewBotName = Just (Name {fromName = "g\49675B{\DC3Cq\CANmbD\DEL5Q\DC4>i\DC4\SI[\1022068|K\44297\57731|\175014"}), @@ -371,12 +371,12 @@ testObject_NewBotResponse_provider_19 :: NewBotResponse testObject_NewBotResponse_provider_19 = NewBotResponse { rsNewBotPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} ], rsNewBotLastPrekey = lastPrekey "u=\NAK", rsNewBotName = Just (Name {fromName = "FvrT0g\\\169897"}), @@ -395,9 +395,9 @@ testObject_NewBotResponse_provider_20 :: NewBotResponse testObject_NewBotResponse_provider_20 = NewBotResponse { rsNewBotPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = "+"}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = "\52025"}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = "+"}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = "\52025"}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} ], rsNewBotLastPrekey = lastPrekey "`|\144284^\US", rsNewBotName = Nothing, diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewClient_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewClient_user.hs index 98bb2187a95..83afd309922 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewClient_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewClient_user.hs @@ -34,7 +34,7 @@ import Wire.API.User.Client.Prekey testObject_NewClient_user_1 :: NewClient testObject_NewClient_user_1 = NewClient - { newClientPrekeys = [Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = "\r"}], + { newClientPrekeys = [UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = "\r"}], newClientLastKey = lastPrekey "\EM", newClientType = TemporaryClientType, newClientLabel = Just "", @@ -95,8 +95,8 @@ testObject_NewClient_user_4 :: NewClient testObject_NewClient_user_4 = NewClient { newClientPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} ], newClientLastKey = lastPrekey "i", newClientType = PermanentClientType, @@ -117,7 +117,7 @@ testObject_NewClient_user_4 = testObject_NewClient_user_5 :: NewClient testObject_NewClient_user_5 = NewClient - { newClientPrekeys = [Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = "\1093219"}], + { newClientPrekeys = [UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = "\1093219"}], newClientLastKey = lastPrekey "?&#", newClientType = TemporaryClientType, newClientLabel = Just "A\170327)", @@ -149,7 +149,7 @@ testObject_NewClient_user_6 = testObject_NewClient_user_7 :: NewClient testObject_NewClient_user_7 = NewClient - { newClientPrekeys = [Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "a"}], + { newClientPrekeys = [UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "a"}], newClientLastKey = lastPrekey "%V[", newClientType = TemporaryClientType, newClientLabel = Just "", @@ -190,10 +190,10 @@ testObject_NewClient_user_9 :: NewClient testObject_NewClient_user_9 = NewClient { newClientPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""} ], newClientLastKey = lastPrekey "", newClientType = LegalHoldClientType, @@ -210,7 +210,7 @@ testObject_NewClient_user_9 = testObject_NewClient_user_10 :: NewClient testObject_NewClient_user_10 = NewClient - { newClientPrekeys = [Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}], + { newClientPrekeys = [UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}], newClientLastKey = lastPrekey "\STX", newClientType = TemporaryClientType, newClientLabel = Just ";*", @@ -231,9 +231,9 @@ testObject_NewClient_user_11 :: NewClient testObject_NewClient_user_11 = NewClient { newClientPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} ], newClientLastKey = lastPrekey "", newClientType = LegalHoldClientType, @@ -255,12 +255,12 @@ testObject_NewClient_user_12 :: NewClient testObject_NewClient_user_12 = NewClient { newClientPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} ], newClientLastKey = lastPrekey "\ENQ", newClientType = PermanentClientType, @@ -282,13 +282,13 @@ testObject_NewClient_user_13 :: NewClient testObject_NewClient_user_13 = NewClient { newClientPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} ], newClientLastKey = lastPrekey "\DC1\DC3", newClientType = LegalHoldClientType, @@ -326,11 +326,11 @@ testObject_NewClient_user_15 :: NewClient testObject_NewClient_user_15 = NewClient { newClientPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} ], newClientLastKey = lastPrekey "\100417\113707", newClientType = TemporaryClientType, @@ -368,10 +368,10 @@ testObject_NewClient_user_17 :: NewClient testObject_NewClient_user_17 = NewClient { newClientPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} ], newClientLastKey = lastPrekey "\138278", newClientType = TemporaryClientType, @@ -409,9 +409,9 @@ testObject_NewClient_user_19 :: NewClient testObject_NewClient_user_19 = NewClient { newClientPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} ], newClientLastKey = lastPrekey "", newClientType = PermanentClientType, @@ -432,7 +432,7 @@ testObject_NewClient_user_19 = testObject_NewClient_user_20 :: NewClient testObject_NewClient_user_20 = NewClient - { newClientPrekeys = [Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}], + { newClientPrekeys = [UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}], newClientLastKey = lastPrekey "<", newClientType = LegalHoldClientType, newClientLabel = Just "+\FS", diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewLegalHoldClient_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewLegalHoldClient_team.hs index afd80a7b11a..443b98ba3ca 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewLegalHoldClient_team.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/NewLegalHoldClient_team.hs @@ -20,7 +20,7 @@ module Test.Wire.API.Golden.Generated.NewLegalHoldClient_team where import Wire.API.Team.LegalHold.External (NewLegalHoldClient (..)) -import Wire.API.User.Client.Prekey (Prekey (Prekey, prekeyId, prekeyKey), PrekeyId (PrekeyId, keyId), lastPrekey) +import Wire.API.User.Client.Prekey (PrekeyId (PrekeyId, keyId), UncheckedPrekeyBundle (UncheckedPrekeyBundle, prekeyId, prekeyKey), lastPrekey) testObject_NewLegalHoldClient_team_1 :: NewLegalHoldClient testObject_NewLegalHoldClient_team_1 = @@ -30,8 +30,8 @@ testObject_NewLegalHoldClient_team_2 :: NewLegalHoldClient testObject_NewLegalHoldClient_team_2 = NewLegalHoldClient { newLegalHoldClientPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 2}, prekeyKey = ",5!"}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "0<\1030053"} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 2}, prekeyKey = ",5!"}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "0<\1030053"} ], newLegalHoldClientLastKey = lastPrekey "\1104977\DLE\1065349\6667\&9,\1015715tft\FS" } @@ -46,7 +46,7 @@ testObject_NewLegalHoldClient_team_3 = testObject_NewLegalHoldClient_team_4 :: NewLegalHoldClient testObject_NewLegalHoldClient_team_4 = NewLegalHoldClient - { newLegalHoldClientPrekeys = [Prekey {prekeyId = PrekeyId {keyId = 5}, prekeyKey = "tp"}], + { newLegalHoldClientPrekeys = [UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 5}, prekeyKey = "tp"}], newLegalHoldClientLastKey = lastPrekey "u%vZ\DC3\1088709D\173228\ENQ\"\188001" } @@ -54,8 +54,8 @@ testObject_NewLegalHoldClient_team_5 :: NewLegalHoldClient testObject_NewLegalHoldClient_team_5 = NewLegalHoldClient { newLegalHoldClientPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 2}, prekeyKey = "Y"}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "n"} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 2}, prekeyKey = "Y"}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = "n"} ], newLegalHoldClientLastKey = lastPrekey "\\\1028142c\128341\&1\182736jO\CAN}T\58009D" } @@ -68,17 +68,17 @@ testObject_NewLegalHoldClient_team_7 :: NewLegalHoldClient testObject_NewLegalHoldClient_team_7 = NewLegalHoldClient { newLegalHoldClientPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = ""} ], newLegalHoldClientLastKey = lastPrekey "" } @@ -91,12 +91,12 @@ testObject_NewLegalHoldClient_team_9 :: NewLegalHoldClient testObject_NewLegalHoldClient_team_9 = NewLegalHoldClient { newLegalHoldClientPrekeys = - [ Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = "\1027435"}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 0}, prekeyKey = "}"}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, - Prekey {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""} + [ UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = "\1027435"}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 0}, prekeyKey = "}"}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""}, + UncheckedPrekeyBundle {prekeyId = PrekeyId {keyId = 1}, prekeyKey = ""} ], newLegalHoldClientLastKey = lastPrekey "y arbitrary - welcome <- arbitrary - CommitBundle commitMsg welcome <$> arbitrary + appMsg <- arbitrary + CommitBundle commitMsg + <$> arbitrary + <*> arbitrary + <*> pure (mkRawMLS . mkMessage . MessagePrivate <$> appMsg) newtype CommitPayload = CommitPayload {unCommitPayload :: RawMLS Commit} deriving newtype (Arbitrary) diff --git a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/PostgresMarshall.hs b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/PostgresMarshall.hs new file mode 100644 index 00000000000..31ce898c43e --- /dev/null +++ b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/PostgresMarshall.hs @@ -0,0 +1,83 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2026 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 . +{-# OPTIONS_GHC -Wno-orphans #-} + +module Test.Wire.API.Roundtrip.PostgresMarshall (tests) where + +import Crypto.Error (CryptoFailable (..)) +import Crypto.KDF.Argon2 qualified as Argon2 +import Data.ByteString.Char8 qualified as BS8 +import Data.Code qualified as Code +import Data.Misc (PlainTextPassword8, fromPlainTextPassword) +import Data.Text.Encoding (encodeUtf8) +import Imports +import Test.Tasty qualified as T +import Test.Tasty.QuickCheck +import Type.Reflection (typeRep) +import Wire.API.Password as Password +import Wire.API.Password.Argon2id (Argon2HashedPassword (..), encodeArgon2HashedPassword) +import Wire.API.Password.Scrypt (encodeScryptPassword) +import Wire.API.PostgresMarshall +import Wire.Arbitrary qualified as Arbitrary () + +tests :: T.TestTree +tests = + T.localOption (T.Timeout (60 * 1000000) "60s") . T.testGroup "PostgresMarshall roundtrip tests" $ + [ testRoundTrip @Text @Code.Key, + testRoundTrip @Text @Code.Value, + testRoundTrip @ByteString @Password.Password + ] + +testRoundTrip :: + forall db domain. + (Arbitrary domain, Typeable domain, PostgresMarshall db domain, PostgresUnmarshall db domain, Eq domain, Show domain) => + T.TestTree +testRoundTrip = testProperty msg trip + where + msg = show (typeRep @domain) + trip (value :: domain) = + counterexample (show value) $ + Right value === (postgresUnmarshall . postgresMarshall @db) value + +instance Arbitrary Password where + arbitrary = Argon2Password . hashPlaintext <$> (arbitrary :: Gen PlainTextPassword8) + where + hashPlaintext plain = + let opts = + Argon2.Options + { variant = Argon2.Argon2id, + version = Argon2.Version13, + iterations = 1, + parallelism = 1, + memory = 8 + } + salt = BS8.pack "static-salt-1234" + password = encodeUtf8 (fromPlainTextPassword plain) + hashedKey = hashWithOptions opts password salt + in Argon2HashedPassword {opts, salt, hashedKey} + hashWithOptions opts password salt = + let tagSize = 16 + in case Argon2.hash opts password salt tagSize of + CryptoFailed err -> error $ "argon2 hash failed: " <> show err + CryptoPassed hash -> hash + +instance Eq Password where + p1 == p2 = passwordText p1 == passwordText p2 + where + passwordText = \case + Argon2Password p -> encodeArgon2HashedPassword p + ScryptPassword p -> encodeScryptPassword p 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 0a083cd4fea..cf0f89456c3 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Run.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Run.hs @@ -31,6 +31,7 @@ import Test.Wire.API.Roundtrip.ByteString qualified as Roundtrip.ByteString import Test.Wire.API.Roundtrip.CSV qualified as Roundtrip.CSV import Test.Wire.API.Roundtrip.HttpApiData qualified as Roundtrip.HttpApiData import Test.Wire.API.Roundtrip.MLS qualified as Roundtrip.MLS +import Test.Wire.API.Roundtrip.PostgresMarshall as PostgresMarshall import Test.Wire.API.Routes qualified as Routes import Test.Wire.API.Routes.Version qualified as Routes.Version import Test.Wire.API.Routes.Version.Wai qualified as Routes.Version.Wai @@ -67,5 +68,6 @@ main = Routes.Version.tests, unsafePerformIO Routes.Version.Wai.tests, RawJson.tests, - OAuth.tests + OAuth.tests, + PostgresMarshall.tests ] diff --git a/libs/wire-api/test/unit/Test/Wire/API/Swagger.hs b/libs/wire-api/test/unit/Test/Wire/API/Swagger.hs index bbb37e6e2a4..c1a1daa4814 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Swagger.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Swagger.hs @@ -46,7 +46,7 @@ tests = testToJSON @(UserMap.QualifiedUserMap (Set Client.Client)), testToJSON @Client.UserClientPrekeyMap, testToJSON @Client.UserClients, - testToJSON @Prekey.Prekey, + testToJSON @Prekey.UncheckedPrekeyBundle, testToJSON @Prekey.PrekeyBundle, testToJSON @Prekey.ClientPrekey, testToJSON @Client.QualifiedUserClientPrekeyMap, 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 11ce3d914ef..684a5f9fb85 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/User.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/User.hs @@ -63,7 +63,7 @@ testEmailVisibleToSelf :: TestTree testEmailVisibleToSelf = testProperty "should not contain email when email visibility is EmailVisibleToSelf" $ \user lhStatus -> - let profile = mkUserProfile EmailVisibleToSelf user lhStatus + let profile = mkUserProfile EmailVisibleToSelf UserTypeRegular user lhStatus in profileEmail profile === Nothing .&&. profileLegalholdStatus profile === lhStatus @@ -71,7 +71,7 @@ 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 + let profile = mkUserProfile EmailVisibleIfOnTeam UserTypeRegular user lhStatus in (profileEmail profile === (userTeam user *> userEmail user)) .&&. profileLegalholdStatus profile === lhStatus @@ -81,13 +81,13 @@ testEmailVisibleIfOnSameTeam = where testNoViewerTeam = testProperty "should not contain email when viewer is not part of a team" $ \user lhStatus -> - let profile = mkUserProfile (EmailVisibleIfOnSameTeam Nothing) user lhStatus + let profile = mkUserProfile (EmailVisibleIfOnSameTeam Nothing) UserTypeRegular 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 + let profile = mkUserProfile (EmailVisibleIfOnSameTeam (Just (viewerTeamId, viewerMembership))) UserTypeRegular user lhStatus in Just viewerTeamId /= userTeam user ==> ( profileEmail profile === Nothing .&&. profileLegalholdStatus profile === lhStatus @@ -97,7 +97,7 @@ testEmailVisibleIfOnSameTeam = \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 + profile = mkUserProfile (EmailVisibleIfOnSameTeam (Just (viewerTeamId, viewerMembership))) UserTypeRegular user lhStatus in ( profileEmail profile === Nothing .&&. profileLegalholdStatus profile === lhStatus ) @@ -106,7 +106,7 @@ testEmailVisibleIfOnSameTeam = \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 + profile = mkUserProfile (EmailVisibleIfOnSameTeam (Just (viewerTeamId, viewerMembership))) UserTypeRegular user lhStatus in viewerRole /= RoleExternalPartner ==> ( profileEmail profile === userEmail user .&&. profileLegalholdStatus profile === lhStatus diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 0d0a1666608..cc4ec01bb57 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -291,6 +291,7 @@ library , case-insensitive , cassandra-util , cassava >=0.5 + , cborg , cereal , comonad , conduit @@ -709,6 +710,7 @@ test-suite wire-api-tests Test.Wire.API.Roundtrip.CSV Test.Wire.API.Roundtrip.HttpApiData Test.Wire.API.Roundtrip.MLS + Test.Wire.API.Roundtrip.PostgresMarshall Test.Wire.API.Routes Test.Wire.API.Routes.Version Test.Wire.API.Routes.Version.Wai diff --git a/libs/wire-subsystems/default.nix b/libs/wire-subsystems/default.nix index 65e5959917d..cf381ee0da6 100644 --- a/libs/wire-subsystems/default.nix +++ b/libs/wire-subsystems/default.nix @@ -23,6 +23,7 @@ , case-insensitive , cassandra-util , conduit +, constraints , containers , contravariant , cql @@ -37,6 +38,7 @@ , extra , file-embed , galley-types +, generics-sop , gitignoreSource , hashable , HaskellNet @@ -93,6 +95,7 @@ , servant-server , singletons , sodium-crypto-sign +, sop-core , ssl-util , statistics , stomp-queue @@ -148,6 +151,7 @@ mkDerivation { case-insensitive cassandra-util conduit + constraints containers contravariant cql @@ -162,6 +166,7 @@ mkDerivation { extra file-embed galley-types + generics-sop hashable HaskellNet HaskellNet-SSL @@ -212,6 +217,7 @@ mkDerivation { servant-server singletons sodium-crypto-sign + sop-core ssl-util statistics stomp-queue @@ -261,6 +267,7 @@ mkDerivation { case-insensitive cassandra-util conduit + constraints containers contravariant cql @@ -275,6 +282,7 @@ mkDerivation { extra file-embed galley-types + generics-sop hashable HaskellNet HaskellNet-SSL @@ -326,6 +334,7 @@ mkDerivation { servant-server singletons sodium-crypto-sign + sop-core ssl-util statistics stomp-queue diff --git a/libs/wire-subsystems/postgres-migrations/20260115150600-conversation-codes.sql b/libs/wire-subsystems/postgres-migrations/20260115150600-conversation-codes.sql new file mode 100644 index 00000000000..533b2e24a93 --- /dev/null +++ b/libs/wire-subsystems/postgres-migrations/20260115150600-conversation-codes.sql @@ -0,0 +1,16 @@ +CREATE TABLE conversation_codes ( + key text NOT NULL, + conversation uuid NOT NULL, + password bytea, + value text NOT NULL, + expires_at timestamptz NOT NULL, + PRIMARY KEY (key) +); + +-- index for lookups like `WHERE key = ? AND scope = ? AND expires_at > now()` +CREATE INDEX conversation_codes_key_expires_at_idx + ON conversation_codes (key, expires_at); + +-- index for deletes like `DELETE ... WHERE expires_at <= now()` +CREATE INDEX conversation_codes_expires_at_idx + ON conversation_codes (expires_at); diff --git a/libs/wire-subsystems/src/Wire/AppStore.hs b/libs/wire-subsystems/src/Wire/AppStore.hs index bc347da1662..5713306827c 100644 --- a/libs/wire-subsystems/src/Wire/AppStore.hs +++ b/libs/wire-subsystems/src/Wire/AppStore.hs @@ -41,7 +41,7 @@ data StoredApp = StoredApp -- The `PostgresMarshall` instances are here in this module -- as -- having them elsewhere would make them orphan instances of -- `StoredApp`. -instance PostgresMarshall StoredApp (UUID, UUID, Value, Text, Text, UUID) where +instance PostgresMarshall (UUID, UUID, Value, Text, Text, UUID) StoredApp where postgresMarshall app = ( postgresMarshall app.id, postgresMarshall app.teamId, @@ -64,5 +64,6 @@ instance PostgresUnmarshall (UUID, UUID, Value, Text, Text, UUID) StoredApp wher data AppStore m a where CreateApp :: StoredApp -> AppStore m () GetApp :: UserId -> TeamId -> AppStore m (Maybe StoredApp) + GetApps :: TeamId -> AppStore m [StoredApp] makeSem ''AppStore diff --git a/libs/wire-subsystems/src/Wire/AppStore/Postgres.hs b/libs/wire-subsystems/src/Wire/AppStore/Postgres.hs index d457003e3c9..4172fce84f1 100644 --- a/libs/wire-subsystems/src/Wire/AppStore/Postgres.hs +++ b/libs/wire-subsystems/src/Wire/AppStore/Postgres.hs @@ -43,6 +43,7 @@ interpretAppStoreToPostgres = interpret $ \case CreateApp app -> createAppImpl app GetApp userId teamId -> getAppImpl userId teamId + GetApps teamId -> getAppsImpl teamId createAppImpl :: ( Member (Input Pool) r, @@ -71,3 +72,16 @@ getAppImpl uid tid = dimapPG [maybeStatement| select (user_id :: uuid), (team_id :: uuid), (metadata :: json), (category :: text), (description :: text), (creator :: uuid) from apps where user_id = ($1 :: uuid) and team_id = ($2 :: uuid) |] + +getAppsImpl :: + ( Member (Input Pool) r, + Member (Embed IO) r, + Member (Error UsageError) r + ) => + TeamId -> + Sem r [StoredApp] +getAppsImpl tid = + runStatement tid $ + dimapPG + [vectorStatement| select (user_id :: uuid), (team_id :: uuid), (metadata :: json), (category :: text), (description :: text), (creator :: uuid) + from apps where team_id = ($1 :: uuid) |] diff --git a/libs/wire-subsystems/src/Wire/AppSubsystem.hs b/libs/wire-subsystems/src/Wire/AppSubsystem.hs index de5ae18a24a..9bfd80a894a 100644 --- a/libs/wire-subsystems/src/Wire/AppSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/AppSubsystem.hs @@ -52,6 +52,7 @@ appSubsystemErrorToHttpError = data AppSubsystem m a where CreateApp :: Local UserId -> TeamId -> Apps.NewApp -> AppSubsystem m Apps.CreatedApp GetApp :: Local UserId -> TeamId -> UserId -> AppSubsystem m Apps.GetApp + GetApps :: Local UserId -> TeamId -> AppSubsystem m [Apps.GetApp] RefreshAppCookie :: Local UserId -> TeamId -> diff --git a/libs/wire-subsystems/src/Wire/AppSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/AppSubsystem/Interpreter.hs index b3f22d1e1e2..9daedd390b0 100644 --- a/libs/wire-subsystems/src/Wire/AppSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/AppSubsystem/Interpreter.hs @@ -19,6 +19,7 @@ module Wire.AppSubsystem.Interpreter where import Data.ByteString.Conversion import Data.Id +import Data.Map qualified as Map import Data.Qualified import Data.RetryAfter import Data.Set qualified as Set @@ -70,6 +71,7 @@ runAppSubsystem :: runAppSubsystem = interpret \case CreateApp lusr tid new -> createAppImpl lusr tid new GetApp lusr tid uid -> getAppImpl lusr tid uid + GetApps lusr tid -> getAppsImpl lusr tid RefreshAppCookie lusr tid appId -> runError $ refreshAppCookieImpl lusr tid appId createAppImpl :: @@ -165,6 +167,37 @@ getAppImpl lusr tid uid = do description = storedApp.description } +getAppsImpl :: + ( Member AppStore r, + Member (Error AppSubsystemError) r, + Member GalleyAPIAccess r, + Member UserStore r + ) => + Local UserId -> + TeamId -> + Sem r [Apps.GetApp] +getAppsImpl lusr tid = do + void $ ensureTeamMember lusr tid + storedApps <- Store.getApps tid + us <- Store.getUsers ((.id) <$> storedApps) + let mkApp (storedApp, u) = + Apps.GetApp + { name = u.name, + pict = fromMaybe (Pict []) u.pict, + assets = fromMaybe [] u.assets, + accentId = u.accentId, + meta = storedApp.meta, + category = storedApp.category, + description = storedApp.description + } + pure $ mkApp <$> matchAndZip storedApps us + where + matchAndZip :: [StoredApp] -> [StoredUser] -> [(StoredApp, StoredUser)] + matchAndZip as us = mapMaybe f as + where + f a = (a,) <$> Map.lookup a.id umap + umap = Map.fromList $ (\u -> (u.id, u)) <$> us + refreshAppCookieImpl :: ( Member AuthenticationSubsystem r, Member AppStore r, diff --git a/libs/wire-subsystems/src/Wire/BrigAPIAccess.hs b/libs/wire-subsystems/src/Wire/BrigAPIAccess.hs index 34b90fe5b00..1a983235611 100644 --- a/libs/wire-subsystems/src/Wire/BrigAPIAccess.hs +++ b/libs/wire-subsystems/src/Wire/BrigAPIAccess.hs @@ -145,7 +145,7 @@ data BrigAPIAccess m a where AddLegalHoldClientToUserEither :: UserId -> ConnId -> - [Prekey] -> + [UncheckedPrekeyBundle] -> LastPrekey -> BrigAPIAccess m (Either AuthenticationError ClientId) RemoveLegalHoldClientFromUser :: UserId -> BrigAPIAccess m () @@ -174,7 +174,7 @@ addLegalHoldClientToUser :: (Member BrigAPIAccess r, Member (Error AuthenticationError) r) => UserId -> ConnId -> - [Prekey] -> + [UncheckedPrekeyBundle] -> LastPrekey -> Sem r ClientId addLegalHoldClientToUser uid con pks lpk = diff --git a/libs/wire-subsystems/src/Wire/BrigAPIAccess/Rpc.hs b/libs/wire-subsystems/src/Wire/BrigAPIAccess/Rpc.hs index bca65344eef..acb4c5abdde 100644 --- a/libs/wire-subsystems/src/Wire/BrigAPIAccess/Rpc.hs +++ b/libs/wire-subsystems/src/Wire/BrigAPIAccess/Rpc.hs @@ -448,7 +448,7 @@ addLegalHoldClientToUser :: (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) => UserId -> ConnId -> - [Prekey] -> + [UncheckedPrekeyBundle] -> LastPrekey -> Sem r (Either AuthenticationError ClientId) addLegalHoldClientToUser uid connId prekeys lastPrekey' = do diff --git a/services/galley/src/Galley/Effects/CodeStore.hs b/libs/wire-subsystems/src/Wire/CodeStore.hs similarity index 68% rename from services/galley/src/Galley/Effects/CodeStore.hs rename to libs/wire-subsystems/src/Wire/CodeStore.hs index 15d71162f3b..528b1b23358 100644 --- a/services/galley/src/Galley/Effects/CodeStore.hs +++ b/libs/wire-subsystems/src/Wire/CodeStore.hs @@ -17,42 +17,22 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Galley.Effects.CodeStore - ( -- * Code store effect - CodeStore (..), - - -- * Create code - createCode, - - -- * Read code - getCode, - - -- * Delete code - deleteCode, - - -- * Code generation - makeKey, - generateCode, - - -- * Configuration - getConversationCodeURI, - ) -where +module Wire.CodeStore where import Data.Code import Data.Id import Data.Misc -import Galley.Data.Types import Imports import Polysemy import Wire.API.Password +import Wire.CodeStore.Code data CodeStore m a where CreateCode :: Code -> Maybe Password -> CodeStore m () - GetCode :: Key -> Scope -> CodeStore m (Maybe (Code, Maybe Password)) - DeleteCode :: Key -> Scope -> CodeStore m () + GetCode :: Key -> CodeStore m (Maybe (Code, Maybe Password)) + DeleteCode :: Key -> CodeStore m () MakeKey :: ConvId -> CodeStore m Key - GenerateCode :: ConvId -> Scope -> Timeout -> CodeStore m Code + GenerateCode :: ConvId -> Timeout -> CodeStore m Code GetConversationCodeURI :: Maybe Text -> CodeStore m (Maybe HttpsUrl) makeSem ''CodeStore diff --git a/services/galley/src/Galley/Cassandra/Code.hs b/libs/wire-subsystems/src/Wire/CodeStore/Cassandra.hs similarity index 60% rename from services/galley/src/Galley/Cassandra/Code.hs rename to libs/wire-subsystems/src/Wire/CodeStore/Cassandra.hs index 407e6ceedea..d320f13369b 100644 --- a/services/galley/src/Galley/Cassandra/Code.hs +++ b/libs/wire-subsystems/src/Wire/CodeStore/Cassandra.hs @@ -15,56 +15,45 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Galley.Cassandra.Code +module Wire.CodeStore.Cassandra ( interpretCodeStoreToCassandra, ) where import Cassandra -import Control.Lens 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 (..)) -import Galley.Env +import Data.Misc (HttpsUrl) import Imports import Polysemy import Polysemy.Input -import Polysemy.TinyLog import Wire.API.Password +import Wire.CodeStore (CodeStore (..)) +import Wire.CodeStore.Cassandra.Queries qualified as Cql +import Wire.CodeStore.Code as Code +import Wire.Util (embedClientInput) interpretCodeStoreToCassandra :: ( Member (Embed IO) r, Member (Input ClientState) r, - Member (Input Env) r, - Member TinyLog r + Member (Input (Either HttpsUrl (Map Text HttpsUrl))) r ) => Sem (CodeStore ': r) a -> Sem r a interpretCodeStoreToCassandra = interpret $ \case - GetCode k s -> do - logEffect "CodeStore.GetCode" - embedClient $ lookupCode k s + GetCode k -> do + embedClientInput $ lookupCode k CreateCode code mPw -> do - logEffect "CodeStore.CreateCode" - embedClient $ insertCode code mPw - DeleteCode k s -> do - logEffect "CodeStore.DeleteCode" - embedClient $ deleteCode k s + embedClientInput $ insertCode code mPw + DeleteCode k -> do + embedClientInput $ deleteCode k MakeKey cid -> do - logEffect "CodeStore.MakeKey" Code.mkKey cid - GenerateCode cid s t -> do - logEffect "CodeStore.GenerateCode" - Code.generate cid s t + GenerateCode cid t -> do + Code.generate cid t GetConversationCodeURI mbHost -> do - logEffect "CodeStore.GetConversationCodeURI" - env <- input - case env ^. convCodeURI of + convCodeURI <- input + case convCodeURI of Left uri -> pure (Just uri) Right map' -> case mbHost of @@ -78,14 +67,13 @@ insertCode c mPw = do let v = codeValue c let cnv = codeConversation c let t = round (codeTTL c) - let s = codeScope c - retry x5 (write Cql.insertCode (params LocalQuorum (k, v, cnv, s, mPw, t))) + retry x5 (write Cql.insertCode (params LocalQuorum (k, v, cnv, mPw, t))) -- | Lookup a conversation by code. -lookupCode :: Key -> Scope -> Client (Maybe (Code, Maybe Password)) -lookupCode k s = - fmap (toCode k s) <$> retry x1 (query1 Cql.lookupCode (params LocalQuorum (k, s))) +lookupCode :: Key -> Client (Maybe (Code, Maybe Password)) +lookupCode k = + fmap (toCode k) <$> retry x1 (query1 Cql.lookupCode (params LocalQuorum (Identity k))) -- | Delete a code associated with the given conversation key -deleteCode :: Key -> Scope -> Client () -deleteCode k s = retry x5 $ write Cql.deleteCode (params LocalQuorum (k, s)) +deleteCode :: Key -> Client () +deleteCode k = retry x5 $ write Cql.deleteCode (params LocalQuorum (Identity k)) diff --git a/libs/wire-subsystems/src/Wire/CodeStore/Cassandra/Queries.hs b/libs/wire-subsystems/src/Wire/CodeStore/Cassandra/Queries.hs new file mode 100644 index 00000000000..23b31b8e9aa --- /dev/null +++ b/libs/wire-subsystems/src/Wire/CodeStore/Cassandra/Queries.hs @@ -0,0 +1,36 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2026 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.CodeStore.Cassandra.Queries where + +import Cassandra as C hiding (Value) +import Data.Id +import Imports +import Wire.API.Conversation.Code +import Wire.API.Password (Password) + +insertCode :: PrepQuery W (Key, Value, ConvId, Maybe Password, Int32) () +insertCode = "INSERT INTO conversation_codes (key, value, conversation, scope, password) VALUES (?, ?, ?, 1, ?) USING TTL ?" + +lookupCode :: PrepQuery R (Identity Key) (Value, Int32, ConvId, Maybe Password) +lookupCode = "SELECT value, ttl(value), conversation, password FROM conversation_codes WHERE key = ? AND scope = 1" + +deleteCode :: PrepQuery W (Identity Key) () +deleteCode = "DELETE FROM conversation_codes WHERE key = ? AND scope = 1" + +selectAllCodes :: PrepQuery R () (Key, Value, Int32, ConvId, Maybe Password) +selectAllCodes = "SELECT key, value, ttl(value), conversation, password FROM conversation_codes" diff --git a/services/galley/src/Galley/Data/Types.hs b/libs/wire-subsystems/src/Wire/CodeStore/Code.hs similarity index 79% rename from services/galley/src/Galley/Data/Types.hs rename to libs/wire-subsystems/src/Wire/CodeStore/Code.hs index 0f5e372a58f..c5c497e44be 100644 --- a/services/galley/src/Galley/Data/Types.hs +++ b/libs/wire-subsystems/src/Wire/CodeStore/Code.hs @@ -2,7 +2,7 @@ -- This file is part of the Wire Server implementation. -- --- Copyright (C) 2022 Wire Swiss GmbH +-- Copyright (C) 2026 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 @@ -17,11 +17,8 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Galley.Data.Types - ( StoredConversation (..), - selfConv, - Code (..), - Scope (..), +module Wire.CodeStore.Code + ( Code (..), toCode, generate, mkKey, @@ -34,34 +31,27 @@ import Data.Code import Data.Id import Data.Range import Data.Text.Ascii qualified as Ascii -import Galley.Data.Scope import Imports import OpenSSL.EVP.Digest (digestBS, getDigestByName) import OpenSSL.Random (randBytes) import Wire.API.Password (Password) -import Wire.StoredConversation - --------------------------------------------------------------------------------- --- Code data Code = Code { codeKey :: !Key, codeValue :: !Value, codeTTL :: !Timeout, codeConversation :: !ConvId, - codeScope :: !Scope, codeHasPassword :: !Bool } deriving (Eq, Show, Generic) -toCode :: Key -> Scope -> (Value, Int32, ConvId, Maybe Password) -> (Code, Maybe Password) -toCode k s (val, ttl, cnv, mPw) = +toCode :: Key -> (Value, Int32, ConvId, Maybe Password) -> (Code, Maybe Password) +toCode k (val, ttl, cnv, mPw) = ( Code { codeKey = k, codeValue = val, codeTTL = Timeout (fromIntegral ttl), codeConversation = cnv, - codeScope = s, codeHasPassword = isJust mPw }, mPw @@ -74,8 +64,8 @@ toCode k s (val, ttl, cnv, mPw) = -- The 'key' is a stable, truncated, base64 encoded sha256 hash of the conversation ID -- The 'value' is a base64 encoded, 120-bit random value (changing on each generation) -generate :: (MonadIO m) => ConvId -> Scope -> Timeout -> m Code -generate cnv s t = do +generate :: (MonadIO m) => ConvId -> Timeout -> m Code +generate cnv t = do key <- mkKey cnv val <- liftIO $ Value . unsafeRange . Ascii.encodeBase64Url <$> randBytes 15 pure @@ -84,7 +74,6 @@ generate cnv s t = do codeValue = val, codeConversation = cnv, codeTTL = t, - codeScope = s, codeHasPassword = False } diff --git a/libs/wire-subsystems/src/Wire/CodeStore/DualWrite.hs b/libs/wire-subsystems/src/Wire/CodeStore/DualWrite.hs new file mode 100644 index 00000000000..112b61a91ed --- /dev/null +++ b/libs/wire-subsystems/src/Wire/CodeStore/DualWrite.hs @@ -0,0 +1,57 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2026 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.CodeStore.DualWrite + ( interpretCodeStoreToCassandraAndPostgres, + ) +where + +import Cassandra (ClientState) +import Data.Misc +import Imports +import Polysemy +import Polysemy.Input +import Wire.CodeStore (CodeStore (..)) +import Wire.CodeStore qualified as CodeStore +import Wire.CodeStore.Cassandra qualified as Cassandra +import Wire.CodeStore.Postgres qualified as Postgres +import Wire.Postgres (PGConstraints) + +interpretCodeStoreToCassandraAndPostgres :: + ( Member (Input ClientState) r, + Member (Input (Either HttpsUrl (Map Text HttpsUrl))) r, + PGConstraints r + ) => + Sem (CodeStore ': r) a -> + Sem r a + +-- | Cassandra is the source of truth during migration; writes are mirrored to Postgres. +interpretCodeStoreToCassandraAndPostgres = interpret $ \case + GetCode k -> do + Cassandra.interpretCodeStoreToCassandra $ CodeStore.getCode k + CreateCode code mPw -> do + Cassandra.interpretCodeStoreToCassandra $ CodeStore.createCode code mPw + Postgres.interpretCodeStoreToPostgres $ CodeStore.createCode code mPw + DeleteCode k -> do + Cassandra.interpretCodeStoreToCassandra $ CodeStore.deleteCode k + Postgres.interpretCodeStoreToPostgres $ CodeStore.deleteCode k + MakeKey cid -> do + Cassandra.interpretCodeStoreToCassandra $ CodeStore.makeKey cid + GenerateCode cid t -> do + Cassandra.interpretCodeStoreToCassandra $ CodeStore.generateCode cid t + GetConversationCodeURI mbHost -> do + Cassandra.interpretCodeStoreToCassandra $ CodeStore.getConversationCodeURI mbHost diff --git a/libs/wire-subsystems/src/Wire/CodeStore/Migration.hs b/libs/wire-subsystems/src/Wire/CodeStore/Migration.hs new file mode 100644 index 00000000000..d260e9cb02f --- /dev/null +++ b/libs/wire-subsystems/src/Wire/CodeStore/Migration.hs @@ -0,0 +1,135 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2026 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.CodeStore.Migration + ( MigrationOptions (..), + migrateCodesLoop, + ) +where + +import Cassandra hiding (Value) +import Data.Code (Key, Value) +import Data.Conduit +import Data.Conduit.List qualified as C +import Data.Id (ConvId) +import Data.Misc (HttpsUrl) +import Hasql.Pool qualified as Hasql +import Imports +import Polysemy +import Polysemy.Error +import Polysemy.Input +import Polysemy.State +import Polysemy.TinyLog +import Prometheus qualified +import System.Logger qualified as Log +import Wire.API.Password +import Wire.CodeStore +import Wire.CodeStore.Cassandra.Queries qualified as Cql +import Wire.CodeStore.Code +import Wire.CodeStore.Postgres qualified as Postgres +import Wire.Migration +import Wire.Postgres +import Wire.Sem.Logger (mapLogger) +import Wire.Sem.Logger.TinyLog (loggerToTinyLog) + +type EffectStack = + [ State Int, + Input ClientState, + Input Hasql.Pool, + Input (Either HttpsUrl (Map Text HttpsUrl)), + TinyLog, + Embed IO, + Final IO + ] + +migrateCodesLoop :: + MigrationOptions -> + ClientState -> + Hasql.Pool -> + Log.Logger -> + Prometheus.Counter -> + Prometheus.Counter -> + Prometheus.Counter -> + IO () +migrateCodesLoop migOpts cassClient pgPool logger migCounter migFinished migFailed = + migrationLoop + logger + "conversation codes" + migFinished + migFailed + (interpreter cassClient pgPool logger "conversation codes") + (migrateAllCodes migOpts migCounter) + +interpreter :: ClientState -> Hasql.Pool -> Log.Logger -> ByteString -> Sem EffectStack a -> IO (Int, a) +interpreter cassClient pgPool logger name = + runFinal + . embedToFinal + . loggerToTinyLog logger + . mapLogger (Log.field "migration" (Log.val name) .) + . raiseUnder + . runInputConst (Right mempty) + . runInputConst pgPool + . runInputConst cassClient + . runState 0 + +migrateAllCodes :: + ( Member (Input Hasql.Pool) r, + Member (Input (Either HttpsUrl (Map Text HttpsUrl))) r, + Member (Embed IO) r, + Member (Input ClientState) r, + Member TinyLog r, + Member (State Int) r + ) => + MigrationOptions -> + Prometheus.Counter -> + ConduitM () Void (Sem r) () +migrateAllCodes migOpts migCounter = do + lift $ info $ Log.msg (Log.val "migrateAllCodes") + withCount (paginateSem Cql.selectAllCodes (paramsP LocalQuorum () migOpts.pageSize) x5) + .| logRetrievedPage migOpts.pageSize id + .| C.mapM_ (traverse_ (handleErrors (migrateCodeRow migCounter))) + +handleErrors :: + ( Member (State Int) r, + Member TinyLog r + ) => + ((Key, Value, Int32, ConvId, Maybe Password) -> Sem (Error Hasql.UsageError : r) ()) -> + (Key, Value, Int32, ConvId, Maybe Password) -> + Sem r () +handleErrors action row@(k, _, _, _, _) = do + eithErr <- runError (action row) + case eithErr of + Right _ -> pure () + Left e -> do + warn $ + Log.msg (Log.val "error occurred during migration") + . Log.field "key" (show k) + . Log.field "error" (show e) + modify (+ 1) + +migrateCodeRow :: + ( Member (Input (Either HttpsUrl (Map Text HttpsUrl))) r, + PGConstraints r + ) => + Prometheus.Counter -> + (Key, Value, Int32, ConvId, Maybe Password) -> + Sem r () +migrateCodeRow migCounter (k, v, ttl, cnv, mPw) = + when (ttl > 0) $ do + let (code, _) = toCode k (v, ttl, cnv, mPw) + Postgres.interpretCodeStoreToPostgres $ createCode code mPw + liftIO $ Prometheus.incCounter migCounter diff --git a/libs/wire-subsystems/src/Wire/CodeStore/Postgres.hs b/libs/wire-subsystems/src/Wire/CodeStore/Postgres.hs new file mode 100644 index 00000000000..0126216d79f --- /dev/null +++ b/libs/wire-subsystems/src/Wire/CodeStore/Postgres.hs @@ -0,0 +1,111 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2026 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.CodeStore.Postgres + ( interpretCodeStoreToPostgres, + ) +where + +import Data.Code +import Data.Id +import Data.Map qualified as Map +import Data.Misc (HttpsUrl) +import Hasql.Statement qualified as Hasql +import Hasql.TH +import Imports +import Polysemy +import Polysemy.Input +import Wire.API.Password +import Wire.API.PostgresMarshall +import Wire.CodeStore (CodeStore (..)) +import Wire.CodeStore.Code as Code +import Wire.Postgres + +interpretCodeStoreToPostgres :: + ( PGConstraints r, + Member (Input (Either HttpsUrl (Map Text HttpsUrl))) r + ) => + Sem (CodeStore ': r) a -> + Sem r a +interpretCodeStoreToPostgres = interpret $ \case + GetCode k -> do + lookupCode k + CreateCode code mPw -> do + insertCode code mPw + DeleteCode k -> do + deleteCode k + MakeKey cid -> do + Code.mkKey cid + GenerateCode cid t -> do + Code.generate cid t + GetConversationCodeURI mbHost -> do + convCodeURI <- input + pure $ case convCodeURI of + Left uri -> Just uri + Right map' -> mbHost >>= flip Map.lookup map' + +insertCode :: (PGConstraints r) => Code -> Maybe Password -> Sem r () +insertCode c password = do + runStatement (codeKey c, codeConversation c, password, codeValue c, round (codeTTL c)) insert + where + insert :: Hasql.Statement (Key, ConvId, Maybe Password, Value, Int32) () + insert = + lmapPG + [resultlessStatement|INSERT INTO conversation_codes + (key, conversation, password, value, expires_at) + VALUES + ($1 :: text, $2 :: uuid, $3 :: bytea?, $4 :: text, now() + make_interval(secs => $5 :: int)) + ON CONFLICT (key) DO UPDATE + SET conversation = ($2 :: uuid), + password = ($3 :: bytea?), + value = ($4 :: text), + expires_at = now() + make_interval(secs => $5 :: int) + |] + +lookupCode :: (PGConstraints r) => Key -> Sem r (Maybe (Code, Maybe Password)) +lookupCode k = do + mRow <- runStatement k selectCode + pure $ fmap (toCode k) mRow + where + selectCode :: Hasql.Statement Key (Maybe (Value, Int32, ConvId, Maybe Password)) + selectCode = + dimapPG + -- on the extraction of the remaining seconds of the TTL + -- `expires_at - now()` produces an interval representing how much time is left + -- `EXTRACT(EPOCH FROM interval)` converts that interval to seconds (a double precision) + -- `FLOOR(...)` truncates fractional seconds + -- `GREATEST(0, ...)` clamps negatives to 0 (expired rows) + -- `::int4` casts to 32‑bit integer. + [maybeStatement|SELECT + value :: text, + GREATEST(0, FLOOR(EXTRACT(EPOCH FROM (expires_at - now()))))::int4 AS ttl_secs, + conversation :: uuid, + password :: bytea? + FROM conversation_codes + WHERE key = ($1 :: text) AND expires_at > now () + |] + +deleteCode :: (PGConstraints r) => Key -> Sem r () +deleteCode k = + runStatement k delete + where + delete :: Hasql.Statement Key () + delete = + lmapPG + [resultlessStatement|DELETE FROM conversation_codes + WHERE key = ($1 :: text) + |] diff --git a/libs/wire-subsystems/src/Wire/ConversationStore.hs b/libs/wire-subsystems/src/Wire/ConversationStore.hs index 2a529d40cd5..9b7b4b97e24 100644 --- a/libs/wire-subsystems/src/Wire/ConversationStore.hs +++ b/libs/wire-subsystems/src/Wire/ConversationStore.hs @@ -224,13 +224,16 @@ instance FromJSON StorageLocation where x -> fail $ "Invalid storage location: " <> Text.unpack x <> ". Valid options: cassandra, postgresql, migration-to-postgresql" data PostgresMigrationOpts = PostgresMigrationOpts - { conversation :: StorageLocation + { conversation :: StorageLocation, + conversationCodes :: StorageLocation } deriving (Show) instance FromJSON PostgresMigrationOpts where parseJSON = withObject "PostgresMigrationOpts" $ \o -> - PostgresMigrationOpts <$> o .: "conversation" + PostgresMigrationOpts + <$> o .: "conversation" + <*> o .: "conversationCodes" getConvOrSubGroupInfo :: (Member ConversationStore r) => diff --git a/libs/wire-subsystems/src/Wire/ConversationStore/MLS/Types.hs b/libs/wire-subsystems/src/Wire/ConversationStore/MLS/Types.hs index b64eb458485..2573cfdd0fd 100644 --- a/libs/wire-subsystems/src/Wire/ConversationStore/MLS/Types.hs +++ b/libs/wire-subsystems/src/Wire/ConversationStore/MLS/Types.hs @@ -109,7 +109,16 @@ imAssocs = IntMap.assocs . unIndexMap -- Note that clients that are in the process of being removed from a group -- (i.e. there is a pending remove proposals for them) are __not__ included in -- this mapping. -type ClientMap a = Map (Qualified UserId) (Map ClientId a) +newtype ClientMap a = ClientMap + { unClientMap :: Map (Qualified UserId) (Map ClientId a) + } + deriving (Show, Eq, Functor) + +instance Semigroup (ClientMap a) where + ClientMap cm1 <> ClientMap cm2 = ClientMap $ Map.unionWith Map.union cm1 cm2 + +instance Monoid (ClientMap a) where + mempty = ClientMap mempty mkClientMap :: [(Domain, UserId, ClientId, Int32, Bool)] -> ClientMap LeafIndex mkClientMap = foldr addEntry mempty @@ -117,30 +126,40 @@ mkClientMap = foldr addEntry mempty addEntry :: (Domain, UserId, ClientId, Int32, Bool) -> ClientMap LeafIndex -> ClientMap LeafIndex addEntry (dom, usr, c, leafidx, pending_removal) | pending_removal = id -- treat as removed, don't add to ClientMap - | otherwise = Map.insertWith (<>) (Qualified usr dom) (Map.singleton c (fromIntegral leafidx)) + | otherwise = ClientMap . Map.insertWith (<>) (Qualified usr dom) (Map.singleton c (fromIntegral leafidx)) . unClientMap + +cmNull :: ClientMap a -> Bool +cmNull (ClientMap cm) = Map.null cm cmToMap :: (Ord a) => ClientMap a -> Map a ClientIdentity cmToMap = Map.fromList . map swap . cmAssocs -cmLookupIndex :: ClientIdentity -> ClientMap LeafIndex -> Maybe LeafIndex -cmLookupIndex cid cm = do +cmLookupIndex :: ClientIdentity -> ClientMap a -> Maybe a +cmLookupIndex cid (ClientMap cm) = do clients <- Map.lookup (cidQualifiedUser cid) cm Map.lookup (ciClient cid) clients -cmRemoveClient :: ClientIdentity -> ClientMap LeafIndex -> ClientMap LeafIndex -cmRemoveClient cid cm = case Map.lookup (cidQualifiedUser cid) cm of - Nothing -> cm - Just clients -> - let clients' = Map.delete (ciClient cid) clients - in if Map.null clients' - then Map.delete (cidQualifiedUser cid) cm - else Map.insert (cidQualifiedUser cid) clients' cm +cmLookup :: Qualified UserId -> ClientMap a -> Maybe (Map ClientId a) +cmLookup quid (ClientMap cm) = Map.lookup quid cm + +cmLookupClients :: Qualified UserId -> ClientMap a -> [ClientId] +cmLookupClients quid (ClientMap cm) = foldMap Map.keys (Map.lookup quid cm) + +cmRemoveClient :: ClientIdentity -> ClientMap a -> ClientMap a +cmRemoveClient cid (ClientMap cm) = ClientMap $ + case Map.lookup (cidQualifiedUser cid) cm of + Nothing -> cm + Just clients -> + let clients' = Map.delete (ciClient cid) clients + in if Map.null clients' + then Map.delete (cidQualifiedUser cid) cm + else Map.insert (cidQualifiedUser cid) clients' cm isClientMember :: ClientIdentity -> ClientMap LeafIndex -> Bool isClientMember ci = isJust . cmLookupIndex ci cmAssocs :: ClientMap a -> [(ClientIdentity, a)] -cmAssocs cm = do +cmAssocs (ClientMap cm) = do (quid, clients) <- Map.assocs cm (clientId, idx) <- Map.assocs clients pure (mkClientIdentity quid clientId, idx) @@ -150,9 +169,10 @@ cmIdentities = map fst . cmAssocs cmSingleton :: ClientIdentity -> a -> ClientMap a cmSingleton cid idx = - Map.singleton - (cidQualifiedUser cid) - (Map.singleton (ciClient cid) idx) + ClientMap $ + Map.singleton + (cidQualifiedUser cid) + (Map.singleton (ciClient cid) idx) -- | Inform a handler for 'POST /conversations/list-ids' if the MLS global team -- conversation and the MLS self-conversation should be included in the diff --git a/libs/wire-subsystems/src/Wire/ConversationStore/Migration.hs b/libs/wire-subsystems/src/Wire/ConversationStore/Migration.hs index 6cae2fc9cf6..a3bf288c239 100644 --- a/libs/wire-subsystems/src/Wire/ConversationStore/Migration.hs +++ b/libs/wire-subsystems/src/Wire/ConversationStore/Migration.hs @@ -22,9 +22,7 @@ module Wire.ConversationStore.Migration where import Cassandra import Cassandra.Settings hiding (pageSize) import Control.Error (lastMay) -import Data.Aeson (FromJSON) import Data.Conduit -import Data.Conduit.Internal (zipSources) import Data.Conduit.List qualified as C import Data.Domain import Data.Id @@ -37,7 +35,6 @@ import Data.Time.Calendar.OrdinalDate (fromOrdinalDate) import Data.Tuple.Extra import Data.Vector (Vector) import Data.Vector qualified as Vector -import GHC.Generics (Generically (..)) import Hasql.Pool qualified as Hasql import Hasql.Statement qualified as Hasql import Hasql.TH @@ -54,7 +51,6 @@ import Polysemy.Time import Polysemy.TinyLog import Prometheus qualified import System.Logger qualified as Log -import UnliftIO.Exception qualified as UnliftIO import Wire.API.Conversation hiding (Member) import Wire.API.Conversation.CellsState import Wire.API.Conversation.Protocol @@ -72,6 +68,7 @@ import Wire.ConversationStore.MLS.Types import Wire.ConversationStore.Migration.Cleanup import Wire.ConversationStore.Migration.Types import Wire.ConversationStore.MigrationLock +import Wire.Migration import Wire.Postgres import Wire.Sem.Concurrency (Concurrency, ConcurrencySafety (..), unsafePooledMapConcurrentlyN_) import Wire.Sem.Concurrency.IO (unsafelyPerformConcurrency) @@ -79,62 +76,56 @@ import Wire.Sem.Logger (mapLogger) import Wire.Sem.Logger.TinyLog (loggerToTinyLog) import Wire.Sem.Paging.Cassandra import Wire.StoredConversation -import Wire.Util -- * Top level logic -type EffectStack = [State Int, Input ClientState, Input Hasql.Pool, Async, Race, TinyLog, Embed IO, Concurrency 'Unsafe, Final IO] - -data MigrationOptions = MigrationOptions - { pageSize :: Int32, - parallelism :: Int - } - deriving (Show, Eq, Generic) - deriving (FromJSON) via Generically MigrationOptions - -migrateConvsLoop :: MigrationOptions -> ClientState -> Hasql.Pool -> Log.Logger -> Prometheus.Counter -> Prometheus.Counter -> Prometheus.Counter -> IO () +type EffectStack = + [ State Int, + Input ClientState, + Input Hasql.Pool, + Async, + Race, + TinyLog, + Embed IO, + Concurrency 'Unsafe, + Final IO + ] + +migrateConvsLoop :: + MigrationOptions -> + ClientState -> + Hasql.Pool -> + Log.Logger -> + Prometheus.Counter -> + Prometheus.Counter -> + Prometheus.Counter -> + IO () migrateConvsLoop migOpts cassClient pgPool logger migCounter migFinished migFailed = - migrationLoop cassClient pgPool logger "conversations" migFinished migFailed $ migrateAllConversations migOpts migCounter - -migrateUsersLoop :: MigrationOptions -> ClientState -> Hasql.Pool -> Log.Logger -> Prometheus.Counter -> Prometheus.Counter -> Prometheus.Counter -> IO () + migrationLoop + logger + "conversations" + migFinished + migFailed + (interpreter cassClient pgPool logger "conversations") + (migrateAllConversations migOpts migCounter) + +migrateUsersLoop :: + MigrationOptions -> + ClientState -> + Hasql.Pool -> + Log.Logger -> + Prometheus.Counter -> + Prometheus.Counter -> + Prometheus.Counter -> + IO () migrateUsersLoop migOpts cassClient pgPool logger migCounter migFinished migFailed = - migrationLoop cassClient pgPool logger "users" migFinished migFailed $ migrateAllUsers migOpts migCounter - -migrationLoop :: ClientState -> Hasql.Pool -> Log.Logger -> ByteString -> Prometheus.Counter -> Prometheus.Counter -> ConduitT () Void (Sem EffectStack) () -> IO () -migrationLoop cassClient pgPool logger name migFinished migFailed migration = do - go 0 `UnliftIO.catch` handleIOError - where - handleIOError :: SomeException -> IO () - handleIOError exc = do - Prometheus.incCounter migFailed - Log.err logger $ - Log.msg (Log.val "migration failed, it won't restart unless the background-worker is restarted.") - . Log.field "migration" name - . Log.field "error" (displayException exc) - UnliftIO.throwIO exc - - go :: Int -> IO () - go nIter = do - runMigration >>= \case - 0 -> do - Log.info logger $ - Log.msg (Log.val "finished migration") - . Log.field "attempt" nIter - . Log.field "migration" name - Prometheus.incCounter migFinished - n -> do - Log.info logger $ - Log.msg (Log.val "finished migration with errors") - . Log.field "migration" name - . Log.field "errors" n - . Log.field "attempt" nIter - go (nIter + 1) - - runMigration :: IO Int - runMigration = - fmap fst - . interpreter cassClient pgPool logger name - $ runConduit migration + migrationLoop + logger + "users" + migFinished + migFailed + (interpreter cassClient pgPool logger "users") + (migrateAllUsers migOpts migCounter) interpreter :: ClientState -> Hasql.Pool -> Log.Logger -> ByteString -> Sem EffectStack a -> IO (Int, a) interpreter cassClient pgPool logger name = @@ -166,7 +157,7 @@ migrateAllConversations :: migrateAllConversations migOpts migCounter = do lift $ info $ Log.msg (Log.val "migrateAllConversations") withCount (paginateSem select (paramsP LocalQuorum () migOpts.pageSize) x5) - .| logRetrievedPage migOpts.pageSize + .| logRetrievedPage migOpts.pageSize runIdentity .| C.mapM_ (unsafePooledMapConcurrentlyN_ migOpts.parallelism (handleErrors (migrateConversation migCounter) "conv")) where select :: PrepQuery R () (Identity ConvId) @@ -188,24 +179,12 @@ migrateAllUsers :: migrateAllUsers migOpts migCounter = do lift $ info $ Log.msg (Log.val "migrateAllUsers") withCount (paginateSem select (paramsP LocalQuorum () migOpts.pageSize) x5) - .| logRetrievedPage migOpts.pageSize + .| logRetrievedPage migOpts.pageSize runIdentity .| C.mapM_ (unsafePooledMapConcurrentlyN_ migOpts.parallelism (handleErrors (migrateUser migCounter) "user")) where select :: PrepQuery R () (Identity UserId) select = "select distinct user from user_remote_conv" -logRetrievedPage :: (Member TinyLog r) => Int32 -> ConduitM (Int32, [Identity (Id a)]) [Id a] (Sem r) () -logRetrievedPage pageSize = - C.mapM - ( \(i, rows) -> do - let estimatedRowsSoFar = (i - 1) * pageSize + fromIntegral (length rows) - info $ Log.msg (Log.val "retrieved page") . Log.field "estimatedRowsSoFar" estimatedRowsSoFar - pure $ map runIdentity rows - ) - -withCount :: (Monad m) => ConduitM () [a] m () -> ConduitM () (Int32, [a]) m () -withCount = zipSources (C.sourceList [1 ..]) - handleErrors :: (Member (State Int) r, Member TinyLog r) => (Id a -> Sem (Error MigrationLockError : Error Hasql.UsageError : r) b) -> ByteString -> Id a -> Sem r (Maybe b) handleErrors action lockType id_ = join <$> handleError (handleError action lockType) lockType id_ @@ -319,7 +298,7 @@ saveConvToPostgres allConvData = do ) () insertConv = - lmapPG @_ @(_, _, _, Vector Int32, Vector Int32, _, _, _, _, _, _, _, _, _, _, _, _, _, _) + lmapPG @(_, _, _, Vector Int32, Vector Int32, _, _, _, _, _, _, _, _, _, _, _, _, _, _) @_ [resultlessStatement|INSERT INTO conversation (id, type, creator, access, access_roles_v2, name, team, message_timer, receipt_mode, protocol, @@ -385,7 +364,7 @@ saveConvToPostgres allConvData = do ) () insertLocalMembers = - lmapPG @_ @(Vector _, Vector _, Vector _, Vector _, Vector _, Vector _, Vector _, Vector _, Vector _, Vector _, Vector _) + lmapPG @(Vector _, Vector _, Vector _, Vector _, Vector _, Vector _, Vector _, Vector _, Vector _, Vector _, Vector _) @_ [resultlessStatement|INSERT INTO conversation_member (conv, "user", service, provider, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role) @@ -397,7 +376,7 @@ saveConvToPostgres allConvData = do |] insertRemoteMembers :: Hasql.Statement ([ConvId], [Domain], [UserId], [RoleName]) () insertRemoteMembers = - lmapPG @_ @(Vector _, Vector _, Vector _, Vector _) + lmapPG @(Vector _, Vector _, Vector _, Vector _) [resultlessStatement|INSERT INTO local_conversation_remote_member (conv, user_remote_domain, user_remote_id, conversation_role) SELECT * FROM UNNEST($1 :: uuid[], $2 :: text[], $3 :: uuid[], $4 :: text[]) @@ -424,7 +403,7 @@ saveConvToPostgres allConvData = do insertMLSClients :: Hasql.Statement ([GroupId], [Domain], [UserId], [ClientId], [Int32], [Bool]) () insertMLSClients = - lmapPG @_ @(Vector _, Vector _, Vector _, Vector _, Vector _, Vector _) + lmapPG @(Vector _, Vector _, Vector _, Vector _, Vector _, Vector _) [resultlessStatement|INSERT INTO mls_group_member_client (group_id, user_domain, "user", client, leaf_node_index, removal_pending) SELECT * @@ -454,7 +433,7 @@ saveConvToPostgres allConvData = do insertSubConvs :: Hasql.Statement ([ConvId], [SubConvId], [Maybe CipherSuiteTag], [Epoch], [UTCTime], [GroupId], [Maybe GroupInfoData]) () insertSubConvs = - lmapPG @_ @(Vector _, Vector _, Vector _, Vector _, Vector _, Vector _, Vector _) + lmapPG @(Vector _, Vector _, Vector _, Vector _, Vector _, Vector _, Vector _) [resultlessStatement|INSERT INTO subconversation (conv_id, subconv_id, cipher_suite, epoch, epoch_timestamp, group_id, public_group_state) SELECT * @@ -495,7 +474,7 @@ saveRemoteMemberStatusToPostgres uid statusses = where insertStatuses :: Hasql.Statement ([UserId], [Domain], [ConvId], [Maybe MutedStatus], [Maybe Text], [Bool], [Maybe Text], [Bool], [Maybe Text]) () insertStatuses = - lmapPG @_ @(Vector _, Vector _, Vector _, Vector _, Vector _, Vector _, Vector _, Vector _, Vector _) + lmapPG @(Vector _, Vector _, Vector _, Vector _, Vector _, Vector _, Vector _, Vector _, Vector _) [resultlessStatement|INSERT INTO remote_conversation_local_member ("user", conv_remote_domain, conv_remote_id, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref) SELECT * @@ -528,24 +507,3 @@ unzip9 [] = ([], [], [], [], [], [], [], [], []) unzip9 ((y1, y2, y3, y4, y5, y6, y7, y8, y9) : ys) = let (l1, l2, l3, l4, l5, l6, l7, l8, l9) = unzip9 ys in (y1 : l1, y2 : l2, y3 : l3, y4 : l4, y5 : l5, y6 : l6, y7 : l7, y8 : l8, y9 : l9) - -paginateSem :: forall a b q r. (Tuple a, Tuple b, RunQ q, Member (Input ClientState) r, Member TinyLog r, Member (Embed IO) r) => q R a b -> QueryParams a -> RetrySettings -> ConduitT () [b] (Sem r) () -paginateSem q p r = do - go =<< lift getFirstPage - where - go page = do - lift $ info $ Log.msg (Log.val "Got a page") - unless (null (result page)) $ - yield (result page) - when (hasMore page) $ - go =<< lift (getNextPage page) - - getFirstPage :: Sem r (Page b) - getFirstPage = do - client <- input - embedClient client $ retry r (paginate q p) - - getNextPage :: Page b -> Sem r (Page b) - getNextPage page = do - client <- input - embedClient client $ retry r (nextPage page) diff --git a/libs/wire-subsystems/src/Wire/ConversationStore/Migration/Cleanup.hs b/libs/wire-subsystems/src/Wire/ConversationStore/Migration/Cleanup.hs index 68ea6ac3b4d..e26533da7b5 100644 --- a/libs/wire-subsystems/src/Wire/ConversationStore/Migration/Cleanup.hs +++ b/libs/wire-subsystems/src/Wire/ConversationStore/Migration/Cleanup.hs @@ -39,7 +39,7 @@ import Wire.Util data DeletionType = DeleteConv | DeleteUser -instance PostgresMarshall DeletionType Text where +instance PostgresMarshall Text DeletionType where postgresMarshall = \case DeleteConv -> "conv" DeleteUser -> "user" diff --git a/libs/wire-subsystems/src/Wire/ConversationStore/MigrationLock.hs b/libs/wire-subsystems/src/Wire/ConversationStore/MigrationLock.hs index 4f74501741e..e0830b5b176 100644 --- a/libs/wire-subsystems/src/Wire/ConversationStore/MigrationLock.hs +++ b/libs/wire-subsystems/src/Wire/ConversationStore/MigrationLock.hs @@ -110,7 +110,7 @@ withMigrationLocks lockType maxWait convOrUsers action = do acquireLocks :: Hasql.Statement [Int64] () acquireLocks = - lmapPG @[_] @(Vector _) + lmapPG @(Vector _) case lockType of LockExclusive -> [resultlessStatement|SELECT (1 :: int) @@ -123,7 +123,7 @@ withMigrationLocks lockType maxWait convOrUsers action = do releaseLocks :: Hasql.Statement [Int64] () releaseLocks = - lmapPG @[_] @(Vector _) + lmapPG @(Vector _) case lockType of LockExclusive -> [resultlessStatement|SELECT (1 :: int) diff --git a/libs/wire-subsystems/src/Wire/ConversationStore/Postgres.hs b/libs/wire-subsystems/src/Wire/ConversationStore/Postgres.hs index ff1c89490cf..f1e6d17569d 100644 --- a/libs/wire-subsystems/src/Wire/ConversationStore/Postgres.hs +++ b/libs/wire-subsystems/src/Wire/ConversationStore/Postgres.hs @@ -158,7 +158,7 @@ upsertConversationImpl lcnv nc = do pure storedConv where insertConvStatement = - lmapPG @_ @(_, _, _, Vector Int32, Vector Int32, _, _, _, _, _, _, _, _, _, _) + lmapPG @(_, _, _, Vector Int32, Vector Int32, _, _, _, _, _, _, _, _, _, _) @_ [resultlessStatement|INSERT INTO conversation (id, type, creator, access, access_roles_v2, name, team, message_timer, receipt_mode, protocol, @@ -255,7 +255,7 @@ getConversationsImpl cids = do where selectMetadata :: Hasql.Statement [ConvId] [ConvRowWithId] selectMetadata = - dimapPG @[_] @(Vector _) + dimapPG @(Vector _) @[_] @(Vector (_, _, _, Maybe (Vector _), Maybe (Vector _), _, _, _, _, _, _, _, _, _, _, _, _, _)) @[ConvRowWithId] [vectorStatement|SELECT (id :: uuid), (type :: integer), (creator :: uuid?), (access :: integer[]?), (access_roles_v2 :: integer[]?), @@ -267,7 +267,7 @@ getConversationsImpl cids = do |] selectAllLocalMembers :: Hasql.Statement [ConvId] [LocalMemberRow] selectAllLocalMembers = - dimapPG @[_] @(Vector _) + dimapPG @(Vector _) @[_] [vectorStatement|SELECT (conv :: uuid), ("user" :: uuid), (service :: uuid?), (provider :: uuid?), (otr_muted_status :: integer?), (otr_muted_ref :: text?), (otr_archived :: boolean?), (otr_archived_ref :: text?), (hidden :: boolean?), (hidden_ref :: text?), (conversation_role :: text?) FROM conversation_member @@ -282,7 +282,7 @@ getConversationsImpl cids = do |] selectAllRemoteMembers :: Hasql.Statement [ConvId] [RemoteMemberRow] selectAllRemoteMembers = - dimapPG @[_] @(Vector _) + dimapPG @(Vector _) @[_] [vectorStatement|SELECT (conv :: uuid), (user_remote_domain :: text), (user_remote_id :: uuid), (conversation_role :: text) FROM local_conversation_remote_member WHERE conv = ANY ($1 :: uuid[]) @@ -393,7 +393,7 @@ getRemoteConversationStatusImpl uid remoteConvs = do where select :: Hasql.Statement (UserId, Domain, [ConvId]) [(ConvId, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text)] select = - dimapPG @_ @(_, _, Vector _) + dimapPG @(_, _, Vector _) [vectorStatement|SELECT (conv_remote_id :: uuid), (otr_muted_status :: integer?), (otr_muted_ref :: text?), (otr_archived :: boolean?), (otr_archived_ref :: text?), @@ -410,7 +410,7 @@ selectConversationsImpl uid cids = where select :: Hasql.Statement (UserId, [ConvId]) [ConvId] select = - dimapPG @_ @(_, Vector _) + dimapPG @(_, Vector _) [vectorStatement|SELECT (conv :: uuid) from conversation_member WHERE "user" = ($1 :: uuid) AND conv = ANY ($2 :: uuid[]) @@ -445,7 +445,7 @@ setConversationAccessImpl convId accessData = where update :: Hasql.Statement (ConvId, Set Access, Set AccessRole) () update = - lmapPG @_ @(_, Vector _, Vector _) + lmapPG @(_, Vector _, Vector _) [resultlessStatement|UPDATE conversation SET access = ($2 :: integer[]), access_roles_v2 = ($3 :: integer[]) WHERE id = ($1 :: uuid)|] @@ -638,7 +638,7 @@ upsertMembersInRemoteConversationImpl (tUntagged -> Qualified cnv domain) users where upsert :: Hasql.Statement ([UserId], [Domain], [ConvId]) () upsert = - lmapPG @_ @(Vector _, Vector _, Vector _) + lmapPG @(Vector _, Vector _, Vector _) [resultlessStatement|INSERT INTO remote_conversation_local_member ("user", conv_remote_domain, conv_remote_id) SELECT * FROM UNNEST($1 :: uuid[], $2 :: text[], $3 :: uuid[]) ON CONFLICT ("user", conv_remote_domain, conv_remote_id) DO NOTHING @@ -829,7 +829,7 @@ haveRemoteConvsImpl uid = where select :: Hasql.Statement [UserId] [UserId] select = - dimapPG @[_] @(Vector _) @(Vector _) @[_] + dimapPG @(Vector _) @[_] @(Vector _) @[_] [vectorStatement|SELECT DISTINCT "user" :: uuid FROM remote_conversation_local_member WHERE "user" = ANY ($1 :: uuid[]) @@ -842,7 +842,7 @@ selectRemoteMembersImpl uids (tUntagged -> Qualified cid domain) = do where select :: Hasql.Statement (Domain, ConvId, [UserId]) [UserId] select = - dimapPG @_ @(_, _, Vector _) + dimapPG @(_, _, Vector _) [vectorStatement|SELECT ("user" :: uuid) FROM remote_conversation_local_member WHERE conv_remote_domain = ($1 :: text) @@ -944,7 +944,7 @@ deleteMembersImpl cid users = where deleteLocalsStmt :: Hasql.Statement (ConvId, [UserId]) () deleteLocalsStmt = - lmapPG @_ @(_, Vector _) + lmapPG @(_, Vector _) [resultlessStatement|DELETE FROM conversation_member WHERE conv = ($1 :: uuid) AND "user" = ANY($2 :: uuid[]) @@ -952,7 +952,7 @@ deleteMembersImpl cid users = deleteRemotesStmt :: Hasql.Statement (ConvId, Domain, [UserId]) () deleteRemotesStmt = - lmapPG @_ @(_, _, Vector _) + lmapPG @(_, _, Vector _) [resultlessStatement|DELETE FROM local_conversation_remote_member WHERE conv = ($1 :: uuid) AND user_remote_domain = ($2 :: text) @@ -965,7 +965,7 @@ deleteMembersInRemoteConversationImpl (tUntagged -> Qualified cid domain) uids = where delete :: Hasql.Statement (Domain, ConvId, [UserId]) () delete = - lmapPG @_ @(_, _, Vector _) + lmapPG @(_, _, Vector _) [resultlessStatement|DELETE FROM remote_conversation_local_member WHERE conv_remote_domain = ($1 :: text) AND conv_remote_id = ($2 :: uuid) @@ -1270,7 +1270,7 @@ searchConversationsImpl req = literal "with conv as (select id, name, access from conversation" <> where_ ( [ clause1 "team" "=" req.team, - clause1 "group_conv_type" "=" (postgresMarshall @_ @Int32 Channel) + clause1 "group_conv_type" "=" (postgresMarshall @Int32 Channel) ] <> [ clause (sortOrderOperator req.sortOrder) diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem.hs index 837ed89a1d5..fa9f1bc7653 100644 --- a/libs/wire-subsystems/src/Wire/EmailSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem.hs @@ -43,5 +43,7 @@ data EmailSubsystem m a where SendTeamInvitationMail :: EmailAddress -> TeamId -> EmailAddress -> InvitationCode -> Maybe Locale -> EmailSubsystem m Text -- | send invitation to an email address associated with a personal user account. SendTeamInvitationMailPersonalUser :: EmailAddress -> TeamId -> EmailAddress -> InvitationCode -> Maybe Locale -> EmailSubsystem m Text + SendMemberWelcomeEmail :: EmailAddress -> TeamId -> Text -> Maybe Locale -> EmailSubsystem m () + SendNewTeamOwnerWelcomeEmail :: EmailAddress -> TeamId -> Text -> Maybe Locale -> Name -> EmailSubsystem m () makeSem ''EmailSubsystem diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs index 58206ef46dd..3225190c16a 100644 --- a/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs @@ -17,23 +17,22 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Wire.EmailSubsystem.Interpreter - ( emailSubsystemInterpreter, - mkMimeAddress, - renderInvitationUrl, - ) -where +module Wire.EmailSubsystem.Interpreter where import Data.Code qualified as Code import Data.Id import Data.Json.Util +import Data.Map as Map import Data.Range (fromRange) import Data.Text qualified as Text import Data.Text.Ascii qualified as Ascii import Data.Text.Lazy (toStrict) +import Data.Text.Template import Imports import Network.Mail.Mime import Polysemy +import Polysemy.Output (Output) +import Polysemy.TinyLog (TinyLog) import Wire.API.Locale import Wire.API.User import Wire.API.User.Activation @@ -42,9 +41,17 @@ import Wire.API.User.Password import Wire.EmailSending (EmailSending, sendMail) import Wire.EmailSubsystem import Wire.EmailSubsystem.Template +import Wire.EmailSubsystem.Templates.Team +import Wire.EmailSubsystem.Templates.User -emailSubsystemInterpreter :: (Member EmailSending r) => Localised UserTemplates -> Localised TeamTemplates -> TemplateBranding -> InterpreterFor EmailSubsystem r +emailSubsystemInterpreter :: + (Member EmailSending r, Member TinyLog r) => + Localised UserTemplates -> + Localised TeamTemplates -> + Map Text Text -> + InterpreterFor EmailSubsystem r emailSubsystemInterpreter userTpls teamTpls branding = interpret \case + -- USER EMAILS SendPasswordResetMail email (key, code) mLocale -> sendPasswordResetMailImpl userTpls branding email key code mLocale SendVerificationMail email key code mLocale -> sendVerificationMailImpl userTpls branding email key code mLocale SendTeamDeletionVerificationMail email code mLocale -> sendTeamDeletionVerificationMailImpl userTpls branding email code mLocale @@ -55,8 +62,11 @@ emailSubsystemInterpreter userTpls teamTpls branding = interpret \case SendTeamActivationMail email name key code mLocale teamName -> sendTeamActivationMailImpl userTpls branding email name key code mLocale teamName SendNewClientEmail email name client locale -> sendNewClientEmailImpl userTpls branding email name client locale SendAccountDeletionEmail email name key code locale -> sendAccountDeletionEmailImpl userTpls branding email name key code locale + -- TEAM EMAILS SendTeamInvitationMail email tid from code loc -> sendTeamInvitationMailImpl teamTpls branding email tid from code loc SendTeamInvitationMailPersonalUser email tid from code loc -> sendTeamInvitationMailPersonalUserImpl teamTpls branding email tid from code loc + SendMemberWelcomeEmail email tid teamName loc -> sendMemberWelcomeEmailImpl teamTpls branding email tid teamName loc + SendNewTeamOwnerWelcomeEmail email tid teamName loc name -> sendNewTeamOwnerWelcomeEmailImpl teamTpls branding email tid teamName loc name ------------------------------------------------------------------------------- -- Verification Email for @@ -65,76 +75,81 @@ emailSubsystemInterpreter userTpls teamTpls branding = interpret \case -- - Team Deletion sendTeamDeletionVerificationMailImpl :: - (Member EmailSending r) => + (Member EmailSending r, Member TinyLog r) => Localised UserTemplates -> - TemplateBranding -> + Map Text Text -> EmailAddress -> Code.Value -> Maybe Locale -> Sem r () sendTeamDeletionVerificationMailImpl userTemplates branding email code mLocale = do let tpl = verificationTeamDeletionEmail . snd $ forLocale mLocale userTemplates - sendMail $ renderSecondFactorVerificationEmail email code tpl branding + mail <- logEmailRenderErrors "team deletion verification email" $ renderSecondFactorVerificationEmail email code tpl branding + sendMail mail sendCreateScimTokenVerificationMailImpl :: - (Member EmailSending r) => + (Member EmailSending r, Member TinyLog r) => Localised UserTemplates -> - TemplateBranding -> + Map Text Text -> EmailAddress -> Code.Value -> Maybe Locale -> Sem r () sendCreateScimTokenVerificationMailImpl userTemplates branding email code mLocale = do let tpl = verificationScimTokenEmail . snd $ forLocale mLocale userTemplates - sendMail $ renderSecondFactorVerificationEmail email code tpl branding + mail <- logEmailRenderErrors "scim token verification email" $ renderSecondFactorVerificationEmail email code tpl branding + sendMail mail sendLoginVerificationMailImpl :: - (Member EmailSending r) => + (Member EmailSending r, Member TinyLog r) => Localised UserTemplates -> - TemplateBranding -> + Map Text Text -> EmailAddress -> Code.Value -> Maybe Locale -> Sem r () sendLoginVerificationMailImpl userTemplates branding email code mLocale = do let tpl = verificationLoginEmail . snd $ forLocale mLocale userTemplates - sendMail $ renderSecondFactorVerificationEmail email code tpl branding + mail <- logEmailRenderErrors "login verification email" $ renderSecondFactorVerificationEmail email code tpl branding + sendMail mail renderSecondFactorVerificationEmail :: + (Member (Output Text) r) => EmailAddress -> Code.Value -> SecondFactorVerificationEmailTemplate -> - TemplateBranding -> - Mail -renderSecondFactorVerificationEmail email codeValue SecondFactorVerificationEmailTemplate {..} branding = - (emptyMail from) - { mailTo = [to], - mailHeaders = - [ ("Subject", toStrict subj), - ("X-Zeta-Purpose", "SecondFactorVerification"), - ("X-Zeta-Code", code) - ], - mailParts = [[plainPart txt, htmlPart html]] - } + Map Text Text -> + Sem r Mail +renderSecondFactorVerificationEmail email codeValue SecondFactorVerificationEmailTemplate {..} branding = do + let replace = + branding + & Map.insert "email" (fromEmail email) + & Map.insert "code" code + txt <- renderTextWithBrandingSem sndFactorVerificationEmailBodyText replace + html <- renderHtmlWithBrandingSem sndFactorVerificationEmailBodyHtml replace + subj <- renderTextWithBrandingSem sndFactorVerificationEmailSubject replace + pure + (emptyMail from) + { mailTo = [to], + mailHeaders = + [ ("Subject", toStrict subj), + ("X-Zeta-Purpose", "SecondFactorVerification"), + ("X-Zeta-Code", code) + ], + mailParts = [[plainPart txt, htmlPart html]] + } where from = Address (Just sndFactorVerificationEmailSenderName) (fromEmail sndFactorVerificationEmailSender) to = Address Nothing (fromEmail email) - txt = renderTextWithBranding sndFactorVerificationEmailBodyText replace branding - html = renderHtmlWithBranding sndFactorVerificationEmailBodyHtml replace branding - subj = renderTextWithBranding sndFactorVerificationEmailSubject replace branding code = Ascii.toText (fromRange codeValue.asciiValue) - replace :: Text -> Text - replace "email" = fromEmail email - replace "code" = code - replace x = x ------------------------------------------------------------------------------- -- Activation Email sendActivationMailImpl :: - (Member EmailSending r) => + (Member EmailSending r, Member TinyLog r) => Localised UserTemplates -> - TemplateBranding -> + Map Text Text -> EmailAddress -> Name -> ActivationKey -> @@ -143,12 +158,13 @@ sendActivationMailImpl :: Sem r () sendActivationMailImpl userTemplates branding email name akey acode mLocale = do let tpl = activationEmail . snd $ forLocale mLocale userTemplates - sendMail $ renderActivationMail email name akey acode tpl branding + mail <- logEmailRenderErrors "activation email" $ renderActivationMail email name akey acode tpl branding + sendMail mail sendEmailAddressUpdateMailImpl :: - (Member EmailSending r) => + (Member EmailSending r, Member TinyLog r) => Localised UserTemplates -> - TemplateBranding -> + Map Text Text -> EmailAddress -> Name -> ActivationKey -> @@ -157,54 +173,52 @@ sendEmailAddressUpdateMailImpl :: Sem r () sendEmailAddressUpdateMailImpl userTemplates branding email name akey acode mLocale = do let tpl = activationEmailUpdate . snd $ forLocale mLocale userTemplates - sendMail $ renderActivationMail email name akey acode tpl branding - -renderActivationMail :: EmailAddress -> Name -> ActivationKey -> ActivationCode -> ActivationEmailTemplate -> TemplateBranding -> Mail -renderActivationMail email name akey@(ActivationKey key) acode@(ActivationCode code) ActivationEmailTemplate {..} branding = - (emptyMail from) - { mailTo = [to], - -- To make automated processing possible, the activation code is also added to - -- headers. {#RefActivationEmailHeaders} - mailHeaders = - [ ("Subject", toStrict subj), - ("X-Zeta-Purpose", "Activation"), - ("X-Zeta-Key", Ascii.toText key), - ("X-Zeta-Code", Ascii.toText code) - ], - mailParts = [[plainPart txt, htmlPart html]] - } + mail <- logEmailRenderErrors "email address update email" $ renderActivationMail email name akey acode tpl branding + sendMail mail + +renderActivationMail :: (Member (Output Text) r) => EmailAddress -> Name -> ActivationKey -> ActivationCode -> ActivationEmailTemplate -> Map Text Text -> Sem r Mail +renderActivationMail email name akey@(ActivationKey key) acode@(ActivationCode code) ActivationEmailTemplate {..} branding = do + url <- renderActivationUrl activationEmailUrl akey acode branding + let replace = + branding + & Map.insert "url" url + & Map.insert "email" (fromEmail email) + & Map.insert "name" (fromName name) + txt <- renderTextWithBrandingSem activationEmailBodyText replace + html <- renderHtmlWithBrandingSem activationEmailBodyHtml replace + subj <- renderTextWithBrandingSem activationEmailSubject replace + pure + (emptyMail from) + { mailTo = [to], + -- To make automated processing possible, the activation code is also added to + -- headers. {#RefActivationEmailHeaders} + mailHeaders = + [ ("Subject", toStrict subj), + ("X-Zeta-Purpose", "Activation"), + ("X-Zeta-Key", Ascii.toText key), + ("X-Zeta-Code", Ascii.toText code) + ], + mailParts = [[plainPart txt, htmlPart html]] + } where - from, to :: Address from = Address (Just activationEmailSenderName) (fromEmail activationEmailSender) to = mkMimeAddress name email - txt, html, subj :: LText - txt = renderTextWithBranding activationEmailBodyText replace branding - html = renderHtmlWithBranding activationEmailBodyHtml replace branding - subj = renderTextWithBranding activationEmailSubject replace branding - - replace :: Text -> Text - replace "url" = renderActivationUrl activationEmailUrl akey acode branding - replace "email" = fromEmail email - replace "name" = fromName name - replace x = x - -renderActivationUrl :: Template -> ActivationKey -> ActivationCode -> TemplateBranding -> Text -renderActivationUrl t (ActivationKey k) (ActivationCode c) branding = - toStrict $ renderTextWithBranding t replace branding - where - replace :: Text -> Text - replace "key" = Ascii.toText k - replace "code" = Ascii.toText c - replace x = x +renderActivationUrl :: (Member (Output Text) r) => Template -> ActivationKey -> ActivationCode -> Map Text Text -> Sem r Text +renderActivationUrl t (ActivationKey k) (ActivationCode c) branding = do + let replace = + branding + & Map.insert "key" (Ascii.toText k) + & Map.insert "code" (Ascii.toText c) + toStrict <$> renderTextWithBrandingSem t replace ------------------------------------------------------------------------------- -- Team Activation Email sendTeamActivationMailImpl :: - (Member EmailSending r) => + (Member EmailSending r, Member TinyLog r) => Localised UserTemplates -> - TemplateBranding -> + Map Text Text -> EmailAddress -> Name -> ActivationKey -> @@ -214,42 +228,43 @@ sendTeamActivationMailImpl :: Sem r () sendTeamActivationMailImpl userTemplates branding email name akey acode mLocale teamName = do let tpl = teamActivationEmail . snd $ forLocale mLocale userTemplates - sendMail $ renderTeamActivationMail email name teamName akey acode tpl branding - -renderTeamActivationMail :: EmailAddress -> Name -> Text -> ActivationKey -> ActivationCode -> TeamActivationEmailTemplate -> TemplateBranding -> Mail -renderTeamActivationMail email name teamName akey@(ActivationKey key) acode@(ActivationCode code) TeamActivationEmailTemplate {..} branding = - (emptyMail from) - { mailTo = [to], - mailHeaders = - [ ("Subject", toStrict subj), - ("X-Zeta-Purpose", "Activation"), - ("X-Zeta-Key", Ascii.toText key), - ("X-Zeta-Code", Ascii.toText code) - ], - mailParts = [[plainPart txt, htmlPart html]] - } + mail <- logEmailRenderErrors "team activation email" $ renderTeamActivationMail email name teamName akey acode tpl branding + sendMail mail + +renderTeamActivationMail :: (Member (Output Text) r) => EmailAddress -> Name -> Text -> ActivationKey -> ActivationCode -> TeamActivationEmailTemplate -> Map Text Text -> Sem r Mail +renderTeamActivationMail email name teamName akey@(ActivationKey key) acode@(ActivationCode code) TeamActivationEmailTemplate {..} branding = do + url <- renderActivationUrl teamActivationEmailUrl akey acode branding + let replace = + branding + & Map.insert "url" url + & Map.insert "email" (fromEmail email) + & Map.insert "name" (fromName name) + & Map.insert "team" teamName + txt <- renderTextWithBrandingSem teamActivationEmailBodyText replace + html <- renderHtmlWithBrandingSem teamActivationEmailBodyHtml replace + subj <- renderTextWithBrandingSem teamActivationEmailSubject replace + pure + (emptyMail from) + { mailTo = [to], + mailHeaders = + [ ("Subject", toStrict subj), + ("X-Zeta-Purpose", "Activation"), + ("X-Zeta-Key", Ascii.toText key), + ("X-Zeta-Code", Ascii.toText code) + ], + mailParts = [[plainPart txt, htmlPart html]] + } where - from, to :: Address from = Address (Just teamActivationEmailSenderName) (fromEmail teamActivationEmailSender) to = mkMimeAddress name email - txt, html, subj :: LText - txt = renderTextWithBranding teamActivationEmailBodyText replace branding - html = renderHtmlWithBranding teamActivationEmailBodyHtml replace branding - subj = renderTextWithBranding teamActivationEmailSubject replace branding - replace :: Text -> Text - replace "url" = renderActivationUrl teamActivationEmailUrl akey acode branding - replace "email" = fromEmail email - replace "name" = fromName name - replace "team" = teamName - replace x = x ------------------------------------------------------------------------------- -- Verification Email sendVerificationMailImpl :: - (Member EmailSending r) => + (Member EmailSending r, Member TinyLog r) => Localised UserTemplates -> - TemplateBranding -> + Map Text Text -> EmailAddress -> ActivationKey -> ActivationCode -> @@ -257,39 +272,42 @@ sendVerificationMailImpl :: Sem r () sendVerificationMailImpl userTemplates branding email akey acode mLocale = do let tpl = verificationEmail . snd $ forLocale mLocale userTemplates - sendMail $ renderVerificationMail email akey acode tpl branding - -renderVerificationMail :: EmailAddress -> ActivationKey -> ActivationCode -> VerificationEmailTemplate -> TemplateBranding -> Mail -renderVerificationMail email akey acode VerificationEmailTemplate {..} branding = - (emptyMail from) - { mailTo = [to], - -- To make automated processing possible, the activation code is also added to - -- headers. {#RefActivationEmailHeaders} - mailHeaders = - [ ("Subject", toStrict subj), - ("X-Zeta-Purpose", "Verification"), - ("X-Zeta-Code", Ascii.toText code) - ], - mailParts = [[plainPart txt, htmlPart html]] - } + mail <- logEmailRenderErrors "verification email" $ renderVerificationMail email akey acode tpl branding + sendMail mail + +renderVerificationMail :: (Member (Output Text) r) => EmailAddress -> ActivationKey -> ActivationCode -> VerificationEmailTemplate -> Map Text Text -> Sem r Mail +renderVerificationMail email akey acode VerificationEmailTemplate {..} branding = do + let replace = + branding + & Map.insert "code" (Ascii.toText code) + & Map.insert "email" (fromEmail email) + txt <- renderTextWithBrandingSem verificationEmailBodyText replace + html <- renderHtmlWithBrandingSem verificationEmailBodyHtml replace + subj <- renderTextWithBrandingSem verificationEmailSubject replace + pure + (emptyMail from) + { mailTo = [to], + -- To make automated processing possible, the activation code is also added to + -- headers. {#RefActivationEmailHeaders} + mailHeaders = + [ ("Subject", toStrict subj), + ("X-Zeta-Purpose", "Verification"), + ("X-Zeta-Code", Ascii.toText code) + ], + mailParts = [[plainPart txt, htmlPart html]] + } where (ActivationKey _, ActivationCode code) = (akey, acode) from = Address (Just verificationEmailSenderName) (fromEmail verificationEmailSender) to = Address Nothing (fromEmail email) - txt = renderTextWithBranding verificationEmailBodyText replace branding - html = renderHtmlWithBranding verificationEmailBodyHtml replace branding - subj = renderTextWithBranding verificationEmailSubject replace branding - replace "code" = Ascii.toText code - replace "email" = fromEmail email - replace x = x ------------------------------------------------------------------------------- -- Password Reset Email sendPasswordResetMailImpl :: - (Member EmailSending r) => + (Member EmailSending r, Member TinyLog r) => Localised UserTemplates -> - TemplateBranding -> + Map Text Text -> EmailAddress -> PasswordResetKey -> PasswordResetCode -> @@ -297,45 +315,46 @@ sendPasswordResetMailImpl :: Sem r () sendPasswordResetMailImpl userTemplates branding email pkey pcode mLocale = do let tpl = passwordResetEmail . snd $ forLocale mLocale userTemplates - sendMail $ renderPwResetMail email pkey pcode tpl branding - -renderPwResetMail :: EmailAddress -> PasswordResetKey -> PasswordResetCode -> PasswordResetEmailTemplate -> TemplateBranding -> Mail -renderPwResetMail email pkey pcode PasswordResetEmailTemplate {..} branding = - (emptyMail from) - { mailTo = [to], - mailHeaders = - [ ("Subject", toStrict subj), - ("X-Zeta-Purpose", "PasswordReset"), - ("X-Zeta-Key", Ascii.toText key), - ("X-Zeta-Code", Ascii.toText code) - ], - mailParts = [[plainPart txt, htmlPart html]] - } + mail <- logEmailRenderErrors "password reset email" $ renderPwResetMail email pkey pcode tpl branding + sendMail mail + +renderPwResetMail :: (Member (Output Text) r) => EmailAddress -> PasswordResetKey -> PasswordResetCode -> PasswordResetEmailTemplate -> Map Text Text -> Sem r Mail +renderPwResetMail email pkey pcode PasswordResetEmailTemplate {..} branding = do + url <- renderPwResetUrl passwordResetEmailUrl pkey pcode + let replace = branding & Map.insert "url" url + txt <- renderTextWithBrandingSem passwordResetEmailBodyText replace + html <- renderHtmlWithBrandingSem passwordResetEmailBodyHtml replace + subj <- renderTextWithBrandingSem passwordResetEmailSubject replace + pure + (emptyMail from) + { mailTo = [to], + mailHeaders = + [ ("Subject", toStrict subj), + ("X-Zeta-Purpose", "PasswordReset"), + ("X-Zeta-Key", Ascii.toText key), + ("X-Zeta-Code", Ascii.toText code) + ], + mailParts = [[plainPart txt, htmlPart html]] + } where (PasswordResetKey key, PasswordResetCode code) = (pkey, pcode) from = Address (Just passwordResetEmailSenderName) (fromEmail passwordResetEmailSender) to = Address Nothing (fromEmail email) - txt = renderTextWithBranding passwordResetEmailBodyText replace branding - html = renderHtmlWithBranding passwordResetEmailBodyHtml replace branding - subj = renderTextWithBranding passwordResetEmailSubject replace branding - replace "url" = renderPwResetUrl passwordResetEmailUrl (pkey, pcode) branding - replace x = x - -renderPwResetUrl :: Template -> PasswordResetPair -> TemplateBranding -> Text -renderPwResetUrl t (PasswordResetKey k, PasswordResetCode c) branding = - toStrict $ renderTextWithBranding t replace branding - where - replace "key" = Ascii.toText k - replace "code" = Ascii.toText c - replace x = x + + renderPwResetUrl t (PasswordResetKey k) (PasswordResetCode c) = do + let replace = + branding + & Map.insert "key" (Ascii.toText k) + & Map.insert "code" (Ascii.toText c) + toStrict <$> renderTextWithBrandingSem t replace ------------------------------------------------------------------------------- -- New Client Email sendNewClientEmailImpl :: - (Member EmailSending r) => + (Member EmailSending r, Member TinyLog r) => Localised UserTemplates -> - TemplateBranding -> + Map Text Text -> EmailAddress -> Name -> Client -> @@ -343,41 +362,45 @@ sendNewClientEmailImpl :: Sem r () sendNewClientEmailImpl userTemplates branding email name client locale = do let tpl = newClientEmail . snd $ forLocale (Just locale) userTemplates - sendMail $ renderNewClientEmail email name locale client tpl branding - -renderNewClientEmail :: EmailAddress -> Name -> Locale -> Client -> NewClientEmailTemplate -> TemplateBranding -> Mail -renderNewClientEmail email name locale Client {..} NewClientEmailTemplate {..} branding = - (emptyMail from) - { mailTo = [to], - mailHeaders = - [ ("Subject", toStrict subj), - ("X-Zeta-Purpose", "NewDevice") - ], - mailParts = [[plainPart txt, htmlPart html]] - } + mail <- logEmailRenderErrors "new client email" $ renderNewClientEmail email name locale client tpl branding + sendMail mail + +renderNewClientEmail :: (Member (Output Text) r) => EmailAddress -> Name -> Locale -> Client -> NewClientEmailTemplate -> Map Text Text -> Sem r Mail +renderNewClientEmail email name locale Client {..} NewClientEmailTemplate {..} branding = do + let replace = + branding + & Map.insert "name" (fromName name) + & Map.insert "label" (fromMaybe defRequestId clientLabel) + & Map.insert "model" (fromMaybe defRequestId clientModel) + & Map.insert "date" formattedDate + txt <- renderTextWithBrandingSem newClientEmailBodyText replace + html <- renderHtmlWithBrandingSem newClientEmailBodyHtml replace + subj <- renderTextWithBrandingSem newClientEmailSubject replace + pure + (emptyMail from) + { mailTo = [to], + mailHeaders = + [ ("Subject", toStrict subj), + ("X-Zeta-Purpose", "NewDevice") + ], + mailParts = [[plainPart txt, htmlPart html]] + } where from = Address (Just newClientEmailSenderName) (fromEmail newClientEmailSender) to = mkMimeAddress name email - txt = renderTextWithBranding newClientEmailBodyText replace branding - html = renderHtmlWithBranding newClientEmailBodyHtml replace branding - subj = renderTextWithBranding newClientEmailSubject replace branding - replace "name" = fromName name - replace "label" = fromMaybe defRequestId clientLabel - replace "model" = fromMaybe defRequestId clientModel - replace "date" = + formattedDate = formatDateTime "%A %e %B %Y, %H:%M - %Z" (timeLocale locale) (fromUTCTimeMillis clientTime) - replace x = x ------------------------------------------------------------------------------- -- Deletion Email sendAccountDeletionEmailImpl :: - (Member EmailSending r) => + (Member EmailSending r, Member TinyLog r) => Localised UserTemplates -> - TemplateBranding -> + Map Text Text -> EmailAddress -> Name -> Code.Key -> @@ -386,54 +409,81 @@ sendAccountDeletionEmailImpl :: Sem r () sendAccountDeletionEmailImpl userTemplates branding email name key code locale = do let tpl = deletionEmail . snd $ forLocale (Just locale) userTemplates - sendMail $ renderDeletionEmail email name key code tpl branding - -renderDeletionEmail :: EmailAddress -> Name -> Code.Key -> Code.Value -> DeletionEmailTemplate -> TemplateBranding -> Mail -renderDeletionEmail email name cKey cValue DeletionEmailTemplate {..} branding = - (emptyMail from) - { mailTo = [to], - mailHeaders = - [ ("Subject", toStrict subj), - ("X-Zeta-Purpose", "Delete"), - ("X-Zeta-Key", key), - ("X-Zeta-Code", code) - ], - mailParts = [[plainPart txt, htmlPart html]] - } + mail <- logEmailRenderErrors "account deletion email" $ renderDeletionEmail email name key code tpl branding + sendMail mail + +renderDeletionEmail :: (Member (Output Text) r) => EmailAddress -> Name -> Code.Key -> Code.Value -> DeletionEmailTemplate -> Map Text Text -> Sem r Mail +renderDeletionEmail email name cKey cValue DeletionEmailTemplate {..} branding = do + url <- renderDeletionUrl deletionEmailUrl cKey cValue branding + let replace = + branding + & Map.insert "url" url + & Map.insert "email" (fromEmail email) + & Map.insert "name" (fromName name) + txt <- renderTextWithBrandingSem deletionEmailBodyText replace + html <- renderHtmlWithBrandingSem deletionEmailBodyHtml replace + subj <- renderTextWithBrandingSem deletionEmailSubject replace + pure + (emptyMail from) + { mailTo = [to], + mailHeaders = + [ ("Subject", toStrict subj), + ("X-Zeta-Purpose", "Delete"), + ("X-Zeta-Key", key), + ("X-Zeta-Code", code) + ], + mailParts = [[plainPart txt, htmlPart html]] + } where from = Address (Just deletionEmailSenderName) (fromEmail deletionEmailSender) to = mkMimeAddress name email - txt = renderTextWithBranding deletionEmailBodyText replace1 branding - html = renderHtmlWithBranding deletionEmailBodyHtml replace1 branding - subj = renderTextWithBranding deletionEmailSubject replace1 branding key = Ascii.toText (fromRange (Code.asciiKey cKey)) code = Ascii.toText (fromRange (Code.asciiValue cValue)) - replace1 "url" = toStrict (renderTextWithBranding deletionEmailUrl replace2 branding) - replace1 "email" = fromEmail email - replace1 "name" = fromName name - replace1 x = x - replace2 "key" = key - replace2 "code" = code - replace2 x = x + +renderDeletionUrl :: (Member (Output Text) r) => Template -> Code.Key -> Code.Value -> Map Text Text -> Sem r Text +renderDeletionUrl t cKey cValue branding = do + let replace = + branding + & Map.insert "key" (Ascii.toText (fromRange (Code.asciiKey cKey))) + & Map.insert "code" (Ascii.toText (fromRange (Code.asciiValue cValue))) + toStrict <$> renderTextWithBrandingSem t replace ------------------------------------------------------------------------------- -- Invitation Email -sendTeamInvitationMailImpl :: (Member EmailSending r) => Localised TeamTemplates -> TemplateBranding -> EmailAddress -> TeamId -> EmailAddress -> InvitationCode -> Maybe Locale -> Sem r Text +sendTeamInvitationMailImpl :: + (Member EmailSending r, Member TinyLog r) => + Localised TeamTemplates -> + Map Text Text -> + EmailAddress -> + TeamId -> + EmailAddress -> + InvitationCode -> + Maybe Locale -> + Sem r Text sendTeamInvitationMailImpl teamTemplates branding to tid from code loc = do let tpl = invitationEmail . snd $ forLocale loc teamTemplates mail = InvitationEmail to tid code from - (renderedMail, renderedInvitaitonUrl) = renderInvitationEmail mail tpl branding + (renderedMail, renderedInvitationUrl) <- logEmailRenderErrors "invitation" $ renderInvitationEmail mail tpl branding sendMail renderedMail - pure renderedInvitaitonUrl + pure renderedInvitationUrl -sendTeamInvitationMailPersonalUserImpl :: (Member EmailSending r) => Localised TeamTemplates -> TemplateBranding -> EmailAddress -> TeamId -> EmailAddress -> InvitationCode -> Maybe Locale -> Sem r Text +sendTeamInvitationMailPersonalUserImpl :: + (Member EmailSending r, Member TinyLog r) => + Localised TeamTemplates -> + Map Text Text -> + EmailAddress -> + TeamId -> + EmailAddress -> + InvitationCode -> + Maybe Locale -> + Sem r Text sendTeamInvitationMailPersonalUserImpl teamTemplates branding to tid from code loc = do let tpl = existingUserInvitationEmail . snd $ forLocale loc teamTemplates mail = InvitationEmail to tid code from - (renderedMail, renderedInvitaitonUrl) = renderInvitationEmail mail tpl branding + (renderedMail, renderedInvitationUrl) <- logEmailRenderErrors "personal user invitation" $ renderInvitationEmail mail tpl branding sendMail renderedMail - pure renderedInvitaitonUrl + pure renderedInvitationUrl data InvitationEmail = InvitationEmail { invTo :: !EmailAddress, @@ -442,38 +492,100 @@ data InvitationEmail = InvitationEmail invInviter :: !EmailAddress } -renderInvitationEmail :: InvitationEmail -> InvitationEmailTemplate -> TemplateBranding -> (Mail, Text) -renderInvitationEmail InvitationEmail {..} InvitationEmailTemplate {..} branding = - ( (emptyMail from) +renderInvitationEmail :: (Member (Output Text) r) => InvitationEmail -> InvitationEmailTemplate -> Map Text Text -> Sem r (Mail, Text) +renderInvitationEmail InvitationEmail {..} InvitationEmailTemplate {..} branding = do + invitationUrl <- renderInvitationUrl invitationEmailUrl invTeamId invInvCode + let replace = branding & Map.insert "inviter" (fromEmail invInviter) & Map.insert "url" invitationUrl + txt <- renderTextWithBrandingSem invitationEmailBodyText replace + html <- renderHtmlWithBrandingSem invitationEmailBodyHtml replace + subj <- renderTextWithBrandingSem invitationEmailSubject replace + pure + ( (emptyMail from) + { mailTo = [to], + mailHeaders = + [ ("Subject", toStrict subj), + ("X-Zeta-Purpose", "TeamInvitation"), + ("X-Zeta-Code", Ascii.toText code) + ], + mailParts = [[plainPart txt, htmlPart html]] + }, + invitationUrl + ) + where + (InvitationCode code) = invInvCode + from = Address (Just invitationEmailSenderName) (fromEmail invitationEmailSender) + to = Address Nothing (fromEmail invTo) + +renderInvitationUrl :: (Member (Output Text) r) => Template -> TeamId -> InvitationCode -> Sem r Text +renderInvitationUrl t tid (InvitationCode c) = + toStrict <$> renderTextWithBrandingSem t (Map.fromList [("team", idToText tid), ("code", Ascii.toText c)]) + +------------------------------------------------------------------------------- +-- Member Welcome Email + +sendMemberWelcomeEmailImpl :: (Member EmailSending r, Member TinyLog r) => Localised TeamTemplates -> Map Text Text -> EmailAddress -> TeamId -> Text -> Maybe Locale -> Sem r () +sendMemberWelcomeEmailImpl teamTemplates branding to tid teamName loc = do + let tpl = memberWelcomeEmail . snd $ forLocale loc teamTemplates + mail <- logEmailRenderErrors "member welcome email" $ renderMemberWelcomeMail to tid teamName tpl branding + sendMail mail + +renderMemberWelcomeMail :: (Member (Output Text) r) => EmailAddress -> TeamId -> Text -> MemberWelcomeEmailTemplate -> Map Text Text -> Sem r Mail +renderMemberWelcomeMail emailTo tid teamName MemberWelcomeEmailTemplate {..} branding = do + let replace = + branding + & Map.insert "url" memberWelcomeEmailUrl + & Map.insert "email" (fromEmail emailTo) + & Map.insert "team_id" (idToText tid) + & Map.insert "team_name" teamName + txt <- renderTextWithBrandingSem memberWelcomeEmailBodyText replace + html <- renderHtmlWithBrandingSem memberWelcomeEmailBodyHtml replace + subj <- renderTextWithBrandingSem memberWelcomeEmailSubject replace + pure + (emptyMail from) { mailTo = [to], mailHeaders = [ ("Subject", toStrict subj), - ("X-Zeta-Purpose", "TeamInvitation"), - ("X-Zeta-Code", Ascii.toText code) + ("X-Zeta-Purpose", "Welcome") ], mailParts = [[plainPart txt, htmlPart html]] - }, - invitationUrl - ) + } where - (InvitationCode code) = invInvCode - from = Address (Just invitationEmailSenderName) (fromEmail invitationEmailSender) - to = Address Nothing (fromEmail invTo) - txt = renderTextWithBranding invitationEmailBodyText replace branding - html = renderHtmlWithBranding invitationEmailBodyHtml replace branding - subj = renderTextWithBranding invitationEmailSubject replace branding - invitationUrl = renderInvitationUrl invitationEmailUrl invTeamId invInvCode branding - replace "url" = invitationUrl - replace "inviter" = fromEmail invInviter - replace x = x - -renderInvitationUrl :: Template -> TeamId -> InvitationCode -> TemplateBranding -> Text -renderInvitationUrl t tid (InvitationCode c) branding = - toStrict $ renderTextWithBranding t replace branding + from = Address (Just memberWelcomeEmailSenderName) (fromEmail memberWelcomeEmailSender) + to = Address Nothing (fromEmail emailTo) + +------------------------------------------------------------------------------- +-- New Team Owner Welcome Email + +sendNewTeamOwnerWelcomeEmailImpl :: (Member EmailSending r, Member TinyLog r) => Localised TeamTemplates -> Map Text Text -> EmailAddress -> TeamId -> Text -> Maybe Locale -> Name -> Sem r () +sendNewTeamOwnerWelcomeEmailImpl teamTemplates branding to tid teamName loc profileName = do + let tpl = newTeamOwnerWelcomeEmail . snd $ forLocale loc teamTemplates + mail <- logEmailRenderErrors "new team owner welcome email" $ renderNewTeamOwnerWelcomeEmail to tid teamName profileName tpl branding + sendMail mail + +renderNewTeamOwnerWelcomeEmail :: (Member (Output Text) r) => EmailAddress -> TeamId -> Text -> Name -> NewTeamOwnerWelcomeEmailTemplate -> Map Text Text -> Sem r Mail +renderNewTeamOwnerWelcomeEmail emailTo tid teamName profileName NewTeamOwnerWelcomeEmailTemplate {..} branding = do + let replace = + branding + & Map.insert "url" newTeamOwnerWelcomeEmailUrl + & Map.insert "email" (fromEmail emailTo) + & Map.insert "team_id" (idToText tid) + & Map.insert "team_name" teamName + & Map.insert "name" profileName.fromName + txt <- renderTextWithBrandingSem newTeamOwnerWelcomeEmailBodyText replace + html <- renderHtmlWithBrandingSem newTeamOwnerWelcomeEmailBodyHtml replace + subj <- renderTextWithBrandingSem newTeamOwnerWelcomeEmailSubject replace + pure + (emptyMail from) + { mailTo = [to], + mailHeaders = + [ ("Subject", toStrict subj), + ("X-Zeta-Purpose", "Welcome") + ], + mailParts = [[plainPart txt, htmlPart html]] + } where - replace "team" = idToText tid - replace "code" = Ascii.toText c - replace x = x + from = Address (Just newTeamOwnerWelcomeEmailSenderName) (fromEmail newTeamOwnerWelcomeEmailSender) + to = Address Nothing (fromEmail emailTo) ------------------------------------------------------------------------------- -- MIME Conversions diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem/Template.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem/Template.hs index 15a31a04eba..cfdecce899a 100644 --- a/libs/wire-subsystems/src/Wire/EmailSubsystem/Template.hs +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem/Template.hs @@ -17,21 +17,20 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Wire.EmailSubsystem.Template - ( module Wire.EmailSubsystem.Template, - - -- * Re-exports - Template, - ) -where +module Wire.EmailSubsystem.Template where import Data.Map qualified as Map +import Data.Text.Encoding qualified as T import Data.Text.Lazy qualified as Lazy import Data.Text.Template import HTMLEntities.Text qualified as HTML import Imports +import Polysemy +import Polysemy.Output +import Polysemy.TinyLog (TinyLog) +import Polysemy.TinyLog qualified as Log +import System.Logger (field, msg, val) import Wire.API.Locale -import Wire.API.User -- | Lookup a localised item from a 'Localised' structure. forLocale :: @@ -72,157 +71,29 @@ renderTextWithBranding tpl replace branding = render tpl (replace . branding) renderHtmlWithBranding :: Template -> (Text -> Text) -> TemplateBranding -> Lazy.Text renderHtmlWithBranding tpl replace branding = render tpl (HTML.text . replace . branding) -data UserTemplates = UserTemplates - { activationSms :: ActivationSmsTemplate, - activationCall :: ActivationCallTemplate, - verificationEmail :: VerificationEmailTemplate, - activationEmail :: ActivationEmailTemplate, - activationEmailUpdate :: ActivationEmailTemplate, - teamActivationEmail :: TeamActivationEmailTemplate, - passwordResetSms :: PasswordResetSmsTemplate, - passwordResetEmail :: PasswordResetEmailTemplate, - loginSms :: LoginSmsTemplate, - loginCall :: LoginCallTemplate, - deletionSms :: DeletionSmsTemplate, - deletionEmail :: DeletionEmailTemplate, - newClientEmail :: NewClientEmailTemplate, - verificationLoginEmail :: SecondFactorVerificationEmailTemplate, - verificationScimTokenEmail :: SecondFactorVerificationEmailTemplate, - verificationTeamDeletionEmail :: SecondFactorVerificationEmailTemplate - } - -data ActivationSmsTemplate = ActivationSmsTemplate - { activationSmslUrl :: Template, - activationSmsText :: Template, - activationSmsSender :: Text - } - -data ActivationCallTemplate = ActivationCallTemplate - { activationCallText :: Template - } - -data VerificationEmailTemplate = VerificationEmailTemplate - { verificationEmailUrl :: Template, - verificationEmailSubject :: Template, - verificationEmailBodyText :: Template, - verificationEmailBodyHtml :: Template, - verificationEmailSender :: EmailAddress, - verificationEmailSenderName :: Text - } - -data ActivationEmailTemplate = ActivationEmailTemplate - { activationEmailUrl :: Template, - activationEmailSubject :: Template, - activationEmailBodyText :: Template, - activationEmailBodyHtml :: Template, - activationEmailSender :: EmailAddress, - activationEmailSenderName :: Text - } - -data TeamActivationEmailTemplate = TeamActivationEmailTemplate - { teamActivationEmailUrl :: Template, - teamActivationEmailSubject :: Template, - teamActivationEmailBodyText :: Template, - teamActivationEmailBodyHtml :: Template, - teamActivationEmailSender :: EmailAddress, - teamActivationEmailSenderName :: Text - } - -data DeletionEmailTemplate = DeletionEmailTemplate - { deletionEmailUrl :: Template, - deletionEmailSubject :: Template, - deletionEmailBodyText :: Template, - deletionEmailBodyHtml :: Template, - deletionEmailSender :: EmailAddress, - deletionEmailSenderName :: Text - } - -data PasswordResetEmailTemplate = PasswordResetEmailTemplate - { passwordResetEmailUrl :: Template, - passwordResetEmailSubject :: Template, - passwordResetEmailBodyText :: Template, - passwordResetEmailBodyHtml :: Template, - passwordResetEmailSender :: EmailAddress, - passwordResetEmailSenderName :: Text - } - -data PasswordResetSmsTemplate = PasswordResetSmsTemplate - { passwordResetSmsText :: Template, - passwordResetSmsSender :: Text - } - -data LoginSmsTemplate = LoginSmsTemplate - { loginSmsUrl :: Template, - loginSmsText :: Template, - loginSmsSender :: Text - } - -data LoginCallTemplate = LoginCallTemplate - { loginCallText :: Template - } - -data DeletionSmsTemplate = DeletionSmsTemplate - { deletionSmsUrl :: Template, - deletionSmsText :: Template, - deletionSmsSender :: Text - } - -data NewClientEmailTemplate = NewClientEmailTemplate - { newClientEmailSubject :: Template, - newClientEmailBodyText :: Template, - newClientEmailBodyHtml :: Template, - newClientEmailSender :: EmailAddress, - newClientEmailSenderName :: Text - } - -data SecondFactorVerificationEmailTemplate = SecondFactorVerificationEmailTemplate - { sndFactorVerificationEmailSubject :: Template, - sndFactorVerificationEmailBodyText :: Template, - sndFactorVerificationEmailBodyHtml :: Template, - sndFactorVerificationEmailSender :: EmailAddress, - sndFactorVerificationEmailSenderName :: Text - } - -data InvitationEmailTemplate = InvitationEmailTemplate - { invitationEmailUrl :: !Template, - invitationEmailSubject :: !Template, - invitationEmailBodyText :: !Template, - invitationEmailBodyHtml :: !Template, - invitationEmailSender :: !EmailAddress, - invitationEmailSenderName :: !Text - } - -data CreatorWelcomeEmailTemplate = CreatorWelcomeEmailTemplate - { creatorWelcomeEmailUrl :: !Text, - creatorWelcomeEmailSubject :: !Template, - creatorWelcomeEmailBodyText :: !Template, - creatorWelcomeEmailBodyHtml :: !Template, - creatorWelcomeEmailSender :: !EmailAddress, - creatorWelcomeEmailSenderName :: !Text - } - -data MemberWelcomeEmailTemplate = MemberWelcomeEmailTemplate - { memberWelcomeEmailUrl :: !Text, - memberWelcomeEmailSubject :: !Template, - memberWelcomeEmailBodyText :: !Template, - memberWelcomeEmailBodyHtml :: !Template, - memberWelcomeEmailSender :: !EmailAddress, - memberWelcomeEmailSenderName :: !Text - } - -data NewTeamOwnerWelcomeEmailTemplate = NewTeamOwnerWelcomeEmailTemplate - { newTeamOwnerWelcomeEmailUrl :: !Text, - newTeamOwnerWelcomeEmailSubject :: !Template, - newTeamOwnerWelcomeEmailBodyText :: !Template, - newTeamOwnerWelcomeEmailBodyHtml :: !Template, - newTeamOwnerWelcomeEmailSender :: !EmailAddress, - newTeamOwnerWelcomeEmailSenderName :: !Text - } - -data TeamTemplates = TeamTemplates - { invitationEmail :: !InvitationEmailTemplate, - existingUserInvitationEmail :: !InvitationEmailTemplate, - creatorWelcomeEmail :: !CreatorWelcomeEmailTemplate, - memberWelcomeEmail :: !MemberWelcomeEmailTemplate, - newTeamOwnerWelcomeEmail :: !NewTeamOwnerWelcomeEmailTemplate - } +renderHtmlWithBrandingSem :: (Member (Output Text) r) => Template -> Map Text Text -> Sem r Lazy.Text +renderHtmlWithBrandingSem = renderWithBrandingSem HTML.text + +renderTextWithBrandingSem :: (Member (Output Text) r) => Template -> Map Text Text -> Sem r Lazy.Text +renderTextWithBrandingSem = renderWithBrandingSem id + +-- If a template field is not declared, do not replace it and drop key to `Output` effect. This way we catch all errors, not just the first, and the caller gets to decide what to do with the error. +renderWithBrandingSem :: (Member (Output Text) r) => (Text -> Text) -> Template -> Map Text Text -> Sem r Lazy.Text +renderWithBrandingSem escapeHtml tpl replace = do + let f x = case Map.lookup x replace of + Just v -> pure v + Nothing -> do + output x + pure x + renderA tpl (escapeHtml <$$> f) + +logEmailRenderErrors :: (Member TinyLog r) => Text -> Sem (Output Text : r) a -> Sem r a +logEmailRenderErrors tplName = + runOutputSem $ + ( \warn -> + do + Log.warn $ + msg (val "Email template rendering failure") + . field "template_name" (val (T.encodeUtf8 tplName)) + . field "unreplaced_variable" (val (T.encodeUtf8 warn)) + ) diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem/Templates/Team.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem/Templates/Team.hs new file mode 100644 index 00000000000..76187fe56de --- /dev/null +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem/Templates/Team.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE StrictData #-} + +-- 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.EmailSubsystem.Templates.Team where + +import Data.Text.Template +import Imports +import Wire.API.User + +data InvitationEmailTemplate = InvitationEmailTemplate + { invitationEmailUrl :: !Template, + invitationEmailSubject :: !Template, + invitationEmailBodyText :: !Template, + invitationEmailBodyHtml :: !Template, + invitationEmailSender :: !EmailAddress, + invitationEmailSenderName :: !Text + } + +data MemberWelcomeEmailTemplate = MemberWelcomeEmailTemplate + { memberWelcomeEmailUrl :: !Text, + memberWelcomeEmailSubject :: !Template, + memberWelcomeEmailBodyText :: !Template, + memberWelcomeEmailBodyHtml :: !Template, + memberWelcomeEmailSender :: !EmailAddress, + memberWelcomeEmailSenderName :: !Text + } + +data NewTeamOwnerWelcomeEmailTemplate = NewTeamOwnerWelcomeEmailTemplate + { newTeamOwnerWelcomeEmailUrl :: !Text, + newTeamOwnerWelcomeEmailSubject :: !Template, + newTeamOwnerWelcomeEmailBodyText :: !Template, + newTeamOwnerWelcomeEmailBodyHtml :: !Template, + newTeamOwnerWelcomeEmailSender :: !EmailAddress, + newTeamOwnerWelcomeEmailSenderName :: !Text + } + +data TeamTemplates = TeamTemplates + { invitationEmail :: !InvitationEmailTemplate, + existingUserInvitationEmail :: !InvitationEmailTemplate, + memberWelcomeEmail :: !MemberWelcomeEmailTemplate, + newTeamOwnerWelcomeEmail :: !NewTeamOwnerWelcomeEmailTemplate + } diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem/Templates/User.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem/Templates/User.hs new file mode 100644 index 00000000000..38077ab8025 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem/Templates/User.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE StrictData #-} + +-- 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.EmailSubsystem.Templates.User where + +import Data.Text.Template +import Imports +import Wire.API.User + +data UserTemplates = UserTemplates + { verificationEmail :: VerificationEmailTemplate, + activationEmail :: ActivationEmailTemplate, + activationEmailUpdate :: ActivationEmailTemplate, + teamActivationEmail :: TeamActivationEmailTemplate, + passwordResetEmail :: PasswordResetEmailTemplate, + deletionEmail :: DeletionEmailTemplate, + newClientEmail :: NewClientEmailTemplate, + verificationLoginEmail :: SecondFactorVerificationEmailTemplate, + verificationScimTokenEmail :: SecondFactorVerificationEmailTemplate, + verificationTeamDeletionEmail :: SecondFactorVerificationEmailTemplate + } + +data VerificationEmailTemplate = VerificationEmailTemplate + { verificationEmailUrl :: Template, + verificationEmailSubject :: Template, + verificationEmailBodyText :: Template, + verificationEmailBodyHtml :: Template, + verificationEmailSender :: EmailAddress, + verificationEmailSenderName :: Text + } + +data ActivationEmailTemplate = ActivationEmailTemplate + { activationEmailUrl :: Template, + activationEmailSubject :: Template, + activationEmailBodyText :: Template, + activationEmailBodyHtml :: Template, + activationEmailSender :: EmailAddress, + activationEmailSenderName :: Text + } + +data TeamActivationEmailTemplate = TeamActivationEmailTemplate + { teamActivationEmailUrl :: Template, + teamActivationEmailSubject :: Template, + teamActivationEmailBodyText :: Template, + teamActivationEmailBodyHtml :: Template, + teamActivationEmailSender :: EmailAddress, + teamActivationEmailSenderName :: Text + } + +data DeletionEmailTemplate = DeletionEmailTemplate + { deletionEmailUrl :: Template, + deletionEmailSubject :: Template, + deletionEmailBodyText :: Template, + deletionEmailBodyHtml :: Template, + deletionEmailSender :: EmailAddress, + deletionEmailSenderName :: Text + } + +data PasswordResetEmailTemplate = PasswordResetEmailTemplate + { passwordResetEmailUrl :: Template, + passwordResetEmailSubject :: Template, + passwordResetEmailBodyText :: Template, + passwordResetEmailBodyHtml :: Template, + passwordResetEmailSender :: EmailAddress, + passwordResetEmailSenderName :: Text + } + +data NewClientEmailTemplate = NewClientEmailTemplate + { newClientEmailSubject :: Template, + newClientEmailBodyText :: Template, + newClientEmailBodyHtml :: Template, + newClientEmailSender :: EmailAddress, + newClientEmailSenderName :: Text + } + +data SecondFactorVerificationEmailTemplate = SecondFactorVerificationEmailTemplate + { sndFactorVerificationEmailSubject :: Template, + sndFactorVerificationEmailBodyText :: Template, + sndFactorVerificationEmailBodyHtml :: Template, + sndFactorVerificationEmailSender :: EmailAddress, + sndFactorVerificationEmailSenderName :: Text + } diff --git a/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem.hs b/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem.hs new file mode 100644 index 00000000000..8d0e802d9f3 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE TemplateHaskell #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2026 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.FeaturesConfigSubsystem where + +import Data.Id (TeamId, UserId) +import Data.Qualified (Local) +import Imports +import Polysemy +import Wire.API.Team.Feature (AllTeamFeatures, LockableFeature) +import Wire.FeaturesConfigSubsystem.Types + +data FeaturesConfigSubsystem m a where + GetFeature :: + forall cfg m. + (GetFeatureConfig cfg) => + UserId -> TeamId -> FeaturesConfigSubsystem m (LockableFeature cfg) + GetFeatureForTeam :: + forall cfg m. + (GetFeatureConfig cfg) => + TeamId -> FeaturesConfigSubsystem m (LockableFeature cfg) + GetFeatureForServer :: + forall cfg m. + (GetFeatureConfig cfg) => + FeaturesConfigSubsystem m (LockableFeature cfg) + GetFeatureForTeamUser :: + forall cfg m. + (GetFeatureConfig cfg) => + UserId -> Maybe TeamId -> FeaturesConfigSubsystem m (LockableFeature cfg) + GetAllTeamFeaturesForTeamMember :: Local UserId -> TeamId -> FeaturesConfigSubsystem m AllTeamFeatures + GetAllTeamFeaturesForTeam :: TeamId -> FeaturesConfigSubsystem m AllTeamFeatures + GetAllTeamFeaturesForServer :: FeaturesConfigSubsystem m AllTeamFeatures + +makeSem ''FeaturesConfigSubsystem diff --git a/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem/Interpreter.hs new file mode 100644 index 00000000000..e82d02a1d7a --- /dev/null +++ b/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem/Interpreter.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} + +module Wire.FeaturesConfigSubsystem.Interpreter where + +import Data.Id +import Data.Qualified (tUnqualified) +import Data.SOP +import Galley.Types.Teams +import Imports +import Polysemy +import Polysemy.Input +import Wire.API.Error +import Wire.API.Error.Galley +import Wire.API.Team.Feature +import Wire.FeaturesConfigSubsystem +import Wire.FeaturesConfigSubsystem.Types +import Wire.FeaturesConfigSubsystem.Utils +import Wire.TeamFeatureStore +import Wire.TeamSubsystem (TeamSubsystem) +import Wire.TeamSubsystem qualified as TeamSubsystem + +runFeaturesConfigSubsystem :: + forall r a. + ( Member TeamFeatureStore r, + Member TeamSubsystem r, + Member (ErrorS 'NotATeamMember) r, + GetFeatureConfigEffects r + ) => + Sem (FeaturesConfigSubsystem : r) a -> + Sem r a +runFeaturesConfigSubsystem = interpret $ \case + GetFeature uid tid -> do + void $ TeamSubsystem.internalGetTeamMember uid tid >>= noteS @'NotATeamMember + doGetFeatureForTeam tid + GetFeatureForTeam tid -> + doGetFeatureForTeam tid + GetFeatureForServer -> + resolveServerFeature + GetFeatureForTeamUser uid mTid -> + doGetFeatureForTeamUser uid mTid + GetAllTeamFeaturesForTeamMember luid tid -> do + void $ TeamSubsystem.internalGetTeamMember (tUnqualified luid) tid >>= noteS @'NotATeamMember + doGetAllTeamFeatures tid + GetAllTeamFeaturesForTeam tid -> + doGetAllTeamFeatures tid + GetAllTeamFeaturesForServer -> + doGetAllTeamFeaturesForServer + +-- Internal helpers + +doGetFeatureForTeam :: + forall cfg r. + ( GetFeatureConfig cfg, + Member TeamFeatureStore r, + GetFeatureConfigEffects r + ) => + TeamId -> + Sem r (LockableFeature cfg) +doGetFeatureForTeam tid = do + dbFeature <- getDbFeature tid + defFeature <- resolveServerFeature + computeFeature tid defFeature dbFeature + +doGetFeatureForTeamUser :: + forall cfg r. + ( GetFeatureConfig cfg, + Member TeamFeatureStore r, + GetFeatureConfigEffects r + ) => + UserId -> + Maybe TeamId -> + Sem r (LockableFeature cfg) +doGetFeatureForTeamUser uid Nothing = getFeatureForUser uid +doGetFeatureForTeamUser _uid (Just tid) = doGetFeatureForTeam tid + +doGetAllTeamFeatures :: + forall r. + ( Member TeamFeatureStore r, + GetFeatureConfigEffects r + ) => + TeamId -> + Sem r AllTeamFeatures +doGetAllTeamFeatures tid = do + features <- getAllDbFeatures tid + defFeatures <- doGetAllTeamFeaturesForServer + hsequence' $ hcliftA2 (Proxy @(GetAllFeaturesForServerConstraints r)) compute defFeatures features + where + compute :: forall p. (GetFeatureConfig p) => LockableFeature p -> DbFeature p -> (Sem r :.: LockableFeature) p + compute defFeature feat = Comp $ computeFeature tid defFeature feat + +doGetAllTeamFeaturesForServer :: forall r. (Member (Input FeatureFlags) r) => Sem r AllTeamFeatures +doGetAllTeamFeaturesForServer = + hsequence' $ + hcpure (Proxy @GetFeatureConfig) $ + Comp resolveServerFeature diff --git a/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem/Types.hs b/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem/Types.hs new file mode 100644 index 00000000000..eaed761e6d4 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem/Types.hs @@ -0,0 +1,151 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module Wire.FeaturesConfigSubsystem.Types where + +import Data.Default +import Data.Id (TeamId, UserId) +import Data.SOP.Sing (SListI) +import Galley.Types.Teams +import Imports +import Polysemy +import Polysemy.Input +import Wire.API.Team.Feature +import Wire.BrigAPIAccess (BrigAPIAccess, getAccountConferenceCallingConfigClient) +import Wire.FeaturesConfigSubsystem.Utils (resolveServerFeature) +import Wire.LegalHold +import Wire.LegalHoldStore + +type GetFeatureConfigEffects r = + ( Member (Input FeatureFlags) r, + Member (Input ExposeInvitationURLsAllowlist) r, + Member LegalHoldStore r, + Member (Input (FeatureDefaults LegalholdConfig)) r, + Member BrigAPIAccess r + ) + +newtype ExposeInvitationURLsAllowlist + = ExposeInvitationURLsAllowlist [TeamId] + +-- | Don't export methods of this typeclass +class + ( IsFeatureConfig cfg, + GetFeatureDefaults (FeatureDefaults cfg), + SListI Features + ) => + GetFeatureConfig cfg + where + getFeatureForUser :: + (GetFeatureConfigEffects r) => + UserId -> + Sem r (LockableFeature cfg) + default getFeatureForUser :: + (GetFeatureConfigEffects r) => + UserId -> + Sem r (LockableFeature cfg) + getFeatureForUser _uid = resolveServerFeature + computeFeature :: + (GetFeatureConfigEffects r) => + TeamId -> + LockableFeature cfg -> + DbFeature cfg -> + Sem r (LockableFeature cfg) + default computeFeature :: + TeamId -> + LockableFeature cfg -> + DbFeature cfg -> + Sem r (LockableFeature cfg) + computeFeature _tid defFeature dbFeature = + pure $ resolveDbFeature defFeature dbFeature + +class (GetFeatureConfig cfg, GetFeatureConfigEffects r) => GetAllFeaturesForServerConstraints r cfg + +instance (GetFeatureConfig cfg, GetFeatureConfigEffects r) => GetAllFeaturesForServerConstraints r cfg + +class (GetFeatureConfig cfg, GetFeatureConfigEffects r) => GetAllTeamFeaturesForUserConstraints r cfg + +instance (GetFeatureConfig cfg, GetFeatureConfigEffects r) => GetAllTeamFeaturesForUserConstraints r cfg + +instance GetFeatureConfig SSOConfig + +instance GetFeatureConfig SearchVisibilityAvailableConfig + +instance GetFeatureConfig ValidateSAMLEmailsConfig + +instance GetFeatureConfig DigitalSignaturesConfig + +instance GetFeatureConfig LegalholdConfig where + computeFeature tid defFeature dbFeature = + setLockableFeatureStatus defFeature <$> computeLegalHoldFeatureStatus tid dbFeature + +instance GetFeatureConfig FileSharingConfig + +instance GetFeatureConfig AppLockConfig + +instance GetFeatureConfig ClassifiedDomainsConfig + +instance GetFeatureConfig ConferenceCallingConfig where + getFeatureForUser uid = do + feat <- getAccountConferenceCallingConfigClient uid + pure $ withLockStatus (def @(LockableFeature ConferenceCallingConfig)).lockStatus feat + + computeFeature _tid defFeature dbFeature = + pure $ + let feat = applyDbFeature dbFeature $ setLockableFeatureStatus defFeature FeatureStatusEnabled + in case feat.lockStatus of + LockStatusLocked -> setLockableFeatureLockStatus defFeature LockStatusLocked + LockStatusUnlocked -> feat + +instance GetFeatureConfig SelfDeletingMessagesConfig + +instance GetFeatureConfig GuestLinksConfig + +instance GetFeatureConfig SndFactorPasswordChallengeConfig + +instance GetFeatureConfig SearchVisibilityInboundConfig + +instance GetFeatureConfig MLSConfig + +instance GetFeatureConfig ChannelsConfig + +instance GetFeatureConfig ExposeInvitationURLsToTeamAdminConfig where + computeFeature tid defFeature dbFeature = do + (ExposeInvitationURLsAllowlist allowList) <- inputs id + let teamAllowed = tid `elem` allowList + lockStatus = if teamAllowed then LockStatusUnlocked else LockStatusLocked + pure $ resolveDbFeature defFeature (dbFeatureLockStatus lockStatus <> dbFeature) + +instance GetFeatureConfig OutlookCalIntegrationConfig + +instance GetFeatureConfig MlsE2EIdConfig + +instance GetFeatureConfig MlsMigrationConfig + +instance GetFeatureConfig EnforceFileDownloadLocationConfig + +instance GetFeatureConfig LimitedEventFanoutConfig + +instance GetFeatureConfig DomainRegistrationConfig + +instance GetFeatureConfig CellsConfig + +instance GetFeatureConfig CellsInternalConfig + +instance GetFeatureConfig AllowedGlobalOperationsConfig + +instance GetFeatureConfig AssetAuditLogConfig + +instance GetFeatureConfig ConsumableNotificationsConfig + +instance GetFeatureConfig ChatBubblesConfig + +instance GetFeatureConfig AppsConfig + +instance GetFeatureConfig SimplifiedUserConnectionRequestQRCodeConfig + +instance GetFeatureConfig StealthUsersConfig + +instance GetFeatureConfig MeetingsConfig + +instance GetFeatureConfig MeetingsPremiumConfig diff --git a/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem/Utils.hs b/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem/Utils.hs new file mode 100644 index 00000000000..877352e5b23 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem/Utils.hs @@ -0,0 +1,19 @@ +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} + +module Wire.FeaturesConfigSubsystem.Utils where + +import Galley.Types.Teams +import Imports +import Polysemy +import Polysemy.Input +import Wire.API.Team.Feature + +resolveServerFeature :: + forall cfg r. + ( GetFeatureDefaults (FeatureDefaults cfg), + NpProject cfg Features, + Member (Input FeatureFlags) r + ) => + Sem r (LockableFeature cfg) +resolveServerFeature = + inputs $ featureDefaults @cfg diff --git a/libs/wire-subsystems/src/Wire/IndexedUserStore/Bulk.hs b/libs/wire-subsystems/src/Wire/IndexedUserStore/Bulk.hs index fa2a714db92..47985da588c 100644 --- a/libs/wire-subsystems/src/Wire/IndexedUserStore/Bulk.hs +++ b/libs/wire-subsystems/src/Wire/IndexedUserStore/Bulk.hs @@ -34,6 +34,7 @@ data IndexedUserStoreBulk m a where -- | Overwrite all users in the ES index, use it when trying to fix some -- inconsistency or while introducing a new field in the mapping. ForceSyncAllUsers :: IndexedUserStoreBulk m () + -- | Run `ForceSyncAllUsers` iff the index version is out of date. MigrateData :: IndexedUserStoreBulk m () makeSem ''IndexedUserStoreBulk diff --git a/libs/wire-subsystems/src/Wire/IndexedUserStore/Bulk/ElasticSearch.hs b/libs/wire-subsystems/src/Wire/IndexedUserStore/Bulk/ElasticSearch.hs index 84c137d9c3c..bbc3f68bd52 100644 --- a/libs/wire-subsystems/src/Wire/IndexedUserStore/Bulk/ElasticSearch.hs +++ b/libs/wire-subsystems/src/Wire/IndexedUserStore/Bulk/ElasticSearch.hs @@ -20,6 +20,7 @@ module Wire.IndexedUserStore.Bulk.ElasticSearch where import Cassandra.Exec (paginateWithStateC) import Cassandra.Util (Writetime (Writetime)) import Conduit (ConduitT, runConduit, (.|)) +import Data.Aeson (encode) import Data.Conduit.Combinators qualified as Conduit import Data.Id import Data.Json.Util (UTCTimeMillis (fromUTCTimeMillis)) @@ -34,6 +35,8 @@ import System.Logger.Message qualified as Log import Wire.API.Team.Feature import Wire.API.Team.Member.Info import Wire.API.Team.Role +import Wire.API.User +import Wire.AppStore import Wire.GalleyAPIAccess import Wire.IndexedUserStore (IndexedUserStore) import Wire.IndexedUserStore qualified as IndexedUserStore @@ -49,6 +52,7 @@ import Wire.UserStore.IndexUser interpretIndexedUserStoreBulk :: ( Member TinyLog r, Member UserStore r, + Member AppStore r, Member (Concurrency Unsafe) r, Member GalleyAPIAccess r, Member IndexedUserStore r, @@ -64,6 +68,7 @@ interpretIndexedUserStoreBulk = interpret \case syncAllUsersImpl :: forall r. ( Member UserStore r, + Member AppStore r, Member TinyLog r, Member (Concurrency 'Unsafe) r, Member GalleyAPIAccess r, @@ -75,6 +80,7 @@ syncAllUsersImpl = syncAllUsersWithVersion ES.ExternalGT forceSyncAllUsersImpl :: forall r. ( Member UserStore r, + Member AppStore r, Member TinyLog r, Member (Concurrency 'Unsafe) r, Member GalleyAPIAccess r, @@ -86,6 +92,7 @@ forceSyncAllUsersImpl = syncAllUsersWithVersion ES.ExternalGTE syncAllUsersWithVersion :: forall r. ( Member UserStore r, + Member AppStore r, Member TinyLog r, Member (Concurrency 'Unsafe) r, Member GalleyAPIAccess r, @@ -108,15 +115,30 @@ syncAllUsersWithVersion mkVersion = mkUserDocs :: ConduitT [IndexUser] [(ES.DocId, UserDoc, ES.VersionControl)] (Sem r) () mkUserDocs = Conduit.mapM $ \page -> do + -- FUTUREWORK: extract team visibilities, roles and user type + -- more efficiently sending one query per page + + -- FUTUREWORK: introduce type ExtendedUser (or something), which + -- contains User, Maybe Role, UserType, ..., and pass around + -- ExtendedUser. this should make the code less convoluted. + let teams :: Map TeamId [IndexUser] = Map.fromListWith (<>) $ mapMaybe (\u -> (,[u]) . value <$> u.teamId) page teamIds = Map.keys teams visMap <- fmap Map.fromList . unsafePooledForConcurrentlyN 16 teamIds $ \t -> (t,) <$> teamSearchVisibilityInbound t + userTypes :: Map UserId UserType <- fmap Map.fromList . unsafePooledForConcurrentlyN 16 page $ \iu -> + (iu.userId,) <$> getUserType iu + warnIfMissingUserTypes page userTypes roles :: Map UserId (WithWritetime Role) <- fmap (Map.fromList . concat) . unsafePooledForConcurrentlyN 16 (Map.toList teams) $ \(t, us) -> do tms <- (.members) <$> selectTeamMemberInfos t (fmap (.userId) us) pure $ mapMaybe mkRoleWithWriteTime tms let vis indexUser = fromMaybe defaultSearchVisibilityInbound $ (flip Map.lookup visMap . value =<< indexUser.teamId) - mkUserDoc indexUser = indexUserToDoc (vis indexUser) ((.value) <$> Map.lookup indexUser.userId roles) indexUser + mkUserDoc indexUser = + indexUserToDoc + (vis indexUser) + (Map.lookup indexUser.userId userTypes) + ((.value) <$> Map.lookup indexUser.userId roles) + indexUser mkDocVersion u = mkVersion . ES.ExternalDocVersion . docVersion $ indexUserToVersion (Map.lookup u.userId roles) u pure $ map (\u -> (userIdToDocId u.userId, mkUserDoc u, mkDocVersion u)) page @@ -132,11 +154,29 @@ syncAllUsersWithVersion mkVersion = ) <$> permissionsToRole tmi.permissions + -- `page` and `userTypes` *should* overlap perfectly, but we're + -- using `unsafePooledForConcurrentlyN` to make concurrent db + -- calls and that swallows any errors that might occur. + -- + -- FUTUREWORK: we need to get rid of `Wire.Sem.Concurrency`, it's + -- unidiomatic and dangerous! + warnIfMissingUserTypes :: [IndexUser] -> Map UserId ignored -> Sem r () + warnIfMissingUserTypes page userTypes = do + let missing = us \\ ts + us, ts :: [UserId] + us = (.userId) <$> page + ts = Map.keys userTypes + unless (null missing) do + warn $ + Log.field "missing" (encode missing) + . Log.msg (Log.val "Reindex: could not lookup all user types!") + migrateDataImpl :: ( Member IndexedUserStore r, Member (Error MigrationException) r, Member IndexedUserMigrationStore r, Member UserStore r, + Member AppStore r, Member (Concurrency Unsafe) r, Member GalleyAPIAccess r, Member TinyLog r @@ -165,3 +205,18 @@ teamSearchVisibilityInbound :: (Member GalleyAPIAccess r) => TeamId -> Sem r Sea teamSearchVisibilityInbound tid = searchVisibilityInboundFromFeatureStatus . (.status) <$> getFeatureConfigForTeam @_ @SearchVisibilityInboundConfig tid + +-- | FUTUREWORK: this is duplicated code from UserSubsystem, we should +-- probably expose it as an action there. +getUserType :: + forall r. + (Member AppStore r) => + IndexUser -> + Sem r UserType +getUserType iu = case iu.serviceId of + Just _ -> pure UserTypeBot + Nothing -> do + mmApp <- mapM (getApp iu.userId) (iu.teamId <&> (.value)) + case join mmApp of + Just _ -> pure UserTypeApp + Nothing -> pure UserTypeRegular diff --git a/libs/wire-subsystems/src/Wire/LegalHold.hs b/libs/wire-subsystems/src/Wire/LegalHold.hs new file mode 100644 index 00000000000..6261f5ae178 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/LegalHold.hs @@ -0,0 +1,27 @@ +module Wire.LegalHold where + +import Data.Default (def) +import Data.Id (TeamId) +import Galley.Types.Teams +import Imports +import Polysemy +import Polysemy.Input (Input, input) +import Wire.API.Team.Feature +import Wire.LegalHoldStore qualified as LegalHoldData + +computeLegalHoldFeatureStatus :: + ( Member LegalHoldData.LegalHoldStore r, + Member (Input (FeatureDefaults LegalholdConfig)) r + ) => + TeamId -> + DbFeature LegalholdConfig -> + Sem r FeatureStatus +computeLegalHoldFeatureStatus tid dbFeature = do + featureLegalHold <- input @(FeatureDefaults LegalholdConfig) + case featureLegalHold of + FeatureLegalHoldDisabledPermanently -> pure FeatureStatusDisabled + FeatureLegalHoldDisabledByDefault -> + pure (applyDbFeature dbFeature def).status + FeatureLegalHoldWhitelistTeamsAndImplicitConsent -> do + wl <- LegalHoldData.isTeamLegalholdWhitelisted tid + pure $ if wl then FeatureStatusEnabled else FeatureStatusDisabled diff --git a/libs/wire-subsystems/src/Wire/LegalHoldStore.hs b/libs/wire-subsystems/src/Wire/LegalHoldStore.hs index 66f675cb49c..8bd32acf93e 100644 --- a/libs/wire-subsystems/src/Wire/LegalHoldStore.hs +++ b/libs/wire-subsystems/src/Wire/LegalHoldStore.hs @@ -17,8 +17,8 @@ data LegalHoldStore m a where CreateSettings :: LegalHoldService -> LegalHoldStore m () GetSettings :: TeamId -> LegalHoldStore m (Maybe LegalHoldService) RemoveSettings :: TeamId -> LegalHoldStore m () - InsertPendingPrekeys :: UserId -> [Prekey] -> LegalHoldStore m () - SelectPendingPrekeys :: UserId -> LegalHoldStore m (Maybe ([Prekey], LastPrekey)) + InsertPendingPrekeys :: UserId -> [UncheckedPrekeyBundle] -> LegalHoldStore m () + SelectPendingPrekeys :: UserId -> LegalHoldStore m (Maybe ([UncheckedPrekeyBundle], LastPrekey)) DropPendingPrekeys :: UserId -> LegalHoldStore m () SetUserLegalHoldStatus :: TeamId -> UserId -> UserLegalHoldStatus -> LegalHoldStore m () SetTeamLegalholdWhitelisted :: TeamId -> LegalHoldStore m () diff --git a/libs/wire-subsystems/src/Wire/LegalHoldStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/LegalHoldStore/Cassandra.hs index e0d473b5b79..2213a85c31d 100644 --- a/libs/wire-subsystems/src/Wire/LegalHoldStore/Cassandra.hs +++ b/libs/wire-subsystems/src/Wire/LegalHoldStore/Cassandra.hs @@ -91,14 +91,14 @@ getSettings tid = fmap toLegalHoldService <$> retry x1 (query1 Q.selectLegalHold removeSettings :: (MonadClient m) => TeamId -> m () removeSettings tid = retry x5 (write Q.removeLegalHoldSettings (params LocalQuorum (Identity tid))) -insertPendingPrekeys :: (MonadClient m) => UserId -> [Prekey] -> m () +insertPendingPrekeys :: (MonadClient m) => UserId -> [UncheckedPrekeyBundle] -> m () insertPendingPrekeys uid keys = retry x5 . batch $ do - forM_ keys $ \(Prekey keyId key) -> addPrepQuery Q.insertPendingPrekeys (uid, keyId, key) + forM_ keys $ \(UncheckedPrekeyBundle keyId key) -> addPrepQuery Q.insertPendingPrekeys (uid, keyId, key) -selectPendingPrekeys :: (MonadClient m) => UserId -> m (Maybe ([Prekey], LastPrekey)) +selectPendingPrekeys :: (MonadClient m) => UserId -> m (Maybe ([UncheckedPrekeyBundle], LastPrekey)) selectPendingPrekeys uid = pickLastKey . fmap fromTuple <$> retry x1 (query Q.selectPendingPrekeys (params LocalQuorum (Identity uid))) where - fromTuple (keyId, key) = Prekey keyId key + fromTuple (keyId, key) = UncheckedPrekeyBundle keyId key pickLastKey allPrekeys = case unsnoc allPrekeys of Nothing -> Nothing Just (keys, lst) -> pure (keys, lastPrekey . prekeyKey $ lst) diff --git a/libs/wire-subsystems/src/Wire/Migration.hs b/libs/wire-subsystems/src/Wire/Migration.hs new file mode 100644 index 00000000000..3a1d6503d3c --- /dev/null +++ b/libs/wire-subsystems/src/Wire/Migration.hs @@ -0,0 +1,129 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2026 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.Migration where + +import Cassandra +import Cassandra.Settings +import Data.Aeson +import Data.Conduit +import Data.Conduit.Internal (zipSources) +import Data.Conduit.List qualified as C +import GHC.Generics (Generically (..)) +import Imports +import Polysemy +import Polysemy.Input +import Polysemy.TinyLog +import Prometheus qualified +import System.Logger qualified as Log +import UnliftIO qualified +import Wire.Util (embedClient) + +data MigrationOptions = MigrationOptions + { pageSize :: Int32, + parallelism :: Int + } + deriving (Show, Eq, Generic) + deriving (FromJSON) via Generically MigrationOptions + +migrationLoop :: + Log.Logger -> + ByteString -> + Prometheus.Counter -> + Prometheus.Counter -> + (Sem r () -> IO (Int, a)) -> + ConduitT () Void (Sem r) () -> + IO () +migrationLoop logger name migFinished migFailed interpreter migration = do + go 0 `UnliftIO.catch` handleIOError + where + handleIOError :: SomeException -> IO () + handleIOError exc = do + Prometheus.incCounter migFailed + Log.err logger $ + Log.msg (Log.val "migration failed, it won't restart unless the background-worker is restarted.") + . Log.field "migration" name + . Log.field "error" (displayException exc) + UnliftIO.throwIO exc + + go :: Int -> IO () + go nIter = do + runMigration >>= \case + 0 -> do + Log.info logger $ + Log.msg (Log.val "finished migration") + . Log.field "attempt" nIter + . Log.field "migration" name + Prometheus.incCounter migFinished + n -> do + Log.info logger $ + Log.msg (Log.val "finished migration with errors") + . Log.field "migration" name + . Log.field "errors" n + . Log.field "attempt" nIter + go (nIter + 1) + + runMigration :: IO Int + runMigration = + fmap fst + . interpreter + $ runConduit migration + +logRetrievedPage :: (Member TinyLog r) => Int32 -> (a -> b) -> ConduitM (Int32, [a]) [b] (Sem r) () +logRetrievedPage pageSize toRow = + C.mapM + ( \(i, rows) -> do + let estimatedRowsSoFar = (i - 1) * pageSize + fromIntegral (length rows) + info $ Log.msg (Log.val "retrieved page") . Log.field "estimatedRowsSoFar" estimatedRowsSoFar + pure $ map toRow rows + ) + +withCount :: (Monad m) => ConduitM () [a] m () -> ConduitM () (Int32, [a]) m () +withCount = zipSources (C.sourceList [1 ..]) + +paginateSem :: + forall a b q r. + ( Tuple a, + Tuple b, + RunQ q, + Member (Input ClientState) r, + Member TinyLog r, + Member (Embed IO) r + ) => + q R a b -> + QueryParams a -> + RetrySettings -> + ConduitT () [b] (Sem r) () +paginateSem q p r = do + go =<< lift getFirstPage + where + go page = do + lift $ info $ Log.msg (Log.val "got a page") + unless (null (result page)) $ + yield (result page) + when (hasMore page) $ + go =<< lift (getNextPage page) + + getFirstPage :: Sem r (Page b) + getFirstPage = do + client <- input + embedClient client $ retry r (paginate q p) + + getNextPage :: Page b -> Sem r (Page b) + getNextPage page = do + client <- input + embedClient client $ retry r (nextPage page) diff --git a/services/galley/src/Galley/Effects/TeamFeatureStore.hs b/libs/wire-subsystems/src/Wire/TeamFeatureStore.hs similarity index 95% rename from services/galley/src/Galley/Effects/TeamFeatureStore.hs rename to libs/wire-subsystems/src/Wire/TeamFeatureStore.hs index d8b53db44e3..7be546ed65d 100644 --- a/services/galley/src/Galley/Effects/TeamFeatureStore.hs +++ b/libs/wire-subsystems/src/Wire/TeamFeatureStore.hs @@ -1,6 +1,6 @@ -- This file is part of the Wire Server implementation. -- --- Copyright (C) 2022 Wire Swiss GmbH +-- Copyright (C) 2026 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 @@ -15,7 +15,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 where +module Wire.TeamFeatureStore where import Data.Id import Polysemy diff --git a/services/galley/src/Galley/Cassandra/TeamFeatures.hs b/libs/wire-subsystems/src/Wire/TeamFeatureStore/Cassandra.hs similarity index 79% rename from services/galley/src/Galley/Cassandra/TeamFeatures.hs rename to libs/wire-subsystems/src/Wire/TeamFeatureStore/Cassandra.hs index c74b96b03f5..2a897bc6b3e 100644 --- a/services/galley/src/Galley/Cassandra/TeamFeatures.hs +++ b/libs/wire-subsystems/src/Wire/TeamFeatureStore/Cassandra.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 Galley.Cassandra.TeamFeatures - ( interpretTeamFeatureStoreToCassandra, - getAllTeamFeaturesForServer, - ) -where +module Wire.TeamFeatureStore.Cassandra (interpretTeamFeatureStoreToCassandra, TeamFeatureStoreError (..)) where import Cassandra import Data.Aeson.Types qualified as A @@ -29,50 +25,42 @@ import Data.Constraint import Data.Id import Data.Map qualified as M import Data.Text.Lazy qualified as LT -import Galley.API.Error -import Galley.API.Teams.Features.Get -import Galley.Cassandra.Store -import Galley.Cassandra.Util -import Galley.Effects.TeamFeatureStore qualified as TFS import Imports import Polysemy import Polysemy.Error import Polysemy.Input -import Polysemy.TinyLog import Wire.API.Team.Feature import Wire.API.Team.Feature.TH import Wire.ConversationStore.Cassandra.Instances () +import Wire.TeamFeatureStore (TeamFeatureStore (..)) +import Wire.Util + +data TeamFeatureStoreError = TeamFeatureStoreErrorInternalError LText interpretTeamFeatureStoreToCassandra :: ( Member (Embed IO) r, Member (Input ClientState) r, - Member (Error InternalError) r, - Member TinyLog r + Member (Error TeamFeatureStoreError) r ) => - Sem (TFS.TeamFeatureStore ': r) a -> + Sem (TeamFeatureStore ': r) a -> Sem r a interpretTeamFeatureStoreToCassandra = interpret $ \case - TFS.GetDbFeature sing tid -> do - logEffect "TeamFeatureStore.GetFeatureConfig" + GetDbFeature sing tid -> do getDbFeatureDyn sing tid - TFS.SetDbFeature sing tid feat -> do - logEffect "TeamFeatureStore.SetFeatureConfig" + SetDbFeature sing tid feat -> do setDbFeatureDyn sing tid feat - TFS.SetFeatureLockStatus sing tid lock -> do - logEffect "TeamFeatureStore.SetFeatureLockStatus" + SetFeatureLockStatus sing tid lock -> do setFeatureLockStatusDyn sing tid (Tagged lock) - TFS.GetAllDbFeatures tid -> do - logEffect "TeamFeatureStore.GetAllTeamFeatures" + GetAllDbFeatures tid -> do getAllDbFeaturesDyn tid - TFS.PatchDbFeature sing tid feat -> do - logEffect "TeamFeatureStore.PatchDbFeature" + PatchDbFeature sing tid feat -> do patchDbFeatureDyn sing tid feat getDbFeatureDyn :: forall cfg r. ( Member (Input ClientState) r, Member (Embed IO) r, - Member (Error InternalError) r + Member (Error TeamFeatureStoreError) r ) => FeatureSingleton cfg -> TeamId -> @@ -81,7 +69,7 @@ getDbFeatureDyn sing tid = case featureSingIsFeature sing of Dict -> do let q :: PrepQuery R (TeamId, Text) (Maybe FeatureStatus, Maybe LockStatus, Maybe DbConfig) q = "select status, lock_status, config from team_features_dyn where team = ? and feature = ?" - embedClient (retry x1 $ query1 q (params LocalQuorum (tid, featureName @cfg))) >>= \case + (embedClientInput (retry x1 $ query1 q (params LocalQuorum (tid, featureName @cfg)))) >>= \case Nothing -> pure mempty Just (status, lockStatus, config) -> runFeatureParser . parseDbFeature $ @@ -117,7 +105,7 @@ patchDbFeatureDyn :: LockableFeaturePatch cfg -> Sem r () patchDbFeatureDyn sing tid patch = case featureSingIsFeature sing of - Dict -> embedClient $ do + Dict -> embedClientInput $ do retry x5 . batch $ do setType BatchLogged setConsistency LocalQuorum @@ -147,21 +135,21 @@ setFeatureLockStatusDyn sing tid (Tagged lockStatus) = case featureSingIsFeature Dict -> do let q :: PrepQuery W (LockStatus, TeamId, Text) () q = "update team_features_dyn set lock_status = ? where team = ? and feature = ?" - embedClient $ + embedClientInput $ retry x5 $ write q (params LocalQuorum (lockStatus, tid, featureName @cfg)) getAllDbFeaturesDyn :: ( Member (Embed IO) r, - Member (Error InternalError) r, - Member (Input ClientState) r + Member (Input ClientState) r, + Member (Error TeamFeatureStoreError) r ) => TeamId -> Sem r (AllFeatures DbFeature) getAllDbFeaturesDyn tid = do let q :: PrepQuery R (Identity TeamId) (Text, Maybe FeatureStatus, Maybe LockStatus, Maybe DbConfig) q = "select feature, status, lock_status, config from team_features_dyn where team = ?" - rows <- embedClient $ retry x1 $ query q (params LocalQuorum (Identity tid)) + rows <- embedClientInput $ retry x1 $ query q (params LocalQuorum (Identity tid)) let m = M.fromList $ do (name, status, lockStatus, config) <- rows pure (name, LockableFeaturePatch {..}) @@ -169,10 +157,10 @@ getAllDbFeaturesDyn tid = do runFeatureParser :: forall r a. - (Member (Error InternalError) r) => + (Member (Error TeamFeatureStoreError) r) => A.Parser a -> Sem r a runFeatureParser p = - mapError (InternalErrorWithDescription . LT.pack) + mapError (TeamFeatureStoreErrorInternalError . LT.pack) . fromEither $ A.parseEither (const p) () diff --git a/libs/wire-subsystems/src/Wire/UserSearch/Types.hs b/libs/wire-subsystems/src/Wire/UserSearch/Types.hs index 317a309defc..28b766f0dba 100644 --- a/libs/wire-subsystems/src/Wire/UserSearch/Types.hs +++ b/libs/wire-subsystems/src/Wire/UserSearch/Types.hs @@ -29,6 +29,7 @@ import Data.ByteString.Lazy import Data.Handle import Data.Id import Data.Json.Util +import Data.Qualified import Data.Text.Encoding import Database.Bloodhound.Types import Imports @@ -61,6 +62,7 @@ mkIndexVersion writetimes = -- consequently removed from the index. data UserDoc = UserDoc { udId :: UserId, + udType :: Maybe UserType, udTeam :: Maybe TeamId, udName :: Maybe Name, udNormalized :: Maybe Text, @@ -85,6 +87,7 @@ instance ToJSON UserDoc where toJSON ud = object [ "id" .= udId ud, + "type" .= udType ud, "team" .= udTeam ud, "name" .= udName ud, "normalized" .= udNormalized ud, @@ -107,6 +110,7 @@ instance FromJSON UserDoc where parseJSON = withObject "UserDoc" $ \o -> UserDoc <$> o .: "id" + <*> o .:? "type" <*> o .:? "team" <*> o .:? "name" <*> o .:? "normalized" @@ -127,6 +131,27 @@ instance FromJSON UserDoc where searchVisibilityInboundFieldName :: Key searchVisibilityInboundFieldName = "search_visibility_inbound" +-- Qualified UserId is not included in `UserDoc`, so it needs to be +-- provided here. Monad will most likely be Identity (I promise we'll +-- always make up some name if missing) or Maybe (if no name, then no +-- contact). +userDocToContact :: (Monad m) => Qualified UserId -> (Maybe Name -> m Text) -> UserDoc -> m Contact +userDocToContact contactQualifiedId getName userDoc = + getName userDoc.udName <&> \name -> + Contact + { contactQualifiedId, + contactName = name, + contactColorId = fromIntegral . fromColourId <$> userDoc.udColourId, + contactHandle = fromHandle <$> userDoc.udHandle, + contactTeam = userDoc.udTeam, + contactType = + -- NB: after wire release upgrade and before ES reindexing, + -- apps may identify as regular users in the search result. + -- this is an accepted limitation and will be fixed in + -- https://github.com/wireapp/wire-server/pull/4947 + fromMaybe UserTypeRegular userDoc.udType + } + userDocToTeamContact :: [UserGroupId] -> UserDoc -> TeamContact userDocToTeamContact userGroups UserDoc {..} = TeamContact diff --git a/libs/wire-subsystems/src/Wire/UserStore/IndexUser.hs b/libs/wire-subsystems/src/Wire/UserStore/IndexUser.hs index b833bbfaad4..824fe49e242 100644 --- a/libs/wire-subsystems/src/Wire/UserStore/IndexUser.hs +++ b/libs/wire-subsystems/src/Wire/UserStore/IndexUser.hs @@ -149,12 +149,14 @@ indexUserToVersion role IndexUser {..} = const () <$$> writeTimeBumper ] -indexUserToDoc :: SearchVisibilityInbound -> Maybe Role -> IndexUser -> UserDoc -indexUserToDoc searchVisInbound mRole IndexUser {..} = +indexUserToDoc :: SearchVisibilityInbound -> Maybe UserType -> Maybe Role -> IndexUser -> UserDoc +indexUserToDoc searchVisInbound mUserType mRole IndexUser {..} = if shouldIndex then UserDoc - { udSearchable = value <$> searchable, + { udId = userId, + udType = mUserType, + udSearchable = value <$> searchable, udEmailUnvalidated = value <$> unverifiedEmail, udSso = sso . value =<< ssoId, udScimExternalId = join $ scimExternalId <$> (value <$> managedBy) <*> (value <$> ssoId), @@ -169,8 +171,7 @@ indexUserToDoc searchVisInbound mRole IndexUser {..} = udHandle = value <$> handle, udNormalized = Just $ normalized name.value.fromName, udName = Just name.value, - udTeam = value <$> teamId, - udId = userId + udTeam = value <$> teamId } else -- We insert a tombstone-style user here, as it's easier than -- deleting the old one. It's mostly empty, but having the status here @@ -214,7 +215,8 @@ normalized = transliterate (trans "Any-Latin; Latin-ASCII; Lower") emptyUserDoc :: UserId -> UserDoc emptyUserDoc uid = UserDoc - { udSearchable = Nothing, + { udType = Nothing, + udSearchable = Nothing, udEmailUnvalidated = Nothing, udSso = Nothing, udScimExternalId = Nothing, diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs index 86be662b3c3..c6524d8e6b4 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs @@ -451,13 +451,11 @@ getLocalUserProfileImpl emailVisibilityConfigWithViewer luid = do lhs :: UserLegalHoldStatus <- do teamMember <- lift $ join <$> (internalGetTeamMember storedUser.id `mapM` storedUser.teamId) pure $ maybe defUserLegalHoldStatus (view legalHoldStatus) teamMember + userType <- lift $ getUserType storedUser.id storedUser.teamId storedUser.serviceId let user = mkUserFromStored domain locale storedUser - usrProfile = mkUserProfile emailVisibilityConfigWithViewer user lhs - app <- lift $ mapM (getApp storedUser.id) storedUser.teamId + usrProfile = mkUserProfile emailVisibilityConfigWithViewer userType user lhs lift $ deleteLocalIfExpired user - pure $ case join app of - Nothing -> usrProfile - Just _ -> usrProfile {profileType = UserTypeApp} + pure $ usrProfile getSelfProfileImpl :: ( Member (Input UserSubsystemConfig) r, @@ -578,6 +576,7 @@ guardLockedHandleField user updateOrigin handle = do updateUserProfileImpl :: ( Member UserStore r, + Member AppStore r, Member (Error UserSubsystemError) r, Member Events r, Member GalleyAPIAccess r, @@ -642,6 +641,7 @@ updateHandleImpl :: Member GalleyAPIAccess r, Member Events r, Member UserStore r, + Member AppStore r, Member IndexedUserStore r, Member Metrics r ) => @@ -708,13 +708,14 @@ checkHandlesImpl check num = reverse <$> collectFree [] check num syncUserIndex :: forall r. ( Member UserStore r, + Member AppStore r, Member GalleyAPIAccess r, Member IndexedUserStore r, Member Metrics r ) => UserId -> Sem r () -syncUserIndex uid = do +syncUserIndex uid = getIndexUser uid >>= maybe deleteFromIndex upsert where @@ -731,8 +732,9 @@ syncUserIndex uid = do (teamSearchVisibilityInbound . value) indexUser.teamId tm <- maybe (pure Nothing) (selectTeamMember . value) indexUser.teamId + userType <- getUserType indexUser.userId (indexUser.teamId <&> (.value)) (indexUser.serviceId <&> (.value)) let mRole = tm >>= mkRoleWithWriteTime - userDoc = indexUserToDoc vis (value <$> mRole) indexUser + userDoc = indexUserToDoc vis (Just userType) (value <$> mRole) indexUser version = ES.ExternalGT . ES.ExternalDocVersion . docVersion $ indexUserToVersion mRole indexUser Metrics.incCounter indexUpdateCounter IndexedUserStore.upsert (userIdToDocId uid) userDoc version @@ -760,6 +762,7 @@ searchUsersImpl :: forall r fedM. ( Member UserStore r, Member GalleyAPIAccess r, + Member AppStore r, Member (Error UserSubsystemError) r, Member IndexedUserStore r, Member FederationConfigStore r, @@ -795,6 +798,7 @@ searchUsersImpl searcherId searchTerm maybeDomain maybeMaxResults = do searchLocally :: forall r. ( Member GalleyAPIAccess r, + Member AppStore r, Member UserStore r, Member IndexedUserStore r, Member (Input UserSubsystemConfig) r @@ -823,7 +827,7 @@ searchLocally searcher searchTerm maybeMaxResults = do esMaxResults else pure $ SearchResult 0 0 0 [] FullSearch Nothing Nothing - let esContacts = map userDocToContact (searchResults esResult) + let esContacts = map userDocToContact' (searchResults esResult) -- Prepend results matching exact handle and results from ES. allContacts = case maybeExactHandleMatch of Nothing -> esContacts @@ -839,15 +843,13 @@ searchLocally searcher searchTerm maybeMaxResults = do handleTeamVisibility _ SearchVisibilityStandard = AllUsers handleTeamVisibility t SearchVisibilityNoNameOutsideTeam = TeamOnly t - userDocToContact :: UserDoc -> Contact - userDocToContact userDoc = - Contact - { contactQualifiedId = tUntagged $ qualifyAs searcher userDoc.udId, - contactName = maybe "" fromName userDoc.udName, - contactColorId = fromIntegral . fromColourId <$> userDoc.udColourId, - contactHandle = Handle.fromHandle <$> userDoc.udHandle, - contactTeam = userDoc.udTeam - } + userDocToContact' :: UserDoc -> Contact + userDocToContact' userDoc = + runIdentity $ + userDocToContact + (tUntagged $ qualifyAs searcher userDoc.udId) + (Identity . maybe "" fromName) + userDoc mkTeamSearchInfo :: Maybe TeamId -> Sem r TeamSearchInfo mkTeamSearchInfo searcherTeamId = do @@ -864,27 +866,26 @@ searchLocally searcher searchTerm maybeMaxResults = do exactHandleSearch :: Sem r (Maybe Contact) exactHandleSearch = runMaybeT $ do - handle <- MaybeT . pure $ Handle.parseHandle searchTerm + handle <- hoistMaybe $ Handle.parseHandle searchTerm owner <- MaybeT $ UserStore.lookupHandle handle storedUser <- MaybeT $ UserStore.getUser owner config <- lift input - let contact = contactFromStoredUser (tDomain searcher) storedUser - isContactVisible = + let isContactVisible = (config.searchSameTeamOnly && (snd . tUnqualified $ searcher) == storedUser.teamId) || (not config.searchSameTeamOnly) if isContactVisible && fromMaybe True storedUser.searchable - then pure contact - else MaybeT $ pure Nothing - - contactFromStoredUser :: Domain -> StoredUser -> Contact - contactFromStoredUser domain storedUser = - Contact - { contactQualifiedId = Qualified storedUser.id domain, - contactName = fromName storedUser.name, - contactHandle = Handle.fromHandle <$> storedUser.handle, - contactColorId = Just . fromIntegral . fromColourId $ storedUser.accentId, - contactTeam = storedUser.teamId - } + then do + userType <- lift $ getUserType storedUser.id storedUser.teamId storedUser.serviceId + pure $ + Contact + { contactQualifiedId = Qualified storedUser.id (tDomain searcher), + contactName = fromName storedUser.name, + contactHandle = Handle.fromHandle <$> storedUser.handle, + contactColorId = Just . fromIntegral . fromColourId $ storedUser.accentId, + contactTeam = storedUser.teamId, + contactType = userType + } + else hoistMaybe Nothing searchRemotely :: ( Member FederationConfigStore r, @@ -1053,6 +1054,7 @@ getAccountsByImpl (tSplit -> (domain, GetBy {includePendingInvitations, getByHan acceptTeamInvitationImpl :: ( Member (Input UserSubsystemConfig) r, Member UserStore r, + Member AppStore r, Member GalleyAPIAccess r, Member (Error UserSubsystemError) r, Member InvitationStore r, @@ -1117,6 +1119,7 @@ getUserExportDataImpl uid = fmap hush . runError @() $ do removeEmailEitherImpl :: ( Member UserKeyStore r, Member UserStore r, + Member AppStore r, Member Events r, Member IndexedUserStore r, Member (Input UserSubsystemConfig) r, @@ -1151,6 +1154,7 @@ checkUserIsAdminImpl uid = do setUserSearchableImpl :: ( Member UserStore r, + Member AppStore r, Member (Error UserSubsystemError) r, Member TeamSubsystem r, Member GalleyAPIAccess r, @@ -1166,3 +1170,20 @@ setUserSearchableImpl luid uid searchable = do ensurePermissions (tUnqualified luid) tid [SetMemberSearchable] UserStore.setUserSearchable uid searchable syncUserIndex uid + +-- * Helpers + +getUserType :: + forall r. + (Member AppStore r) => + UserId -> + Maybe TeamId -> + Maybe ServiceId -> + Sem r UserType +getUserType uid mTid mbServiceId = case mbServiceId of + Just _ -> pure UserTypeBot + Nothing -> do + mmApp <- mapM (getApp uid) mTid + case join mmApp of + Just _ -> pure UserTypeApp + Nothing -> pure UserTypeRegular diff --git a/libs/wire-subsystems/templates/ar/user/call/activation.txt b/libs/wire-subsystems/templates/ar/user/call/activation.txt deleted file mode 100644 index 6ffbabae462..00000000000 --- a/libs/wire-subsystems/templates/ar/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -رمز واير لك هو ${code}. diff --git a/libs/wire-subsystems/templates/ar/user/call/login.txt b/libs/wire-subsystems/templates/ar/user/call/login.txt deleted file mode 100644 index f10b7e17e4f..00000000000 --- a/libs/wire-subsystems/templates/ar/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -رمز دخول واير الخاص بك هو ${code}. diff --git a/libs/wire-subsystems/templates/ar/user/sms/activation.txt b/libs/wire-subsystems/templates/ar/user/sms/activation.txt deleted file mode 100644 index 8525e4f964f..00000000000 --- a/libs/wire-subsystems/templates/ar/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -رمز واير الخاص بك هو ${code}. - - قم بإدخال الرمز أعلاه لإتمام التسجيل في واير. diff --git a/libs/wire-subsystems/templates/ar/user/sms/deletion.txt b/libs/wire-subsystems/templates/ar/user/sms/deletion.txt deleted file mode 100644 index c9ce376421c..00000000000 --- a/libs/wire-subsystems/templates/ar/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -انقر لحذف حسابك الخاص في واير. -${url} diff --git a/libs/wire-subsystems/templates/ar/user/sms/login.txt b/libs/wire-subsystems/templates/ar/user/sms/login.txt deleted file mode 100644 index b328bd89a1b..00000000000 --- a/libs/wire-subsystems/templates/ar/user/sms/login.txt +++ /dev/null @@ -1,3 +0,0 @@ -رمز دخول واير الخاص بك هو ${code}. - -قم بإدخاله في تطبيق واير لتتمكن من تسجيل الدخول : ${code}. diff --git a/libs/wire-subsystems/templates/ar/user/sms/password-reset.txt b/libs/wire-subsystems/templates/ar/user/sms/password-reset.txt deleted file mode 100644 index 912478bdee2..00000000000 --- a/libs/wire-subsystems/templates/ar/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -رمز الاسترداد الخاص بك في واير هو ${code}. - -افتح تطبيق واير واستخدم هذا الرمز لإتمام إعادة تعيين كلمة المرور. \ No newline at end of file diff --git a/libs/wire-subsystems/templates/de/team/email/new-creator-welcome-subject.txt b/libs/wire-subsystems/templates/de/team/email/new-creator-welcome-subject.txt deleted file mode 100644 index 34083e277c1..00000000000 --- a/libs/wire-subsystems/templates/de/team/email/new-creator-welcome-subject.txt +++ /dev/null @@ -1 +0,0 @@ -Neues Team auf Wire \ No newline at end of file diff --git a/libs/wire-subsystems/templates/de/team/email/new-creator-welcome.html b/libs/wire-subsystems/templates/de/team/email/new-creator-welcome.html deleted file mode 100644 index 89fba8a6f5d..00000000000 --- a/libs/wire-subsystems/templates/de/team/email/new-creator-welcome.html +++ /dev/null @@ -1 +0,0 @@ -Neues Team auf Wire

wire.com

Dein neues Team.

Du hast soeben mit ${email} ein Team namens ${team_name} auf Wire erstellt.

Deine 30-tägige Testversion beginnt heute.

 

Wire vereint sichere Verschlüsselung mit reichhaltigem Funktionsumfang und einfacher Bedienung in einer einzigen App. Unterstützt alle gängigen Plattformen.

 
Lade deine Teamkameraden ein
 

Falls du nicht auf den Button klicken kannst, kopiere den Link und füge ihn in deinem Browser ein:

${url}

Wenn Du Fragen hast, bitte kontaktiere uns.

Team ID: ${team_id}

Datenschutz · Missbrauch melden
© WIRE SWISS GmbH. ALLE RECHTE VORBEHALTEN.

                                                           
\ No newline at end of file diff --git a/libs/wire-subsystems/templates/de/team/email/new-creator-welcome.txt b/libs/wire-subsystems/templates/de/team/email/new-creator-welcome.txt deleted file mode 100644 index dd8638c1370..00000000000 --- a/libs/wire-subsystems/templates/de/team/email/new-creator-welcome.txt +++ /dev/null @@ -1,24 +0,0 @@ -DEIN NEUES TEAM. -Du hast soeben mit ${email} ein Team namens ${team_name} auf Wire erstellt. - -Deine 30-tägige Testversion beginnt heute. - -Wire vereint sichere Verschlüsselung mit reichhaltigem Funktionsumfang und -einfacher Bedienung in einer einzigen App. Unterstützt alle gängigen -Plattformen. - -Lade deine Teamkameraden ein [${url}]Falls du nicht auf den Button klicken -kannst, kopiere den Link und füge ihn in deinem Browser ein: - -${url} - -Wenn Du Fragen hast, bitte kontaktiere uns -[https://support.wire.com/hc/de/requests/new]. - -Team ID: ${team_id} - - --------------------------------------------------------------------------------- - -Datenschutz [https://wire.com/legal/] · Missbrauch melden [misuse@wire.com] -© WIRE SWISS GmbH. ALLE RECHTE VORBEHALTEN. \ No newline at end of file diff --git a/libs/wire-subsystems/templates/de/user/call/activation.txt b/libs/wire-subsystems/templates/de/user/call/activation.txt deleted file mode 100644 index c2051759f67..00000000000 --- a/libs/wire-subsystems/templates/de/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -Guten Tag, Ihr Bestätigungscode für Wire lautet: ${code}. Noch einmal, Ihr Code lautet: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/de/user/call/login.txt b/libs/wire-subsystems/templates/de/user/call/login.txt deleted file mode 100644 index da209aae607..00000000000 --- a/libs/wire-subsystems/templates/de/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -Guten Tag, Ihr Login-Code für Wire lautet: ${code}. Noch einmal, Ihr Code lautet: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/de/user/sms/activation.txt b/libs/wire-subsystems/templates/de/user/sms/activation.txt deleted file mode 100644 index 98a94de540c..00000000000 --- a/libs/wire-subsystems/templates/de/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -Ihr ${brand}-Code ist ${code}. - -Öffnen Sie ${url}, um Ihre Nummer zu bestätigen. diff --git a/libs/wire-subsystems/templates/de/user/sms/deletion.txt b/libs/wire-subsystems/templates/de/user/sms/deletion.txt deleted file mode 100644 index 596d8e46adb..00000000000 --- a/libs/wire-subsystems/templates/de/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -Tippen Sie hier, um Ihr ${brand}-Benutzerkonto zu löschen. -${url} diff --git a/libs/wire-subsystems/templates/de/user/sms/login.txt b/libs/wire-subsystems/templates/de/user/sms/login.txt deleted file mode 100644 index fd91e0edbde..00000000000 --- a/libs/wire-subsystems/templates/de/user/sms/login.txt +++ /dev/null @@ -1,4 +0,0 @@ -Ihr Login-Code für ${brand} lautet ${code}. - - -Öffnen Sie ${url}, um sich anzumelden. diff --git a/libs/wire-subsystems/templates/de/user/sms/password-reset.txt b/libs/wire-subsystems/templates/de/user/sms/password-reset.txt deleted file mode 100644 index 89ab00d5cd6..00000000000 --- a/libs/wire-subsystems/templates/de/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -Ihr Wiederherstellungscode für ${brand} ist ${code}. - -Verwenden Sie diesen Code, um das Zurücksetzen des Passworts abzuschließen. diff --git a/libs/wire-subsystems/templates/en/team/email/new-creator-welcome-subject.txt b/libs/wire-subsystems/templates/en/team/email/new-creator-welcome-subject.txt deleted file mode 100644 index a2f9b0fce16..00000000000 --- a/libs/wire-subsystems/templates/en/team/email/new-creator-welcome-subject.txt +++ /dev/null @@ -1 +0,0 @@ -New team on Wire \ No newline at end of file diff --git a/libs/wire-subsystems/templates/en/team/email/new-creator-welcome.html b/libs/wire-subsystems/templates/en/team/email/new-creator-welcome.html deleted file mode 100644 index 839eaba980c..00000000000 --- a/libs/wire-subsystems/templates/en/team/email/new-creator-welcome.html +++ /dev/null @@ -1 +0,0 @@ -New team on Wire

wire.com

Your new team.

You have just created a team called ${team_name} on Wire with ${email}.

Your 30–day free trial starts today.

 

Wire combines strong encryption, a rich feature set and ease-of-use in one app like never before. Works on all popular platforms.

 
Invite your teammates
 

If you can’t click the button, copy and paste this link to your browser:

${url}

If you have any questions, please contact us.

Team ID: ${team_id}

Privacy · Report Misuse
© WIRE SWISS GmbH. ALL RIGHTS RESERVED.

                                                           
\ No newline at end of file diff --git a/libs/wire-subsystems/templates/en/team/email/new-creator-welcome.txt b/libs/wire-subsystems/templates/en/team/email/new-creator-welcome.txt deleted file mode 100644 index 209b41899ec..00000000000 --- a/libs/wire-subsystems/templates/en/team/email/new-creator-welcome.txt +++ /dev/null @@ -1,23 +0,0 @@ -YOUR NEW TEAM. -You have just created a team called ${team_name} on Wire with ${email}. - -Your 30–day free trial starts today. - -Wire combines strong encryption, a rich feature set and ease-of-use in one app -like never before. Works on all popular platforms. - -Invite your teammates [${url}]If you can’t click the button, copy and paste this -link to your browser: - -${url} - -If you have any questions, please contact us -[https://support.wire.com/hc/en-us/requests/new]. - -Team ID: ${team_id} - - --------------------------------------------------------------------------------- - -Privacy [https://wire.com/legal/] · Report Misuse [misuse@wire.com] -© WIRE SWISS GmbH. ALL RIGHTS RESERVED. \ No newline at end of file diff --git a/libs/wire-subsystems/templates/en/user/call/activation.txt b/libs/wire-subsystems/templates/en/user/call/activation.txt deleted file mode 100644 index 4ad404bbb14..00000000000 --- a/libs/wire-subsystems/templates/en/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -Hello, your Wire verification code is: ${code}. Once again, your code is: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/en/user/call/login.txt b/libs/wire-subsystems/templates/en/user/call/login.txt deleted file mode 100644 index 931afe85eec..00000000000 --- a/libs/wire-subsystems/templates/en/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -Hello, your Wire login code is: ${code}. Once again, your code is: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/en/user/sms/activation.txt b/libs/wire-subsystems/templates/en/user/sms/activation.txt deleted file mode 100644 index 69d66e37b0c..00000000000 --- a/libs/wire-subsystems/templates/en/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -Your ${brand} code is ${code}. - -Open ${url} to verify your number. diff --git a/libs/wire-subsystems/templates/en/user/sms/deletion.txt b/libs/wire-subsystems/templates/en/user/sms/deletion.txt deleted file mode 100644 index 07a9b8e54c1..00000000000 --- a/libs/wire-subsystems/templates/en/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -Tap to delete your ${brand} account. -${url} diff --git a/libs/wire-subsystems/templates/en/user/sms/login.txt b/libs/wire-subsystems/templates/en/user/sms/login.txt deleted file mode 100644 index 26a0a436325..00000000000 --- a/libs/wire-subsystems/templates/en/user/sms/login.txt +++ /dev/null @@ -1,3 +0,0 @@ -Your ${brand} login code is ${code}. - -Open ${url} to log in. diff --git a/libs/wire-subsystems/templates/en/user/sms/password-reset.txt b/libs/wire-subsystems/templates/en/user/sms/password-reset.txt deleted file mode 100644 index d99d8bff89a..00000000000 --- a/libs/wire-subsystems/templates/en/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -Your ${brand} recovery code is ${code}. - -Use this code to complete the password reset. diff --git a/libs/wire-subsystems/templates/es-ES/user/call/activation.txt b/libs/wire-subsystems/templates/es-ES/user/call/activation.txt deleted file mode 100644 index 03ffdcfb8ab..00000000000 --- a/libs/wire-subsystems/templates/es-ES/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -Hola, su código de verificación de Wire es: ${code} una vez más, su código es: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/es-ES/user/call/login.txt b/libs/wire-subsystems/templates/es-ES/user/call/login.txt deleted file mode 100644 index a5706ff4fb8..00000000000 --- a/libs/wire-subsystems/templates/es-ES/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -Hola, su código de inicio de sesion Wire es: ${code} una vez más, su código es: ${code} diff --git a/libs/wire-subsystems/templates/es-ES/user/sms/activation.txt b/libs/wire-subsystems/templates/es-ES/user/sms/activation.txt deleted file mode 100644 index df0bc231c21..00000000000 --- a/libs/wire-subsystems/templates/es-ES/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -Su código de Wire es ${code}. - -Abrir ${url} para verificar tu número o introducir manualmente el código Wire en la parte superior. diff --git a/libs/wire-subsystems/templates/es-ES/user/sms/deletion.txt b/libs/wire-subsystems/templates/es-ES/user/sms/deletion.txt deleted file mode 100644 index 856b8392819..00000000000 --- a/libs/wire-subsystems/templates/es-ES/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -Toca para eliminar tu cuenta de Wire. -${url} diff --git a/libs/wire-subsystems/templates/es-ES/user/sms/login.txt b/libs/wire-subsystems/templates/es-ES/user/sms/login.txt deleted file mode 100644 index 3b1db9c4b33..00000000000 --- a/libs/wire-subsystems/templates/es-ES/user/sms/login.txt +++ /dev/null @@ -1,3 +0,0 @@ -El código de inicio de sesion de Wire es ${code}. - -Abra ${url} para iniciar sesión, o introduzca este código en la aplicación de Wire: ${code}. diff --git a/libs/wire-subsystems/templates/es-ES/user/sms/password-reset.txt b/libs/wire-subsystems/templates/es-ES/user/sms/password-reset.txt deleted file mode 100644 index c0a623d7898..00000000000 --- a/libs/wire-subsystems/templates/es-ES/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -Su código de recuperación de Wire es ${code}. - -Abra la aplicación Wire y use este código para completar el restablecimiento de contraseña. \ No newline at end of file diff --git a/libs/wire-subsystems/templates/et/user/call/activation.txt b/libs/wire-subsystems/templates/et/user/call/activation.txt deleted file mode 100644 index 939e891fb63..00000000000 --- a/libs/wire-subsystems/templates/et/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -Hei, sinu Wire kinnituskood on: ${code}. Veelkord, kood on: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/et/user/call/login.txt b/libs/wire-subsystems/templates/et/user/call/login.txt deleted file mode 100644 index 5249ea6caa6..00000000000 --- a/libs/wire-subsystems/templates/et/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -Hei, sinu Wire sisselogimiskood on: ${code}. Veelkord, kood on: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/et/user/sms/activation.txt b/libs/wire-subsystems/templates/et/user/sms/activation.txt deleted file mode 100644 index ddc0b074631..00000000000 --- a/libs/wire-subsystems/templates/et/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -Your ${brand} code is ${code}. - -Toksa ${url} et number kinnitada. diff --git a/libs/wire-subsystems/templates/et/user/sms/deletion.txt b/libs/wire-subsystems/templates/et/user/sms/deletion.txt deleted file mode 100644 index 07a9b8e54c1..00000000000 --- a/libs/wire-subsystems/templates/et/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -Tap to delete your ${brand} account. -${url} diff --git a/libs/wire-subsystems/templates/et/user/sms/login.txt b/libs/wire-subsystems/templates/et/user/sms/login.txt deleted file mode 100644 index 34755c3343a..00000000000 --- a/libs/wire-subsystems/templates/et/user/sms/login.txt +++ /dev/null @@ -1,3 +0,0 @@ -Your ${brand} login code is ${code}. - -Sisselogimiseks ava aadress ${url} diff --git a/libs/wire-subsystems/templates/et/user/sms/password-reset.txt b/libs/wire-subsystems/templates/et/user/sms/password-reset.txt deleted file mode 100644 index 067c0e51f62..00000000000 --- a/libs/wire-subsystems/templates/et/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -Your ${brand} recovery code is ${code}. - -Kasuta seda koodi parooli muutmiseks. diff --git a/libs/wire-subsystems/templates/fa/user/call/activation.txt b/libs/wire-subsystems/templates/fa/user/call/activation.txt deleted file mode 100644 index cec5faf0365..00000000000 --- a/libs/wire-subsystems/templates/fa/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -سلام، کد تایید حساب شما: ${code} است. یک‌بار دیگه، این کد ${code} برای تایید حساب شما است. \ No newline at end of file diff --git a/libs/wire-subsystems/templates/fa/user/call/login.txt b/libs/wire-subsystems/templates/fa/user/call/login.txt deleted file mode 100644 index 6a2d09f4844..00000000000 --- a/libs/wire-subsystems/templates/fa/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -سلام، کد تایید حساب شما: ${code} است. یک‌بار دیگه، این کد ${code} برای تایید حساب شما است. diff --git a/libs/wire-subsystems/templates/fa/user/sms/activation.txt b/libs/wire-subsystems/templates/fa/user/sms/activation.txt deleted file mode 100644 index 80fb8deec6e..00000000000 --- a/libs/wire-subsystems/templates/fa/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -کد Wire شما ${code} . - -از طریق ${url} شماره تلفن را تایید و یا کد بالا را در Wire بصورت دستی وارد کنید. diff --git a/libs/wire-subsystems/templates/fa/user/sms/deletion.txt b/libs/wire-subsystems/templates/fa/user/sms/deletion.txt deleted file mode 100644 index dda9c0e3c3b..00000000000 --- a/libs/wire-subsystems/templates/fa/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -اینجا بزنید تا حساب Wire خود را پاک کنید. -${url} diff --git a/libs/wire-subsystems/templates/fa/user/sms/login.txt b/libs/wire-subsystems/templates/fa/user/sms/login.txt deleted file mode 100644 index fd2fc9d8789..00000000000 --- a/libs/wire-subsystems/templates/fa/user/sms/login.txt +++ /dev/null @@ -1,3 +0,0 @@ -این کد ${code} برای ورود شما قابل استفاده است. - -پیوند ${url} را برای وارد شدن باز کنید و یا این کد ${code} را در Wire خود بصورت دستی وارد کنید. diff --git a/libs/wire-subsystems/templates/fa/user/sms/password-reset.txt b/libs/wire-subsystems/templates/fa/user/sms/password-reset.txt deleted file mode 100644 index 120b40adca9..00000000000 --- a/libs/wire-subsystems/templates/fa/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -این کد ${code} برای بازیابی حساب Wire شما است. - -برای تکمیل مراحل بازیابی رمزعبور خود، در اپ Wire این کد را وارد کنید. \ No newline at end of file diff --git a/libs/wire-subsystems/templates/fr/user/call/activation.txt b/libs/wire-subsystems/templates/fr/user/call/activation.txt deleted file mode 100644 index 391fe95d6ac..00000000000 --- a/libs/wire-subsystems/templates/fr/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -Bonjour, votre code de vérification pour Wire est : ${code}. Je répète, votre code est : ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/fr/user/call/login.txt b/libs/wire-subsystems/templates/fr/user/call/login.txt deleted file mode 100644 index 20a123ba2c1..00000000000 --- a/libs/wire-subsystems/templates/fr/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -Bonjour, votre code de connexion Wire est : ${code}. Je répète, votre code est : ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/fr/user/sms/activation.txt b/libs/wire-subsystems/templates/fr/user/sms/activation.txt deleted file mode 100644 index be11bb1e3c1..00000000000 --- a/libs/wire-subsystems/templates/fr/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -Votre code ${brand} est ${code}. - -Ouvrez ${url} pour vérifier votre numéro. diff --git a/libs/wire-subsystems/templates/fr/user/sms/deletion.txt b/libs/wire-subsystems/templates/fr/user/sms/deletion.txt deleted file mode 100644 index 8fb5c0c3b57..00000000000 --- a/libs/wire-subsystems/templates/fr/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -Cliquez pour supprimer votre compte ${brand}. -${url} diff --git a/libs/wire-subsystems/templates/fr/user/sms/login.txt b/libs/wire-subsystems/templates/fr/user/sms/login.txt deleted file mode 100644 index 0b859e561a6..00000000000 --- a/libs/wire-subsystems/templates/fr/user/sms/login.txt +++ /dev/null @@ -1,3 +0,0 @@ -Votre code de connexion ${brand} est ${code}. - -Ouvrez ${url} pour vous connecter. diff --git a/libs/wire-subsystems/templates/fr/user/sms/password-reset.txt b/libs/wire-subsystems/templates/fr/user/sms/password-reset.txt deleted file mode 100644 index 5ad45f6dd89..00000000000 --- a/libs/wire-subsystems/templates/fr/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -Votre code de récupération ${brand} est ${code}. - -Utilisez ce code pour finir de réinitialiser votre mot de passe. diff --git a/libs/wire-subsystems/templates/it/user/call/activation.txt b/libs/wire-subsystems/templates/it/user/call/activation.txt deleted file mode 100644 index c1b51fc95b8..00000000000 --- a/libs/wire-subsystems/templates/it/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -Ciao, il tuo codice verifica di Wire è: ${code}. Ancora una volta, il codice è: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/it/user/call/login.txt b/libs/wire-subsystems/templates/it/user/call/login.txt deleted file mode 100644 index fd6cfc78e6a..00000000000 --- a/libs/wire-subsystems/templates/it/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -Ciao, il tuo codice di accesso di Wire è: ${code}. Ancora una volta, il codice è: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/it/user/sms/activation.txt b/libs/wire-subsystems/templates/it/user/sms/activation.txt deleted file mode 100644 index 2f831a186d0..00000000000 --- a/libs/wire-subsystems/templates/it/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -Il codice del tuo ${brand} è ${code}. - -Apri ${url} per verificare il tuo numero. diff --git a/libs/wire-subsystems/templates/it/user/sms/deletion.txt b/libs/wire-subsystems/templates/it/user/sms/deletion.txt deleted file mode 100644 index 954020d32c8..00000000000 --- a/libs/wire-subsystems/templates/it/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -Tocca per eliminare il tuo profilo di ${brand}. -${url} diff --git a/libs/wire-subsystems/templates/it/user/sms/login.txt b/libs/wire-subsystems/templates/it/user/sms/login.txt deleted file mode 100644 index 84a0b9861d0..00000000000 --- a/libs/wire-subsystems/templates/it/user/sms/login.txt +++ /dev/null @@ -1,3 +0,0 @@ -Il tuo codice di accesso di ${brand} è ${code}. - -Apri ${url} per accedere. diff --git a/libs/wire-subsystems/templates/it/user/sms/password-reset.txt b/libs/wire-subsystems/templates/it/user/sms/password-reset.txt deleted file mode 100644 index b9aa4d7a945..00000000000 --- a/libs/wire-subsystems/templates/it/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -Il tuo codice di recupero di ${brand} è ${code}. - -Usa questo codice per completare il ripristino della password. diff --git a/libs/wire-subsystems/templates/ja/user/call/activation.txt b/libs/wire-subsystems/templates/ja/user/call/activation.txt deleted file mode 100644 index d62a4fa1c53..00000000000 --- a/libs/wire-subsystems/templates/ja/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -こんにちは、あなたのWire確認コードは、${code} です。 もう一度、あなたのコードは${code} です。 \ No newline at end of file diff --git a/libs/wire-subsystems/templates/ja/user/call/login.txt b/libs/wire-subsystems/templates/ja/user/call/login.txt deleted file mode 100644 index 443ac057de1..00000000000 --- a/libs/wire-subsystems/templates/ja/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -こんにちは、あなたのWire確認コードは、${code} です。 もう一度、あなたのコードは ${code} です。 \ No newline at end of file diff --git a/libs/wire-subsystems/templates/ja/user/sms/activation.txt b/libs/wire-subsystems/templates/ja/user/sms/activation.txt deleted file mode 100644 index 5b27432624a..00000000000 --- a/libs/wire-subsystems/templates/ja/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -あなたの ${brand} の ログインコードは ${code} です - -${url} を開いて、あなたの番号を認証してください。 diff --git a/libs/wire-subsystems/templates/ja/user/sms/deletion.txt b/libs/wire-subsystems/templates/ja/user/sms/deletion.txt deleted file mode 100644 index f552addbd5c..00000000000 --- a/libs/wire-subsystems/templates/ja/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -タップして、あなたの ${brand} のアカウントを削除します -${url} diff --git a/libs/wire-subsystems/templates/ja/user/sms/login.txt b/libs/wire-subsystems/templates/ja/user/sms/login.txt deleted file mode 100644 index ac0ec8b47d1..00000000000 --- a/libs/wire-subsystems/templates/ja/user/sms/login.txt +++ /dev/null @@ -1,3 +0,0 @@ -あなたの ${brand} ログインコードは ${code} です - -${url} を開いて、ログインしてください。 diff --git a/libs/wire-subsystems/templates/ja/user/sms/password-reset.txt b/libs/wire-subsystems/templates/ja/user/sms/password-reset.txt deleted file mode 100644 index 9476d182cb1..00000000000 --- a/libs/wire-subsystems/templates/ja/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -あなたの ${brand} の リカバリーコードは ${code} です。 - -このコードを使ってパスワードのリセットを完了してください。 diff --git a/libs/wire-subsystems/templates/lt/user/call/activation.txt b/libs/wire-subsystems/templates/lt/user/call/activation.txt deleted file mode 100644 index 579b007b3ee..00000000000 --- a/libs/wire-subsystems/templates/lt/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -Sveiki, jūsų „Wire“ patvirtinimo kodas yra: ${code}. Dar kartą, jūsų kodas yra: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/lt/user/call/login.txt b/libs/wire-subsystems/templates/lt/user/call/login.txt deleted file mode 100644 index 807fd238462..00000000000 --- a/libs/wire-subsystems/templates/lt/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -Sveiki, jūsų „Wire“ prisijungimo kodas yra: ${code}. Dar kartą, jūsų kodas yra: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/lt/user/sms/activation.txt b/libs/wire-subsystems/templates/lt/user/sms/activation.txt deleted file mode 100644 index 68bfeccaac9..00000000000 --- a/libs/wire-subsystems/templates/lt/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -Jūsų ${brand} kodas yra ${code}. - -Atverkite ${url} norėdami patvirtinti savo numerį. diff --git a/libs/wire-subsystems/templates/lt/user/sms/deletion.txt b/libs/wire-subsystems/templates/lt/user/sms/deletion.txt deleted file mode 100644 index b918b6f022b..00000000000 --- a/libs/wire-subsystems/templates/lt/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -Bakstelėkite, norėdami ištrinti savo ${brand} paskyrą. -${url} diff --git a/libs/wire-subsystems/templates/lt/user/sms/login.txt b/libs/wire-subsystems/templates/lt/user/sms/login.txt deleted file mode 100644 index 36ad720403a..00000000000 --- a/libs/wire-subsystems/templates/lt/user/sms/login.txt +++ /dev/null @@ -1,3 +0,0 @@ -Jūsų ${brand} prisijungimo kodas yra ${code}. - -Atverkite ${url} norėdami prisijungti. diff --git a/libs/wire-subsystems/templates/lt/user/sms/password-reset.txt b/libs/wire-subsystems/templates/lt/user/sms/password-reset.txt deleted file mode 100644 index 5baca0ba65c..00000000000 --- a/libs/wire-subsystems/templates/lt/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -Jūsų ${brand} atkūrimo kodas yra ${code}. - -Naudokite šį kodą norėdami užbaigti slaptažodžio atstatymą. diff --git a/libs/wire-subsystems/templates/pl/user/call/activation.txt b/libs/wire-subsystems/templates/pl/user/call/activation.txt deleted file mode 100644 index 8b52566e1ed..00000000000 --- a/libs/wire-subsystems/templates/pl/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -Witaj, Twój kod weryfikacyjny Wire to: ${code}. Jeszcze raz twój kod to: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/pl/user/call/login.txt b/libs/wire-subsystems/templates/pl/user/call/login.txt deleted file mode 100644 index b2d8c07e3b3..00000000000 --- a/libs/wire-subsystems/templates/pl/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -Witaj, Twój kod logowania Wire to: ${code}. Jeszcze raz twój kod to: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/pl/user/sms/activation.txt b/libs/wire-subsystems/templates/pl/user/sms/activation.txt deleted file mode 100644 index 7fc97d25b1c..00000000000 --- a/libs/wire-subsystems/templates/pl/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -Twój kod ${brand} to ${code}. - -Otwórz ${url} aby zweryfikować swój numer. diff --git a/libs/wire-subsystems/templates/pl/user/sms/deletion.txt b/libs/wire-subsystems/templates/pl/user/sms/deletion.txt deleted file mode 100644 index 97abae34dde..00000000000 --- a/libs/wire-subsystems/templates/pl/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -Dotknij, aby usunąć swoje konto ${brand}. -${url} diff --git a/libs/wire-subsystems/templates/pl/user/sms/login.txt b/libs/wire-subsystems/templates/pl/user/sms/login.txt deleted file mode 100644 index f3b86d6a962..00000000000 --- a/libs/wire-subsystems/templates/pl/user/sms/login.txt +++ /dev/null @@ -1,3 +0,0 @@ -Twój kod logowania ${brand} to ${code}. - -Otwórz ${url} aby się zalogować. diff --git a/libs/wire-subsystems/templates/pl/user/sms/password-reset.txt b/libs/wire-subsystems/templates/pl/user/sms/password-reset.txt deleted file mode 100644 index 046e6e86c5c..00000000000 --- a/libs/wire-subsystems/templates/pl/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -Twój kod odzyskiwania ${brand} to ${code}. - -Użyj tego kodu, aby ukończyć resetowanie hasła. diff --git a/libs/wire-subsystems/templates/pt-BR/user/call/activation.txt b/libs/wire-subsystems/templates/pt-BR/user/call/activation.txt deleted file mode 100644 index cb2c9e8fd11..00000000000 --- a/libs/wire-subsystems/templates/pt-BR/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -O seu código Wire é ${code} Mais uma vez, o seu código é: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/pt-BR/user/call/login.txt b/libs/wire-subsystems/templates/pt-BR/user/call/login.txt deleted file mode 100644 index f195a6dee90..00000000000 --- a/libs/wire-subsystems/templates/pt-BR/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -Olá, seu código de login do Wire é: ${code} Mais uma vez, o seu código é: ${code} diff --git a/libs/wire-subsystems/templates/pt-BR/user/sms/activation.txt b/libs/wire-subsystems/templates/pt-BR/user/sms/activation.txt deleted file mode 100644 index 4ca44857e08..00000000000 --- a/libs/wire-subsystems/templates/pt-BR/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -Seu código do Wire é ${code}. - -Abra ${url} para verificar o seu número ou manualmente insira o código acima no Wire. diff --git a/libs/wire-subsystems/templates/pt-BR/user/sms/deletion.txt b/libs/wire-subsystems/templates/pt-BR/user/sms/deletion.txt deleted file mode 100644 index 2d8932d3dc5..00000000000 --- a/libs/wire-subsystems/templates/pt-BR/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -Toque para apagar a sua conta no Wire. -${url} diff --git a/libs/wire-subsystems/templates/pt-BR/user/sms/login.txt b/libs/wire-subsystems/templates/pt-BR/user/sms/login.txt deleted file mode 100644 index d6a6f1aeb7b..00000000000 --- a/libs/wire-subsystems/templates/pt-BR/user/sms/login.txt +++ /dev/null @@ -1,3 +0,0 @@ -Seu código de login do Wire é ${code}. - -Abra ${url} para entrar, ou insira esse código no aplicativo do Wire: ${code}. diff --git a/libs/wire-subsystems/templates/pt-BR/user/sms/password-reset.txt b/libs/wire-subsystems/templates/pt-BR/user/sms/password-reset.txt deleted file mode 100644 index 62aaa793092..00000000000 --- a/libs/wire-subsystems/templates/pt-BR/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -Seu código de recuperação do Wire é ${code}. - -Abra o Wire e use esse código para concluir a redefinição de senha. \ No newline at end of file diff --git a/libs/wire-subsystems/templates/pt/user/call/activation.txt b/libs/wire-subsystems/templates/pt/user/call/activation.txt deleted file mode 100644 index 9198dbdff87..00000000000 --- a/libs/wire-subsystems/templates/pt/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -Olá, seu código de verificação do Wire é: ${code}. Novamente, seu código é: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/pt/user/call/login.txt b/libs/wire-subsystems/templates/pt/user/call/login.txt deleted file mode 100644 index 7da656975eb..00000000000 --- a/libs/wire-subsystems/templates/pt/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -Olá, seu código de login do Wire é: ${code}. Novamente, seu código é: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/pt/user/sms/activation.txt b/libs/wire-subsystems/templates/pt/user/sms/activation.txt deleted file mode 100644 index 520eb63c92d..00000000000 --- a/libs/wire-subsystems/templates/pt/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -Seu código ${brand} é ${code}. - -Acesse ${url} para verificar seu número. diff --git a/libs/wire-subsystems/templates/pt/user/sms/deletion.txt b/libs/wire-subsystems/templates/pt/user/sms/deletion.txt deleted file mode 100644 index 7faf69e6639..00000000000 --- a/libs/wire-subsystems/templates/pt/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -Toque para excluir sua conta no ${brand}. -${url} diff --git a/libs/wire-subsystems/templates/pt/user/sms/login.txt b/libs/wire-subsystems/templates/pt/user/sms/login.txt deleted file mode 100644 index ef5e8fd5d16..00000000000 --- a/libs/wire-subsystems/templates/pt/user/sms/login.txt +++ /dev/null @@ -1,3 +0,0 @@ -Seu código de login ${brand} é ${code}. - -Acesse ${url} para entrar. diff --git a/libs/wire-subsystems/templates/pt/user/sms/password-reset.txt b/libs/wire-subsystems/templates/pt/user/sms/password-reset.txt deleted file mode 100644 index 3667edd333c..00000000000 --- a/libs/wire-subsystems/templates/pt/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -Seu código de recuperação ${brand} é ${code}. - -Use este código para concluir a redefinição de senha. diff --git a/libs/wire-subsystems/templates/ru/user/call/activation.txt b/libs/wire-subsystems/templates/ru/user/call/activation.txt deleted file mode 100644 index abecab36f3f..00000000000 --- a/libs/wire-subsystems/templates/ru/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -Здравствуйте, ваш код для подтверждения Wire: ${code}. Еще разок, ваш код подтверждения: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/ru/user/call/login.txt b/libs/wire-subsystems/templates/ru/user/call/login.txt deleted file mode 100644 index fb8b3ac2fff..00000000000 --- a/libs/wire-subsystems/templates/ru/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -Здравствуйте, ваш код для входа в Wire: ${code}. Еще раз, ваш код подтверждения: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/ru/user/sms/activation.txt b/libs/wire-subsystems/templates/ru/user/sms/activation.txt deleted file mode 100644 index 414a58f3381..00000000000 --- a/libs/wire-subsystems/templates/ru/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -Ваш код ${brand}: ${code}. - -Откройте ${url}, чтобы подтвердить ваш номер. diff --git a/libs/wire-subsystems/templates/ru/user/sms/deletion.txt b/libs/wire-subsystems/templates/ru/user/sms/deletion.txt deleted file mode 100644 index 194f5ceb1fc..00000000000 --- a/libs/wire-subsystems/templates/ru/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -Нажмите для удаления вашего аккаунта ${brand}. -${url} diff --git a/libs/wire-subsystems/templates/ru/user/sms/login.txt b/libs/wire-subsystems/templates/ru/user/sms/login.txt deleted file mode 100644 index 5cf0687df4d..00000000000 --- a/libs/wire-subsystems/templates/ru/user/sms/login.txt +++ /dev/null @@ -1,3 +0,0 @@ -Ваш код входа ${brand}: ${code}. - -Откройте ${url}, чтобы войти. diff --git a/libs/wire-subsystems/templates/ru/user/sms/password-reset.txt b/libs/wire-subsystems/templates/ru/user/sms/password-reset.txt deleted file mode 100644 index e19f76b4f92..00000000000 --- a/libs/wire-subsystems/templates/ru/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -Ваш код восстановления ${brand}: ${code}. - -Используйте этот код, чтобы завершить сброс пароля. diff --git a/libs/wire-subsystems/templates/si/user/call/activation.txt b/libs/wire-subsystems/templates/si/user/call/activation.txt deleted file mode 100644 index c7754ab63c1..00000000000 --- a/libs/wire-subsystems/templates/si/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -ආයුබෝවන්, ඔබගේ වයර් සත්‍යාපන කේතය: ${code}. නැවත වරක්, ඔබගේ කේතය: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/si/user/call/login.txt b/libs/wire-subsystems/templates/si/user/call/login.txt deleted file mode 100644 index ccb91205ee0..00000000000 --- a/libs/wire-subsystems/templates/si/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -ආයුබෝවන්, ඔබගේ වයර් කේතය: ${code}. නැවත වරක්, ඔබගේ කේතය: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/si/user/sms/activation.txt b/libs/wire-subsystems/templates/si/user/sms/activation.txt deleted file mode 100644 index e029a030748..00000000000 --- a/libs/wire-subsystems/templates/si/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -ඔබගේ ${brand} කේතය ${code} වේ. - -ඔබගේ අංකය සත්‍යාපනයට ${url} අරින්න. diff --git a/libs/wire-subsystems/templates/si/user/sms/deletion.txt b/libs/wire-subsystems/templates/si/user/sms/deletion.txt deleted file mode 100644 index 15b1622cad3..00000000000 --- a/libs/wire-subsystems/templates/si/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -${brand} ගිණුම මැකීමට තට්ටු කරන්න. -${url} diff --git a/libs/wire-subsystems/templates/si/user/sms/login.txt b/libs/wire-subsystems/templates/si/user/sms/login.txt deleted file mode 100644 index 5b0be13a59d..00000000000 --- a/libs/wire-subsystems/templates/si/user/sms/login.txt +++ /dev/null @@ -1,3 +0,0 @@ -ඔබගේ ${brand} කේතය ${code} වේ. - -පිවිසීමට ${url} අරින්න. diff --git a/libs/wire-subsystems/templates/si/user/sms/password-reset.txt b/libs/wire-subsystems/templates/si/user/sms/password-reset.txt deleted file mode 100644 index d39d0227116..00000000000 --- a/libs/wire-subsystems/templates/si/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -ඔබගේ ${brand} ප්‍රතිසාධන කේතය ${code} වේ. - -මුරපදය යළි සැකසීම සඳහා මෙම කේතය භාවිතා කරන්න. diff --git a/libs/wire-subsystems/templates/sv-SE/user/call/activation.txt b/libs/wire-subsystems/templates/sv-SE/user/call/activation.txt deleted file mode 100644 index c30dc2c5f35..00000000000 --- a/libs/wire-subsystems/templates/sv-SE/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -Hej, din verifieringskod för Wire är: ${code} En gång till, din kod är: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/sv-SE/user/call/login.txt b/libs/wire-subsystems/templates/sv-SE/user/call/login.txt deleted file mode 100644 index ae1683918b8..00000000000 --- a/libs/wire-subsystems/templates/sv-SE/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -Hej, din inloggningskod för Wire är: ${code} En gång till, koden är: ${code} diff --git a/libs/wire-subsystems/templates/sv-SE/user/sms/activation.txt b/libs/wire-subsystems/templates/sv-SE/user/sms/activation.txt deleted file mode 100644 index f69ec87f5ce..00000000000 --- a/libs/wire-subsystems/templates/sv-SE/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -Din kod för Wire är ${code}. - -Öppna ${url} för att verifiera ditt nummer eller skriv in koden manuellt i Wire. diff --git a/libs/wire-subsystems/templates/sv-SE/user/sms/deletion.txt b/libs/wire-subsystems/templates/sv-SE/user/sms/deletion.txt deleted file mode 100644 index 3579926fd6e..00000000000 --- a/libs/wire-subsystems/templates/sv-SE/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -Tryck för att radera ditt Wire konto. -${url} diff --git a/libs/wire-subsystems/templates/sv-SE/user/sms/login.txt b/libs/wire-subsystems/templates/sv-SE/user/sms/login.txt deleted file mode 100644 index b9625b62156..00000000000 --- a/libs/wire-subsystems/templates/sv-SE/user/sms/login.txt +++ /dev/null @@ -1,3 +0,0 @@ -Din inloggningskod till Wire är ${code}. - -Gå in på ${url} för att logga in, eller skriv in denna kod i Wire appen: ${code}. diff --git a/libs/wire-subsystems/templates/sv-SE/user/sms/password-reset.txt b/libs/wire-subsystems/templates/sv-SE/user/sms/password-reset.txt deleted file mode 100644 index 2bace001278..00000000000 --- a/libs/wire-subsystems/templates/sv-SE/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -Din återställningkod för Wire är ${code}. - -Öppna Wire och använd denna kod för att slutföra din lösenords återställning. \ No newline at end of file diff --git a/libs/wire-subsystems/templates/tr/user/call/activation.txt b/libs/wire-subsystems/templates/tr/user/call/activation.txt deleted file mode 100644 index d1208907366..00000000000 --- a/libs/wire-subsystems/templates/tr/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -Merhaba, Wire doğrulama kodunuz: ${code}. Bir kez daha, kodunuz: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/tr/user/call/login.txt b/libs/wire-subsystems/templates/tr/user/call/login.txt deleted file mode 100644 index 0a7091f6d20..00000000000 --- a/libs/wire-subsystems/templates/tr/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -Merhaba, Wire giriş kodunuz: ${code}. Birkez daha, kodunuz şudur: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/tr/user/sms/activation.txt b/libs/wire-subsystems/templates/tr/user/sms/activation.txt deleted file mode 100644 index 0f297cd946d..00000000000 --- a/libs/wire-subsystems/templates/tr/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -${brand} kodunuz ${code}. - -Numaranızı doğrulamak için: ${url}. diff --git a/libs/wire-subsystems/templates/tr/user/sms/deletion.txt b/libs/wire-subsystems/templates/tr/user/sms/deletion.txt deleted file mode 100644 index 41a4be3755a..00000000000 --- a/libs/wire-subsystems/templates/tr/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -${brand} hesabınızı silmek için tıklayın. -${url} diff --git a/libs/wire-subsystems/templates/tr/user/sms/login.txt b/libs/wire-subsystems/templates/tr/user/sms/login.txt deleted file mode 100644 index 7cd50436ad3..00000000000 --- a/libs/wire-subsystems/templates/tr/user/sms/login.txt +++ /dev/null @@ -1,3 +0,0 @@ -${brand}} giriş kodunuz ${code}. - -Giriş yapmak için: ${url}. diff --git a/libs/wire-subsystems/templates/tr/user/sms/password-reset.txt b/libs/wire-subsystems/templates/tr/user/sms/password-reset.txt deleted file mode 100644 index 2b4f0933ef2..00000000000 --- a/libs/wire-subsystems/templates/tr/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -${brand} kurtarma kodunuz ${code}. - -Şifre sıfırlama işlemini tamamlamak için bu kodu kullanın. diff --git a/libs/wire-subsystems/templates/uk/user/call/activation.txt b/libs/wire-subsystems/templates/uk/user/call/activation.txt deleted file mode 100644 index ba6af2fca76..00000000000 --- a/libs/wire-subsystems/templates/uk/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -Привіт, ваш код підтвердження Wire ${code}. Ще раз, ваш код підтвердження: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/uk/user/call/login.txt b/libs/wire-subsystems/templates/uk/user/call/login.txt deleted file mode 100644 index 6225ce7e680..00000000000 --- a/libs/wire-subsystems/templates/uk/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -Привіт, ваш код для входу в Wire ${code}. Ще раз, ваш код для входу: ${code} diff --git a/libs/wire-subsystems/templates/uk/user/sms/activation.txt b/libs/wire-subsystems/templates/uk/user/sms/activation.txt deleted file mode 100644 index 06aee57582b..00000000000 --- a/libs/wire-subsystems/templates/uk/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -Ваш код Wire: ${code}. - -Використовуйте його, щоб завершити реєстрацію. diff --git a/libs/wire-subsystems/templates/uk/user/sms/deletion.txt b/libs/wire-subsystems/templates/uk/user/sms/deletion.txt deleted file mode 100644 index 3950a2bd4e6..00000000000 --- a/libs/wire-subsystems/templates/uk/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -Торкніться, щоб видалити ваш Wire-акаунт. -${url} diff --git a/libs/wire-subsystems/templates/uk/user/sms/login.txt b/libs/wire-subsystems/templates/uk/user/sms/login.txt deleted file mode 100644 index 1bd6bcb75a1..00000000000 --- a/libs/wire-subsystems/templates/uk/user/sms/login.txt +++ /dev/null @@ -1,3 +0,0 @@ -Ваш код Wire: ${code}. - -Використовуйте його, щоб увійти в Wire. diff --git a/libs/wire-subsystems/templates/uk/user/sms/password-reset.txt b/libs/wire-subsystems/templates/uk/user/sms/password-reset.txt deleted file mode 100644 index c40a0ecfed6..00000000000 --- a/libs/wire-subsystems/templates/uk/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -Ваш код Wire: ${code}. - -Використовуйте його, щоб завершити скидання паролю. \ No newline at end of file diff --git a/libs/wire-subsystems/templates/vi/user/call/activation.txt b/libs/wire-subsystems/templates/vi/user/call/activation.txt deleted file mode 100644 index bc29d9b108e..00000000000 --- a/libs/wire-subsystems/templates/vi/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -Xin chào, mã xác thực Wire của bạn là: ${code}. Một lần nữa, mã của bạn là: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/vi/user/call/login.txt b/libs/wire-subsystems/templates/vi/user/call/login.txt deleted file mode 100644 index d1e101d5e58..00000000000 --- a/libs/wire-subsystems/templates/vi/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -Xin chào, mã đăng nhập Wire của bạn là: ${code}. Một lần nữa, mã của bạn là: ${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/vi/user/sms/activation.txt b/libs/wire-subsystems/templates/vi/user/sms/activation.txt deleted file mode 100644 index e9987182a50..00000000000 --- a/libs/wire-subsystems/templates/vi/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -Mã ${brand} của bạn là ${code}. - -Mở ${url} để xác minh số điện thoại của bạn. diff --git a/libs/wire-subsystems/templates/vi/user/sms/deletion.txt b/libs/wire-subsystems/templates/vi/user/sms/deletion.txt deleted file mode 100644 index 63b7431b400..00000000000 --- a/libs/wire-subsystems/templates/vi/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -Chạm để xoá tài khoản ${brand} của bạn. -${url} diff --git a/libs/wire-subsystems/templates/vi/user/sms/login.txt b/libs/wire-subsystems/templates/vi/user/sms/login.txt deleted file mode 100644 index e12fa3949bd..00000000000 --- a/libs/wire-subsystems/templates/vi/user/sms/login.txt +++ /dev/null @@ -1,3 +0,0 @@ -Mã đăng nhập ${brand} của bạn là ${code}. - -Mở ${url} để đăng nhập. diff --git a/libs/wire-subsystems/templates/vi/user/sms/password-reset.txt b/libs/wire-subsystems/templates/vi/user/sms/password-reset.txt deleted file mode 100644 index de5c4600cd4..00000000000 --- a/libs/wire-subsystems/templates/vi/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -Mã khôi phục ${brand} của bạn là ${code}. - -Sử dụng mã này để hoàn tất việc đặt lại mật khẩu. diff --git a/libs/wire-subsystems/templates/zh-TW/user/call/activation.txt b/libs/wire-subsystems/templates/zh-TW/user/call/activation.txt deleted file mode 100644 index 614602910a0..00000000000 --- a/libs/wire-subsystems/templates/zh-TW/user/call/activation.txt +++ /dev/null @@ -1 +0,0 @@ -您好，您的Wire驗證碼是：${code} 再重複一次，您的驗證碼是：${code} \ No newline at end of file diff --git a/libs/wire-subsystems/templates/zh-TW/user/call/login.txt b/libs/wire-subsystems/templates/zh-TW/user/call/login.txt deleted file mode 100644 index c9454cab367..00000000000 --- a/libs/wire-subsystems/templates/zh-TW/user/call/login.txt +++ /dev/null @@ -1 +0,0 @@ -您好，您的Wire驗證碼是：${code} 再重複一次，您的驗證碼是：${code} diff --git a/libs/wire-subsystems/templates/zh-TW/user/sms/activation.txt b/libs/wire-subsystems/templates/zh-TW/user/sms/activation.txt deleted file mode 100644 index 8a05f205758..00000000000 --- a/libs/wire-subsystems/templates/zh-TW/user/sms/activation.txt +++ /dev/null @@ -1,3 +0,0 @@ -您的Wire驗證碼是${code}。 - -請開啟${url} 或手動輸入以上的驗證碼來完成驗證程序。 diff --git a/libs/wire-subsystems/templates/zh-TW/user/sms/deletion.txt b/libs/wire-subsystems/templates/zh-TW/user/sms/deletion.txt deleted file mode 100644 index dadb28e6f9c..00000000000 --- a/libs/wire-subsystems/templates/zh-TW/user/sms/deletion.txt +++ /dev/null @@ -1,2 +0,0 @@ -點一下來刪除您的Wire帳號 -${url} diff --git a/libs/wire-subsystems/templates/zh-TW/user/sms/login.txt b/libs/wire-subsystems/templates/zh-TW/user/sms/login.txt deleted file mode 100644 index 4f7f65b11a8..00000000000 --- a/libs/wire-subsystems/templates/zh-TW/user/sms/login.txt +++ /dev/null @@ -1,3 +0,0 @@ -您的Wire驗證碼是${code}。 - -開啟${url} 來登入，或手動輸入此代碼來完成程序。 diff --git a/libs/wire-subsystems/templates/zh-TW/user/sms/password-reset.txt b/libs/wire-subsystems/templates/zh-TW/user/sms/password-reset.txt deleted file mode 100644 index 75973fa7372..00000000000 --- a/libs/wire-subsystems/templates/zh-TW/user/sms/password-reset.txt +++ /dev/null @@ -1,3 +0,0 @@ -您的Wire恢復代碼是${code}。 - -請開啟Wire然後輸入此代碼來完成密碼重設程序。 \ No newline at end of file diff --git a/libs/wire-subsystems/test/resources/postgres-credentials.yaml b/libs/wire-subsystems/test/resources/postgres-credentials.yaml new file mode 100644 index 00000000000..dfcbb7e44a9 --- /dev/null +++ b/libs/wire-subsystems/test/resources/postgres-credentials.yaml @@ -0,0 +1 @@ +posty-the-gres diff --git a/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs index 1ff35582da0..dfb43290761 100644 --- a/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs @@ -42,6 +42,7 @@ import Wire.API.User import Wire.API.User qualified as User import Wire.API.User.Auth import Wire.API.User.Password +import Wire.AppStore import Wire.AuthenticationSubsystem import Wire.AuthenticationSubsystem.Config import Wire.AuthenticationSubsystem.Interpreter @@ -81,7 +82,8 @@ type AllEffects = EmailSubsystem, UserStore, State [StoredUser], - State (Map EmailAddress [SentMail]) + State (Map EmailAddress [SentMail]), + State [StoredApp] ] runAllEffects :: Domain -> [User] -> Maybe [Text] -> Sem AllEffects a -> Either AuthenticationSubsystemError a @@ -92,6 +94,7 @@ runAllEffects localDomain preexistingUsers mAllowedEmailDomains = local = toLocalUnsafe localDomain () } in run + . evalState mempty . evalState mempty . evalState mempty . inMemoryUserStoreInterpreter diff --git a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs index 204fc5ed737..fbd01bdd5b6 100644 --- a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs +++ b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs @@ -522,10 +522,17 @@ miniGetAllProfiles :: Sem r [UserProfile] miniGetAllProfiles = do users <- gets (.users) + apps <- gets (.apps) dom <- input pure $ map - (\u -> mkUserProfileWithEmail Nothing (mkUserFromStored dom miniLocale u) defUserLegalHoldStatus) + ( \u -> + let userType + | any ((== u.id) . (.id)) apps = UserTypeApp + | isJust u.serviceId = UserTypeBot + | otherwise = UserTypeRegular + in mkUserProfileWithEmail Nothing userType (mkUserFromStored dom miniLocale u) defUserLegalHoldStatus + ) users miniGetUsersByIds :: [UserId] -> MiniFederationMonad 'Brig [UserProfile] diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/AppStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/AppStore.hs index 4eec779120b..b62e7acd60c 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/AppStore.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/AppStore.hs @@ -31,3 +31,4 @@ inMemoryAppStoreInterpreter :: inMemoryAppStoreInterpreter = interpret $ \case CreateApp app -> modify (app :) GetApp uid tid -> gets $ find $ \app -> app.id == uid && app.teamId == tid + GetApps tid -> gets $ filter $ \app -> app.teamId == tid diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs index 558c9742df2..fcb8cb27168 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/EmailSubsystem.hs @@ -55,3 +55,5 @@ noopEmailSubsystemInterpreter = interpret \case SendTeamDeletionVerificationMail {} -> pure () SendTeamInvitationMail {} -> pure "" SendTeamInvitationMailPersonalUser {} -> pure "" + SendMemberWelcomeEmail {} -> pure () + SendNewTeamOwnerWelcomeEmail {} -> pure () diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/IndexedUserStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/IndexedUserStore.hs index 85b27a86b3a..f481ed73674 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/IndexedUserStore.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/IndexedUserStore.hs @@ -30,10 +30,7 @@ import Polysemy.State import Wire.API.Team.Size import Wire.API.User.Search import Wire.IndexedUserStore -import Wire.MockInterpreters.UserStore (storedUserToIndexUser) -import Wire.StoredUser import Wire.UserSearch.Types -import Wire.UserStore.IndexUser newtype OrdDocId = OrdDocId Text deriving (Show, Eq, Ord) @@ -54,17 +51,6 @@ emptyIndex = docs = mempty } -storedUserToDoc :: StoredUser -> UserDoc -storedUserToDoc user = - let indexUser = storedUserToIndexUser user - in indexUserToDoc defaultSearchVisibilityInbound Nothing indexUser - -indexFromStoredUsers :: [StoredUser] -> UserIndex -indexFromStoredUsers storedUsers = do - run . execState emptyIndex . inMemoryIndexedUserStoreInterpreter $ do - for_ storedUsers $ \storedUser -> - upsert (userIdToDocId storedUser.id) (storedUserToDoc storedUser) ES.NoVersionControl - runInMemoryIndexedUserStoreIntepreter :: InterpreterFor IndexedUserStore r runInMemoryIndexedUserStoreIntepreter = evalState emptyIndex diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs index 391e8305d1e..6e2086242c4 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs @@ -63,8 +63,9 @@ inMemoryUserStoreInterpreter = interpret $ \case if u.id == uid then u {emailUnvalidated = Just email} :: StoredUser else u - GetIndexUser uid -> - gets $ fmap storedUserToIndexUser . find (\user -> user.id == uid) + GetIndexUser uid -> do + mUser <- gets @[StoredUser] $ find (\user -> user.id == uid) + pure $ storedUserToIndexUser <$> mUser GetIndexUsersPaginated _pageSize _pagingState -> error "GetIndexUsersPaginated not implemented in inMemoryUserStoreInterpreter" UpdateUserHandleEither uid hUpdate -> runError $ modifyLocalUsers (traverse doUpdate) @@ -72,7 +73,7 @@ inMemoryUserStoreInterpreter = interpret $ \case doUpdate :: StoredUser -> Sem (Error StoredUserUpdateError : r) StoredUser doUpdate u | u.id == uid = do - handles <- gets $ mapMaybe (.handle) + handles <- gets @[StoredUser] $ mapMaybe (.handle) when ( hUpdate.old /= Just hUpdate.new @@ -87,7 +88,7 @@ inMemoryUserStoreInterpreter = interpret $ \case us <- get us' <- f us put us' - DeleteUser user -> modify $ filter (\u -> u.id /= User.userId user) + DeleteUser user -> modify @[StoredUser] $ filter (\u -> u.id /= User.userId user) LookupHandle h -> lookupHandleImpl h GlimpseHandle h -> lookupHandleImpl h LookupStatus uid -> lookupStatusImpl uid @@ -105,7 +106,7 @@ inMemoryUserStoreInterpreter = interpret $ \case doUpdate :: StoredUser -> StoredUser doUpdate u = if u.id == uid then u {email = Nothing} else u GetUserTeam uid -> do - gets $ \users -> do + gets @[StoredUser] $ \users -> do user <- find (\user -> user.id == uid) users user.teamId SetUserSearchable uid (SetSearchable searchable) -> modify $ map f diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs index 71dc9644408..fe979c1cf16 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs @@ -69,4 +69,4 @@ userSubsystemTestInterpreter initialUsers = SetUserSearchable {} -> error "SetUserSearchable: implement on demand (userSubsystemInterpreter)" toProfile :: User -> UserProfile -toProfile u = mkUserProfileWithEmail (userEmail u) u UserLegalHoldDisabled +toProfile u = mkUserProfileWithEmail (userEmail u) UserTypeRegular u UserLegalHoldDisabled diff --git a/libs/wire-subsystems/test/unit/Wire/UserSearch/TypesSpec.hs b/libs/wire-subsystems/test/unit/Wire/UserSearch/TypesSpec.hs index 4fae73f196a..a09d56bd8ff 100644 --- a/libs/wire-subsystems/test/unit/Wire/UserSearch/TypesSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/UserSearch/TypesSpec.hs @@ -64,7 +64,8 @@ userDoc1 = udScimExternalId = Nothing, udSso = Nothing, udEmailUnvalidated = Nothing, - udSearchable = Nothing + udSearchable = Nothing, + udType = Nothing } -- Dont touch this. This represents serialized legacy data. diff --git a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs index edfb8af1f83..3c93c88d4d9 100644 --- a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs @@ -38,6 +38,7 @@ import Data.Set (insert, member, notMember) import Data.Set qualified as S import Data.String.Conversions (cs) import Data.Text.Encoding (encodeUtf8) +import Database.Bloodhound.Internal.Client qualified as ES import Imports import Polysemy import Polysemy.Error @@ -60,6 +61,7 @@ import Wire.API.User.Search import Wire.API.UserEvent import Wire.AuthenticationSubsystem.Error import Wire.DomainRegistrationStore qualified as DRS +import Wire.IndexedUserStore qualified as IU import Wire.InvitationStore (InsertInvitation, StoredInvitation) import Wire.InvitationStore qualified as InvitationStore import Wire.MiniBackend @@ -67,6 +69,8 @@ import Wire.MockInterpreters import Wire.RateLimit import Wire.StoredUser import Wire.UserKeyStore +import Wire.UserSearch.Types +import Wire.UserStore.IndexUser import Wire.UserSubsystem import Wire.UserSubsystem.Error import Wire.UserSubsystem.HandleBlacklist @@ -100,6 +104,7 @@ spec = describe "UserSubsystem.Interpreter" do mkExpectedProfiles domain users = [ mkUserProfileWithEmail Nothing + (if isJust targetUser.serviceId then UserTypeBot else UserTypeRegular) (mkUserFromStored domain miniLocale targetUser) defUserLegalHoldStatus | targetUser <- users @@ -159,6 +164,7 @@ spec = describe "UserSubsystem.Interpreter" do in retrievedProfiles === [ mkUserProfile (fmap (const $ (,) <$> viewer.teamId <*> Just teamMember) config.emailVisibilityConfig) + (if isJust targetUser.serviceId then UserTypeBot else UserTypeRegular) (mkUserFromStored domain config.defaultLocale targetUser) defUserLegalHoldStatus ] @@ -175,6 +181,7 @@ spec = describe "UserSubsystem.Interpreter" do in retrievedProfile === [ mkUserProfile (fmap (const Nothing) config.emailVisibilityConfig) + (if isJust targetUser.serviceId then UserTypeBot else UserTypeRegular) (mkUserFromStored domain config.defaultLocale targetUser) defUserLegalHoldStatus ] @@ -1091,6 +1098,19 @@ spec = describe "UserSubsystem.Interpreter" do \(ActiveStoredUser searcheeNoHandle) (searcheeHandle :: Handle) (ActiveStoredUser searcher) localDomain configBase -> let teamMember = mkTeamMember searcher.id fullPermissions Nothing defUserLegalHoldStatus searchee = searcheeNoHandle {handle = Just searcheeHandle} :: StoredUser + + storedUserToDoc :: StoredUser -> UserDoc + storedUserToDoc user = + let indexUser = storedUserToIndexUser user + userType = if isJust user.serviceId then UserTypeBot else UserTypeRegular + in indexUserToDoc defaultSearchVisibilityInbound (Just userType) Nothing indexUser + + indexFromStoredUsers :: [StoredUser] -> UserIndex + indexFromStoredUsers storedUsers = do + run . execState emptyIndex . inMemoryIndexedUserStoreInterpreter $ do + for_ storedUsers $ \storedUser -> + IU.upsert (userIdToDocId storedUser.id) (storedUserToDoc storedUser) ES.NoVersionControl + localBackend = def { users = [searchee, searcher], @@ -1111,6 +1131,7 @@ spec = describe "UserSubsystem.Interpreter" do contactQualifiedId = Qualified searchee.id localDomain, contactName = fromName searchee.name, contactHandle = fromHandle <$> searchee.handle, - contactColorId = Just . fromIntegral $ searchee.accentId.fromColourId + contactColorId = Just . fromIntegral $ searchee.accentId.fromColourId, + contactType = UserTypeRegular } pure $ result.searchResults === [expectedContact | fromMaybe True searchee.searchable] diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index ff58ed19431..5dc5e19c770 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -102,6 +102,7 @@ common common-all , case-insensitive , cassandra-util , conduit + , constraints , containers , contravariant , cql @@ -116,6 +117,7 @@ common common-all , extra , file-embed , galley-types + , generics-sop , hashable , HaskellNet , HaskellNet-SSL @@ -164,6 +166,7 @@ common common-all , servant-server , singletons , sodium-crypto-sign + , sop-core , ssl-util , statistics , stomp-queue @@ -222,6 +225,13 @@ library Wire.BlockListStore.Cassandra Wire.BrigAPIAccess Wire.BrigAPIAccess.Rpc + Wire.CodeStore + Wire.CodeStore.Cassandra + Wire.CodeStore.Cassandra.Queries + Wire.CodeStore.Code + Wire.CodeStore.DualWrite + Wire.CodeStore.Migration + Wire.CodeStore.Postgres Wire.ConversationStore Wire.ConversationStore.Cassandra Wire.ConversationStore.Cassandra.Instances @@ -246,6 +256,8 @@ library Wire.EmailSubsystem Wire.EmailSubsystem.Interpreter Wire.EmailSubsystem.Template + Wire.EmailSubsystem.Templates.Team + Wire.EmailSubsystem.Templates.User Wire.EnterpriseLoginSubsystem Wire.EnterpriseLoginSubsystem.Error Wire.EnterpriseLoginSubsystem.Interpreter @@ -254,6 +266,10 @@ library Wire.Events Wire.ExternalAccess Wire.ExternalAccess.External + Wire.FeaturesConfigSubsystem + Wire.FeaturesConfigSubsystem.Interpreter + Wire.FeaturesConfigSubsystem.Types + Wire.FeaturesConfigSubsystem.Utils Wire.FederationAPIAccess Wire.FederationAPIAccess.Interpreter Wire.FederationConfigStore @@ -275,11 +291,13 @@ library Wire.InternalEvent Wire.InvitationStore Wire.InvitationStore.Cassandra + Wire.LegalHold Wire.LegalHoldStore Wire.LegalHoldStore.Cassandra Wire.LegalHoldStore.Cassandra.Queries Wire.LegalHoldStore.Env Wire.ListItems + Wire.Migration Wire.NotificationSubsystem Wire.NotificationSubsystem.Interpreter Wire.PaginationState @@ -314,6 +332,8 @@ library Wire.TeamCollaboratorsStore.Postgres Wire.TeamCollaboratorsSubsystem Wire.TeamCollaboratorsSubsystem.Interpreter + Wire.TeamFeatureStore + Wire.TeamFeatureStore.Cassandra Wire.TeamInvitationSubsystem Wire.TeamInvitationSubsystem.Error Wire.TeamInvitationSubsystem.Interpreter diff --git a/nix/default.nix b/nix/default.nix index 71f9845b8d9..a1cc06954f1 100644 --- a/nix/default.nix +++ b/nix/default.nix @@ -65,6 +65,7 @@ let pkgs.niv pkgs.zip pkgs.entr + pkgs.postgresql ] ++ docsPkgs; }; inherit (pkgs) mls-test-cli; diff --git a/nix/haskell-pins.nix b/nix/haskell-pins.nix index 5481009262b..c723af12bc1 100644 --- a/nix/haskell-pins.nix +++ b/nix/haskell-pins.nix @@ -52,9 +52,7 @@ let # maintained by us # ---------------- - cryptobox-haskell = { - src = inputs.cryptobox-haskell; - }; + # None # -------------------- # END maintained by us diff --git a/nix/manual-overrides.nix b/nix/manual-overrides.nix index ea0449d5306..1deaa71cb09 100644 --- a/nix/manual-overrides.nix +++ b/nix/manual-overrides.nix @@ -1,4 +1,4 @@ -{ libsodium, protobuf, hlib, mls-test-cli, fetchurl, curl, pkg-config, postgresql, openssl, ... }: +{ libsodium, protobuf, hlib, mls-test-cli, fetchurl, curl, pkg-config, postgresql, openssl, icu, cryptobox, stdenv, ... }: # FUTUREWORK: Figure out a way to detect if some of these packages are not # actually marked broken, so we can cleanup this file on every nixpkgs bump. hself: hsuper: { @@ -72,6 +72,12 @@ hself: hsuper: { # ------------------------------------ template = hlib.markUnbroken hsuper.template; system-linux-proc = hlib.markUnbroken hsuper.system-linux-proc; + # FSEvents doesn't work in nix sandbox on macOS; on Linux inotify works fine + fsnotify = (if stdenv.isDarwin then hlib.dontCheck else (x: x)) + (hlib.markUnbroken hsuper.fsnotify); + + # Federator monitor tests use fsnotify which doesn't work in nix sandbox on macOS + federator = (if stdenv.isDarwin then hlib.dontCheck else (x: x)) hsuper.federator; # ----------------- # version overrides @@ -90,8 +96,10 @@ hself: hsuper: { hoogle = hlib.justStaticExecutables (hlib.dontCheck (hsuper.hoogle)); # Extra dependencies/flags for local packages - http2-manager = hlib.enableCabalFlag hsuper.http2-manager "-f-test-trailing-dot"; + cryptobox-haskell = hlib.addBuildDepends hsuper.cryptobox-haskell [ cryptobox ]; + http2-manager = hlib.disableCabalFlag hsuper.http2-manager "test-trailing-dot"; sodium-crypto-sign = hlib.addPkgconfigDepend hsuper.sodium-crypto-sign libsodium.dev; + text-icu-translit = hlib.addPkgconfigDepend hsuper.text-icu-translit icu; types-common-journal = hlib.addBuildTool hsuper.types-common-journal protobuf; wire-api = hlib.addBuildTool hsuper.wire-api mls-test-cli; wire-message-proto-lens = hlib.addBuildTool hsuper.wire-message-proto-lens protobuf; diff --git a/nix/overlay.nix b/nix/overlay.nix index 2ccc18888e2..d418911d2c9 100644 --- a/nix/overlay.nix +++ b/nix/overlay.nix @@ -1,6 +1,5 @@ self: super: { - cryptobox = self.callPackage ./pkgs/cryptobox { }; zauth = self.callPackage ./pkgs/zauth { }; mls-test-cli = self.callPackage ./pkgs/mls-test-cli { }; diff --git a/nix/pkgs/cryptobox/.gitignore b/nix/pkgs/cryptobox/.gitignore deleted file mode 100644 index 3f66fdb7d63..00000000000 --- a/nix/pkgs/cryptobox/.gitignore +++ /dev/null @@ -1 +0,0 @@ -/crate2nix-sources diff --git a/nix/pkgs/cryptobox/Cargo.nix b/nix/pkgs/cryptobox/Cargo.nix deleted file mode 100644 index 0f803cf1b3d..00000000000 --- a/nix/pkgs/cryptobox/Cargo.nix +++ /dev/null @@ -1,958 +0,0 @@ -# This file was @generated by crate2nix 0.10.0 with the command: -# "generate" -# See https://github.com/kolloch/crate2nix for more info. - -{ nixpkgs ? -, pkgs ? import nixpkgs { config = { }; } -, lib ? pkgs.lib -, stdenv ? pkgs.stdenv -, buildRustCrateForPkgs ? if buildRustCrate != null - then lib.warn "crate2nix: Passing `buildRustCrate` as argument to Cargo.nix is deprecated. If you don't customize `buildRustCrate`, replace `callPackage ./Cargo.nix {}` by `import ./Cargo.nix { inherit pkgs; }`, and if you need to customize `buildRustCrate`, use `buildRustCrateForPkgs` instead." (_: buildRustCrate) - else pkgs: pkgs.buildRustCrate - # Deprecated -, buildRustCrate ? null - # This is used as the `crateOverrides` argument for `buildRustCrate`. -, defaultCrateOverrides ? pkgs.defaultCrateOverrides - # The features to enable for the root_crate or the workspace_members. -, rootFeatures ? [ "default" ] - # If true, throw errors instead of issueing deprecation warnings. -, strictDeprecation ? false - # Used for conditional compilation based on CPU feature detection. -, targetFeatures ? [ ] - # Whether to perform release builds: longer compile times, faster binaries. -, release ? true - # Additional crate2nix configuration if it exists. -, crateConfig ? if builtins.pathExists ./crate-config.nix - then pkgs.callPackage ./crate-config.nix { } - else { } -}: - -rec { - # - # "public" attributes that we attempt to keep stable with new versions of crate2nix. - # - - rootCrate = rec { - packageId = "cryptobox-c"; - - # Use this attribute to refer to the derivation building your root crate package. - # You can override the features with rootCrate.build.override { features = [ "default" "feature1" ... ]; }. - build = internal.buildRustCrateWithFeatures { - inherit packageId; - }; - - # Debug support which might change between releases. - # File a bug if you depend on any for non-debug work! - debug = internal.debugCrate { inherit packageId; }; - }; - # Refer your crate build derivation by name here. - # You can override the features with - # workspaceMembers."${crateName}".build.override { features = [ "default" "feature1" ... ]; }. - workspaceMembers = { - "cryptobox-c" = rec { - packageId = "cryptobox-c"; - build = internal.buildRustCrateWithFeatures { - packageId = "cryptobox-c"; - }; - - # Debug support which might change between releases. - # File a bug if you depend on any for non-debug work! - debug = internal.debugCrate { inherit packageId; }; - }; - }; - - # A derivation that joins the outputs of all workspace members together. - allWorkspaceMembers = pkgs.symlinkJoin { - name = "all-workspace-members"; - paths = - let members = builtins.attrValues workspaceMembers; - in builtins.map (m: m.build) members; - }; - - # - # "internal" ("private") attributes that may change in every new version of crate2nix. - # - - internal = rec { - # Build and dependency information for crates. - # Many of the fields are passed one-to-one to buildRustCrate. - # - # Noteworthy: - # * `dependencies`/`buildDependencies`: similar to the corresponding fields for buildRustCrate. - # but with additional information which is used during dependency/feature resolution. - # * `resolvedDependencies`: the selected default features reported by cargo - only included for debugging. - # * `devDependencies` as of now not used by `buildRustCrate` but used to - # inject test dependencies into the build - - crates = { - "byteorder" = rec { - crateName = "byteorder"; - version = "1.2.1"; - edition = "2015"; - sha256 = "08qdzm6y639swc9crvkav59cp46lmfj84rlsbvcakb9zwyvhaa35"; - authors = [ - "Andrew Gallant " - ]; - features = { - "default" = [ "std" ]; - }; - resolvedDefaultFeatures = [ "default" "std" ]; - }; - "cbor-codec" = rec { - crateName = "cbor-codec"; - version = "0.7.1"; - edition = "2015"; - sha256 = "0ihg2ixp71nkwcgg8jfip774q5dia4d16l786wlcadrbaqis10z0"; - libName = "cbor"; - authors = [ - "Toralf Wittner " - ]; - dependencies = [ - { - name = "byteorder"; - packageId = "byteorder"; - } - { - name = "libc"; - packageId = "libc"; - } - ]; - features = { - "quickcheck" = [ "dep:quickcheck" ]; - "random" = [ "quickcheck" ]; - }; - }; - "cryptobox" = rec { - crateName = "cryptobox"; - version = "1.0.0"; - edition = "2015"; - workspace_member = null; - src = pkgs.fetchgit { - url = "https://github.com/wireapp/cryptobox"; - rev = "ec45a50c3608d00744625125125932beac890965"; - sha256 = "0sada781pwczmxhlnw0qhkh54k22jdhymc5kaczrwk86s4b3w2hk"; - }; - authors = [ - "Wire Swiss GmbH " - ]; - dependencies = [ - { - name = "byteorder"; - packageId = "byteorder"; - } - { - name = "cbor-codec"; - packageId = "cbor-codec"; - } - { - name = "proteus"; - packageId = "proteus"; - } - ]; - - }; - "cryptobox-c" = rec { - crateName = "cryptobox-c"; - version = "1.0.0"; - edition = "2015"; - workspace_member = null; - src = pkgs.fetchgit { - url = "https://github.com/wireapp/cryptobox-c"; - rev = "4067ad96b125942545dbdec8c1a89f1e1b65d013"; - sha256 = "1i9dlhw0xk1viglyhail9fb36v1awrypps8jmhrkz8k1bhx98ci3"; - }; - type = [ "cdylib" ]; - authors = [ - "Wire Swiss GmbH " - ]; - dependencies = [ - { - name = "cryptobox"; - packageId = "cryptobox"; - } - { - name = "libc"; - packageId = "libc"; - } - { - name = "proteus"; - packageId = "proteus"; - } - ]; - - }; - "hkdf" = rec { - crateName = "hkdf"; - version = "0.2.0"; - edition = "2015"; - workspace_member = null; - src = pkgs.fetchgit { - url = "https://github.com/wireapp/hkdf"; - rev = "215025dc0efec119a7368447ed97bb908eddfb1c"; - sha256 = "1s0q2xq489r4zmbhd501mm9qpwaw9zv3bz0pii493l1qhzvi3n3i"; - }; - authors = [ - "Wire Swiss GmbH " - ]; - dependencies = [ - { - name = "sodiumoxide"; - packageId = "sodiumoxide"; - usesDefaultFeatures = false; - } - ]; - - }; - "libc" = rec { - crateName = "libc"; - version = "0.2.35"; - edition = "2015"; - sha256 = "1sr0la5n6bq1g1yqpfjffmdwiv8szn7siy5vzidx559y56dlw9ln"; - authors = [ - "The Rust Project Developers" - ]; - features = { - "default" = [ "use_std" ]; - }; - resolvedDefaultFeatures = [ "default" "use_std" ]; - }; - "libsodium-sys" = rec { - crateName = "libsodium-sys"; - version = "0.0.16"; - edition = "2015"; - sha256 = "0hjmdxjz32yq4gxwjg608bi7cf9igilsmsv9lslcli4dxpp1pggw"; - libName = "libsodium_sys"; - libPath = "lib.rs"; - authors = [ - "dnaq" - ]; - dependencies = [ - { - name = "libc"; - packageId = "libc"; - } - ]; - buildDependencies = [ - { - name = "pkg-config"; - packageId = "pkg-config"; - } - ]; - - }; - "pkg-config" = rec { - crateName = "pkg-config"; - version = "0.3.9"; - edition = "2015"; - sha256 = "00x9vc7667m4r8sn8idgpmj9yf1ih6bj1cdrshf1mkb5h5mlr2rs"; - authors = [ - "Alex Crichton " - ]; - - }; - "proteus" = rec { - crateName = "proteus"; - version = "1.0.0"; - edition = "2015"; - workspace_member = null; - src = pkgs.fetchgit { - url = "https://github.com/wireapp/proteus"; - rev = "bbecc0c649d020bb208ad83d120c6971913e2eeb"; - sha256 = "0dp4fzd39kzr0z1rq78vmgvyvpg9b13k1fq37gmsvr2qlkkjv4x6"; - }; - authors = [ - "Wire Swiss GmbH " - ]; - dependencies = [ - { - name = "byteorder"; - packageId = "byteorder"; - } - { - name = "cbor-codec"; - packageId = "cbor-codec"; - } - { - name = "hkdf"; - packageId = "hkdf"; - } - { - name = "libc"; - packageId = "libc"; - } - { - name = "sodiumoxide"; - packageId = "sodiumoxide"; - usesDefaultFeatures = false; - features = [ "std" ]; - } - ]; - - }; - "sodiumoxide" = rec { - crateName = "sodiumoxide"; - version = "0.0.16"; - edition = "2015"; - sha256 = "02m0mbyq4k4p7baz659ndaixancl19x2anaysqm3alcs9zqv4p7b"; - authors = [ - "dnaq" - ]; - dependencies = [ - { - name = "libc"; - packageId = "libc"; - } - { - name = "libsodium-sys"; - packageId = "libsodium-sys"; - } - ]; - features = { - "default" = [ "serde" "std" ]; - "serde" = [ "dep:serde" ]; - }; - resolvedDefaultFeatures = [ "std" ]; - }; - }; - - # - # crate2nix/default.nix (excerpt start) - # - - /* Target (platform) data for conditional dependencies. - This corresponds roughly to what buildRustCrate is setting. - */ - defaultTarget = { - unix = true; - windows = false; - fuchsia = true; - test = false; - - # This doesn't appear to be officially documented anywhere yet. - # See https://github.com/rust-lang-nursery/rust-forge/issues/101. - os = - if stdenv.hostPlatform.isDarwin - then "macos" - else stdenv.hostPlatform.parsed.kernel.name; - arch = stdenv.hostPlatform.parsed.cpu.name; - family = "unix"; - env = "gnu"; - endian = - if stdenv.hostPlatform.parsed.cpu.significantByte.name == "littleEndian" - then "little" else "big"; - pointer_width = toString stdenv.hostPlatform.parsed.cpu.bits; - vendor = stdenv.hostPlatform.parsed.vendor.name; - debug_assertions = false; - }; - - /* Filters common temp files and build files. */ - # TODO(pkolloch): Substitute with gitignore filter - sourceFilter = name: type: - let - baseName = builtins.baseNameOf (builtins.toString name); - in - ! ( - # Filter out git - baseName == ".gitignore" - || (type == "directory" && baseName == ".git") - - # Filter out build results - || ( - type == "directory" && ( - baseName == "target" - || baseName == "_site" - || baseName == ".sass-cache" - || baseName == ".jekyll-metadata" - || baseName == "build-artifacts" - ) - ) - - # Filter out nix-build result symlinks - || ( - type == "symlink" && lib.hasPrefix "result" baseName - ) - - # Filter out IDE config - || ( - type == "directory" && ( - baseName == ".idea" || baseName == ".vscode" - ) - ) || lib.hasSuffix ".iml" baseName - - # Filter out nix build files - || baseName == "Cargo.nix" - - # Filter out editor backup / swap files. - || lib.hasSuffix "~" baseName - || builtins.match "^\\.sw[a-z]$$" baseName != null - || builtins.match "^\\..*\\.sw[a-z]$$" baseName != null - || lib.hasSuffix ".tmp" baseName - || lib.hasSuffix ".bak" baseName - || baseName == "tests.nix" - ); - - /* Returns a crate which depends on successful test execution - of crate given as the second argument. - - testCrateFlags: list of flags to pass to the test exectuable - testInputs: list of packages that should be available during test execution - */ - crateWithTest = { crate, testCrate, testCrateFlags, testInputs, testPreRun, testPostRun }: - assert builtins.typeOf testCrateFlags == "list"; - assert builtins.typeOf testInputs == "list"; - assert builtins.typeOf testPreRun == "string"; - assert builtins.typeOf testPostRun == "string"; - let - # override the `crate` so that it will build and execute tests instead of - # building the actual lib and bin targets We just have to pass `--test` - # to rustc and it will do the right thing. We execute the tests and copy - # their log and the test executables to $out for later inspection. - test = - let - drv = testCrate.override - ( - _: { - buildTests = true; - } - ); - # If the user hasn't set any pre/post commands, we don't want to - # insert empty lines. This means that any existing users of crate2nix - # don't get a spurious rebuild unless they set these explicitly. - testCommand = pkgs.lib.concatStringsSep "\n" - (pkgs.lib.filter (s: s != "") [ - testPreRun - "$f $testCrateFlags 2>&1 | tee -a $out" - testPostRun - ]); - in - pkgs.runCommand "run-tests-${testCrate.name}" - { - inherit testCrateFlags; - buildInputs = testInputs; - } '' - set -ex - - export RUST_BACKTRACE=1 - - # recreate a file hierarchy as when running tests with cargo - - # the source for test data - ${pkgs.xorg.lndir}/bin/lndir ${crate.src} - - # build outputs - testRoot=target/debug - mkdir -p $testRoot - - # executables of the crate - # we copy to prevent std::env::current_exe() to resolve to a store location - for i in ${crate}/bin/*; do - cp "$i" "$testRoot" - done - chmod +w -R . - - # test harness executables are suffixed with a hash, like cargo does - # this allows to prevent name collision with the main - # executables of the crate - hash=$(basename $out) - for file in ${drv}/tests/*; do - f=$testRoot/$(basename $file)-$hash - cp $file $f - ${testCommand} - done - ''; - in - pkgs.runCommand "${crate.name}-linked" - { - inherit (crate) outputs crateName; - passthru = (crate.passthru or { }) // { - inherit test; - }; - } '' - echo tested by ${test} - ${lib.concatMapStringsSep "\n" (output: "ln -s ${crate.${output}} ${"$"}${output}") crate.outputs} - ''; - - /* A restricted overridable version of builtRustCratesWithFeatures. */ - buildRustCrateWithFeatures = - { packageId - , features ? rootFeatures - , crateOverrides ? defaultCrateOverrides - , buildRustCrateForPkgsFunc ? null - , runTests ? false - , testCrateFlags ? [ ] - , testInputs ? [ ] - # Any command to run immediatelly before a test is executed. - , testPreRun ? "" - # Any command run immediatelly after a test is executed. - , testPostRun ? "" - }: - lib.makeOverridable - ( - { features - , crateOverrides - , runTests - , testCrateFlags - , testInputs - , testPreRun - , testPostRun - }: - let - buildRustCrateForPkgsFuncOverriden = - if buildRustCrateForPkgsFunc != null - then buildRustCrateForPkgsFunc - else - ( - if crateOverrides == pkgs.defaultCrateOverrides - then buildRustCrateForPkgs - else - pkgs: (buildRustCrateForPkgs pkgs).override { - defaultCrateOverrides = crateOverrides; - } - ); - builtRustCrates = builtRustCratesWithFeatures { - inherit packageId features; - buildRustCrateForPkgsFunc = buildRustCrateForPkgsFuncOverriden; - runTests = false; - }; - builtTestRustCrates = builtRustCratesWithFeatures { - inherit packageId features; - buildRustCrateForPkgsFunc = buildRustCrateForPkgsFuncOverriden; - runTests = true; - }; - drv = builtRustCrates.crates.${packageId}; - testDrv = builtTestRustCrates.crates.${packageId}; - derivation = - if runTests then - crateWithTest - { - crate = drv; - testCrate = testDrv; - inherit testCrateFlags testInputs testPreRun testPostRun; - } - else drv; - in - derivation - ) - { inherit features crateOverrides runTests testCrateFlags testInputs testPreRun testPostRun; }; - - /* Returns an attr set with packageId mapped to the result of buildRustCrateForPkgsFunc - for the corresponding crate. - */ - builtRustCratesWithFeatures = - { packageId - , features - , crateConfigs ? crates - , buildRustCrateForPkgsFunc - , runTests - , target ? defaultTarget - } @ args: - assert (builtins.isAttrs crateConfigs); - assert (builtins.isString packageId); - assert (builtins.isList features); - assert (builtins.isAttrs target); - assert (builtins.isBool runTests); - let - rootPackageId = packageId; - mergedFeatures = mergePackageFeatures - ( - args // { - inherit rootPackageId; - target = target // { test = runTests; }; - } - ); - # Memoize built packages so that reappearing packages are only built once. - builtByPackageIdByPkgs = mkBuiltByPackageIdByPkgs pkgs; - mkBuiltByPackageIdByPkgs = pkgs: - let - self = { - crates = lib.mapAttrs (packageId: value: buildByPackageIdForPkgsImpl self pkgs packageId) crateConfigs; - build = mkBuiltByPackageIdByPkgs pkgs.buildPackages; - }; - in - self; - buildByPackageIdForPkgsImpl = self: pkgs: packageId: - let - features = mergedFeatures."${packageId}" or [ ]; - crateConfig' = crateConfigs."${packageId}"; - crateConfig = - builtins.removeAttrs crateConfig' [ "resolvedDefaultFeatures" "devDependencies" ]; - devDependencies = - lib.optionals - (runTests && packageId == rootPackageId) - (crateConfig'.devDependencies or [ ]); - dependencies = - dependencyDerivations { - inherit features target; - buildByPackageId = depPackageId: - # proc_macro crates must be compiled for the build architecture - if crateConfigs.${depPackageId}.procMacro or false - then self.build.crates.${depPackageId} - else self.crates.${depPackageId}; - dependencies = - (crateConfig.dependencies or [ ]) - ++ devDependencies; - }; - buildDependencies = - dependencyDerivations { - inherit features target; - buildByPackageId = depPackageId: - self.build.crates.${depPackageId}; - dependencies = crateConfig.buildDependencies or [ ]; - }; - filterEnabledDependenciesForThis = dependencies: filterEnabledDependencies { - inherit dependencies features target; - }; - dependenciesWithRenames = - lib.filter (d: d ? "rename") - ( - filterEnabledDependenciesForThis - ( - (crateConfig.buildDependencies or [ ]) - ++ (crateConfig.dependencies or [ ]) - ++ devDependencies - ) - ); - # Crate renames have the form: - # - # { - # crate_name = [ - # { version = "1.2.3"; rename = "crate_name01"; } - # ]; - # # ... - # } - crateRenames = - let - grouped = - lib.groupBy - (dependency: dependency.name) - dependenciesWithRenames; - versionAndRename = dep: - let - package = crateConfigs."${dep.packageId}"; - in - { inherit (dep) rename; version = package.version; }; - in - lib.mapAttrs (name: choices: builtins.map versionAndRename choices) grouped; - in - buildRustCrateForPkgsFunc pkgs - ( - crateConfig // { - src = crateConfig.src or ( - pkgs.fetchurl rec { - name = "${crateConfig.crateName}-${crateConfig.version}.tar.gz"; - # https://www.pietroalbini.org/blog/downloading-crates-io/ - # Not rate-limited, CDN URL. - url = "https://static.crates.io/crates/${crateConfig.crateName}/${crateConfig.crateName}-${crateConfig.version}.crate"; - sha256 = - assert (lib.assertMsg (crateConfig ? sha256) "Missing sha256 for ${name}"); - crateConfig.sha256; - } - ); - extraRustcOpts = lib.lists.optional (targetFeatures != [ ]) "-C target-feature=${lib.concatMapStringsSep "," (x: "+${x}") targetFeatures}"; - inherit features dependencies buildDependencies crateRenames release; - } - ); - in - builtByPackageIdByPkgs; - - /* Returns the actual derivations for the given dependencies. */ - dependencyDerivations = - { buildByPackageId - , features - , dependencies - , target - }: - assert (builtins.isList features); - assert (builtins.isList dependencies); - assert (builtins.isAttrs target); - let - enabledDependencies = filterEnabledDependencies { - inherit dependencies features target; - }; - depDerivation = dependency: buildByPackageId dependency.packageId; - in - map depDerivation enabledDependencies; - - /* Returns a sanitized version of val with all values substituted that cannot - be serialized as JSON. - */ - sanitizeForJson = val: - if builtins.isAttrs val - then lib.mapAttrs (n: v: sanitizeForJson v) val - else if builtins.isList val - then builtins.map sanitizeForJson val - else if builtins.isFunction val - then "function" - else val; - - /* Returns various tools to debug a crate. */ - debugCrate = { packageId, target ? defaultTarget }: - assert (builtins.isString packageId); - let - debug = rec { - # The built tree as passed to buildRustCrate. - buildTree = buildRustCrateWithFeatures { - buildRustCrateForPkgsFunc = _: lib.id; - inherit packageId; - }; - sanitizedBuildTree = sanitizeForJson buildTree; - dependencyTree = sanitizeForJson - ( - buildRustCrateWithFeatures { - buildRustCrateForPkgsFunc = _: crate: { - "01_crateName" = crate.crateName or false; - "02_features" = crate.features or [ ]; - "03_dependencies" = crate.dependencies or [ ]; - }; - inherit packageId; - } - ); - mergedPackageFeatures = mergePackageFeatures { - features = rootFeatures; - inherit packageId target; - }; - diffedDefaultPackageFeatures = diffDefaultPackageFeatures { - inherit packageId target; - }; - }; - in - { internal = debug; }; - - /* Returns differences between cargo default features and crate2nix default - features. - - This is useful for verifying the feature resolution in crate2nix. - */ - diffDefaultPackageFeatures = - { crateConfigs ? crates - , packageId - , target - }: - assert (builtins.isAttrs crateConfigs); - let - prefixValues = prefix: lib.mapAttrs (n: v: { "${prefix}" = v; }); - mergedFeatures = - prefixValues - "crate2nix" - (mergePackageFeatures { inherit crateConfigs packageId target; features = [ "default" ]; }); - configs = prefixValues "cargo" crateConfigs; - combined = lib.foldAttrs (a: b: a // b) { } [ mergedFeatures configs ]; - onlyInCargo = - builtins.attrNames - (lib.filterAttrs (n: v: !(v ? "crate2nix") && (v ? "cargo")) combined); - onlyInCrate2Nix = - builtins.attrNames - (lib.filterAttrs (n: v: (v ? "crate2nix") && !(v ? "cargo")) combined); - differentFeatures = lib.filterAttrs - ( - n: v: - (v ? "crate2nix") - && (v ? "cargo") - && (v.crate2nix.features or [ ]) != (v."cargo".resolved_default_features or [ ]) - ) - combined; - in - builtins.toJSON { - inherit onlyInCargo onlyInCrate2Nix differentFeatures; - }; - - /* Returns an attrset mapping packageId to the list of enabled features. - - If multiple paths to a dependency enable different features, the - corresponding feature sets are merged. Features in rust are additive. - */ - mergePackageFeatures = - { crateConfigs ? crates - , packageId - , rootPackageId ? packageId - , features ? rootFeatures - , dependencyPath ? [ crates.${packageId}.crateName ] - , featuresByPackageId ? { } - , target - # Adds devDependencies to the crate with rootPackageId. - , runTests ? false - , ... - } @ args: - assert (builtins.isAttrs crateConfigs); - assert (builtins.isString packageId); - assert (builtins.isString rootPackageId); - assert (builtins.isList features); - assert (builtins.isList dependencyPath); - assert (builtins.isAttrs featuresByPackageId); - assert (builtins.isAttrs target); - assert (builtins.isBool runTests); - let - crateConfig = crateConfigs."${packageId}" or (builtins.throw "Package not found: ${packageId}"); - expandedFeatures = expandFeatures (crateConfig.features or { }) features; - enabledFeatures = enableFeatures (crateConfig.dependencies or [ ]) expandedFeatures; - depWithResolvedFeatures = dependency: - let - packageId = dependency.packageId; - features = dependencyFeatures enabledFeatures dependency; - in - { inherit packageId features; }; - resolveDependencies = cache: path: dependencies: - assert (builtins.isAttrs cache); - assert (builtins.isList dependencies); - let - enabledDependencies = filterEnabledDependencies { - inherit dependencies target; - features = enabledFeatures; - }; - directDependencies = map depWithResolvedFeatures enabledDependencies; - foldOverCache = op: lib.foldl op cache directDependencies; - in - foldOverCache - ( - cache: { packageId, features }: - let - cacheFeatures = cache.${packageId} or [ ]; - combinedFeatures = sortedUnique (cacheFeatures ++ features); - in - if cache ? ${packageId} && cache.${packageId} == combinedFeatures - then cache - else - mergePackageFeatures { - features = combinedFeatures; - featuresByPackageId = cache; - inherit crateConfigs packageId target runTests rootPackageId; - } - ); - cacheWithSelf = - let - cacheFeatures = featuresByPackageId.${packageId} or [ ]; - combinedFeatures = sortedUnique (cacheFeatures ++ enabledFeatures); - in - featuresByPackageId // { - "${packageId}" = combinedFeatures; - }; - cacheWithDependencies = - resolveDependencies cacheWithSelf "dep" - ( - crateConfig.dependencies or [ ] - ++ lib.optionals - (runTests && packageId == rootPackageId) - (crateConfig.devDependencies or [ ]) - ); - cacheWithAll = - resolveDependencies - cacheWithDependencies "build" - (crateConfig.buildDependencies or [ ]); - in - cacheWithAll; - - /* Returns the enabled dependencies given the enabled features. */ - filterEnabledDependencies = { dependencies, features, target }: - assert (builtins.isList dependencies); - assert (builtins.isList features); - assert (builtins.isAttrs target); - - lib.filter - ( - dep: - let - targetFunc = dep.target or (features: true); - in - targetFunc { inherit features target; } - && ( - !(dep.optional or false) - || builtins.any (doesFeatureEnableDependency dep) features - ) - ) - dependencies; - - /* Returns whether the given feature should enable the given dependency. */ - doesFeatureEnableDependency = { name, rename ? null, ... }: feature: - let - prefix = "${name}/"; - len = builtins.stringLength prefix; - startsWithPrefix = builtins.substring 0 len feature == prefix; - in - (rename == null && feature == name) - || (rename != null && rename == feature) - || startsWithPrefix; - - /* Returns the expanded features for the given inputFeatures by applying the - rules in featureMap. - - featureMap is an attribute set which maps feature names to lists of further - feature names to enable in case this feature is selected. - */ - expandFeatures = featureMap: inputFeatures: - assert (builtins.isAttrs featureMap); - assert (builtins.isList inputFeatures); - let - expandFeature = feature: - assert (builtins.isString feature); - [ feature ] ++ (expandFeatures featureMap (featureMap."${feature}" or [ ])); - outFeatures = lib.concatMap expandFeature inputFeatures; - in - sortedUnique outFeatures; - - /* This function adds optional dependencies as features if they are enabled - indirectly by dependency features. This function mimics Cargo's behavior - described in a note at: - https://doc.rust-lang.org/nightly/cargo/reference/features.html#dependency-features - */ - enableFeatures = dependencies: features: - assert (builtins.isList features); - assert (builtins.isList dependencies); - let - additionalFeatures = lib.concatMap - ( - dependency: - assert (builtins.isAttrs dependency); - let - enabled = builtins.any (doesFeatureEnableDependency dependency) features; - in - if (dependency.optional or false) && enabled then [ dependency.name ] else [ ] - ) - dependencies; - in - sortedUnique (features ++ additionalFeatures); - - /* - Returns the actual features for the given dependency. - - features: The features of the crate that refers this dependency. - */ - dependencyFeatures = features: dependency: - assert (builtins.isList features); - assert (builtins.isAttrs dependency); - let - defaultOrNil = - if dependency.usesDefaultFeatures or true - then [ "default" ] - else [ ]; - explicitFeatures = dependency.features or [ ]; - additionalDependencyFeatures = - let - dependencyPrefix = (dependency.rename or dependency.name) + "/"; - dependencyFeatures = - builtins.filter (f: lib.hasPrefix dependencyPrefix f) features; - in - builtins.map (lib.removePrefix dependencyPrefix) dependencyFeatures; - in - defaultOrNil ++ explicitFeatures ++ additionalDependencyFeatures; - - /* Sorts and removes duplicates from a list of strings. */ - sortedUnique = features: - assert (builtins.isList features); - assert (builtins.all builtins.isString features); - let - outFeaturesSet = lib.foldl (set: feature: set // { "${feature}" = 1; }) { } features; - outFeaturesUnique = builtins.attrNames outFeaturesSet; - in - builtins.sort (a: b: a < b) outFeaturesUnique; - - deprecationWarning = message: value: - if strictDeprecation - then builtins.throw "strictDeprecation enabled, aborting: ${message}" - else builtins.trace message value; - - # - # crate2nix/default.nix (excerpt end) - # - }; -} - diff --git a/nix/pkgs/cryptobox/README.md b/nix/pkgs/cryptobox/README.md deleted file mode 100644 index babc4e88b77..00000000000 --- a/nix/pkgs/cryptobox/README.md +++ /dev/null @@ -1,7 +0,0 @@ -# How to update - -``` -crate2nix source add git https://github.com/wireapp/cryptobox-c --rev $your-rev -crate2nix generate -``` - diff --git a/nix/pkgs/cryptobox/crate2nix-sources.nix b/nix/pkgs/cryptobox/crate2nix-sources.nix deleted file mode 100644 index 3e1364ba616..00000000000 --- a/nix/pkgs/cryptobox/crate2nix-sources.nix +++ /dev/null @@ -1,115 +0,0 @@ -# Support functions to create a nix generated workspace for out-of-tree sources. -# -# You do not need to check this in since it will be regenerated every time it is -# used by crate2nix. -# -# This file was @generated by crate2nix 0.10.0 with the command: -# "generate" -# -# See https://github.com/kolloch/crate2nix for more info. - -{ nixpkgs ? -, pkgs ? import nixpkgs { } -, lib ? pkgs.lib - # The path to crate2nix.json. -, crate2nixJson ? ./crate2nix.json -}: - -let - config = builtins.fromJSON (builtins.readFile crate2nixJson); - sources = config.sources or (builtins.throw "no sources in ${crate2nixJson}"); -in -rec { - /* An attrset mapping a source name to its source (as a derivation). */ - fetchedSourcesByName = lib.mapAttrs internal.sourceFromConfig sources; - - /* A derivation building a directory symlinking all workspace member sources - by their name. - */ - fetchedSources = - let sources = lib.mapAttrsToList (name: path: { inherit name path; }) fetchedSourcesByName; - in - pkgs.linkFarm "crate2nix-sources" sources; - - internal = rec { - sourceFromConfig = name: { type, ... } @ source: - assert builtins.isString name; - assert builtins.isString type; - - if type == "Git" - then - pkgs.fetchgit - { - url = source.url; - rev = source.rev; - sha256 = source.sha256; - } - else if type == "CratesIo" - then downloadFromCratesIo source - else if type == "Nix" - then resolveNix source - else builtins.throw "Unexpected source type '${type}' for source: ${builtins.toJSON source}"; - - /* Resolves a source configuration of type "Nix". - - It can either have - - * a `{ package = ...; ... }` path which will be resolved with pkg.callPackage - - * or an `{ import = ...; ... }` path which will be imported. - - Within that context and additional optional `attr` attribute path is resolved. - - E.g. - ```nix - { - type = "Nix"; - import = "./nix/sources.nix"; - attr = "myPackage.release"; - } - ``` - */ - resolveNix = { type, ... } @ source: - assert type == "Nix"; - - let - attrs = - if source ? package - then pkgs.callPackage (./. + "/${source.package}") { } - else if source ? "import" - then import (./. + ''/${source."import"}'') - else builtins.throw "Neither import nor package in nix source."; - attrPath = lib.splitString "." source.attr; - sourceDerivation = - if source ? attr - then - lib.attrByPath - attrPath - (builtins.throw - '' - Did not find attribute '${source.attr or ""}' - in '${source.package or source.import or "missing file"}'. - '') - attrs - else attrs; - in - sourceDerivation; - - downloadFromCratesIo = { type, name, version, sha256 }: - assert type == "CratesIo"; - - let - archive = pkgs.fetchurl { - name = "${name}-${version}.tar.gz"; - url = "https://crates.io/api/v1/crates/${name}/${version}/download"; - inherit sha256; - }; - in - pkgs.runCommand (lib.removeSuffix ".tar.gz" name) { } - '' - mkdir -p $out - tar -xzf ${archive} --strip-components=1 -C $out - ''; - }; -} - diff --git a/nix/pkgs/cryptobox/crate2nix.json b/nix/pkgs/cryptobox/crate2nix.json deleted file mode 100644 index 7cd2843f097..00000000000 --- a/nix/pkgs/cryptobox/crate2nix.json +++ /dev/null @@ -1,10 +0,0 @@ -{ - "sources": { - "cryptobox-c": { - "type": "Git", - "url": "https://github.com/wireapp/cryptobox-c", - "rev": "4067ad96b125942545dbdec8c1a89f1e1b65d013", - "sha256": "1i9dlhw0xk1viglyhail9fb36v1awrypps8jmhrkz8k1bhx98ci3" - } - } -} \ No newline at end of file diff --git a/nix/pkgs/cryptobox/default.nix b/nix/pkgs/cryptobox/default.nix deleted file mode 100644 index c5c4311c0c5..00000000000 --- a/nix/pkgs/cryptobox/default.nix +++ /dev/null @@ -1,38 +0,0 @@ -{ pkgs -, libsodium -, pkg-config -, runCommand -}: - -let - # load the crate2nix crate tree - crates = import ./Cargo.nix { - inherit pkgs; - nixpkgs = pkgs.path; - - # per-crate overrides - defaultCrateOverrides = pkgs.defaultCrateOverrides // { - libsodium-sys = prev: { - nativeBuildInputs = prev.nativeBuildInputs or [ ] ++ [ pkg-config ]; - buildInputs = [ libsodium ]; - }; - }; - }; - - rootCrate = crates.rootCrate.build; - -in - -# HACK: rather than providing the multi-output crate output, expose a single- - # output structure in the format expected by cryptobox-haskell. - # Note it expects the .so file to be called libcryptobox.so, not - # libcryptobox_c.so, and the cbox.h to be present. - # In the future, we might want to rework this to instead have cryptobox-c crate - # emit a .pc file, and all downstream tooling use pkg-config to discover things, - # but today is not that day. -runCommand "cryptobox" { } '' - mkdir -p $out/lib $out/include - cp ${rootCrate.lib}/lib/libcryptobox_c* $out/lib/ - ln -sfn libcryptobox_c.so $out/lib/libcryptobox.so - cp ${rootCrate.src}/src/cbox.h $out/include -'' diff --git a/nix/pkgs/rusty_jwt_tools_ffi/default.nix b/nix/pkgs/rusty_jwt_tools_ffi/default.nix index adb3ef3b800..4863378368d 100644 --- a/nix/pkgs/rusty_jwt_tools_ffi/default.nix +++ b/nix/pkgs/rusty_jwt_tools_ffi/default.nix @@ -4,41 +4,34 @@ , pkg-config , perl , gitMinimal +, stdenv }: -# TODO: update to crate2nix once https://github.com/wireapp/rusty-jwt-tools as a -# Cargo.lock file in its root (not at the ffi/ subpath). - let - version = "0.9.0"; + version = "0.14.0"; src = fetchFromGitHub { owner = "wireapp"; repo = "rusty-jwt-tools"; - rev = "05441e98d9c7c5ec9bfcfba84e885988278f10e6"; - sha256 = "sha256-HVq2BpPKp3cfdlKrS1AYWQ+a5VigFsYfSecZ60SFATI="; + rev = "b5de03a239d41b51e7cf9cd7c2674fa6be205134"; + sha256 = "sha256-k7zxtdpLYWP+EYa+Vf6enViS+jIR2zt07yBZdozhKuE="; }; - cargoLockFile = builtins.toFile "cargo.lock" (builtins.readFile "${src}/Cargo.lock"); - in rustPlatform.buildRustPackage { name = "rusty_jwt-tools_ffi-${version}"; inherit version src; + # `buildRustPackage` requires `cargoHash`. So we have to update it as well + # when the Git `rev` is changed. + cargoHash = "sha256-gvFEwb+Cxnk7GhWrKs4hEhfyAI/QiE8Zqd2ZXXLbvuE="; - cargoLock = { - lockFile = cargoLockFile; - 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-4BWvSzFZhlA+mKj+Y6GNEwNSKikNGVjDoPxyxiw9TFE="; - "biscuit-0.6.0-beta1" = "sha256-no7b4Un+7AES7EwWdZh/oeIa4w0caKLAUFsHWqgJOrg="; - "jwt-simple-0.13.0" = "sha256-QkVi7EGrU3nF+/32tNjTtAILo8sjasR27nyRgBH+xoA="; - "rcgen-0.9.2" = "sha256-3jFzInwdzFBot+L2Vm5NLF1ml33GH2+Iv3LqqGhLxFs="; - "ring-0.17.0-not-released-yet" = "sha256-TP8yZo64J/d1fw8l2J4+ol70EcHvpvHJBdpF3A+6Dgo="; - }; - }; - - postPatch = '' - cp ${cargoLockFile} Cargo.lock + # Fix install_name on Darwin to use absolute paths + postInstall = lib.optionalString stdenv.isDarwin '' + for lib in $out/lib/librusty_jwt_tools_ffi*.dylib; do + if [ -f "$lib" ]; then + libname=$(basename "$lib") + install_name_tool -id "$out/lib/$libname" "$lib" + fi + done ''; - doCheck = false; + + nativeBuildInputs = lib.optionals stdenv.isDarwin [ stdenv.cc.bintools ]; } diff --git a/nix/wire-server.nix b/nix/wire-server.nix index dd2b183877f..918e9599750 100644 --- a/nix/wire-server.nix +++ b/nix/wire-server.nix @@ -157,7 +157,7 @@ let ]; manualOverrides = import ./manual-overrides.nix (with pkgs; { - inherit (pkgs) libsodium protobuf fetchpatch fetchurl curl pkg-config postgresql openssl; + inherit (pkgs) libsodium protobuf fetchpatch fetchurl curl pkg-config postgresql openssl icu cryptobox stdenv; inherit hlib mls-test-cli; }); @@ -196,7 +196,7 @@ let # so they don't depend on all the haskell dependencies. These exectuables # are "static" from the perspective of ghc, i.e. they don't dynamically # depend on other haskell packages but they still dynamically depend on C - # dependencies like openssl, cryptobox, libxml2, etc. Doing this makes the + # dependencies like openssl, libxml2, etc. Doing this makes the # final images that we generate much smaller as we don't have to carry # around so files for all haskell packages. staticExecs = localMods@{ enableOptimization, enableDocs, enableTests }: diff --git a/postgres-schema.sql b/postgres-schema.sql index 378195989b4..a0f4b619b33 100644 --- a/postgres-schema.sql +++ b/postgres-schema.sql @@ -102,6 +102,21 @@ CREATE TABLE public.conversation ( ALTER TABLE public.conversation OWNER TO "wire-server"; +-- +-- Name: conversation_codes; Type: TABLE; Schema: public; Owner: wire-server +-- + +CREATE TABLE public.conversation_codes ( + key text NOT NULL, + conversation uuid NOT NULL, + password bytea, + value text NOT NULL, + expires_at timestamp with time zone NOT NULL +); + + +ALTER TABLE public.conversation_codes OWNER TO "wire-server"; + -- -- Name: conversation_member; Type: TABLE; Schema: public; Owner: wire-server -- @@ -282,6 +297,14 @@ ALTER TABLE ONLY public.collaborators ADD CONSTRAINT collaborators_pkey PRIMARY KEY (user_id, team_id); +-- +-- Name: conversation_codes conversation_codes_pkey; Type: CONSTRAINT; Schema: public; Owner: wire-server +-- + +ALTER TABLE ONLY public.conversation_codes + ADD CONSTRAINT conversation_codes_pkey PRIMARY KEY (key); + + -- -- Name: conversation_member conversation_member_pkey; Type: CONSTRAINT; Schema: public; Owner: wire-server -- @@ -392,6 +415,20 @@ CREATE INDEX collaborators_team_id_idx ON public.collaborators USING btree (team CREATE INDEX collaborators_user_id_idx ON public.collaborators USING btree (user_id); +-- +-- Name: conversation_codes_expires_at_idx; Type: INDEX; Schema: public; Owner: wire-server +-- + +CREATE INDEX conversation_codes_expires_at_idx ON public.conversation_codes USING btree (expires_at); + + +-- +-- Name: conversation_codes_key_expires_at_idx; Type: INDEX; Schema: public; Owner: wire-server +-- + +CREATE INDEX conversation_codes_key_expires_at_idx ON public.conversation_codes USING btree (key, expires_at); + + -- -- Name: conversation_member_user_idx; Type: INDEX; Schema: public; Owner: wire-server -- diff --git a/services/background-worker/background-worker.cabal b/services/background-worker/background-worker.cabal index 891e864d63d..595e3d01eac 100644 --- a/services/background-worker/background-worker.cabal +++ b/services/background-worker/background-worker.cabal @@ -21,7 +21,7 @@ library Wire.BackgroundWorker.Options Wire.BackgroundWorker.Util Wire.DeadUserNotificationWatcher - Wire.MigrateConversations + Wire.PostgresMigrations hs-source-dirs: src default-language: GHC2021 diff --git a/services/background-worker/background-worker.integration.yaml b/services/background-worker/background-worker.integration.yaml index 4ee7abbe100..db49fb502d5 100644 --- a/services/background-worker/background-worker.integration.yaml +++ b/services/background-worker/background-worker.integration.yaml @@ -68,6 +68,7 @@ migrateConversations: false migrateConversationsOptions: pageSize: 10000 parallelism: 2 +migrateConversationCodes: false # Background jobs consumer configuration for integration backgroundJobs: @@ -77,3 +78,4 @@ backgroundJobs: postgresMigration: conversation: postgresql + conversationCodes: postgresql diff --git a/services/background-worker/src/Wire/BackgroundWorker.hs b/services/background-worker/src/Wire/BackgroundWorker.hs index c30c1d809aa..ab20dd7c8be 100644 --- a/services/background-worker/src/Wire/BackgroundWorker.hs +++ b/services/background-worker/src/Wire/BackgroundWorker.hs @@ -34,7 +34,8 @@ import Wire.BackgroundWorker.Health qualified as Health import Wire.BackgroundWorker.Jobs.Consumer qualified as Jobs import Wire.BackgroundWorker.Options import Wire.DeadUserNotificationWatcher qualified as DeadUserNotificationWatcher -import Wire.MigrateConversations qualified as MigrateConversations +import Wire.Migration +import Wire.PostgresMigrations qualified as Migrations run :: Opts -> IO () run opts = do @@ -53,7 +54,14 @@ run opts = do then runAppT env $ withNamedLogger "migrate-conversations" $ - MigrateConversations.startWorker opts.migrateConversationsOptions + Migrations.conversations opts.migrateConversationsOptions + else pure $ pure () + cleanUpConvCodesMigration <- + if opts.migrateConversationCodes + then + runAppT env $ + withNamedLogger "migrate-conversation-codes" $ + Migrations.conversationCodes (MigrationOptions 1000 1) else pure $ pure () cleanupJobs <- runAppT env $ @@ -61,10 +69,11 @@ run opts = do Jobs.startWorker amqpEP let cleanup = void . runConcurrently $ - (,,,) + (,,,,) <$> Concurrently cleanupDeadUserNotifWatcher <*> Concurrently cleanupBackendNotifPusher <*> Concurrently cleanupConvMigration + <*> Concurrently cleanUpConvCodesMigration <*> Concurrently cleanupJobs let server = defaultServer (T.unpack opts.backgroundWorker.host) opts.backgroundWorker.port env.logger diff --git a/services/background-worker/src/Wire/BackgroundWorker/Options.hs b/services/background-worker/src/Wire/BackgroundWorker/Options.hs index 48cc531b586..6dc18f03a2b 100644 --- a/services/background-worker/src/Wire/BackgroundWorker/Options.hs +++ b/services/background-worker/src/Wire/BackgroundWorker/Options.hs @@ -28,7 +28,7 @@ import Network.AMQP.Extended import System.Logger.Extended import Util.Options import Wire.ConversationStore (PostgresMigrationOpts) -import Wire.ConversationStore.Migration (MigrationOptions) +import Wire.Migration (MigrationOptions) data Opts = Opts { logLevel :: !Level, @@ -52,6 +52,7 @@ data Opts = Opts postgresMigration :: !PostgresMigrationOpts, migrateConversations :: !Bool, migrateConversationsOptions :: !MigrationOptions, + migrateConversationCodes :: !Bool, backgroundJobs :: BackgroundJobsConfig, federationDomain :: Domain } diff --git a/services/background-worker/src/Wire/MigrateConversations.hs b/services/background-worker/src/Wire/PostgresMigrations.hs similarity index 69% rename from services/background-worker/src/Wire/MigrateConversations.hs rename to services/background-worker/src/Wire/PostgresMigrations.hs index 75587e1ae5b..a4c1cbff2d1 100644 --- a/services/background-worker/src/Wire/MigrateConversations.hs +++ b/services/background-worker/src/Wire/PostgresMigrations.hs @@ -15,7 +15,7 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Wire.MigrateConversations where +module Wire.PostgresMigrations where import Imports import Prometheus @@ -23,10 +23,11 @@ import System.Logger qualified as Log import UnliftIO import Wire.BackgroundWorker.Env import Wire.BackgroundWorker.Util +import Wire.CodeStore.Migration import Wire.ConversationStore.Migration -startWorker :: MigrationOptions -> AppT IO CleanupAction -startWorker migOpts = do +conversations :: MigrationOptions -> AppT IO CleanupAction +conversations migOpts = do cassClient <- asks (.cassandraGalley) pgPool <- asks (.hasqlPool) logger <- asks (.logger) @@ -47,3 +48,20 @@ startWorker migOpts = do Log.info logger $ Log.msg (Log.val "cancelling conversation migration") cancel convLoop cancel userLoop + +conversationCodes :: MigrationOptions -> AppT IO CleanupAction +conversationCodes migOpts = do + cassClient <- asks (.cassandraGalley) + pgPool <- asks (.hasqlPool) + logger <- asks (.logger) + Log.info logger $ Log.msg (Log.val "starting conversation codes migration") + count <- register $ counter $ Prometheus.Info "wire_conv_codes_migrated_to_pg" "Number of conversation codes migrated to Postgresql" + finished <- register $ counter $ Prometheus.Info "wire_conv_codes_migration_finished" "Whether the conversation codes migration to Postgresql is finished successfully" + failed <- register $ counter $ Prometheus.Info "wire_conv_codes_migration_failed" "Whether the conversation codes migration to Postgresql has failed" + + migrationLoop <- async . lift $ migrateCodesLoop migOpts cassClient pgPool logger count finished failed + + Log.info logger $ Log.msg (Log.val "started conversation codes migration") + pure $ do + Log.info logger $ Log.msg (Log.val "cancelling conversation codes migration") + cancel migrationLoop diff --git a/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs b/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs index 04307949b21..e10ab43123d 100644 --- a/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs +++ b/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs @@ -361,7 +361,11 @@ spec = do amqpJobsPublisherChannel = undefined amqpBackendNotificationsChannel = undefined federationDomain = Domain "local" - postgresMigration = PostgresMigrationOpts CassandraStorage + postgresMigration = + PostgresMigrationOpts + { conversation = CassandraStorage, + conversationCodes = CassandraStorage + } gundeckEndpoint = undefined brigEndpoint = undefined @@ -395,7 +399,11 @@ spec = do amqpJobsPublisherChannel = undefined amqpBackendNotificationsChannel = undefined federationDomain = Domain "local" - postgresMigration = PostgresMigrationOpts CassandraStorage + postgresMigration = + PostgresMigrationOpts + { conversation = CassandraStorage, + conversationCodes = CassandraStorage + } gundeckEndpoint = undefined brigEndpoint = undefined backendNotificationMetrics <- mkBackendNotificationMetrics diff --git a/services/background-worker/test/Test/Wire/Util.hs b/services/background-worker/test/Test/Wire/Util.hs index f7f24a54f08..cdb020a2223 100644 --- a/services/background-worker/test/Test/Wire/Util.hs +++ b/services/background-worker/test/Test/Wire/Util.hs @@ -39,7 +39,11 @@ testEnv = do let cassandra = undefined cassandraGalley = undefined cassandraBrig = undefined - postgresMigration = PostgresMigrationOpts CassandraStorage + postgresMigration = + PostgresMigrationOpts + { conversation = CassandraStorage, + conversationCodes = CassandraStorage + } statuses <- newIORef mempty backendNotificationMetrics <- mkBackendNotificationMetrics workerRunningGauge <- mkWorkerRunningGauge diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 67449f7bb01..be188db9d0e 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -191,7 +191,6 @@ library Brig.Schema.V90_DomainRegistrationTeamIndex Brig.Schema.V91_UpdateDomainRegistrationSchema_AddWebappUrl Brig.Team.API - Brig.Team.Email Brig.Team.Template Brig.Template Brig.User.API.Handle @@ -232,7 +231,6 @@ library , conduit >=1.2.8 , containers >=0.5 , cookie >=0.4 - , cryptobox-haskell >=0.1.1 , crypton , currency-codes >=2.0 , data-default @@ -366,6 +364,7 @@ executable brig-integration API.Team API.Team.Util API.TeamUserSearch + API.Template API.User API.User.Account API.User.Auth diff --git a/services/brig/brig.integration.yaml b/services/brig/brig.integration.yaml index a711f0e382d..7d39b7166de 100644 --- a/services/brig/brig.integration.yaml +++ b/services/brig/brig.integration.yaml @@ -126,25 +126,25 @@ emailSMS: forgot: https://wire.com/forgot/ support: https://support.wire.com/ user: - activationUrl: http://127.0.0.1:8080/activate?key=${key}&code=${code} - smsActivationUrl: http://127.0.0.1:8080/v/${code} - passwordResetUrl: http://127.0.0.1:8080/password-reset/${key}?code=${code} - invitationUrl: http://127.0.0.1:8080/register?invitation_code=${code} - deletionUrl: http://127.0.0.1:8080/users/delete?key=${key}&code=${code} + activationUrl: https://example.com/verify/?key=${key}&code=${code} + smsActivationUrl: https://example.com/v/${code} + passwordResetUrl: https://example.com/reset/?key=${key}&code=${code} + invitationUrl: https://example.com/register?invitation_code=${code} + deletionUrl: https://example.com/d/?key=${key}&code=${code} provider: homeUrl: https://provider.localhost/ - providerActivationUrl: http://127.0.0.1:8080/provider/activate?key=${key}&code=${code} + providerActivationUrl: http://127.0.0.1:8080/verify/bot/?key=${key}&code=${code} approvalUrl: http://127.0.0.1:8080/provider/approve?key=${key}&code=${code} approvalTo: success@simulator.amazonses.com - providerPwResetUrl: http://127.0.0.1:8080/provider/password-reset?key=${key}&code=${code} + providerPwResetUrl: http://127.0.0.1:8080/reset/bot/?key=${key}&code=${code} team: - tInvitationUrl: http://127.0.0.1:8080/register?team=${team}&team_code=${code} - tExistingUserInvitationUrl: http://127.0.0.1:8080/accept-invitation?team-code=${code} - tActivationUrl: http://127.0.0.1:8080/register?team=${team}&team_code=${code} - tCreatorWelcomeUrl: http://127.0.0.1:8080/creator-welcome-website - tMemberWelcomeUrl: http://127.0.0.1:8080/member-welcome-website + tInvitationUrl: https://example.com/join/?team-code=${code} + tExistingUserInvitationUrl: https://example.com/accept-invitation/?team-code=${code} + tActivationUrl: https://example.com/verify/?key=${key}&code=${code} + tCreatorWelcomeUrl: https://example.com/creator-welcome-website + tMemberWelcomeUrl: https://example.com/member-welcome-website zauth: privateKeys: ../../libs/wire-subsystems/test/resources/zauth/privkeys.txt diff --git a/services/brig/default.nix b/services/brig/default.nix index 550ed4212b3..754e7b06b81 100644 --- a/services/brig/default.nix +++ b/services/brig/default.nix @@ -29,7 +29,6 @@ , conduit , containers , cookie -, cryptobox-haskell , crypton , currency-codes , data-default @@ -184,7 +183,6 @@ mkDerivation { conduit containers cookie - cryptobox-haskell crypton currency-codes data-default diff --git a/services/brig/src/Brig/API/Client.hs b/services/brig/src/Brig/API/Client.hs index 51100f5867a..b86f5508ac4 100644 --- a/services/brig/src/Brig/API/Client.hs +++ b/services/brig/src/Brig/API/Client.hs @@ -469,7 +469,7 @@ claimLocalMultiPrekeyBundles protectee userClients = do . Message.userClients $ userClients where - getChunk :: Map UserId (Set ClientId) -> AppT r (Map UserId (Map ClientId (Maybe Prekey))) + getChunk :: Map UserId (Set ClientId) -> AppT r (Map UserId (Map ClientId (Maybe UncheckedPrekeyBundle))) getChunk m = do e <- ask AppT $ @@ -482,13 +482,13 @@ claimLocalMultiPrekeyBundles protectee userClients = do getUserKeys :: UserId -> Set ClientId -> - (AppT r) (Map ClientId (Maybe Prekey)) + (AppT r) (Map ClientId (Maybe UncheckedPrekeyBundle)) getUserKeys u = sequenceA . Map.fromSet (getClientKeys u) getClientKeys :: UserId -> ClientId -> - (AppT r) (Maybe Prekey) + (AppT r) (Maybe UncheckedPrekeyBundle) getClientKeys u c = do key <- fmap prekeyData <$> wrapHttpClient (Data.claimPrekey u c) when (isNothing key) $ noPrekeys u c @@ -622,6 +622,5 @@ createAccessToken luid cid method link proof = do method maxSkewSeconds expiresAt - now pubKeyBundle pure $ (DPoPAccessTokenResponse token DPoP expiresIn, NoStore) diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index e4fbf8ed6c2..1bc41a7d6af 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -52,7 +52,7 @@ import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import Brig.Options hiding (internalEvents) import Brig.Provider.API import Brig.Team.API qualified as Team -import Brig.Team.Email qualified as Team +import Brig.Template (InvitationUrlTemplates) import Brig.Types.Activation (ActivationPair) import Brig.Types.Intra import Brig.User.API.Handle qualified as Handle @@ -167,7 +167,6 @@ import Wire.DeleteQueue import Wire.DomainRegistrationStore (DomainRegistrationStore) import Wire.EmailSending (EmailSending) import Wire.EmailSubsystem -import Wire.EmailSubsystem.Template import Wire.EnterpriseLoginSubsystem (EnterpriseLoginSubsystem) import Wire.EnterpriseLoginSubsystem qualified as EnterpriseLogin import Wire.Error @@ -318,7 +317,8 @@ versionedSwaggerDocsAPI Nothing = tocPage [ "

Internal (not versioned)

", "

Openapi docs for internal endpoints are served per service. I.e. there's one for `brig`, one for `cannon`, \ \etc.. This is because Openapi doesn't play well with multiple actions having the same combination of HTTP \ - \method and URL path.

" + \method and URL path.

", + "

BACKDOORS FOR TESTING (staging only): For testing some of the internal end-points can be used on our staging env through basic auth. If you want to know which ones support this, here is one. You can search this file your path and check if that says `basic_auth: true`.

" ] <> mconcat [ [ s <> ":
", @@ -393,7 +393,7 @@ servantSitemap :: Member UserKeyStore r, Member ActivationCodeStore r, Member UserStore r, - Member (Input TeamTemplates) r, + Member (Input InvitationUrlTemplates) r, Member UserSubsystem r, Member TeamInvitationSubsystem r, Member VerificationCodeSubsystem r, @@ -633,6 +633,7 @@ servantSitemap = appsAPI = Named @"create-app" createApp :<|> Named @"get-app" getApp + :<|> Named @"get-apps" getApps :<|> Named @"refresh-app-cookie" refreshAppCookie --------------------------------------------------------------------------- @@ -906,7 +907,7 @@ upgradePersonalToTeam :: Member TinyLog r, Member UserSubsystem r, Member UserStore r, - Member EmailSending r + Member EmailSubsystem r ) => Local UserId -> Public.BindingNewTeamUser -> @@ -930,7 +931,6 @@ createUser :: Member UserSubsystem r, Member PasswordResetCodeStore r, Member HashPassword r, - Member EmailSending r, Member ActivationCodeStore r, Member RateLimit r, Member AuthenticationSubsystem r @@ -992,15 +992,15 @@ createUser ip (Public.NewUserPublic new) = lift . runExceptT $ do | otherwise = liftSem $ sendActivationMail email name key code locale - sendWelcomeEmail :: (Member EmailSending r) => Public.EmailAddress -> Public.CreateUserTeam -> Public.NewTeamUser -> Maybe Public.Locale -> (AppT r) () + sendWelcomeEmail :: (Member EmailSubsystem r) => Public.EmailAddress -> Public.CreateUserTeam -> Public.NewTeamUser -> Maybe Public.Locale -> (AppT r) () -- NOTE: Welcome e-mails for the team creator are not dealt by brig anymore sendWelcomeEmail e (Public.CreateUserTeam t n) newUser l = case newUser of Public.NewTeamCreator _ -> pure () Public.NewTeamMember _ -> - Team.sendMemberWelcomeMail e t n l + liftSem $ sendMemberWelcomeEmail e t n l Public.NewTeamMemberSSO _ -> - Team.sendMemberWelcomeMail e t n l + liftSem $ sendMemberWelcomeEmail e t n l getSelf :: (Member UserSubsystem r) => Local UserId -> Handler r Public.SelfProfile getSelf self = @@ -1756,6 +1756,9 @@ createApp lusr tid new = lift . liftSem $ AppSubsystem.createApp lusr tid new getApp :: (_) => Local UserId -> TeamId -> UserId -> Handler r GetApp getApp lusr tid uid = lift . liftSem $ AppSubsystem.getApp lusr tid uid +getApps :: (_) => Local UserId -> TeamId -> Handler r [GetApp] +getApps lusr tid = lift . liftSem $ AppSubsystem.getApps lusr tid + refreshAppCookie :: (_) => Local UserId -> TeamId -> UserId -> Handler r RefreshAppCookieResponse refreshAppCookie lusr tid appId = do mc <- lift . liftSem $ AppSubsystem.refreshAppCookie lusr tid appId diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 7c0397cefee..8ef4f403374 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -80,7 +80,6 @@ import Brig.Effects.UserPendingActivationStore (UserPendingActivation (..), User import Brig.Effects.UserPendingActivationStore qualified as UserPendingActivationStore import Brig.IO.Intra qualified as Intra import Brig.Options hiding (internalEvents) -import Brig.Team.Email import Brig.Types.Activation (ActivationPair) import Brig.Types.Intra import Brig.User.Auth.Cookie qualified as Auth @@ -130,7 +129,6 @@ import Wire.ActivationCodeStore qualified as ActivationCode import Wire.AuthenticationSubsystem (AuthenticationSubsystem, internalLookupPasswordResetCode) import Wire.BlockListStore as BlockListStore import Wire.DeleteQueue -import Wire.EmailSending import Wire.EmailSubsystem import Wire.Error import Wire.Events (Events) @@ -273,7 +271,7 @@ upgradePersonalToTeam :: Member (Input (Local ())) r, Member Now r, Member (ConnectionStore InternalPaging) r, - Member EmailSending r + Member EmailSubsystem r ) => Local UserId -> BindingNewTeamUser -> @@ -301,12 +299,13 @@ upgradePersonalToTeam luid bNewTeam = do -- send confirmation email for_ (userEmail user) $ \email -> do - sendNewTeamOwnerWelcomeEmail - email - tid - bNewTeam.bnuTeam.newTeamName.fromRange - (Just user.userLocale) - user.userDisplayName + liftSem $ + sendNewTeamOwnerWelcomeEmail + email + tid + bNewTeam.bnuTeam.newTeamName.fromRange + (Just user.userLocale) + user.userDisplayName pure $! createUserTeam where diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index a4be8cebffa..cbdcbe1469f 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -32,7 +32,7 @@ module Brig.App closeEnv, providerTemplatesWithLocale, teamTemplatesWithLocale, - teamTemplatesNoLocale, + invitationUrlTemplates, cargoholdLens, galleyLens, galleyEndpointLens, @@ -53,6 +53,7 @@ module Brig.App providerTemplatesLens, teamTemplatesLens, templateBrandingLens, + templateBrandingAsMapLens, httpManagerLens, http2ManagerLens, extGetManagerLens, @@ -113,7 +114,7 @@ import Brig.Queue.Stomp qualified as Stomp import Brig.Queue.Types import Brig.Schema.Run qualified as Migrations import Brig.Team.Template -import Brig.Template (Localised, genTemplateBranding) +import Brig.Template (InvitationUrlTemplates (..), Localised, genTemplateBranding, genTemplateBrandingMap) import Brig.User.Search.Index (IndexEnv (..), MonadIndexIO (..), runIndexIO) import Brig.User.Template import Cassandra (runClient) @@ -165,6 +166,7 @@ import Wire.AuthenticationSubsystem.Config (ZAuthEnv) import Wire.AuthenticationSubsystem.Config qualified as AuthenticationSubsystem import Wire.EmailSending.SMTP qualified as SMTP import Wire.EmailSubsystem.Template (TemplateBranding, forLocale) +import Wire.EmailSubsystem.Templates.User import Wire.ExternalAccess.External import Wire.RateLimit.Interpreter import Wire.SessionStore @@ -201,6 +203,7 @@ data Env = Env providerTemplates :: Localised ProviderTemplates, teamTemplates :: Localised TeamTemplates, templateBranding :: TemplateBranding, + templateBrandingAsMap :: Map Text Text, httpManager :: Manager, http2Manager :: Http2Manager, extGetManager :: (Manager, [Fingerprint Rsa] -> SSL.SSL -> IO ()), @@ -238,6 +241,7 @@ newEnv opts = do ptp <- loadProviderTemplates opts ttp <- loadTeamTemplates opts let branding = genTemplateBranding . Opt.templateBranding . Opt.general . Opt.emailSMS $ opts + brandingAsMap = genTemplateBrandingMap . Opt.templateBranding . Opt.general . Opt.emailSMS $ opts (emailAWSOpts, emailSMTP) <- emailConn lgr $ Opt.email (Opt.emailSMS opts) aws <- AWS.mkEnv lgr (Opt.aws opts) emailAWSOpts mgr zau <- initZAuth opts @@ -296,6 +300,7 @@ newEnv opts = do providerTemplates = ptp, teamTemplates = ttp, templateBranding = branding, + templateBrandingAsMap = brandingAsMap, httpManager = mgr, http2Manager = h2Mgr, extGetManager = ext, @@ -444,10 +449,16 @@ teamTemplatesWithLocale l = forLocale l <$> asks (.teamTemplates) providerTemplatesWithLocale :: (MonadReader Env m) => Maybe Locale -> m (Locale, ProviderTemplates) providerTemplatesWithLocale l = forLocale l <$> asks (.providerTemplates) --- this works because team templates is not affected by `forLocale`; it is useful where we --- use the `TeamTemplates` only for finding invitation url templates (those are not localized). -teamTemplatesNoLocale :: (MonadReader Env m) => m TeamTemplates -teamTemplatesNoLocale = snd <$> teamTemplatesWithLocale Nothing +invitationUrlTemplates :: (MonadReader Env m) => m InvitationUrlTemplates +invitationUrlTemplates = do + -- this works because team templates is not affected by `forLocale`; it is useful where we + -- use the `TeamTemplates` only for finding invitation url templates (those are not localized). + teamTemplates <- snd <$> teamTemplatesWithLocale Nothing + pure $ + InvitationUrlTemplates + { personalUser = teamTemplates.existingUserInvitationEmail.invitationEmailUrl, + newUser = teamTemplates.invitationEmail.invitationEmailUrl + } closeEnv :: Env -> IO () closeEnv e = do diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index 13bef0bfbc6..727526a406b 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -30,7 +30,7 @@ import Brig.Effects.UserPendingActivationStore.Cassandra (userPendingActivationS import Brig.IO.Intra (runEvents) import Brig.Options (federationDomainConfigs, federationStrategy) import Brig.Options qualified as Opt -import Brig.Team.Template (TeamTemplates) +import Brig.Template (InvitationUrlTemplates) import Brig.User.Search.Index (IndexEnv (..)) import Cassandra qualified as Cas import Control.Exception (ErrorCall) @@ -210,7 +210,7 @@ type BrigLowerLevelEffects = Input VerificationCodeThrottleTTL, Input (Local ()), Input (AuthenticationSubsystemConfig), - Input TeamTemplates, + Input InvitationUrlTemplates, GundeckAPIAccess, FederationConfigStore, Jwk, @@ -345,7 +345,7 @@ runBrigToIO e (AppT ma) = do . interpretJwk . interpretFederationDomainConfig e.casClient e.settings.federationStrategy (foldMap (remotesMapFromCfgFile . fmap (.federationDomainConfig)) e.settings.federationDomainConfigs) . runGundeckAPIAccess e.gundeckEndpoint - . runInputConst (teamTemplatesNoLocale e) + . runInputConst (invitationUrlTemplates e) . runInputConst authenticationSubsystemConfig . runInputConst localUnit . runInputConst (fromIntegral $ Opt.twoFACodeGenerationDelaySecs e.settings) @@ -389,7 +389,7 @@ runBrigToIO e (AppT ma) = do . runDeleteQueue e.internalEvents . interpretPropertySubsystem propertySubsystemConfig . interpretVerificationCodeSubsystem - . emailSubsystemInterpreter e.userTemplates e.teamTemplates e.templateBranding + . emailSubsystemInterpreter e.userTemplates e.teamTemplates e.templateBrandingAsMap . interpretAppStoreToPostgres . interpretTeamCollaboratorsStoreToPostgres . interpretTeamSubsystemToGalleyAPI diff --git a/services/brig/src/Brig/Data/Client.hs b/services/brig/src/Brig/Data/Client.hs index b94e0dd00df..33248f0962d 100644 --- a/services/brig/src/Brig/Data/Client.hs +++ b/services/brig/src/Brig/Data/Client.hs @@ -63,7 +63,6 @@ import Control.Lens import Control.Monad.Catch import Control.Monad.Random (randomRIO) import Control.Retry -import Data.ByteString.Base64 qualified as B64 import Data.ByteString.Conversion (toByteString, toByteString') import Data.ByteString.Lazy qualified as LBS import Data.HashMap.Strict qualified as HashMap @@ -78,8 +77,6 @@ import Data.UUID qualified as UUID import Imports import Polysemy (Member) import Prometheus qualified as Prom -import System.CryptoBox (Result (Success)) -import System.CryptoBox qualified as CryptoBox import System.Logger.Class (field, msg, val) import System.Logger.Class qualified as Log import UnliftIO (pooledMapConcurrentlyN) @@ -268,21 +265,15 @@ updateClientLastActive u c t = updateClientLastActiveQuery (params LocalQuorum (t, u, c)) -updatePrekeys :: (MonadClient m) => UserId -> ClientId -> [Prekey] -> ExceptT ClientDataError m () +updatePrekeys :: (MonadClient m) => UserId -> ClientId -> [UncheckedPrekeyBundle] -> ExceptT ClientDataError m () updatePrekeys u c pks = do - plain <- mapM (hoistEither . fmapL (const MalformedPrekeys) . B64.decode . toByteString' . prekeyKey) pks - binary <- liftIO $ zipWithM check pks plain - unless (and binary) $ + unless (all check pks) $ throwE MalformedPrekeys for_ pks $ \k -> do let args = (u, c, prekeyId k, prekeyKey k) retry x5 $ write insertClientKey (params LocalQuorum args) where - check a b = do - i <- CryptoBox.isPrekey b - case i of - Success n -> pure (CryptoBox.prekeyId n == keyId (prekeyId a)) - _ -> pure False + check pk = parsePrekeyBundlePrekeyId pk == Right (prekeyId pk) claimPrekey :: ( Log.MonadLogger m, @@ -315,7 +306,7 @@ claimPrekey u c = field "user" (toByteString u) . field "client" (toByteString c) . msg (val "last resort prekey used") - pure $ Just (ClientPrekey c (Prekey i k)) + pure $ Just (ClientPrekey c (UncheckedPrekeyBundle i k)) removeAndReturnPreKey Nothing = pure Nothing pickRandomPrekey :: (MonadIO f) => [(PrekeyId, Text)] -> f (Maybe (PrekeyId, Text)) diff --git a/services/brig/src/Brig/Effects/JwtTools.hs b/services/brig/src/Brig/Effects/JwtTools.hs index d50b4090e79..4163490c286 100644 --- a/services/brig/src/Brig/Effects/JwtTools.hs +++ b/services/brig/src/Brig/Effects/JwtTools.hs @@ -63,8 +63,6 @@ data JwtTools m a where Word16 -> -- | The expiration date and time, in seconds since "the epoch" Epoch -> - -- | Current time in seconds since "the epoch" - Epoch -> -- | PEM format concatenated private key and public key of the Wire backend PEMKeys -> JwtTools m (Either CertEnrollmentError DPoPAccessToken) @@ -73,7 +71,7 @@ makeSem ''JwtTools interpretJwtTools :: (Member (Embed IO) r) => Sem (JwtTools ': r) a -> Sem r a interpretJwtTools = interpret $ \case - GenerateDPoPAccessToken proof cid handle displayName tid nonce uri method skew ex now pem -> + GenerateDPoPAccessToken proof cid handle displayName tid nonce uri method skew ex pem -> mapLeft RustError <$> runExceptT ( DPoPAccessToken @@ -90,7 +88,6 @@ interpretJwtTools = interpret $ \case method (Jwt.MaxSkewSecs skew) (Jwt.ExpiryEpoch (epochNumber ex)) - (Jwt.NowEpoch (epochNumber now)) (Jwt.PemBundle (toByteString' pem)) ) where diff --git a/services/brig/src/Brig/Index/Eval.hs b/services/brig/src/Brig/Index/Eval.hs index dbc6a74f953..523582c1c70 100644 --- a/services/brig/src/Brig/Index/Eval.hs +++ b/services/brig/src/Brig/Index/Eval.hs @@ -22,11 +22,10 @@ module Brig.Index.Eval where import Brig.App (initHttpManagerWithTLSConfig, mkIndexEnv) -import Brig.Index.Options -import Brig.Options +import Brig.Index.Options as IxOpts +import Brig.Options as Opt import Brig.User.Search.Index import Cassandra (Client, runClient) -import Cassandra.Options import Cassandra.Util (defInitCassandra) import Control.Exception (throwIO) import Control.Lens @@ -39,16 +38,21 @@ import Data.Credentials (Credentials (..)) import Data.Id import Database.Bloodhound qualified as ES import Database.Bloodhound.Internal.Client (BHEnv (..)) +import Hasql.Pool +import Hasql.Pool.Extended import Imports import Polysemy import Polysemy.Embed (runEmbedded) import Polysemy.Error +import Polysemy.Input import Polysemy.TinyLog hiding (Logger) import System.Logger qualified as Log import System.Logger.Class (Logger) -import Util.Options (initCredentials) +import Util.Options import Wire.API.Federation.Client (FederatorClient) import Wire.API.Federation.Error +import Wire.AppStore +import Wire.AppStore.Postgres import Wire.BlockListStore (BlockListStore) import Wire.BlockListStore.Cassandra import Wire.FederationAPIAccess @@ -86,6 +90,7 @@ type BrigIndexEffectStack = FederationAPIAccess FederatorClient, Error FederationError, UserStore, + AppStore, IndexedUserStore, Error IndexedUserStoreError, IndexedUserMigrationStore, @@ -97,15 +102,18 @@ type BrigIndexEffectStack = Metrics, TinyLog, Concurrency 'Unsafe, + Input Pool, + Error UsageError, Embed IO, Final IO ] -runSem :: ESConnectionSettings -> CassandraSettings -> Endpoint -> Logger -> Sem BrigIndexEffectStack a -> IO a -runSem esConn cas galleyEndpoint logger action = do +runSem :: ESConnectionSettings -> CassandraSettings -> PostgresSettings -> Endpoint -> Logger -> Sem BrigIndexEffectStack a -> IO a +runSem esConn cas pg galleyEndpoint logger action = do mgr <- initHttpManagerWithTLSConfig esConn.esInsecureSkipVerifyTls esConn.esCaCert mEsCreds :: Maybe Credentials <- for esConn.esCredentials initCredentials casClient <- defInitCassandra (toCassandraOpts cas) logger + pgPool <- initPostgresPool pg.pool pg.settings pg.passwordFile let bhEnv = BHEnv { bhServer = toESServer esConn.esServer, @@ -125,6 +133,8 @@ runSem esConn cas galleyEndpoint logger action = do migrationIndexName = fromMaybe defaultMigrationIndexName (esMigrationIndexName esConn) runFinal . embedToFinal + . throwErrorToIOFinal @UsageError + . runInputConst pgPool . unsafelyPerformConcurrency . loggerToTinyLogReqId reqId logger . ignoreMetrics @@ -138,6 +148,7 @@ runSem esConn cas galleyEndpoint logger action = do . interpretIndexedUserMigrationStoreES bhEnv migrationIndexName . throwErrorToIOFinal @IndexedUserStoreError . interpretIndexedUserStoreES indexedUserStoreConfig + . interpretAppStoreToPostgres . interpretUserStoreCassandra casClient . throwErrorToIOFinal @FederationError . noFederationAPIAccess @@ -161,17 +172,17 @@ runCommand l = \case Reset es galley -> do e <- initIndex l (es ^. esConnection) galley runIndexIO e $ resetIndex (mkCreateIndexSettings es) - Reindex es cas galley -> do - runSem (es ^. esConnection) cas galley l $ + Reindex es cas pg galley -> do + runSem (es ^. esConnection) cas pg galley l $ IndexedUserStoreBulk.syncAllUsers - ReindexSameOrNewer es cas galley -> do - runSem (es ^. esConnection) cas galley l $ + ReindexSameOrNewer es cas pg galley -> do + runSem (es ^. esConnection) cas pg galley l $ IndexedUserStoreBulk.forceSyncAllUsers UpdateMapping esConn galley -> do e <- initIndex l esConn galley runIndexIO e updateMapping - Migrate es cas galley -> do - runSem (es ^. esConnection) cas galley l $ + Migrate es cas pg galley -> do + runSem (es ^. esConnection) cas pg galley l $ IndexedUserStoreBulk.migrateData ReindexFromAnotherIndex reindexSettings -> do mgr <- diff --git a/services/brig/src/Brig/Index/Options.hs b/services/brig/src/Brig/Index/Options.hs index f72db003042..8b0966d25f5 100644 --- a/services/brig/src/Brig/Index/Options.hs +++ b/services/brig/src/Brig/Index/Options.hs @@ -34,7 +34,9 @@ module Brig.Index.Options cPort, cTlsCa, cKeyspace, + PostgresSettings (..), localElasticSettings, + brigOptsToPostgresSettings, localCassandraSettings, commandParser, mkCreateIndexSettings, @@ -47,13 +49,23 @@ module Brig.Index.Options where import Brig.Index.Types (CreateIndexSettings (..)) +import Brig.Options qualified as Opts import Cassandra qualified as C import Control.Lens +import Data.Aeson as Aeson +import Data.Aeson.Key qualified as AKey +import Data.Aeson.KeyMap qualified as AKM +import Data.Aeson.Text qualified as Aeson import Data.ByteString.Lens +import Data.Map qualified as Map +import Data.Misc import Data.Text qualified as Text +import Data.Text.Encoding (encodeUtf8) +import Data.Text.Lazy qualified as LText import Data.Text.Strict.Lens -import Data.Time.Clock (NominalDiffTime) +import Data.Time (NominalDiffTime) import Database.Bloodhound qualified as ES +import Hasql.Pool.Extended import Imports import Options.Applicative import URI.ByteString @@ -63,11 +75,11 @@ import Util.Options (CassandraOpts (..), Endpoint (..), FilePathSecrets) data Command = Create ElasticSettings Endpoint | Reset ElasticSettings Endpoint - | Reindex ElasticSettings CassandraSettings Endpoint - | ReindexSameOrNewer ElasticSettings CassandraSettings Endpoint + | Reindex ElasticSettings CassandraSettings PostgresSettings Endpoint + | ReindexSameOrNewer ElasticSettings CassandraSettings PostgresSettings Endpoint | -- | 'ElasticSettings' has shards and other settings that are not needed here. UpdateMapping ESConnectionSettings Endpoint - | Migrate ElasticSettings CassandraSettings Endpoint + | Migrate ElasticSettings CassandraSettings PostgresSettings Endpoint | ReindexFromAnotherIndex ReindexFromAnotherIndexSettings deriving (Show) @@ -90,6 +102,15 @@ data ElasticSettings = ElasticSettings } deriving (Show) +data PostgresSettings = PostgresSettings + { pool :: !PoolConfig, + passwordFile :: !(Maybe FilePathSecrets), + -- | Postgresql settings, the key values must be in libpq format. + -- https://www.postgresql.org/docs/17/libpq-connect.html#LIBPQ-PARAMKEYWORDS + settings :: !(Map Text Text) + } + deriving (Show) + data CassandraSettings = CassandraSettings { _cHost :: String, _cPort :: Word16, @@ -147,6 +168,14 @@ localElasticSettings = _esDeleteTemplate = Nothing } +brigOptsToPostgresSettings :: Opts.Opts -> PostgresSettings +brigOptsToPostgresSettings opts = + PostgresSettings + { pool = opts.postgresqlPool, + passwordFile = opts.postgresqlPassword, + settings = opts.postgresql + } + localCassandraSettings :: CassandraSettings localCassandraSettings = CassandraSettings @@ -297,6 +326,70 @@ credentialsPathParser = ) ) +postgresSettingsParser :: Parser PostgresSettings +postgresSettingsParser = + PostgresSettings + <$> poolConfigParser + <*> optional + ( strOption + ( long "pg-password-file" + <> metavar "FILE" + <> help "File containing PostgreSQL password" + ) + ) + <*> option + (eitherReader parseJsonMap) + ( long "pg-settings" + <> metavar "JSON" + <> help "PostgreSQL connection parameters as JSON object" + <> value Map.empty + ) + +poolConfigParser :: Parser PoolConfig +poolConfigParser = + PoolConfig + <$> option + auto + ( long "pg-pool-size" + <> metavar "INT" + <> help "Connection pool size" + <> value 10 + ) + <*> option + (eitherReader (parseDuration . Text.pack)) + ( long "pg-pool-acquisition-timeout" + <> metavar "Duration" + <> help "Pool acquisition timeout in seconds" + <> value (unsafeParseDuration "10s") + ) + <*> option + (eitherReader (parseDuration . Text.pack)) + ( long "pg-pool-aging-timeout" + <> metavar "Duration" + <> help "Pool aging timeout in seconds" + <> value (unsafeParseDuration "1d") + ) + <*> option + (eitherReader (parseDuration . Text.pack)) + ( long "pg-pool-idleness-timeout" + <> metavar "Duration" + <> help "Pool idleness timeout in seconds" + <> value (unsafeParseDuration "10m") + ) + +parseJsonMap :: String -> Either String (Map Text Text) +parseJsonMap s = do + Aeson.eitherDecodeStrict' (encodeUtf8 (Text.pack s)) >>= \case + Object hmap -> pure $ Map.fromList $ bimap AKey.toText valueToText <$> AKM.toList hmap + bad -> Left $ "invalid json object: " <> show bad + where + valueToText :: Value -> Text + valueToText (String t) = t + valueToText (Bool b) = (if b then "true" else "false") + valueToText (Number n) = (Text.pack (show n)) + valueToText Null = "null" + valueToText v = LText.toStrict (Aeson.encodeToLazyText v) + cassandraSettingsParser :: Parser CassandraSettings cassandraSettingsParser = CassandraSettings @@ -394,19 +487,19 @@ commandParser = <> command "reindex" ( info - (Reindex <$> elasticSettingsParser <*> cassandraSettingsParser <*> galleyEndpointParser) + (Reindex <$> elasticSettingsParser <*> cassandraSettingsParser <*> postgresSettingsParser <*> galleyEndpointParser) (progDesc "Reindex all users from Cassandra if there is a new version.") ) <> command "reindex-if-same-or-newer" ( info - (ReindexSameOrNewer <$> elasticSettingsParser <*> cassandraSettingsParser <*> galleyEndpointParser) + (ReindexSameOrNewer <$> elasticSettingsParser <*> cassandraSettingsParser <*> postgresSettingsParser <*> galleyEndpointParser) (progDesc "Reindex all users from Cassandra, even if the version has not changed.") ) <> command "migrate-data" ( info - (Migrate <$> elasticSettingsParser <*> cassandraSettingsParser <*> galleyEndpointParser) + (Migrate <$> elasticSettingsParser <*> cassandraSettingsParser <*> postgresSettingsParser <*> galleyEndpointParser) (progDesc "Migrate data in elastic search") ) <> command diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index 603aeaa5e48..86c7ffb13e8 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -898,7 +898,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)) (\u -> pure $ Public.mkUserProfile EmailVisibleToSelf u UserLegalHoldNoConsent) p + maybe (throwStd (errorToWai @'E.UserNotFound)) (\u -> pure $ Public.mkUserProfile EmailVisibleToSelf UserTypeBot u UserLegalHoldNoConsent) p botGetClient :: (Member GalleyAPIAccess r) => BotId -> (Handler r) (Maybe Public.Client) botGetClient bot = do diff --git a/services/brig/src/Brig/Provider/Email.hs b/services/brig/src/Brig/Provider/Email.hs index b5c168d4e33..5d8b558dced 100644 --- a/services/brig/src/Brig/Provider/Email.hs +++ b/services/brig/src/Brig/Provider/Email.hs @@ -31,6 +31,7 @@ import Data.Range import Data.Text (pack) import Data.Text.Ascii qualified as Ascii import Data.Text.Lazy qualified as LT +import Data.Text.Template import Imports import Network.Mail.Mime import Polysemy diff --git a/services/brig/src/Brig/Provider/Template.hs b/services/brig/src/Brig/Provider/Template.hs index 2c50f22fcd6..50a0eab4c93 100644 --- a/services/brig/src/Brig/Provider/Template.hs +++ b/services/brig/src/Brig/Provider/Template.hs @@ -21,11 +21,7 @@ module Brig.Provider.Template ApprovalRequestEmailTemplate (..), ApprovalConfirmEmailTemplate (..), PasswordResetEmailTemplate (..), - -- , TODO: NewServiceEmailTemplate (..) loadProviderTemplates, - - -- * Re-exports - Template, ) where @@ -34,9 +30,10 @@ import Brig.Template import Data.ByteString.Conversion (fromByteString) import Data.Misc (HttpsUrl) import Data.Text.Encoding (encodeUtf8) +import Data.Text.Template import Imports import Wire.API.User.Identity -import Wire.EmailSubsystem.Template +import Wire.EmailSubsystem.Templates.User data ProviderTemplates = ProviderTemplates { activationEmail :: !ActivationEmailTemplate, @@ -65,15 +62,6 @@ data ApprovalConfirmEmailTemplate = ApprovalConfirmEmailTemplate approvalConfirmEmailHomeUrl :: !HttpsUrl } --- TODO --- data NewServiceEmailTemplate = NewServiceEmailTemplate --- { newServiceEmailSubject :: !Template --- , newServiceEmailBodyText :: !Template --- , newServiceEmailBodyHtml :: !Template --- , newServiceEmailSender :: !Email --- , newServiceEmailSenderName :: !Text --- } - loadProviderTemplates :: Opts -> IO (Localised ProviderTemplates) loadProviderTemplates o = readLocalesDir defLocale (templateDir gOptions) "provider" $ \fp -> ProviderTemplates diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 5b8022812ef..2ee190aa815 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -32,6 +32,7 @@ import Brig.API.User qualified as API import Brig.API.Util (logEmail, logInvitationCode) import Brig.App as App import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) +import Brig.Template import Brig.Types.Team (TeamSize) import Control.Lens (view, (^.)) import Control.Monad.Trans.Except @@ -47,6 +48,7 @@ import Network.Wai.Utilities hiding (Error, code, message) import Polysemy import Polysemy.Error import Polysemy.Input (Input, input) +import Polysemy.Output (ignoreOutput) import Polysemy.TinyLog (TinyLog) import Polysemy.TinyLog qualified as Log import Servant hiding (Handler, JSON, addHeader) @@ -70,7 +72,6 @@ import Wire.API.User hiding (fromEmail) import Wire.AuthenticationSubsystem import Wire.BlockListStore import Wire.EmailSubsystem.Interpreter (renderInvitationUrl) -import Wire.EmailSubsystem.Template import Wire.Error import Wire.Events (Events) import Wire.GalleyAPIAccess (GalleyAPIAccess, ShowOrHideInvitationUrl (..)) @@ -95,7 +96,7 @@ servantAPI :: Member UserSubsystem r, Member Store.InvitationStore r, Member TinyLog r, - Member (Input TeamTemplates) r, + Member (Input InvitationUrlTemplates) r, Member (Input (Local ())) r, Member (Error UserSubsystemError) r, Member IndexedUserStore r, @@ -221,7 +222,7 @@ listInvitations :: ( Member GalleyAPIAccess r, Member TinyLog r, Member InvitationStore r, - Member (Input TeamTemplates) r, + Member (Input InvitationUrlTemplates) r, Member (Input (Local ())) r, Member UserSubsystem r, Member (Error UserSubsystemError) r, @@ -253,15 +254,15 @@ listInvitations uid tid startingId mSize = do isPersonalUserMigration <- isPersonalUser (mkEmailKey si.email) template <- if isPersonalUserMigration - then invitationEmailUrl . existingUserInvitationEmail <$> input - else invitationEmailUrl . invitationEmail <$> input - let url = renderInvitationUrl template tid si.code id + then (.personalUser) <$> input @InvitationUrlTemplates + else (.newUser) <$> input @InvitationUrlTemplates + url <- ignoreOutput $ renderInvitationUrl template tid si.code toInvitation url ShowInvitationUrl si mkInviteUrl :: forall r. ( Member TinyLog r, - Member (Input TeamTemplates) r + Member (Input InvitationUrlTemplates) r ) => ShowOrHideInvitationUrl -> TeamId -> @@ -269,8 +270,8 @@ mkInviteUrl :: Sem r (Maybe (URIRef Absolute)) mkInviteUrl HideInvitationUrl _ _ = pure Nothing mkInviteUrl ShowInvitationUrl team c = do - template <- invitationEmailUrl . invitationEmail <$> input - let url = renderInvitationUrl template team c id + template <- (.newUser) <$> input + url <- ignoreOutput $ renderInvitationUrl template team c parseHttpsUrl url where parseHttpsUrl :: Text -> Sem r (Maybe (URIRef Absolute)) @@ -288,7 +289,7 @@ getInvitation :: ( Member GalleyAPIAccess r, Member InvitationStore r, Member TinyLog r, - Member (Input TeamTemplates) r, + Member (Input InvitationUrlTemplates) r, Member (Error UserSubsystemError) r, Member TeamSubsystem r ) => diff --git a/services/brig/src/Brig/Team/Email.hs b/services/brig/src/Brig/Team/Email.hs deleted file mode 100644 index 90dc3519483..00000000000 --- a/services/brig/src/Brig/Team/Email.hs +++ /dev/null @@ -1,98 +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.Team.Email - ( sendMemberWelcomeMail, - sendNewTeamOwnerWelcomeEmail, - ) -where - -import Brig.App -import Brig.Team.Template -import Data.Id (TeamId, idToText) -import Data.Text.Lazy (toStrict) -import Imports -import Network.Mail.Mime -import Polysemy -import Wire.API.User -import Wire.EmailSending -import Wire.EmailSubsystem.Template - -sendMemberWelcomeMail :: (Member EmailSending r) => EmailAddress -> TeamId -> Text -> Maybe Locale -> (AppT r) () -sendMemberWelcomeMail to tid teamName loc = do - tpl <- memberWelcomeEmail . snd <$> teamTemplatesWithLocale loc - branding <- asks (.templateBranding) - liftSem $ sendMail $ renderMemberWelcomeMail to tid teamName tpl branding - -sendNewTeamOwnerWelcomeEmail :: (Member EmailSending r) => EmailAddress -> TeamId -> Text -> Maybe Locale -> Name -> (AppT r) () -sendNewTeamOwnerWelcomeEmail to tid teamName loc profileName = do - tpl <- newTeamOwnerWelcomeEmail . snd <$> teamTemplatesWithLocale loc - branding <- asks (.templateBranding) - liftSem $ sendMail $ renderNewTeamOwnerWelcomeEmail to tid teamName profileName tpl branding - -------------------------------------------------------------------------------- --- Member Welcome Email - -renderMemberWelcomeMail :: EmailAddress -> TeamId -> Text -> MemberWelcomeEmailTemplate -> TemplateBranding -> Mail -renderMemberWelcomeMail emailTo tid teamName MemberWelcomeEmailTemplate {..} branding = - (emptyMail from) - { mailTo = [to], - mailHeaders = - [ ("Subject", toStrict subj), - ("X-Zeta-Purpose", "Welcome") - ], - mailParts = [[plainPart txt, htmlPart html]] - } - where - from = Address (Just memberWelcomeEmailSenderName) (fromEmail memberWelcomeEmailSender) - to = Address Nothing (fromEmail emailTo) - txt = renderTextWithBranding memberWelcomeEmailBodyText replace branding - html = renderHtmlWithBranding memberWelcomeEmailBodyHtml replace branding - subj = renderTextWithBranding memberWelcomeEmailSubject replace branding - replace "url" = memberWelcomeEmailUrl - replace "email" = fromEmail emailTo - replace "team_id" = idToText tid - replace "team_name" = teamName - replace x = x - -------------------------------------------------------------------------------- --- New Team Owner Welcome Email - -renderNewTeamOwnerWelcomeEmail :: EmailAddress -> TeamId -> Text -> Name -> NewTeamOwnerWelcomeEmailTemplate -> TemplateBranding -> Mail -renderNewTeamOwnerWelcomeEmail emailTo tid teamName profileName NewTeamOwnerWelcomeEmailTemplate {..} branding = - (emptyMail from) - { mailTo = [to], - mailHeaders = - [ ("Subject", toStrict subj), - ("X-Zeta-Purpose", "Welcome") - ], - mailParts = [[plainPart txt, htmlPart html]] - } - where - from = Address (Just newTeamOwnerWelcomeEmailSenderName) (fromEmail newTeamOwnerWelcomeEmailSender) - to = Address Nothing (fromEmail emailTo) - txt = renderTextWithBranding newTeamOwnerWelcomeEmailBodyText replace branding - html = renderHtmlWithBranding newTeamOwnerWelcomeEmailBodyHtml replace branding - subj = renderTextWithBranding newTeamOwnerWelcomeEmailSubject replace branding - replace "url" = newTeamOwnerWelcomeEmailUrl - replace "email" = fromEmail emailTo - replace "team_id" = idToText tid - replace "team_name" = teamName - replace "name" = profileName.fromName - replace x = x diff --git a/services/brig/src/Brig/Team/Template.hs b/services/brig/src/Brig/Team/Template.hs index 4ca5feccfdf..2d2526d558e 100644 --- a/services/brig/src/Brig/Team/Template.hs +++ b/services/brig/src/Brig/Team/Template.hs @@ -18,19 +18,16 @@ module Brig.Team.Template ( TeamTemplates (..), InvitationEmailTemplate (..), - CreatorWelcomeEmailTemplate (..), MemberWelcomeEmailTemplate (..), loadTeamTemplates, - - -- * Re-exports - Template, ) where import Brig.Options import Brig.Template +import Data.Text.Template import Imports -import Wire.EmailSubsystem.Template +import Wire.EmailSubsystem.Templates.Team loadTeamTemplates :: Opts -> IO (Localised TeamTemplates) loadTeamTemplates o = readLocalesDir defLocale (templateDir gOptions) "team" $ \fp -> @@ -49,13 +46,6 @@ loadTeamTemplates o = readLocalesDir defLocale (templateDir gOptions) "team" $ \ <*> pure (emailSender gOptions) <*> readText fp "email/sender.txt" ) - <*> ( CreatorWelcomeEmailTemplate (tCreatorWelcomeUrl tOptions) - <$> readTemplate fp "email/new-creator-welcome-subject.txt" - <*> readTemplate fp "email/new-creator-welcome.txt" - <*> readTemplate fp "email/new-creator-welcome.html" - <*> pure (emailSender gOptions) - <*> readText fp "email/sender.txt" - ) <*> ( MemberWelcomeEmailTemplate (tMemberWelcomeUrl tOptions) <$> readTemplate fp "email/new-member-welcome-subject.txt" <*> readTemplate fp "email/new-member-welcome.txt" diff --git a/services/brig/src/Brig/Template.hs b/services/brig/src/Brig/Template.hs index 906f395d8ef..778c59815a3 100644 --- a/services/brig/src/Brig/Template.hs +++ b/services/brig/src/Brig/Template.hs @@ -19,18 +19,13 @@ -- | Common templating utilities. module Brig.Template - ( -- * Reading templates + ( InvitationUrlTemplates (..), Localised, readLocalesDir, readTemplateWithDefault, readTextWithDefault, - - -- * Rendering templates genTemplateBranding, - - -- * Re-exports - Template, - template, + genTemplateBrandingMap, ) where @@ -46,6 +41,11 @@ import System.IO.Error (isDoesNotExistError) import Wire.API.User import Wire.EmailSubsystem.Template (Localised (Localised)) +data InvitationUrlTemplates = InvitationUrlTemplates + { personalUser :: Template, + newUser :: Template + } + -- | See 'genTemplateBranding'. type TemplateBranding = Text -> Text @@ -150,3 +150,18 @@ genTemplateBranding BrandingOpts {..} = fn fn "forgot" = forgot fn "support" = support fn other = other + +genTemplateBrandingMap :: BrandingOpts -> Map Text Text +genTemplateBrandingMap opts = + Map.fromList + [ ("brand", opts.brand), + ("brand_url", opts.brandUrl), + ("brand_label_url", opts.brandLabelUrl), + ("brand_logo", opts.brandLogoUrl), + ("brand_service", opts.brandService), + ("copyright", opts.copyright), + ("misuse", opts.misuse), + ("legal", opts.legal), + ("forgot", opts.forgot), + ("support", opts.support) + ] diff --git a/services/brig/src/Brig/User/API/Handle.hs b/services/brig/src/Brig/User/API/Handle.hs index 0b97637255e..ecad744a942 100644 --- a/services/brig/src/Brig/User/API/Handle.hs +++ b/services/brig/src/Brig/User/API/Handle.hs @@ -101,5 +101,6 @@ contactFromProfile profile = contactName = fromName $ profileName profile, contactHandle = fromHandle <$> profileHandle profile, contactColorId = Just . fromIntegral . fromColourId $ profileAccentId profile, - contactTeam = profileTeam profile + contactTeam = profileTeam profile, + contactType = profileType profile } diff --git a/services/brig/src/Brig/User/Search/Index.hs b/services/brig/src/Brig/User/Search/Index.hs index 634f059559f..4c4919729d9 100644 --- a/services/brig/src/Brig/User/Search/Index.hs +++ b/services/brig/src/Brig/User/Search/Index.hs @@ -466,6 +466,14 @@ indexMapping = mpIndex = True, mpAnalyzer = Nothing, mpFields = mempty + }, + "type" + .= MappingProperty + { mpType = MPKeyword, + mpStore = False, + mpIndex = True, + mpAnalyzer = Nothing, + mpFields = mempty } ] ] diff --git a/services/brig/src/Brig/User/Search/SearchIndex.hs b/services/brig/src/Brig/User/Search/SearchIndex.hs index da1458aa415..b648bb0cf7a 100644 --- a/services/brig/src/Brig/User/Search/SearchIndex.hs +++ b/services/brig/src/Brig/User/Search/SearchIndex.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StrictData #-} -- This file is part of the Wire Server implementation. @@ -30,12 +29,11 @@ import Control.Lens hiding (setting, (#), (.=)) import Control.Monad.Catch (MonadThrow, throwM) import Data.Aeson.Key qualified as Key import Data.Domain (Domain) -import Data.Handle (Handle (fromHandle)) import Data.Id import Data.Qualified (Qualified (Qualified)) import Database.Bloodhound qualified as ES import Imports hiding (log, searchable) -import Wire.API.User (ColourId (..), Name (fromName)) +import Wire.API.User (Name (fromName)) import Wire.API.User.Search import Wire.IndexedUserStore (IndexedUserStoreError (..)) import Wire.IndexedUserStore.ElasticSearch (mappingName) @@ -80,7 +78,7 @@ queryIndex (IndexQuery q f _) s = do r <- ES.searchByType idx mappingName search >>= ES.parseEsResponse @_ @(ES.SearchResult UserDoc) - either (throwM . IndexLookupError) (traverse (userDocToContact localDomain) . mkResult) r + either (throwM . IndexLookupError) (traverse (userDocToContact' localDomain) . mkResult) r where mkResult es = let results = mapMaybe ES.hitSource . ES.hits . ES.searchHits $ es @@ -94,14 +92,12 @@ queryIndex (IndexQuery q f _) s = do searchHasMore = Nothing } -userDocToContact :: (MonadThrow m) => Domain -> UserDoc -> m Contact -userDocToContact localDomain UserDoc {..} = do - let contactQualifiedId = Qualified udId localDomain - contactName <- maybe (throwM $ IndexError "Name not found") (pure . fromName) udName - let contactColorId = fromIntegral . fromColourId <$> udColourId - contactHandle = fromHandle <$> udHandle - contactTeam = udTeam - pure $ Contact {..} + userDocToContact' :: (MonadThrow m) => Domain -> UserDoc -> m Contact + userDocToContact' localDomain userDoc = do + userDocToContact + (Qualified userDoc.udId localDomain) + (maybe (throwM $ IndexError "Name not found") (pure . fromName)) + userDoc -- | The default or canonical 'IndexQuery'. -- diff --git a/services/brig/src/Brig/User/Template.hs b/services/brig/src/Brig/User/Template.hs index 110d979bc80..ff5304519e9 100644 --- a/services/brig/src/Brig/User/Template.hs +++ b/services/brig/src/Brig/User/Template.hs @@ -15,44 +15,18 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Brig.User.Template - ( UserTemplates (..), - ActivationSmsTemplate (..), - VerificationEmailTemplate (..), - ActivationEmailTemplate (..), - TeamActivationEmailTemplate (..), - ActivationCallTemplate (..), - PasswordResetSmsTemplate (..), - PasswordResetEmailTemplate (..), - LoginSmsTemplate (..), - LoginCallTemplate (..), - DeletionSmsTemplate (..), - DeletionEmailTemplate (..), - NewClientEmailTemplate (..), - SecondFactorVerificationEmailTemplate (..), - loadUserTemplates, - - -- * Re-exports - Template, - ) -where +module Brig.User.Template (loadUserTemplates) where import Brig.Options qualified as Opt import Brig.Template +import Data.Text.Template import Imports -import Wire.EmailSubsystem.Template +import Wire.EmailSubsystem.Templates.User loadUserTemplates :: Opt.Opts -> IO (Localised UserTemplates) loadUserTemplates o = readLocalesDir defLocale templateDir "user" $ \fp -> UserTemplates - <$> ( ActivationSmsTemplate smsActivationUrl - <$> readTemplate fp "sms/activation.txt" - <*> pure smsSender - ) - <*> ( ActivationCallTemplate - <$> readTemplate fp "call/activation.txt" - ) - <*> ( VerificationEmailTemplate activationUrl + <$> ( VerificationEmailTemplate activationUrl <$> readTemplate fp "email/verification-subject.txt" <*> readTemplate fp "email/verification.txt" <*> readTemplate fp "email/verification.html" @@ -80,10 +54,6 @@ loadUserTemplates o = readLocalesDir defLocale templateDir "user" $ \fp -> <*> pure emailSender <*> readText fp "email/sender.txt" ) - <*> ( PasswordResetSmsTemplate - <$> readTemplate fp "sms/password-reset.txt" - <*> pure smsSender - ) <*> ( PasswordResetEmailTemplate passwordResetUrl <$> readTemplate fp "email/password-reset-subject.txt" <*> readTemplate fp "email/password-reset.txt" @@ -91,17 +61,6 @@ loadUserTemplates o = readLocalesDir defLocale templateDir "user" $ \fp -> <*> pure emailSender <*> readText fp "email/sender.txt" ) - <*> ( LoginSmsTemplate smsActivationUrl - <$> readTemplate fp "sms/login.txt" - <*> pure smsSender - ) - <*> ( LoginCallTemplate - <$> readTemplate fp "call/login.txt" - ) - <*> ( DeletionSmsTemplate deletionUserUrl - <$> readTemplate fp "sms/deletion.txt" - <*> pure smsSender - ) <*> ( DeletionEmailTemplate deletionUserUrl <$> readTemplate fp "email/deletion-subject.txt" <*> readTemplate fp "email/deletion.txt" @@ -142,8 +101,6 @@ loadUserTemplates o = readLocalesDir defLocale templateDir "user" $ \fp -> uOptions = o.emailSMS.user tOptions = o.emailSMS.team emailSender = gOptions.emailSender - smsSender = gOptions.smsSender - smsActivationUrl = template uOptions.smsActivationUrl activationUrl = template uOptions.activationUrl teamActivationUrl = template tOptions.tActivationUrl passwordResetUrl = template uOptions.passwordResetUrl diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index 6500e1fa7c4..8458e31e23c 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/services/brig/test/integration/API/Provider.hs @@ -1411,7 +1411,7 @@ getBotPreKeyIds brig bid = . header "Z-Type" "bot" . header "Z-Bot" (toByteString' bid) -updateBotPrekeys :: Brig -> BotId -> [Prekey] -> Http ResponseLBS +updateBotPrekeys :: Brig -> BotId -> [UncheckedPrekeyBundle] -> Http ResponseLBS updateBotPrekeys brig bid prekeys = post $ brig @@ -1762,7 +1762,7 @@ data TestBot = TestBot testBotConv :: !Ext.BotConvView, testBotToken :: !Text, testBotLastPrekey :: !LastPrekey, - testBotPrekeys :: ![Prekey], + testBotPrekeys :: ![UncheckedPrekeyBundle], testBotLocale :: !Locale, testBotOrigin :: !Ext.BotUserView } diff --git a/services/brig/test/integration/API/Search.hs b/services/brig/test/integration/API/Search.hs index a4809993f05..2fb1fbdf5fa 100644 --- a/services/brig/test/integration/API/Search.hs +++ b/services/brig/test/integration/API/Search.hs @@ -40,7 +40,7 @@ import Brig.App (initHttpManagerWithTLSConfig) import Brig.Index.Eval (initIndex, runCommand) import Brig.Index.Options import Brig.Index.Options qualified as IndexOpts -import Brig.Options (ElasticSearchOpts) +import Brig.Options import Brig.Options qualified as Opt import Brig.Options qualified as Opts import Brig.User.Search.Index @@ -800,7 +800,7 @@ runReindexFromAnotherIndex logger opts newIndexName migrationIndexName = in runCommand logger $ ReindexFromAnotherIndex reindexSettings runReindexFromDatabase :: - (ElasticSettings -> CassandraSettings -> Endpoint -> Command) -> + (ElasticSettings -> CassandraSettings -> PostgresSettings -> Endpoint -> Command) -> Log.Logger -> Opt.Opts -> ES.IndexName -> @@ -819,14 +819,14 @@ runReindexFromDatabase syncCommand logger opts newIndexName migrationIndexName = & IndexOpts.esIndexShardCount .~ shards & IndexOpts.esIndexRefreshInterval .~ refreshInterval cassandraSettings :: CassandraSettings = - ( localCassandraSettings - & IndexOpts.cHost .~ (Text.unpack opts.cassandra.endpoint.host) - & IndexOpts.cPort .~ (opts.cassandra.endpoint.port) - & IndexOpts.cKeyspace .~ (C.Keyspace opts.cassandra.keyspace) - ) - + localCassandraSettings + & IndexOpts.cHost .~ (Text.unpack opts.cassandra.endpoint.host) + & IndexOpts.cPort .~ (opts.cassandra.endpoint.port) + & IndexOpts.cKeyspace .~ (C.Keyspace opts.cassandra.keyspace) + postgresSettings :: PostgresSettings = + brigOptsToPostgresSettings opts endpoint :: Endpoint = opts.galley - in runCommand logger $ syncCommand elasticSettings cassandraSettings endpoint + in runCommand logger $ syncCommand elasticSettings cassandraSettings postgresSettings endpoint toESConnectionSettings :: ElasticSearchOpts -> ES.IndexName -> ESConnectionSettings toESConnectionSettings opts migrationIndexName = ESConnectionSettings {..} diff --git a/services/brig/test/integration/API/Team.hs b/services/brig/test/integration/API/Team.hs index a8afd847fab..174eb48a4b8 100644 --- a/services/brig/test/integration/API/Team.hs +++ b/services/brig/test/integration/API/Team.hs @@ -43,7 +43,6 @@ import Data.LegalHold (UserLegalHoldStatus (UserLegalHoldDisabled)) import Data.String.Conversions (cs) import Data.Text qualified as Text import Data.Text.Ascii qualified as Ascii -import Data.Text.Encoding (encodeUtf8) import Data.UUID qualified as UUID (fromString) import Data.UUID.V4 qualified as UUID import Imports @@ -251,8 +250,7 @@ testInvitationUrl opts brig = do isJust invCode @? "Expect an invitation code in the backend" Just inviter @=? inv.createdBy tid @=? inv.team - getQueryParam "team_code" resp @=? (invCode <&> (toStrict . toByteString)) - getQueryParam "team" resp @=? (pure . encodeUtf8 . idToText) tid + getQueryParam "team-code" resp @=? (invCode <&> (toStrict . toByteString)) getQueryParam :: ByteString -> ResponseLBS -> Maybe ByteString getQueryParam name r = do diff --git a/services/brig/test/integration/API/Template.hs b/services/brig/test/integration/API/Template.hs new file mode 100644 index 00000000000..d5ef52cc0e2 --- /dev/null +++ b/services/brig/test/integration/API/Template.hs @@ -0,0 +1,235 @@ +module API.Template (tests) where + +import Bilge +import Brig.Options +import Brig.Team.Template (loadTeamTemplates) +import Brig.Template +import Brig.User.Template (loadUserTemplates) +import Data.Code +import Data.Id +import Data.Json.Util +import Data.Map qualified as Map +import Data.Range +import Data.Text.Ascii (AsciiChars (validate), encodeBase64Url) +import Data.Text.Ascii qualified as Ascii +import Data.Time (UTCTime (..), fromGregorian, secondsToDiffTime) +import Data.UUID qualified as UUID +import Imports +import Network.Mail.Mime +import Polysemy +import Polysemy.Output +import Test.Tasty +import Test.Tasty.HUnit +import Util +import Wire.API.Locale +import Wire.API.User (InvitationCode (InvitationCode, fromInvitationCode)) +import Wire.API.User.Activation +import Wire.API.User.Client (Client (..), ClientCapabilityList (..), ClientType (..)) +import Wire.API.User.EmailAddress +import Wire.API.User.Password +import Wire.API.User.Profile +import Wire.EmailSubsystem.Interpreter +import Wire.EmailSubsystem.Template +import Wire.EmailSubsystem.Templates.Team +import Wire.EmailSubsystem.Templates.User + +tests :: Opts -> Manager -> IO TestTree +tests opts m = do + team <- liftIO $ loadTeamTemplates opts + user <- liftIO $ loadUserTemplates opts + let teamTemplates = Map.assocs $ uncurry Map.insert team.locDefault team.locOther + userTemplates = Map.assocs $ uncurry Map.insert user.locDefault user.locOther + b = genTemplateBrandingMap opts.emailSMS.general.templateBranding + pure $ + testGroup + "email templates" + [ testGroup + "team" + $ fmap + ( \(loc, ts) -> + testGroup + (show loc) + [ test m "team invitation" $ testTeamInvitationEmail b ts, + test m "team invitation existing user" $ testTeamInvitationEmailExistingUser b ts, + test m "member welcome" $ testMemberWelcomeEmail b ts, + test m "new team owner welcome" $ testNewTeamOwnerWelcomeEmail b ts + ] + ) + teamTemplates, + testGroup "user" $ + fmap + ( \(loc, ts) -> + testGroup + (show loc) + [ test m "password reset email" $ testPasswordResetEmail b ts, + test m "verification email" $ testVerificationEmail b ts, + test m "team deletion verification email" $ testTeamDeletionVerificationEmail b ts, + test m "scim token verification email" $ testScimTokenVerificationEmail b ts, + test m "login verification email" $ testLoginVerificationEmail b ts, + test m "new client email" $ testNewClientEmail b loc ts, + test m "account deletion email" $ testAccountDeletionEmail b ts, + test m "activation email" $ testActivationEmail b ts, + test m "activation email update" $ testActivationEmailUpdate b ts, + test m "team activation email" $ testTeamActivationEmail b ts + ] + ) + userTemplates + ] + +testTeamInvitationEmailExistingUser :: (HasCallStack) => Map Text Text -> TeamTemplates -> Http () +testTeamInvitationEmailExistingUser branding templates = do + let tpl = templates.existingUserInvitationEmail + (errs, (mail, url)) = run $ runOutputList @Text $ renderInvitationEmail input tpl branding + input = + InvitationEmail + { invTo = fromJust $ emailAddressText "test@example.com", + invTeamId = Id (fromJust $ UUID.fromString "123e4567-e89b-12d3-a456-426614174000"), + invInvCode = InvitationCode {fromInvitationCode = fromRight undefined (validate "ZoMX0xs=")}, + invInviter = fromJust $ emailAddressText "inviter@example.com" + } + liftIO $ mail.mailFrom.addressEmail @?= (fromEmail tpl.invitationEmailSender) + liftIO $ url @?= "https://example.com/accept-invitation/?team-code=ZoMX0xs=" + assertNoErrors errs + +testTeamInvitationEmail :: (HasCallStack) => Map Text Text -> TeamTemplates -> Http () +testTeamInvitationEmail branding templates = do + let tpl = templates.invitationEmail + (errs, (mail, url)) = run $ runOutputList @Text $ renderInvitationEmail input tpl branding + input = + InvitationEmail + { invTo = fromJust $ emailAddressText "test@example.com", + invTeamId = Id (fromJust $ UUID.fromString "123e4567-e89b-12d3-a456-426614174000"), + invInvCode = InvitationCode {fromInvitationCode = fromRight undefined (validate "ZoMX0xs=")}, + invInviter = fromJust $ emailAddressText "inviter@example.com" + } + liftIO $ mail.mailFrom.addressEmail @?= (fromEmail tpl.invitationEmailSender) + liftIO $ url @?= "https://example.com/join/?team-code=ZoMX0xs=" + assertNoErrors errs + +testMemberWelcomeEmail :: (HasCallStack) => Map Text Text -> TeamTemplates -> Http () +testMemberWelcomeEmail branding templates = do + let tpl = templates.memberWelcomeEmail + to = fromJust $ emailAddressText "test@example.com" + tid = Id (fromJust $ UUID.fromString "123e4567-e89b-12d3-a456-426614174000") + tname = "funky team" + (errs, _) = run $ runOutputList @Text $ renderMemberWelcomeMail to tid tname tpl branding + assertNoErrors errs + +testNewTeamOwnerWelcomeEmail :: (HasCallStack) => Map Text Text -> TeamTemplates -> Http () +testNewTeamOwnerWelcomeEmail branding templates = do + let tpl = templates.newTeamOwnerWelcomeEmail + to = fromJust $ emailAddressText "test@example.com" + tid = Id (fromJust $ UUID.fromString "123e4567-e89b-12d3-a456-426614174000") + tname = "funky team" + name = Name "name" + (errs, _) = run $ runOutputList @Text $ renderNewTeamOwnerWelcomeEmail to tid tname name tpl branding + assertNoErrors errs + +testPasswordResetEmail :: (HasCallStack) => Map Text Text -> UserTemplates -> Http () +testPasswordResetEmail branding templates = do + let tpl = templates.passwordResetEmail + to = fromJust $ emailAddressText "test@example.com" + key = mkPasswordResetKey (Id UUID.nil) + code = PasswordResetCode . encodeBase64Url $ "bar" + (errs, _) = run $ runOutputList @Text $ renderPwResetMail to key code tpl branding + assertNoErrors errs + +testVerificationEmail :: (HasCallStack) => Map Text Text -> UserTemplates -> Http () +testVerificationEmail branding templates = do + let tpl = templates.verificationEmail + to = fromJust $ emailAddressText "test@example.com" + key = ActivationKey . Ascii.unsafeFromText $ "key" + code = ActivationCode . Ascii.unsafeFromText $ "code" + (errs, _) = run $ runOutputList @Text $ renderVerificationMail to key code tpl branding + assertNoErrors errs + +testTeamDeletionVerificationEmail :: (HasCallStack) => Map Text Text -> UserTemplates -> Http () +testTeamDeletionVerificationEmail branding templates = do + let tpl = templates.verificationTeamDeletionEmail + to = fromJust $ emailAddressText "test@example.com" + code = Value . unsafeRange . Ascii.unsafeFromText $ "code" + (errs, _) = run $ runOutputList @Text $ renderSecondFactorVerificationEmail to code tpl branding + assertNoErrors errs + +testScimTokenVerificationEmail :: (HasCallStack) => Map Text Text -> UserTemplates -> Http () +testScimTokenVerificationEmail branding templates = do + let tpl = templates.verificationScimTokenEmail + to = fromJust $ emailAddressText "test@example.com" + code = Value . unsafeRange . Ascii.unsafeFromText $ "code" + (errs, _) = run $ runOutputList @Text $ renderSecondFactorVerificationEmail to code tpl branding + assertNoErrors errs + +testLoginVerificationEmail :: (HasCallStack) => Map Text Text -> UserTemplates -> Http () +testLoginVerificationEmail branding templates = do + let tpl = templates.verificationLoginEmail + to = fromJust $ emailAddressText "test@example.com" + code = Value . unsafeRange . Ascii.unsafeFromText $ "code" + (errs, _) = run $ runOutputList @Text $ renderSecondFactorVerificationEmail to code tpl branding + assertNoErrors errs + +testActivationEmail :: (HasCallStack) => Map Text Text -> UserTemplates -> Http () +testActivationEmail branding templates = do + let tpl = templates.activationEmail + to = fromJust $ emailAddressText "test@example.com" + name = Name "name" + key = ActivationKey . Ascii.unsafeFromText $ "key" + code = ActivationCode . Ascii.unsafeFromText $ "code" + (errs, _) = run $ runOutputList @Text $ renderActivationMail to name key code tpl branding + assertNoErrors errs + +testActivationEmailUpdate :: (HasCallStack) => Map Text Text -> UserTemplates -> Http () +testActivationEmailUpdate branding templates = do + let tpl = templates.activationEmailUpdate + to = fromJust $ emailAddressText "test@example.com" + name = Name "name" + key = ActivationKey . Ascii.unsafeFromText $ "key" + code = ActivationCode . Ascii.unsafeFromText $ "code" + (errs, _) = run $ runOutputList @Text $ renderActivationMail to name key code tpl branding + assertNoErrors errs + +testTeamActivationEmail :: (HasCallStack) => Map Text Text -> UserTemplates -> Http () +testTeamActivationEmail branding templates = do + let tpl = templates.teamActivationEmail + to = fromJust $ emailAddressText "test@example.com" + name = Name "name" + teamName = "team-name" + key = ActivationKey . Ascii.unsafeFromText $ "key" + code = ActivationCode . Ascii.unsafeFromText $ "code" + (errs, _) = run $ runOutputList @Text $ renderTeamActivationMail to name teamName key code tpl branding + assertNoErrors errs + +testNewClientEmail :: (HasCallStack) => Map Text Text -> Locale -> UserTemplates -> Http () +testNewClientEmail branding loc templates = do + let tpl = templates.newClientEmail + to = fromJust $ emailAddressText "test@example.com" + name = Name "name" + client = + Client + { clientId = ClientId 1, + clientType = PermanentClientType, + clientTime = toUTCTimeMillis (UTCTime (fromGregorian 2020 1 1) (secondsToDiffTime 0)), + clientClass = Nothing, + clientLabel = Just "label", + clientCookie = Nothing, + clientModel = Just "model", + clientCapabilities = ClientCapabilityList mempty, + clientMLSPublicKeys = Map.empty, + clientLastActive = Nothing + } + (errs, _) = run $ runOutputList @Text $ renderNewClientEmail to name loc client tpl branding + assertNoErrors errs + +testAccountDeletionEmail :: (HasCallStack) => Map Text Text -> UserTemplates -> Http () +testAccountDeletionEmail branding templates = do + let tpl = templates.deletionEmail + to = fromJust $ emailAddressText "test@example.com" + name = Name "name" + key = Key . unsafeRange . Ascii.unsafeFromText $ "ABCDEFGHIJKLMNOPQRST" + code = Value . unsafeRange . Ascii.unsafeFromText $ "code123" + (errs, _) = run $ runOutputList @Text $ renderDeletionEmail to name key code tpl branding + assertNoErrors errs + +assertNoErrors :: [Text] -> Http () +assertNoErrors errs = + liftIO $ + assertBool ("The following variables were not replaced: " <> show (nub errs)) (null errs) diff --git a/services/brig/test/integration/API/User/Client.hs b/services/brig/test/integration/API/User/Client.hs index 683225bda0b..917c42cef19 100644 --- a/services/brig/test/integration/API/User/Client.hs +++ b/services/brig/test/integration/API/User/Client.hs @@ -505,7 +505,7 @@ testClientsWithoutPrekeys brig cannon db opts = do ) === responseJsonEither where - expectedClientMap :: Domain -> UserId -> [(ClientId, Maybe Prekey)] -> QualifiedUserClientPrekeyMap + expectedClientMap :: Domain -> UserId -> [(ClientId, Maybe UncheckedPrekeyBundle)] -> QualifiedUserClientPrekeyMap expectedClientMap domain u xs = mkQualifiedUserClientPrekeyMap $ Map.singleton domain $ @@ -595,7 +595,7 @@ testClientsWithoutPrekeysV4 brig cannon db opts = do ) === responseJsonEither -expectedClientMapClientsWithoutPrekeys :: Domain -> UserId -> [(ClientId, Maybe Prekey)] -> Maybe [Qualified UserId] -> QualifiedUserClientPrekeyMapV4 +expectedClientMapClientsWithoutPrekeys :: Domain -> UserId -> [(ClientId, Maybe UncheckedPrekeyBundle)] -> Maybe [Qualified UserId] -> QualifiedUserClientPrekeyMapV4 expectedClientMapClientsWithoutPrekeys domain u xs failed = QualifiedUserClientPrekeyMapV4 { qualifiedUserClientPrekeys = @@ -1228,7 +1228,7 @@ testUpdateClient opts brig = do === statusCode ) - checkClientPrekeys :: (HasCallStack) => Prekey -> Http () + checkClientPrekeys :: (HasCallStack) => UncheckedPrekeyBundle -> Http () checkClientPrekeys expectedPrekey = do flushClientPrekey >>= \case Nothing -> error "unexpected." diff --git a/services/brig/test/integration/Federation/End2end.hs b/services/brig/test/integration/Federation/End2end.hs index a49dace7efe..447dfb016e2 100644 --- a/services/brig/test/integration/Federation/End2end.hs +++ b/services/brig/test/integration/Federation/End2end.hs @@ -189,7 +189,7 @@ testClaimMultiPrekeyBundleSuccess brig1 brig2 = do (prekeys1, prekeys') = splitAt 5 prekeys prekeys2 = take 4 prekeys' mkClients = Set.fromList . map prekeyClient - mkClientMap :: [ClientPrekey] -> Map ClientId (Maybe Prekey) + mkClientMap :: [ClientPrekey] -> Map ClientId (Maybe UncheckedPrekeyBundle) mkClientMap = Map.fromList . map (prekeyClient &&& Just . prekeyData) qmap :: (Ord a) => [(Qualified a, b)] -> Map Domain (Map a b) qmap = fmap Map.fromList . indexQualified . map (sequenceAOf _1) diff --git a/services/brig/test/integration/Federation/Util.hs b/services/brig/test/integration/Federation/Util.hs index d042b258ff7..c2cb0fbf558 100644 --- a/services/brig/test/integration/Federation/Util.hs +++ b/services/brig/test/integration/Federation/Util.hs @@ -89,7 +89,7 @@ withTempMockFederator opts resp action = } withSettingsOverrides opts' action -generateClientPrekeys :: Brig -> [(Prekey, LastPrekey)] -> Http (Qualified UserId, [ClientPrekey]) +generateClientPrekeys :: Brig -> [(UncheckedPrekeyBundle, LastPrekey)] -> Http (Qualified UserId, [ClientPrekey]) generateClientPrekeys brig prekeys = do quser <- userQualifiedId <$> randomUser brig let mkClient (pk, lpk) = defNewClient PermanentClientType [pk] lpk diff --git a/services/brig/test/integration/Run.hs b/services/brig/test/integration/Run.hs index dbbbafff99b..660ed693b62 100644 --- a/services/brig/test/integration/Run.hs +++ b/services/brig/test/integration/Run.hs @@ -31,6 +31,7 @@ import API.Settings qualified as Settings import API.SystemSettings qualified as SystemSettings import API.Team qualified as Team import API.TeamUserSearch qualified as TeamUserSearch +import API.Template qualified import API.User qualified as User import API.UserPendingActivation qualified as UserPendingActivation import Bilge hiding (header, host, port) @@ -152,6 +153,7 @@ runTests iConf brigOpts otherArgs = do federationEnd2End <- Federation.End2end.spec brigOpts mg b g ch c f brigTwo galleyTwo ch2 cannonTwo federationEndpoints <- API.Federation.tests mg brigOpts b fedBrigClient internalApi <- API.Internal.tests brigOpts mg db b (brig iConf) gd g + emailTemplates <- API.Template.tests brigOpts mg let smtp = SMTP.tests mg lg oauthAPI = API.OAuth.tests mg db b n brigOpts @@ -174,7 +176,8 @@ runTests iConf brigOpts otherArgs = do internalApi, smtp, oauthAPI, - federationEnd2End + federationEnd2End, + emailTemplates ] where mkRequest (Endpoint h p) = Bilge.host (encodeUtf8 h) . Bilge.port p diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index 99f580235f7..a4ee56fa4ff 100644 --- a/services/brig/test/integration/Util.hs +++ b/services/brig/test/integration/Util.hs @@ -684,10 +684,10 @@ addClientReq brig uid new = . contentJson . body (RequestBodyLBS $ encode new) -defNewClient :: ClientType -> [Prekey] -> LastPrekey -> NewClient +defNewClient :: ClientType -> [UncheckedPrekeyBundle] -> LastPrekey -> NewClient defNewClient = defNewClientWithVerificationCode Nothing -defNewClientWithVerificationCode :: Maybe Code.Value -> ClientType -> [Prekey] -> LastPrekey -> NewClient +defNewClientWithVerificationCode :: Maybe Code.Value -> ClientType -> [UncheckedPrekeyBundle] -> LastPrekey -> NewClient defNewClientWithVerificationCode mbCode ty pks lpk = (newClient ty lpk) { newClientPassword = Just defPassword, @@ -903,34 +903,34 @@ defEmailLogin e = emailLogin e defPassword (Just defCookieLabel) emailLogin :: EmailAddress -> PlainTextPassword6 -> Maybe CookieLabel -> Login emailLogin e pw cl = MkLogin (LoginByEmail e) pw cl Nothing -somePrekeys :: [Prekey] +somePrekeys :: [UncheckedPrekeyBundle] somePrekeys = - [ Prekey (PrekeyId 1) "pQABAQECoQBYIOjl7hw0D8YRNqkkBQETCxyr7/ywE/2R5RWcUPM+GJACA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 2) "pQABAQICoQBYIGoXawUQWQ9ZW+MXhvuo9ALOBUjLff8S5VdAokN29C1OA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 3) "pQABAQMCoQBYIEjdt+YWd3lHmG8pamULLMubAMZw556IO8kW7s1MLFytA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 4) "pQABAQQCoQBYIPIaOA3Xqfk4Lh2/pU88Owd2eW5eplHpywr+Mx4QGyiMA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 5) "pQABAQUCoQBYIHnafNR4Gh3ID71lYzToewEVag4EKskDFq+gaeraOlSJA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 6) "pQABAQYCoQBYIFXUkVftE7kK22waAzhOjOmJVex3EBTU8RHZFx2o1Ed8A6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 7) "pQABAQcCoQBYIDXdN8VlKb5lbgPmoDPLPyqNIEyShG4oT/DlW0peRRZUA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 8) "pQABAQgCoQBYIJH1ewvIVV3yGqQvdr/QM9HARzMgo5ksOTRyKEuN2aZzA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 9) "pQABAQkCoQBYIFcAnXdx0M1Q1hoDDfgMK9r+Zchn8YlVHHaQwQYhRk1dA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 10) "pQABAQoCoQBYIGs3vyxwmzEZ+qKNy4wpFkxc+Bgkb0D76ZEbxeeh/9DVA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 11) "pQABAQsCoQBYIGUiBeOJALP5dkMduUZ/u6MDhHNrsrBUa3f0YlSSWZbzA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 12) "pQABAQwCoQBYIMp6QNNTPDZgL3DSSD/QWWnBI7LsTZp2RhY/HLqnIwRZA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 13) "pQABAQ0CoQBYIJXSSUrE5RCNyB5pg+m6vGwK7RvJ+rs9dsdHitxnfDhuA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 14) "pQABAQ4CoQBYIHmtOX7jCKBHFDysb4H0z/QWoCSaEyjerZaT/HOP8bgDA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 15) "pQABAQ8CoQBYIIaMCTcPKj2HuYQ7i9ZaxUw9j5Bz8TPjoAaTZ5eB0w1kA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 16) "pQABARACoQBYIHWAOacKuWH81moJVveJ0FSfipWocfspOIBhaU6VLWUsA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 17) "pQABARECoQBYIA8XtUXtnMxQslULnNAeHBIivlLRe/+qdh2j6nTfDAchA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 18) "pQABARICoQBYIGgzg6SzgTTOgnk48pa6y2Rgjy004DkeBo4CMld3Jlr6A6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 19) "pQABARMCoQBYIEoEFiIpCHgn74CAD+GhIfIgbQtdCqQqkOXHWxRlG6Y6A6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 20) "pQABARQCoQBYINVEwTRxNSe0rxZxon4Rifz2l4rtQZn7mHtKYCiFAK9IA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 21) "pQABARUCoQBYIN3aeX2Ayi2rPFbiaYb+O2rdHUpFhzRs2j28pCmbGpflA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 22) "pQABARYCoQBYIJe5OJ17YKQrNmIH3sE++r++4Z5ld36axqAMjjQ3jtQWA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 23) "pQABARcCoQBYIASE94LjK6Raipk/lN/YewouqO+kcQGpxIqP+iW2hyHiA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 24) "pQABARgYAqEAWCBZ222LpS6/99Btlw+83PihrA655skwsNevt//8oz5axQOhAKEAWCCy39UyMEgetquvTo7P19bcyfnWBzQMOEG1v+0wub0magT2", - Prekey (PrekeyId 25) "pQABARgZAqEAWCDGEwo61w4O8T8lyw0HdoOjGWBKQUNqo6+jSfrPR9alrAOhAKEAWCCy39UyMEgetquvTo7P19bcyfnWBzQMOEG1v+0wub0magT2", - Prekey (PrekeyId 26) "pQABARgaAqEAWCBMSQoQ6B35plB80i1O3AWlJSftCEbCbju97Iykg5+NWQOhAKEAWCCy39UyMEgetquvTo7P19bcyfnWBzQMOEG1v+0wub0magT2" + [ UncheckedPrekeyBundle (PrekeyId 1) "pQABAQECoQBYIOjl7hw0D8YRNqkkBQETCxyr7/ywE/2R5RWcUPM+GJACA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 2) "pQABAQICoQBYIGoXawUQWQ9ZW+MXhvuo9ALOBUjLff8S5VdAokN29C1OA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 3) "pQABAQMCoQBYIEjdt+YWd3lHmG8pamULLMubAMZw556IO8kW7s1MLFytA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 4) "pQABAQQCoQBYIPIaOA3Xqfk4Lh2/pU88Owd2eW5eplHpywr+Mx4QGyiMA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 5) "pQABAQUCoQBYIHnafNR4Gh3ID71lYzToewEVag4EKskDFq+gaeraOlSJA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 6) "pQABAQYCoQBYIFXUkVftE7kK22waAzhOjOmJVex3EBTU8RHZFx2o1Ed8A6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 7) "pQABAQcCoQBYIDXdN8VlKb5lbgPmoDPLPyqNIEyShG4oT/DlW0peRRZUA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 8) "pQABAQgCoQBYIJH1ewvIVV3yGqQvdr/QM9HARzMgo5ksOTRyKEuN2aZzA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 9) "pQABAQkCoQBYIFcAnXdx0M1Q1hoDDfgMK9r+Zchn8YlVHHaQwQYhRk1dA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 10) "pQABAQoCoQBYIGs3vyxwmzEZ+qKNy4wpFkxc+Bgkb0D76ZEbxeeh/9DVA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 11) "pQABAQsCoQBYIGUiBeOJALP5dkMduUZ/u6MDhHNrsrBUa3f0YlSSWZbzA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 12) "pQABAQwCoQBYIMp6QNNTPDZgL3DSSD/QWWnBI7LsTZp2RhY/HLqnIwRZA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 13) "pQABAQ0CoQBYIJXSSUrE5RCNyB5pg+m6vGwK7RvJ+rs9dsdHitxnfDhuA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 14) "pQABAQ4CoQBYIHmtOX7jCKBHFDysb4H0z/QWoCSaEyjerZaT/HOP8bgDA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 15) "pQABAQ8CoQBYIIaMCTcPKj2HuYQ7i9ZaxUw9j5Bz8TPjoAaTZ5eB0w1kA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 16) "pQABARACoQBYIHWAOacKuWH81moJVveJ0FSfipWocfspOIBhaU6VLWUsA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 17) "pQABARECoQBYIA8XtUXtnMxQslULnNAeHBIivlLRe/+qdh2j6nTfDAchA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 18) "pQABARICoQBYIGgzg6SzgTTOgnk48pa6y2Rgjy004DkeBo4CMld3Jlr6A6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 19) "pQABARMCoQBYIEoEFiIpCHgn74CAD+GhIfIgbQtdCqQqkOXHWxRlG6Y6A6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 20) "pQABARQCoQBYINVEwTRxNSe0rxZxon4Rifz2l4rtQZn7mHtKYCiFAK9IA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 21) "pQABARUCoQBYIN3aeX2Ayi2rPFbiaYb+O2rdHUpFhzRs2j28pCmbGpflA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 22) "pQABARYCoQBYIJe5OJ17YKQrNmIH3sE++r++4Z5ld36axqAMjjQ3jtQWA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 23) "pQABARcCoQBYIASE94LjK6Raipk/lN/YewouqO+kcQGpxIqP+iW2hyHiA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 24) "pQABARgYAqEAWCBZ222LpS6/99Btlw+83PihrA655skwsNevt//8oz5axQOhAKEAWCCy39UyMEgetquvTo7P19bcyfnWBzQMOEG1v+0wub0magT2", + UncheckedPrekeyBundle (PrekeyId 25) "pQABARgZAqEAWCDGEwo61w4O8T8lyw0HdoOjGWBKQUNqo6+jSfrPR9alrAOhAKEAWCCy39UyMEgetquvTo7P19bcyfnWBzQMOEG1v+0wub0magT2", + UncheckedPrekeyBundle (PrekeyId 26) "pQABARgaAqEAWCBMSQoQ6B35plB80i1O3AWlJSftCEbCbju97Iykg5+NWQOhAKEAWCCy39UyMEgetquvTo7P19bcyfnWBzQMOEG1v+0wub0magT2" ] someLastPrekeys :: [LastPrekey] diff --git a/services/federator/default.nix b/services/federator/default.nix index e1beff920cf..febce147be2 100644 --- a/services/federator/default.nix +++ b/services/federator/default.nix @@ -16,13 +16,14 @@ , crypton-x509 , crypton-x509-validation , data-default +, directory , dns , dns-util , exceptions , extended , filepath +, fsnotify , gitignoreSource -, hinotify , HsOpenSSL , hspec , hspec-junit-formatter @@ -91,12 +92,13 @@ mkDerivation { crypton-x509 crypton-x509-validation data-default + directory dns dns-util exceptions extended filepath - hinotify + fsnotify HsOpenSSL http-client http-media @@ -174,6 +176,7 @@ mkDerivation { containers crypton-x509-validation data-default + directory dns-util filepath HsOpenSSL diff --git a/services/federator/federator.cabal b/services/federator/federator.cabal index 597cfc7e119..30da9928c5c 100644 --- a/services/federator/federator.cabal +++ b/services/federator/federator.cabal @@ -116,12 +116,13 @@ library , crypton-x509 , crypton-x509-validation , data-default + , directory , dns , dns-util , exceptions , extended , filepath - , hinotify + , fsnotify , HsOpenSSL , http-client , http-media @@ -386,6 +387,7 @@ test-suite federator-tests , containers , crypton-x509-validation , data-default + , directory , dns-util , federator , filepath diff --git a/services/federator/src/Federator/Monitor/Internal.hs b/services/federator/src/Federator/Monitor/Internal.hs index d696c6e18e5..8b3ab0f94a8 100644 --- a/services/federator/src/Federator/Monitor/Internal.hs +++ b/services/federator/src/Federator/Monitor/Internal.hs @@ -18,16 +18,11 @@ module Federator.Monitor.Internal where import Control.Exception (try) -import Data.ByteString (packCStringLen, useAsCStringLen) import Data.Map qualified as Map import Data.Set qualified as Set import Data.Text qualified as Text -import Data.Text.Encoding qualified as Text -import Data.Text.Encoding.Error qualified as Text import Federator.Options (RunSettings (..)) -import GHC.Foreign (peekCStringLen, withCStringLen) -import GHC.IO.Encoding (getFileSystemEncoding) -import Imports +import Imports hiding (makeAbsolute) import Network.Wai.Utilities.Exception import OpenSSL.Session (SSLContext) import OpenSSL.Session qualified as SSL @@ -38,17 +33,17 @@ import Polysemy.Final (Final) import Polysemy.Resource qualified as Polysemy import Polysemy.TinyLog (TinyLog) import Polysemy.TinyLog qualified as Log +import System.Directory (makeAbsolute) +import System.FSNotify import System.FilePath -import System.INotify import System.Logger (Logger) import System.Logger.Message qualified as Log -import System.Posix.ByteString (RawFilePath) import System.Posix.Files import Wire.Arbitrary import Wire.Sem.Logger.TinyLog qualified as Log data Monitor = Monitor - { monINotify :: INotify, + { monWatchManager :: WatchManager, monOnNewContext :: SSLContext -> IO (), monWatches :: IORef Watches, monSettings :: RunSettings, @@ -56,29 +51,14 @@ data Monitor = Monitor monLock :: MVar () } --- This is needed because the normal Posix file system API uses strings, while --- the inotify API uses bytestrings. --- /Note/: File paths are strings obtained using the "file system encoding", --- which is the same as the locale encoding, but uses some escaping tricks to --- be able to represent arbitrary data as strings. -rawPath :: FilePath -> IO RawFilePath -rawPath path = do - encoding <- getFileSystemEncoding - withCStringLen encoding path packCStringLen - -fromRawPath :: RawFilePath -> IO FilePath -fromRawPath path = do - encoding <- getFileSystemEncoding - useAsCStringLen path (peekCStringLen encoding) - data WatchedPath - = WatchedFile RawFilePath - | WatchedDir RawFilePath (Set RawFilePath) + = WatchedFile FilePath + | WatchedDir FilePath (Set FilePath) deriving stock (Eq, Ord, Show, Generic) deriving (Arbitrary) via (GenericUniform WatchedPath) mergePaths :: [WatchedPath] -> Set WatchedPath -mergePaths = Set.fromList . merge . sort +mergePaths wpaths = Set.fromList $ filterRedundant $ merge $ sort wpaths where merge [] = [] merge [w] = [w] @@ -87,20 +67,30 @@ mergePaths = Set.fromList . merge . sort (WatchedDir dir1 paths1, WatchedDir dir2 paths2) | dir1 == dir2 -> merge (WatchedDir dir1 (paths1 <> paths2) : ws) _ -> w1 : merge (w2 : ws) - -watchedPath :: WatchedPath -> RawFilePath + -- Filter out WatchedFile entries that are already covered by a WatchedDir + -- This prevents duplicate watches on the same directory for the same file, + -- which would cause duplicate events with fsnotify + filterRedundant ws = + let dirs = Map.fromList [(dir, files) | WatchedDir dir files <- ws] + isCovered (WatchedFile path) = + let dir = takeDirectory path + file = takeFileName path + in -- Don't filter if filename is empty (edge case for root paths) + file /= "" && case Map.lookup dir dirs of + Just files -> Set.member file files + Nothing -> False + isCovered _ = False + in filter (not . isCovered) ws + +watchedPath :: WatchedPath -> FilePath watchedPath (WatchedFile path) = path watchedPath (WatchedDir dir _) = dir -watchPathEvents :: WatchedPath -> [EventVariety] -watchPathEvents (WatchedFile _) = [CloseWrite] -watchPathEvents (WatchedDir _ _) = [MoveIn, Create] - -- Since we are watching a filesystem path, and not an inode, we need to replace a -- file watch when the file gets overwritten. -- This type is a map of paths to watches used to keep track of both file and -- directory watches as they get deleted and recreated. -type Watches = Map RawFilePath (WatchDescriptor, WatchedPath) +type Watches = Map FilePath (StopListening, WatchedPath) runSemDefault :: Logger -> Sem '[TinyLog, Embed IO, Final IO] a -> IO a runSemDefault logger = Polysemy.runFinal . Polysemy.embedToFinal . Log.loggerToTinyLog logger @@ -120,13 +110,14 @@ delMonitor monitor = Polysemy.resourceToIOFinal $ do watches <- readIORef (monWatches monitor) traverse_ stop watches + embed $ stopManager (monWatchManager monitor) where - stop (wd, _) = do + stop (stopListening, wpath) = do -- ignore exceptions when removing watches - embed . void . try @IOException $ removeWatch wd + embed . void . try @IOException $ stopListening Log.trace $ Log.msg ("stopped watching file" :: Text) - . Log.field "descriptor" (show wd) + . Log.field "path" (watchedPath wpath) mkMonitor :: ( Member TinyLog r, @@ -140,17 +131,16 @@ mkMonitor :: RunSettings -> Sem r Monitor mkMonitor runSem onNewContext rs = do - inotify <- embed initINotify + mgr <- embed startManager Log.trace $ - Log.msg ("inotify initialized" :: Text) - . Log.field "inotify" (show inotify) + Log.msg ("fsnotify watch manager initialized" :: Text) lock <- embed @IO $ newMVar () watchesVar <- embed @IO $ newIORef mempty let monitor = Monitor - { monINotify = inotify, + { monWatchManager = mgr, monOnNewContext = onNewContext, monWatches = watchesVar, monSettings = rs, @@ -162,7 +152,7 @@ mkMonitor runSem onNewContext rs = do traverse_ (addWatchedFile monitor) (toList paths) pure monitor -data Action = ReplaceWatch RawFilePath | ReloadSettings +data MonitorAction = ReplaceWatch FilePath | ReloadSettings deriving (Eq, Ord, Show) handleEvent :: @@ -189,13 +179,25 @@ handleEvent runSem monitor wpath e = do -- reloaded, otherwise there is a window of time (after reloading settings, -- but before the new watch is set) where changes to the settings can go -- undetected -getActions :: WatchedPath -> Event -> [Action] -getActions (WatchedFile path) (Closed _ mpath True) - | maybe True (== path) mpath = [ReloadSettings] -getActions (WatchedDir dir paths) (MovedIn _ path _) - | Set.member path paths = [ReplaceWatch (dir <> "/" <> path), ReloadSettings] -getActions (WatchedDir dir paths) (Created _ path) - | Set.member path paths = [ReplaceWatch (dir <> "/" <> path), ReloadSettings] +-- +-- We use CloseWrite events (Linux-only) instead of Modified events for +-- triggering reloads. CloseWrite is generated when a file is closed after +-- being opened for writing, which reliably indicates the write is complete. +-- Modified events may fire multiple times during a write operation (before +-- the file is fully written) and would cause duplicate reloads. +-- +-- On macOS (FSEvents), CloseWrite is not available, but the tests are +-- disabled there anyway (fsnotify tests don't work in nix sandbox on macOS). +getActions :: WatchedPath -> Event -> [MonitorAction] +getActions (WatchedFile path) (CloseWrite filePath _ _) + | filePath == path = [ReloadSettings] +getActions (WatchedFile path) (Added filePath _ _) + | filePath == path = [ReplaceWatch path, ReloadSettings] +getActions (WatchedDir _dir paths) (Added filePath _ _) + | Set.member (takeFileName filePath) paths = + [ReplaceWatch filePath, ReloadSettings] +getActions (WatchedDir _dir paths) (CloseWrite filePath _ _) + | Set.member (takeFileName filePath) paths = [ReloadSettings] getActions _ _ = [] applyAction :: @@ -204,7 +206,7 @@ applyAction :: Member (Polysemy.Error FederationSetupError) r ) => Monitor -> - Action -> + MonitorAction -> Sem r () applyAction monitor ReloadSettings = do sslCtx' <- mkSSLContext (monSettings monitor) @@ -218,7 +220,7 @@ applyAction monitor (ReplaceWatch path) = do addWatchedFile monitor wpath case wpath of WatchedDir dir paths -> - traverse_ (applyAction monitor . ReplaceWatch . ((dir <> "/") <>)) paths + traverse_ (applyAction monitor . ReplaceWatch . (dir )) (Set.toList paths) WatchedFile _ -> pure () addWatchedFile :: @@ -232,17 +234,15 @@ addWatchedFile monitor wpath = do r <- embed . try @SomeException $ addWatchAndSave - (monINotify monitor) - (watchPathEvents wpath) + (monWatchManager monitor) (monWatches monitor) wpath (monHandler monitor wpath) - let pathText = Text.decodeUtf8With Text.lenientDecode (watchedPath wpath) + let pathText = Text.pack (watchedPath wpath) case r of - Right w -> + Right _ -> Log.trace $ Log.msg ("watching file" :: Text) - . Log.field "descriptor" (show w) . Log.field "path" pathText Left e -> do Log.err $ @@ -251,25 +251,31 @@ addWatchedFile monitor wpath = do . Log.field "error" (displayException e) addWatchAndSave :: - INotify -> - [EventVariety] -> + WatchManager -> IORef Watches -> WatchedPath -> (Event -> IO ()) -> - IO WatchDescriptor -addWatchAndSave inotify events watchesVar wpath handler = do + IO () +addWatchAndSave mgr watchesVar wpath handler = do let path = watchedPath wpath + -- For files, watch the parent directory; for directories, watch the directory itself + dirToWatch = case wpath of + WatchedFile fp -> takeDirectory fp + WatchedDir dir _ -> dir + -- Create filter predicate based on what we're watching + predicate = case wpath of + WatchedFile fp -> \event -> eventPath event == fp + WatchedDir _ files -> \event -> Set.member (takeFileName (eventPath event)) files -- create a new watch - w' <- addWatch inotify events path handler + stopListening <- watchDir mgr dirToWatch predicate handler -- atomically save it in the map, and return the old one - mw <- + mOld <- atomicModifyIORef watchesVar $ - swap . Map.alterF (,Just (w', wpath)) path + swap . Map.alterF (,Just (stopListening, wpath)) path -- remove the old watch - case mw of + case mOld of Nothing -> pure () - Just (w, _) -> void . try @IOException $ removeWatch w - pure w' + Just (oldStopListening, _) -> void . try @IOException $ oldStopListening certificatePaths :: RunSettings -> [FilePath] certificatePaths rs = @@ -300,9 +306,8 @@ resolveSymlink path' = do watchedPaths :: (FilePath -> IO (Maybe FilePath)) -> FilePath -> IO [WatchedPath] watchedPaths resolve path' = do path <- makeAbsolute path' - rpath <- rawPath path dirs <- watchedDirs resolve path - pure $ WatchedFile rpath : dirs + pure $ WatchedFile path : dirs watchedDirs :: (FilePath -> IO (Maybe FilePath)) -> FilePath -> IO [WatchedPath] watchedDirs resolve path = do @@ -313,9 +318,8 @@ watchedDirs resolve path = do then pure [] -- base case: root directory else do wds <- watchedDirs resolve dir - rdir <- rawPath (dropTrailingPathSeparator dir) - rbase <- rawPath base - pure $ WatchedDir rdir (Set.singleton rbase) : wds + let normalizedDir = dropTrailingPathSeparator dir + pure $ WatchedDir normalizedDir (Set.singleton base) : wds pure (dirs0 ++ dirs1) data FederationSetupError diff --git a/services/federator/test/integration/Test/Federator/IngressSpec.hs b/services/federator/test/integration/Test/Federator/IngressSpec.hs index 41b9f42af3c..be2b1c16270 100644 --- a/services/federator/test/integration/Test/Federator/IngressSpec.hs +++ b/services/federator/test/integration/Test/Federator/IngressSpec.hs @@ -59,7 +59,7 @@ spec env = do brig <- view teBrig <$> ask user <- randomUser brig - let expectedProfile = mkUserProfile EmailVisibleToSelf user UserLegalHoldNoConsent + let expectedProfile = mkUserProfile EmailVisibleToSelf UserTypeRegular 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 1daee8e77e4..180d41b9813 100644 --- a/services/federator/test/integration/Test/Federator/InwardSpec.hs +++ b/services/federator/test/integration/Test/Federator/InwardSpec.hs @@ -70,7 +70,7 @@ spec env = brig <- view teBrig <$> ask user <- randomUser brig - let expectedProfile = mkUserProfile EmailVisibleToSelf user UserLegalHoldNoConsent + let expectedProfile = mkUserProfile EmailVisibleToSelf UserTypeRegular user UserLegalHoldNoConsent bdy <- responseJsonError =<< inwardCall "/federation/brig/get-users-by-ids" (encode [userId user]) diff --git a/services/federator/test/unit/Test/Federator/Monitor.hs b/services/federator/test/unit/Test/Federator/Monitor.hs index 6630080f29a..c9ca645b189 100644 --- a/services/federator/test/unit/Test/Federator/Monitor.hs +++ b/services/federator/test/unit/Test/Federator/Monitor.hs @@ -20,19 +20,18 @@ module Test.Federator.Monitor (tests) where import Control.Concurrent.Chan import Control.Exception (bracket) import Control.Monad.Trans.Cont -import Data.ByteString qualified as BS -import Data.ByteString.Char8 qualified as B8 import Data.Set qualified as Set import Federator.Monitor import Federator.Monitor.Internal import Federator.Options -import Imports +import Imports hiding (getCurrentDirectory, makeAbsolute) import OpenSSL.Session (SSLContext) import Polysemy qualified import Polysemy.Error qualified as Polysemy +import System.Directory (getCurrentDirectory, makeAbsolute) import System.FilePath import System.IO.Temp -import System.Posix (createSymbolicLink, getWorkingDirectory) +import System.Posix (createSymbolicLink) import System.Timeout import Test.Federator.Options (defRunSettings) import Test.Tasty @@ -218,7 +217,7 @@ testMonitorSymlinkUpdate = settings <- withSymlinkSettings _ <- withSilentMonitor reloads settings liftIO $ do - wd <- getWorkingDirectory + wd <- getCurrentDirectory removeFile (clientCertificate settings) createSymbolicLink @@ -374,32 +373,26 @@ testMergeWatchedPaths = in mergedCount <= origCount, testProperty "has the same paths" $ \(wpaths :: [WatchedPath]) -> let f (WatchedFile path) = [path] - f (WatchedDir dir files) = map (dir <>) (Set.toList files) + f (WatchedDir dir files) = map (dir ) (Set.toList files) mergedPaths = Set.fromList (Set.toList (mergePaths wpaths) >>= f) origPaths = Set.fromList (wpaths >>= f) in mergedPaths == origPaths ] -newtype Path = Path {getRawPath :: ByteString} - -getPath :: Path -> IO FilePath -getPath = fromRawPath . getRawPath +-- Wrapper for testing path operations +newtype Path = Path {getPath :: FilePath} + deriving (Show) getAbsolutePath :: Path -> IO FilePath -getAbsolutePath p = do - path <- getPath p - makeAbsolute ("/" <> path) - -instance Show Path where - show = show . getRawPath +getAbsolutePath p = makeAbsolute ("/" <> getPath p) instance Arbitrary Path where arbitrary = - Path . B8.intercalate "/" - <$> listOf (BS.pack <$> listOf1 ch) + Path . intercalate "/" + <$> listOf (listOf1 ch) where - ch :: Gen Word8 - ch = arbitrary `suchThat` (/= fromIntegral (ord '/')) + ch :: Gen Char + ch = arbitrary `suchThat` (/= '/') trivialResolve :: FilePath -> IO (Maybe FilePath) trivialResolve _ = pure Nothing @@ -415,8 +408,8 @@ testDirectoryTraversal = pure (length wpaths == length (splitPath path)), testProperty "relative paths are resolved correctly" $ \(path' :: Path) -> ioProperty $ do - dir <- getWorkingDirectory - path <- getPath path' + dir <- getCurrentDirectory + let path = getPath path' wpaths <- watchedPaths trivialResolve path wpaths' <- watchedPaths trivialResolve (dir path) pure $ wpaths == wpaths', @@ -424,10 +417,10 @@ testDirectoryTraversal = evalContT $ do settings <- withKubernetesSettings liftIO $ do - rroot <- rawPath $ takeDirectory (clientCertificate settings) + let root = takeDirectory (clientCertificate settings) wpaths <- mergePaths <$> watchedPaths resolveSymlink (clientCertificate settings) assertBool "symlink targets should be watched" $ Set.member - (WatchedDir rroot (Set.fromList ["cert.pem", "..data", "..foo"])) + (WatchedDir root (Set.fromList ["cert.pem", "..data", "..foo"])) wpaths ] diff --git a/services/galley/default.nix b/services/galley/default.nix index a6dbd9161ea..988d5378dc7 100644 --- a/services/galley/default.nix +++ b/services/galley/default.nix @@ -23,7 +23,6 @@ , cereal , comonad , conduit -, constraints , containers , cookie , crypton @@ -144,7 +143,6 @@ mkDerivation { cassandra-util cassava comonad - constraints containers crypton crypton-x509 diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 8f8d45f27d6..f1d6b4f299c 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -138,25 +138,19 @@ library Galley.App Galley.Cassandra Galley.Cassandra.Client - Galley.Cassandra.Code Galley.Cassandra.CustomBackend Galley.Cassandra.Queries Galley.Cassandra.SearchVisibility Galley.Cassandra.Store Galley.Cassandra.Team - Galley.Cassandra.TeamFeatures Galley.Cassandra.TeamNotifications Galley.Cassandra.Util - Galley.Data.Scope Galley.Data.TeamNotifications - Galley.Data.Types Galley.Effects Galley.Effects.ClientStore - Galley.Effects.CodeStore Galley.Effects.CustomBackendStore Galley.Effects.Queue Galley.Effects.SearchVisibilityStore - Galley.Effects.TeamFeatureStore Galley.Effects.TeamMemberStore Galley.Effects.TeamNotificationStore Galley.Env @@ -272,7 +266,6 @@ library , cassandra-util >=0.16.2 , cassava >=0.5.2 , comonad - , constraints , containers >=0.5 , crypton , crypton-x509 diff --git a/services/galley/galley.integration.yaml b/services/galley/galley.integration.yaml index f4dce07f1b7..e2106c63e67 100644 --- a/services/galley/galley.integration.yaml +++ b/services/galley/galley.integration.yaml @@ -247,4 +247,4 @@ journal: # if set, journals; if not set, disables journaling postgresMigration: conversation: postgresql - # conversation: cassandra + conversationCodes: postgresql diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index a29eb18d893..10474662d9a 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -75,9 +75,7 @@ import Galley.API.MLS.Migration import Galley.API.MLS.Removal import Galley.API.Teams.Features.Get import Galley.API.Util -import Galley.Data.Scope (Scope (ReusableCode)) import Galley.Effects -import Galley.Effects.CodeStore qualified as E import Galley.Env (Env) import Galley.Options (Opts) import Galley.Validation @@ -110,15 +108,17 @@ import Wire.API.MLS.Group.Serialisation qualified as Serialisation import Wire.API.MLS.SubConversation import Wire.API.Push.V2 qualified as PushV2 import Wire.API.Routes.Internal.Brig.Connection -import Wire.API.Team.Feature import Wire.API.Team.LegalHold import Wire.API.Team.Member import Wire.API.Team.Permission (Perm (AddRemoveConvMember, ModifyConvName)) import Wire.API.User as User import Wire.BrigAPIAccess qualified as E +import Wire.CodeStore +import Wire.CodeStore qualified as E import Wire.ConversationStore qualified as E import Wire.ConversationSubsystem import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig (..)) +import Wire.FeaturesConfigSubsystem import Wire.FederationAPIAccess qualified as E import Wire.FireAndForget qualified as E import Wire.NotificationSubsystem @@ -258,7 +258,8 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con Member ProposalStore r, Member Random r, Member TeamFeatureStore r, - Member TinyLog r + Member TinyLog r, + Member FeaturesConfigSubsystem r ) HasConversationActionEffects 'ConversationUpdateAddPermissionTag r = ( Member (Error NoChanges) r, @@ -519,7 +520,7 @@ performAction :: Sem r (PerformActionResult tag) performAction tag origUser lconv action = do let lcnv = fmap (.id_) lconv - conv = tUnqualified lconv + storedConv = tUnqualified lconv case tag of SConversationJoinTag -> do (extraTargets, action') <- performConversationJoin origUser lconv action @@ -540,7 +541,7 @@ performAction tag origUser lconv action = do traverse_ (removeUser lconv RemoveUserExcludeMain) presentVictims pure $ mkPerformActionResult action -- FUTUREWORK: should we return the filtered action here? SConversationMemberUpdateTag -> do - void $ ensureOtherMember lconv (cmuTarget action) conv + void $ ensureOtherMember lconv (cmuTarget action) storedConv E.setOtherMember lcnv (cmuTarget action) (cmuUpdate action) pure $ mkPerformActionResult action SConversationDeleteTag -> do @@ -548,8 +549,8 @@ performAction tag origUser lconv action = do E.removeAllMLSClients groupId E.deleteAllProposals groupId - let cid = conv.id_ - for_ (conv & mlsMetadata <&> cnvmlsGroupId . fst) $ \gidParent -> do + let cid = storedConv.id_ + for_ (storedConv & mlsMetadata <&> cnvmlsGroupId . fst) $ \gidParent -> do sconvs <- E.listSubConversations cid for_ (Map.assocs sconvs) $ \(subid, mlsData) -> do let gidSub = cnvmlsGroupId mlsData @@ -558,24 +559,24 @@ performAction tag origUser lconv action = do deleteGroup gidParent key <- E.makeKey (tUnqualified lcnv) - E.deleteCode key ReusableCode - case convTeam conv of + E.deleteCode key + case convTeam storedConv of Nothing -> E.deleteConversation (tUnqualified lcnv) Just tid -> E.deleteTeamConversation tid (tUnqualified lcnv) pure $ mkPerformActionResult action SConversationRenameTag -> do - zusrMembership <- join <$> forM conv.metadata.cnvmTeam (TeamSubsystem.internalGetTeamMember (qUnqualified origUser)) + zusrMembership <- join <$> forM storedConv.metadata.cnvmTeam (TeamSubsystem.internalGetTeamMember (qUnqualified origUser)) for_ zusrMembership $ \tm -> unless (tm `hasPermission` ModifyConvName) $ throwS @'InvalidOperation cn <- rangeChecked (cupName action) E.setConversationName (tUnqualified lcnv) cn pure $ mkPerformActionResult action SConversationMessageTimerUpdateTag -> do - when (Data.convMessageTimer conv == cupMessageTimer action) noChanges + when (Data.convMessageTimer storedConv == cupMessageTimer action) noChanges E.setConversationMessageTimer (tUnqualified lcnv) (cupMessageTimer action) pure $ mkPerformActionResult action SConversationReceiptModeUpdateTag -> do - when (Data.convReceiptMode conv == Just (cruReceiptMode action)) noChanges + when (Data.convReceiptMode storedConv == Just (cruReceiptMode action)) noChanges E.setConversationReceiptMode (tUnqualified lcnv) (cruReceiptMode action) pure $ mkPerformActionResult action SConversationAccessDataTag -> do @@ -594,9 +595,9 @@ performAction tag origUser lconv action = do E.updateToMixedProtocol (tUnqualified lcnv) gid epoch pure $ mkPerformActionResult action (ProtocolMixedTag, ProtocolMLSTag, Just tid) -> do - mig <- getFeatureForTeam @MlsMigrationConfig tid + mig <- getFeatureForTeam tid now <- Now.get - mlsConv <- mkMLSConversation conv >>= noteS @'ConvInvalidProtocolTransition + mlsConv <- mkMLSConversation storedConv >>= noteS @'ConvInvalidProtocolTransition ok <- checkMigrationCriteria now mlsConv mig unless ok $ throwS @'MLSMigrationCriteriaNotSatisfied removeExtraneousClients origUser lconv @@ -610,7 +611,7 @@ performAction tag origUser lconv action = do noChanges (_, _, _) -> throwS @'ConvInvalidProtocolTransition SConversationUpdateAddPermissionTag -> do - when (conv.metadata.cnvmChannelAddPermission == Just (addPermission action)) noChanges + when (storedConv.metadata.cnvmChannelAddPermission == Just (addPermission action)) noChanges E.updateChannelAddPermissions (tUnqualified lcnv) (addPermission action) pure $ mkPerformActionResult action SConversationResetTag -> do @@ -798,7 +799,7 @@ performConversationAccessData qusr lconv action = do ) $ do key <- E.makeKey (tUnqualified lcnv) - E.deleteCode key ReusableCode + E.deleteCode key -- Determine bots and members to be removed let filterBotsAndMembers = @@ -1038,39 +1039,39 @@ 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. + let sca = cu.action (mActualAction, extraTargets) <- case cu.action of - sca@(SomeConversationAction singTag action) -> case singTag of - SConversationJoinTag -> do - let ConversationJoin toAdd role joinType = action - let (localUsers, remoteUsers) = partitionQualified loc toAdd - addedLocalUsers <- Set.toList <$> addLocalUsersToRemoteConv rconvId cu.origUserId localUsers - let allAddedUsers = map (tUntagged . qualifyAs loc) addedLocalUsers <> map tUntagged remoteUsers - pure $ - ( fmap - (\users -> SomeConversationAction SConversationJoinTag (ConversationJoin users role joinType)) - (nonEmpty allAddedUsers), - addedLocalUsers - ) - SConversationLeaveTag -> do - let users = foldQualified loc (pure . tUnqualified) (const []) cu.origUserId - E.deleteMembersInRemoteConversation rconvId users - pure (Just sca, []) - SConversationRemoveMembersTag -> do - let localUsers = getLocalUsers (tDomain loc) . crmTargets $ action - E.deleteMembersInRemoteConversation rconvId localUsers - pure (Just sca, []) - SConversationMemberUpdateTag -> - pure (Just sca, []) - SConversationDeleteTag -> do - E.deleteMembersInRemoteConversation rconvId presentUsers - pure (Just sca, []) - SConversationRenameTag -> pure (Just sca, []) - SConversationMessageTimerUpdateTag -> pure (Just sca, []) - SConversationReceiptModeUpdateTag -> pure (Just sca, []) - SConversationAccessDataTag -> pure (Just sca, []) - SConversationUpdateProtocolTag -> pure (Just sca, []) - SConversationUpdateAddPermissionTag -> pure (Just sca, []) - SConversationResetTag -> pure (Just sca, []) + SomeConversationAction SConversationJoinTag action -> do + let ConversationJoin toAdd role joinType = action + let (localUsers, remoteUsers) = partitionQualified loc toAdd + addedLocalUsers <- Set.toList <$> addLocalUsersToRemoteConv rconvId cu.origUserId localUsers + let allAddedUsers = map (tUntagged . qualifyAs loc) addedLocalUsers <> map tUntagged remoteUsers + pure $ + ( fmap + (\users -> SomeConversationAction SConversationJoinTag (ConversationJoin users role joinType)) + (nonEmpty allAddedUsers), + addedLocalUsers + ) + SomeConversationAction SConversationLeaveTag _ -> do + let users = foldQualified loc (pure . tUnqualified) (const []) cu.origUserId + E.deleteMembersInRemoteConversation rconvId users + pure (Just sca, []) + SomeConversationAction SConversationRemoveMembersTag action -> do + let localUsers = getLocalUsers (tDomain loc) . crmTargets $ action + E.deleteMembersInRemoteConversation rconvId localUsers + pure (Just sca, []) + SomeConversationAction SConversationMemberUpdateTag _ -> + pure (Just sca, []) + SomeConversationAction SConversationDeleteTag _ -> do + E.deleteMembersInRemoteConversation rconvId presentUsers + pure (Just sca, []) + SomeConversationAction SConversationRenameTag _ -> pure (Just sca, []) + SomeConversationAction SConversationMessageTimerUpdateTag _ -> pure (Just sca, []) + SomeConversationAction SConversationReceiptModeUpdateTag _ -> pure (Just sca, []) + SomeConversationAction SConversationAccessDataTag _ -> pure (Just sca, []) + SomeConversationAction SConversationUpdateProtocolTag _ -> pure (Just sca, []) + SomeConversationAction SConversationUpdateAddPermissionTag _ -> pure (Just sca, []) + SomeConversationAction SConversationResetTag _ -> pure (Just sca, []) -- On conversation join, the member(s) joining are not included in the presentUsers, -- however they are included in the alreadyPresentUsers from the incoming request. diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index 6de6c71e7c3..d22b336ea75 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -47,7 +47,6 @@ import Galley.API.Error import Galley.API.MLS import Galley.API.Mapping import Galley.API.One2One -import Galley.API.Teams.Features.Get (getFeatureForTeam) import Galley.API.Util import Galley.App (Env) import Galley.Effects @@ -83,6 +82,7 @@ import Wire.API.User import Wire.BrigAPIAccess import Wire.ConversationStore qualified as E import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.FeaturesConfigSubsystem import Wire.FederationAPIAccess qualified as E import Wire.NotificationSubsystem import Wire.Sem.Now (Now) @@ -126,7 +126,7 @@ createGroupConversationUpToV3 :: Member LegalHoldStore r, Member TeamStore r, Member P.TinyLog r, - Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member TeamCollaboratorsSubsystem r, Member Random r, Member TeamSubsystem r, @@ -175,7 +175,7 @@ createGroupOwnConversation :: Member LegalHoldStore r, Member TeamStore r, Member P.TinyLog r, - Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member TeamCollaboratorsSubsystem r, Member Random r, Member TeamSubsystem r @@ -223,7 +223,7 @@ createGroupConversation :: Member LegalHoldStore r, Member TeamStore r, Member P.TinyLog r, - Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member TeamCollaboratorsSubsystem r, Member Random r, Member TeamSubsystem r @@ -271,7 +271,7 @@ createGroupConvAndMkResponse :: Member NotificationSubsystem r, Member LegalHoldStore r, Member TeamStore r, - Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member TeamCollaboratorsSubsystem r, Member Random r, Member TeamSubsystem r, @@ -316,7 +316,7 @@ createGroupConversationGeneric :: Member LegalHoldStore r, Member TeamStore r, Member P.TinyLog r, - Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member TeamCollaboratorsSubsystem r, Member Random r, Member TeamSubsystem r @@ -383,8 +383,7 @@ checkCreateConvPermissions :: Member (ErrorS ChannelsNotEnabled) r, Member (ErrorS NotAnMlsConversation) r, Member TeamStore r, - Member (Input Opts) r, - Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member TeamCollaboratorsSubsystem r, Member TeamSubsystem r ) => @@ -440,8 +439,7 @@ checkCreateConvPermissions lusr newConv (Just tinfo) allUsers = do ensureCreateChannelPermissions :: forall r. ( Member (ErrorS OperationDenied) r, - Member (Input Opts) r, - Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member (ErrorS NotATeamMember) r, Member (ErrorS ChannelsNotEnabled) r, Member (ErrorS NotAnMlsConversation) r @@ -450,7 +448,7 @@ checkCreateConvPermissions lusr newConv (Just tinfo) allUsers = do Maybe TeamMember -> Sem r () ensureCreateChannelPermissions tid (Just tm) = do - channelsConf <- getFeatureForTeam @ChannelsConfig tid + channelsConf :: LockableFeature ChannelsConfig <- getFeatureForTeam tid when (channelsConf.status == FeatureStatusDisabled) $ throwS @ChannelsNotEnabled when (newConv.newConvProtocol /= BaseProtocolMLSTag) $ throwS @NotAnMlsConversation case channelsConf.config.allowedToCreateChannels of diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 5a5cd06db6b..725117fe7f6 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -93,9 +93,11 @@ import Wire.API.Routes.Named import Wire.API.Routes.Public.Galley.MLS import Wire.API.ServantProto import Wire.API.User (BaseProtocolTag (..)) +import Wire.CodeStore import Wire.ConversationStore qualified as E import Wire.ConversationSubsystem import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.FeaturesConfigSubsystem import Wire.FireAndForget qualified as E import Wire.NotificationSubsystem import Wire.Sem.Now (Now) @@ -505,7 +507,8 @@ updateConversation :: Member TeamCollaboratorsSubsystem r, Member E.MLSCommitLockStore r, Member TeamStore r, - Member (Input ConversationSubsystemConfig) r + Member (Input ConversationSubsystemConfig) r, + Member FeaturesConfigSubsystem r ) => Domain -> ConversationUpdateRequest -> @@ -635,7 +638,6 @@ sendMLSCommitBundle :: Member (Input Opts) r, Member Now r, Member LegalHoldStore r, - Member TeamFeatureStore r, Member Resource r, Member TeamStore r, Member TeamSubsystem r, @@ -644,6 +646,7 @@ sendMLSCommitBundle :: Member ProposalStore r, Member TeamCollaboratorsSubsystem r, Member E.MLSCommitLockStore r, + Member FeaturesConfigSubsystem r, Member (Input ConversationSubsystemConfig) r ) => Domain -> diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index e8140aa492b..7c50cd9d5ee 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -91,8 +91,10 @@ import Wire.API.User.Client import Wire.BackendNotificationQueueAccess import Wire.ConversationStore import Wire.ConversationStore qualified as E +import Wire.ConversationStore.MLS.Types import Wire.ConversationSubsystem import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.FeaturesConfigSubsystem (FeaturesConfigSubsystem) import Wire.LegalHoldStore as LegalHoldStore import Wire.NotificationSubsystem import Wire.Sem.Now (Now) @@ -338,17 +340,16 @@ rmUser :: Member NotificationSubsystem r, Member ConversationSubsystem r, Member (Input Env) r, - Member (Input Opts) r, Member Now r, Member (ListItems p2 TeamId) r, Member ProposalStore r, Member P.TinyLog r, Member Random r, - Member TeamFeatureStore r, Member TeamStore r, Member (Input FanoutLimit) r, Member TeamSubsystem r, - Member (Input ConversationSubsystemConfig) r + Member (Input ConversationSubsystemConfig) r, + Member FeaturesConfigSubsystem r ) => Local UserId -> Maybe ConnId -> @@ -376,7 +377,7 @@ rmUser lusr conn = do leaveTeams page = for_ (pageItems page) $ \tid -> do toNotify <- handleImpossibleErrors $ - getFeatureForTeam @LimitedEventFanoutConfig tid + getFeatureForTeam @_ @LimitedEventFanoutConfig tid >>= ( \case FeatureStatusEnabled -> Left <$> E.getTeamAdmins tid FeatureStatusDisabled -> Right <$> getTeamMembersForFanout tid @@ -517,4 +518,4 @@ iGetMLSClientListForConv :: Sem r ClientList iGetMLSClientListForConv gid = do cm <- E.lookupMLSClients gid - pure $ ClientList (concatMap (Map.keys . snd) (Map.assocs cm)) + pure $ ClientList (concatMap (Map.keys . snd) (Map.assocs (unClientMap cm))) diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index db530859c11..2aa4a480886 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -444,7 +444,7 @@ requestDevice lzusr tid uid = do changeLegalholdStatusAndHandlePolicyConflicts tid luid userLHStatus UserLegalHoldPending notifyClientsAboutLegalHoldRequest zusr (tUnqualified luid) lastPrekey' - requestDeviceFromService :: Local UserId -> Sem r (LastPrekey, [Prekey]) + requestDeviceFromService :: Local UserId -> Sem r (LastPrekey, [UncheckedPrekeyBundle]) requestDeviceFromService luid = do LegalHoldData.dropPendingPrekeys (tUnqualified luid) lhDevice <- LHService.requestNewDevice tid luid diff --git a/services/galley/src/Galley/API/LegalHold/Team.hs b/services/galley/src/Galley/API/LegalHold/Team.hs index 557b19fee5b..977fcfb2918 100644 --- a/services/galley/src/Galley/API/LegalHold/Team.hs +++ b/services/galley/src/Galley/API/LegalHold/Team.hs @@ -24,11 +24,9 @@ module Galley.API.LegalHold.Team ) where -import Data.Default import Data.Id import Data.Range import Galley.Effects -import Galley.Effects.TeamFeatureStore import Galley.Env import Galley.Types.Teams as Team import Imports @@ -39,7 +37,8 @@ import Wire.API.Error.Galley import Wire.API.Team.Feature import Wire.API.Team.Size import Wire.BrigAPIAccess -import Wire.LegalHoldStore qualified as LegalHoldData +import Wire.LegalHold +import Wire.TeamFeatureStore assertLegalHoldEnabledForTeam :: forall r. @@ -54,23 +53,6 @@ assertLegalHoldEnabledForTeam tid = unlessM (isLegalHoldEnabledForTeam tid) $ throwS @'LegalHoldNotEnabled -computeLegalHoldFeatureStatus :: - ( Member LegalHoldStore r, - Member (Input (FeatureDefaults LegalholdConfig)) r - ) => - TeamId -> - DbFeature LegalholdConfig -> - Sem r FeatureStatus -computeLegalHoldFeatureStatus tid dbFeature = do - featureLegalHold <- input @(FeatureDefaults LegalholdConfig) - case featureLegalHold of - FeatureLegalHoldDisabledPermanently -> pure FeatureStatusDisabled - FeatureLegalHoldDisabledByDefault -> - pure (applyDbFeature dbFeature def).status - FeatureLegalHoldWhitelistTeamsAndImplicitConsent -> do - wl <- LegalHoldData.isTeamLegalholdWhitelisted tid - pure $ if wl then FeatureStatusEnabled else FeatureStatusDisabled - isLegalHoldEnabledForTeam :: forall r. ( Member LegalHoldStore r, diff --git a/services/galley/src/Galley/API/MLS/CheckClients.hs b/services/galley/src/Galley/API/MLS/CheckClients.hs index 31ff97cf2ce..9a834fd708d 100644 --- a/services/galley/src/Galley/API/MLS/CheckClients.hs +++ b/services/galley/src/Galley/API/MLS/CheckClients.hs @@ -58,10 +58,10 @@ checkClients :: checkClients lConvOrSub ciphersuite newCM = do let convOrSub = tUnqualified lConvOrSub cm = convOrSub.members - fmap catMaybes . forM (Map.assocs newCM) $ + fmap catMaybes . forM (Map.assocs (unClientMap newCM)) $ \(qtarget, newclients) -> do mClientData <- getClientData lConvOrSub ciphersuite qtarget - unreachable <- case (mClientData, Map.lookup qtarget cm) of + unreachable <- case (mClientData, cmLookup qtarget cm) of -- user is already present, skip check in this case (_, Just existingClients) -> do -- make sure none of the new clients already exist in the group @@ -79,7 +79,7 @@ checkClients lConvOrSub ciphersuite newCM = do let clients = Map.keysSet ( fmap fst newclients - <> Map.findWithDefault mempty qtarget cm + <> fold (cmLookup qtarget cm) ) -- We check the following condition: diff --git a/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs b/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs index 4fe175b8507..ac15b43399f 100644 --- a/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs +++ b/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs @@ -97,7 +97,7 @@ processInternalCommit senderIdentity con lConvOrSub ciphersuite ciphersuiteUpdat let convOrSub = tUnqualified lConvOrSub qusr = cidQualifiedUser senderIdentity.client cm = convOrSub.members - newUserClients = Map.assocs (paAdd action) + newUserClients = Map.assocs (unClientMap (paAdd action)) -- check that all pending proposals are referenced in the commit allPendingProposals <- @@ -135,9 +135,9 @@ processInternalCommit senderIdentity con lConvOrSub ciphersuite ciphersuiteUpdat -- subconversation case, an empty list is returned. membersToRemove <- case convOrSub of SubConv _ _ -> pure [] - Conv _ -> mapMaybe hush <$$> for (Map.assocs (paRemove action)) $ + Conv _ -> mapMaybe hush <$$> for (Map.assocs (unClientMap (paRemove action))) $ \(qtarget, Map.keysSet -> clients) -> runError @() $ do - let clientsInConv = Map.keysSet (Map.findWithDefault mempty qtarget cm) + let clientsInConv = foldMap Map.keysSet (cmLookup qtarget cm) let removedClients = Set.intersection clients clientsInConv -- ignore user if none of their clients are being removed @@ -242,7 +242,7 @@ processInternalCommit senderIdentity con lConvOrSub ciphersuite ciphersuiteUpdat -- Remove clients from the conversation state. This includes client removals -- of all types (see Note [client removal]). - for_ (Map.assocs (paRemove action)) $ \(qtarget, clients) -> do + for_ (Map.assocs (unClientMap (paRemove action))) $ \(qtarget, clients) -> do removeMLSClients (cnvmlsGroupId convOrSub.mlsMeta) qtarget (Map.keysSet clients) -- add clients to the conversation state diff --git a/services/galley/src/Galley/API/MLS/GroupInfoCheck.hs b/services/galley/src/Galley/API/MLS/GroupInfoCheck.hs index e4dcfc4e5bc..798345adf3a 100644 --- a/services/galley/src/Galley/API/MLS/GroupInfoCheck.hs +++ b/services/galley/src/Galley/API/MLS/GroupInfoCheck.hs @@ -45,6 +45,7 @@ import Wire.API.MLS.Serialisation import Wire.API.Team.Feature import Wire.ConversationStore import Wire.ConversationStore.MLS.Types +import Wire.FeaturesConfigSubsystem (FeaturesConfigSubsystem) data GroupInfoMismatch = GroupInfoMismatch {clients :: [(Int, ClientIdentity)]} @@ -55,8 +56,8 @@ checkGroupState :: ( Member (Error GroupInfoMismatch) r, Member (Input Opts) r, Member (Error MLSProtocolError) r, - Member TeamFeatureStore r, - Member ConversationStore r + Member ConversationStore r, + Member FeaturesConfigSubsystem r ) => ConvOrSubConv -> IndexMap -> @@ -102,7 +103,7 @@ existingGroupStateMismatch convOrSub = Right m -> pure m isGroupInfoCheckEnabled :: - ( Member TeamFeatureStore r, + ( Member FeaturesConfigSubsystem r, Member (Input Opts) r ) => Maybe TeamId -> @@ -111,5 +112,5 @@ isGroupInfoCheckEnabled Nothing = pure False isGroupInfoCheckEnabled (Just tid) = fmap isJust . runNonDetMaybe $ do global <- inputs (view $ settings . checkGroupInfo) guard (global == Just True) - mls <- getFeatureForTeam @MLSConfig tid + mls <- getFeatureForTeam @_ @MLSConfig tid guard (getAny mls.config.mlsGroupInfoDiagnostics) diff --git a/services/galley/src/Galley/API/MLS/IncomingMessage.hs b/services/galley/src/Galley/API/MLS/IncomingMessage.hs index 2a0e7309646..3a3fba62514 100644 --- a/services/galley/src/Galley/API/MLS/IncomingMessage.hs +++ b/services/galley/src/Galley/API/MLS/IncomingMessage.hs @@ -71,6 +71,7 @@ data IncomingBundle = IncomingBundle sender :: Sender, commit :: RawMLS Commit, rawMessage :: RawMLS Message, + appMessage :: Maybe IncomingMessage, welcome :: Maybe (RawMLS Welcome), groupInfo :: RawMLS GroupInfo, serialized :: ByteString @@ -137,6 +138,7 @@ mkIncomingBundle bundle = do sender = content.sender, commit = commit, rawMessage = bundle.value.commitMsg, + appMessage = bundle.value.appMessage >>= mkIncomingMessage, welcome = bundle.value.welcome, groupInfo = bundle.value.groupInfo, serialized = bundle.raw diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index 052b8132b0b..8ca29cac361 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -89,6 +89,7 @@ import Wire.ConversationStore import Wire.ConversationStore.MLS.Types import Wire.ConversationSubsystem import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.FeaturesConfigSubsystem import Wire.FederationAPIAccess import Wire.NotificationSubsystem import Wire.Sem.Now qualified as Now @@ -178,7 +179,6 @@ postMLSCommitBundle :: Member (Error MLSOutOfSyncError) r, Member (ErrorS GroupIdVersionNotSupported) r, Member (Input EnableOutOfSyncCheck) r, - Member TeamFeatureStore r, Member Random r, Member Resource r, Members MLSBundleStaticErrors r, @@ -186,7 +186,8 @@ postMLSCommitBundle :: Member ConversationSubsystem r, Member MLSCommitLockStore r, Member TeamSubsystem r, - Member (Input ConversationSubsystemConfig) r + Member (Input ConversationSubsystemConfig) r, + Member FeaturesConfigSubsystem r ) => Local x -> Qualified UserId -> @@ -209,7 +210,6 @@ postMLSCommitBundleFromLocalUser :: Member (Error GroupInfoDiagnostics) r, Member (Error MLSOutOfSyncError) r, Member (ErrorS GroupIdVersionNotSupported) r, - Member TeamFeatureStore r, Member Random r, Member Resource r, Members MLSBundleStaticErrors r, @@ -217,7 +217,8 @@ postMLSCommitBundleFromLocalUser :: Member ConversationSubsystem r, Member MLSCommitLockStore r, Member TeamSubsystem r, - Member (Input ConversationSubsystemConfig) r + Member (Input ConversationSubsystemConfig) r, + Member FeaturesConfigSubsystem r ) => Version -> Local UserId -> @@ -244,7 +245,6 @@ postMLSCommitBundleToLocalConv :: Member (Error MLSOutOfSyncError) r, Member (ErrorS GroupIdVersionNotSupported) r, Member (Input EnableOutOfSyncCheck) r, - Member TeamFeatureStore r, Member Random r, Member Resource r, Members MLSBundleStaticErrors r, @@ -252,7 +252,8 @@ postMLSCommitBundleToLocalConv :: Member ConversationSubsystem r, Member MLSCommitLockStore r, Member TeamSubsystem r, - Member (Input ConversationSubsystemConfig) r + Member (Input ConversationSubsystemConfig) r, + Member FeaturesConfigSubsystem r ) => Qualified UserId -> ClientId -> @@ -265,6 +266,9 @@ postMLSCommitBundleToLocalConv qusr c conn bundle ctype lConvOrSubId = do lConvOrSub <- fetchConvOrSub qusr bundle.groupId ctype lConvOrSubId let convOrSub = tUnqualified lConvOrSub + -- validate application message + traverse_ (validateMessage qusr c lConvOrSub (Just (succ bundle.epoch))) bundle.appMessage + ciphersuite <- note (mlsProtocolError "Unsupported ciphersuite") $ cipherSuiteTag bundle.groupInfo.value.groupContext.cipherSuite @@ -314,7 +318,7 @@ postMLSCommitBundleToLocalConv qusr c conn bundle ctype lConvOrSubId = do -- reject message if the conversation is out of sync lift $ do - let newUsers = Map.keysSet action.paAdd + let newUsers = Map.keysSet (unClientMap action.paAdd) checkConversationOutOfSync newUsers lConvOrSub ciphersuite lift $ @@ -333,7 +337,7 @@ postMLSCommitBundleToLocalConv qusr c conn bundle ctype lConvOrSubId = do bundle.commit.value -- the sender client is included in the Add action on the first commit, -- but it doesn't need to get a welcome message, so we filter it out here - let newClients = filter ((/=) senderIdentity.client) (cmIdentities (paAdd action)) + let newClients = cmRemoveClient senderIdentity.client (paAdd action) pure (events, newClients) Nothing -> do (newIndexMap, action) <- lift $ getExternalCommitData senderIdentity.client lConvOrSub bundle.epoch bundle.commit.value @@ -347,15 +351,25 @@ postMLSCommitBundleToLocalConv qusr c conn bundle ctype lConvOrSubId = do bundle.epoch action bundle.commit.value.path - pure ([], []) + pure ([], mempty) lift $ do updateOutOfSyncFlag senderIdentity.client lConvOrSub storeGroupInfo convOrSub.id (GroupInfoData bundle.groupInfo.raw) propagateMessage qusr (Just c) lConvOrSub conn bundle.rawMessage convOrSub.members pure (events, newClients) + -- send welcome messages for_ bundle.welcome $ \welcome -> - sendWelcomes lConvOrSubId qusr conn newClients welcome + sendWelcomes lConvOrSubId qusr conn (cmIdentities newClients) welcome + + -- send application message + for_ bundle.appMessage $ \msg -> do + -- reload conversation from db to make sure we have an up-to-date list of members + lConvOrSub' <- fetchConvOrSub qusr bundle.groupId ctype lConvOrSubId + let convOrSub' = tUnqualified lConvOrSub' + propagateMessage qusr (Just c) lConvOrSub' conn msg.rawMessage $ + void convOrSub'.members + pure events handleGroupInfoMismatch :: @@ -510,8 +524,29 @@ postMLSMessageToLocalConv :: Sem r [LocalConversationUpdate] postMLSMessageToLocalConv qusr c con msg ctype convOrSubId = do lConvOrSub <- fetchConvOrSub qusr msg.groupId ctype convOrSubId - let convOrSub = tUnqualified lConvOrSub + validateMessage qusr c lConvOrSub Nothing msg + propagateMessage qusr (Just c) lConvOrSub con msg.rawMessage (tUnqualified lConvOrSub).members + pure [] + +validateMessage :: + ( HasProposalEffects r, + Member (ErrorS ConvNotFound) r, + Member (ErrorS MLSClientSenderUserMismatch) r, + Member (ErrorS MLSStaleMessage) r, + Member (ErrorS MLSUnsupportedMessage) r, + Member (Error MLSOutOfSyncError) r, + Member (ErrorS MLSInvalidLeafNodeSignature) r, + Member (Input EnableOutOfSyncCheck) r + ) => + Qualified UserId -> + ClientId -> + Local ConvOrSubConv -> + Maybe Epoch -> + IncomingMessage -> + Sem r () +validateMessage qusr c lConvOrSub mEpoch msg = do + let convOrSub = tUnqualified lConvOrSub for_ msg.sender $ \sender -> void $ getSenderIdentity qusr c sender lConvOrSub @@ -537,22 +572,21 @@ postMLSMessageToLocalConv qusr c con msg ctype convOrSubId = do -- reject application messages for epoch 0 let epochInt :: Epoch -> Integer epochInt = fromIntegral . epochNumber + when (epochInt msg.epoch == 0) . throw $ mlsProtocolError "Application messages at epoch 0 are not supported" -- reject application messages older than 2 epochs - case convOrSub.mlsMeta.cnvmlsActiveData of + let mEpoch' = mEpoch <|> fmap (.epoch) convOrSub.mlsMeta.cnvmlsActiveData + case mEpoch' of Nothing -> throw $ mlsProtocolError "Application messages at epoch 0 are not supported" - Just activeData -> + Just epoch -> when - ( epochInt msg.epoch < epochInt activeData.epoch - 2 - || epochInt msg.epoch > epochInt activeData.epoch + ( epochInt msg.epoch < epochInt epoch - 2 + || epochInt msg.epoch > epochInt epoch ) $ throwS @'MLSStaleMessage - propagateMessage qusr (Just c) lConvOrSub con msg.rawMessage (tUnqualified lConvOrSub).members - pure [] - postMLSMessageToRemoteConv :: ( Members MLSMessageStaticErrors r, HasProposalEffects r, diff --git a/services/galley/src/Galley/API/MLS/OutOfSync.hs b/services/galley/src/Galley/API/MLS/OutOfSync.hs index 955efdd84ff..e12aaddf65e 100644 --- a/services/galley/src/Galley/API/MLS/OutOfSync.hs +++ b/services/galley/src/Galley/API/MLS/OutOfSync.hs @@ -97,5 +97,5 @@ getOutOfSyncUsers newMembers lconv = Set.fromList $ map (tUntagged . qualifyAs lconv . (.id_)) conv.mcLocalMembers <> map (tUntagged . (.id_)) conv.mcRemoteMembers - groupMembers = Map.keysSet conv.mcMembers <> newMembers + groupMembers = Map.keysSet (unClientMap conv.mcMembers) <> newMembers in Set.difference convMembers groupMembers diff --git a/services/galley/src/Galley/API/MLS/Propagate.hs b/services/galley/src/Galley/API/MLS/Propagate.hs index d7a543349ce..a8a656a4677 100644 --- a/services/galley/src/Galley/API/MLS/Propagate.hs +++ b/services/galley/src/Galley/API/MLS/Propagate.hs @@ -35,7 +35,6 @@ 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.LeafNode import Wire.API.MLS.Message import Wire.API.MLS.Serialisation import Wire.API.MLS.SubConversation @@ -64,7 +63,7 @@ propagateMessage :: Local ConvOrSubConv -> Maybe ConnId -> RawMLS Message -> - ClientMap LeafIndex -> + ClientMap a -> Sem r () propagateMessage qusr mSenderClient lConvOrSub con msg cm = do now <- Now.get @@ -120,14 +119,12 @@ propagateMessage qusr mSenderClient lConvOrSub con msg cm = do localMemberRecipient loc lm = do let localUserQId = tUntagged (qualifyAs loc localUserId) localUserId = lm.id_ - clients <- nonEmpty $ Map.keys (Map.findWithDefault mempty localUserQId cmWithoutSender) + clients <- nonEmpty $ cmLookupClients localUserQId cmWithoutSender pure $ Recipient localUserId (RecipientClientsSome clients) remoteMemberMLSClients :: RemoteMember -> Maybe (UserId, NonEmpty ClientId) remoteMemberMLSClients rm = do let remoteUserQId = tUntagged rm.id_ remoteUserId = qUnqualified remoteUserQId - clients <- - nonEmpty . map fst $ - Map.assocs (Map.findWithDefault mempty remoteUserQId cmWithoutSender) + clients <- nonEmpty $ cmLookupClients remoteUserQId cmWithoutSender pure (remoteUserId, clients) diff --git a/services/galley/src/Galley/API/MLS/Proposal.hs b/services/galley/src/Galley/API/MLS/Proposal.hs index 72d2db09d3e..68dc6a0a7a4 100644 --- a/services/galley/src/Galley/API/MLS/Proposal.hs +++ b/services/galley/src/Galley/API/MLS/Proposal.hs @@ -82,9 +82,7 @@ data ProposalAction = ProposalAction instance Semigroup ProposalAction where ProposalAction add1 rem1 <> ProposalAction add2 rem2 = - ProposalAction - (Map.unionWith mappend add1 add2) - (Map.unionWith mappend rem1 rem2) + ProposalAction (add1 <> add2) (rem1 <> rem2) instance Monoid ProposalAction where mempty = ProposalAction mempty mempty diff --git a/services/galley/src/Galley/API/MLS/Removal.hs b/services/galley/src/Galley/API/MLS/Removal.hs index a65e4a0c80b..9ae0b7712f3 100644 --- a/services/galley/src/Galley/API/MLS/Removal.hs +++ b/services/galley/src/Galley/API/MLS/Removal.hs @@ -249,7 +249,8 @@ removeUser lc includeMain qusr = do getClients = map (first (mkClientIdentity qusr)) . Map.assocs - . Map.findWithDefault mempty qusr + . fold + . cmLookup qusr . (.members) case includeMain of RemoveUserIncludeMain -> diff --git a/services/galley/src/Galley/API/MLS/SubConversation.hs b/services/galley/src/Galley/API/MLS/SubConversation.hs index 3616c18e773..8d45dfc410c 100644 --- a/services/galley/src/Galley/API/MLS/SubConversation.hs +++ b/services/galley/src/Galley/API/MLS/SubConversation.hs @@ -34,7 +34,6 @@ where import Control.Arrow import Control.Monad.Codensity hiding (reset) import Data.Id -import Data.Map qualified as Map import Data.Qualified import Galley.API.MLS import Galley.API.MLS.Conversation @@ -336,7 +335,7 @@ leaveLocalSubConversation cid lcnv sub = do -- plan to remove the leaver from the member list Eff.planClientRemoval gid (Identity cid) let cm = cmRemoveClient cid (scMembers subConv) - if Map.null cm + if cmNull cm then do resetLocalSubConversation (cidQualifiedUser cid) diff --git a/services/galley/src/Galley/API/MLS/Util.hs b/services/galley/src/Galley/API/MLS/Util.hs index 1127873fc5d..77ee2fd6701 100644 --- a/services/galley/src/Galley/API/MLS/Util.hs +++ b/services/galley/src/Galley/API/MLS/Util.hs @@ -24,7 +24,6 @@ import Data.Id import Data.Qualified import Data.Set qualified as Set import Data.Text qualified as T -import Galley.Data.Types import Galley.Effects import Imports import Polysemy @@ -44,6 +43,7 @@ import Wire.API.MLS.Serialisation import Wire.API.MLS.SubConversation import Wire.ConversationStore import Wire.ProposalStore +import Wire.StoredConversation getLocalConvForUser :: ( Member (ErrorS 'ConvNotFound) r, diff --git a/services/galley/src/Galley/API/Public/Bot.hs b/services/galley/src/Galley/API/Public/Bot.hs index 4d151325496..1a28c98dfe3 100644 --- a/services/galley/src/Galley/API/Public/Bot.hs +++ b/services/galley/src/Galley/API/Public/Bot.hs @@ -25,7 +25,6 @@ import Galley.API.Update import Galley.App import Galley.Effects import Galley.Effects qualified as E -import Galley.Options import Polysemy import Polysemy.Input import Wire.API.Error @@ -34,6 +33,7 @@ import Wire.API.Event.Team qualified as Public () import Wire.API.Provider.Bot import Wire.API.Routes.API import Wire.API.Routes.Public.Galley.Bot +import Wire.FeaturesConfigSubsystem (FeaturesConfigSubsystem) import Wire.TeamSubsystem (TeamSubsystem) botAPI :: API BotAPI GalleyEffects @@ -45,12 +45,11 @@ getBotConversation :: forall r. ( Member E.ConversationStore r, Member (Input (Local ())) r, - Member (Input Opts) r, - Member TeamFeatureStore r, Member (ErrorS 'AccessDenied) r, Member (ErrorS 'ConvNotFound) r, Member TeamStore r, - Member TeamSubsystem r + Member TeamSubsystem r, + Member FeaturesConfigSubsystem r ) => BotId -> ConvId -> diff --git a/services/galley/src/Galley/API/Public/Feature.hs b/services/galley/src/Galley/API/Public/Feature.hs index 09e315fc0ba..81f8d6247c8 100644 --- a/services/galley/src/Galley/API/Public/Feature.hs +++ b/services/galley/src/Galley/API/Public/Feature.hs @@ -29,6 +29,7 @@ import Wire.API.Routes.API import Wire.API.Routes.Public.Galley.Feature import Wire.API.Routes.Version import Wire.API.Team.Feature +import Wire.FeaturesConfigSubsystem (getAllTeamFeaturesForTeamMember) featureAPIGetPut :: forall cfg r. (_) => API (FeatureAPIGetPut cfg) r featureAPIGetPut = @@ -62,7 +63,7 @@ featureAPI = <@> hoistAPI id featureAPIGetPut <@> mkNamedAPI @'("get", LimitedEventFanoutConfig) getFeature <@> mkNamedAPI @"get-all-feature-configs-for-user" getAllTeamFeaturesForUser - <@> mkNamedAPI @"get-all-feature-configs-for-team" getAllTeamFeaturesForTeam + <@> mkNamedAPI @"get-all-feature-configs-for-team" getAllTeamFeaturesForTeamMember <@> deprecatedFeatureConfigAPI <@> deprecatedFeatureAPI <@> mkNamedAPI @'("get", DomainRegistrationConfig) getFeature diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 7d3e758030c..ee61bf748a4 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -75,11 +75,8 @@ import Galley.API.Mapping qualified as Mapping import Galley.API.One2One import Galley.API.Teams.Features.Get import Galley.API.Util -import Galley.Data.Types (Code (codeConversation)) -import Galley.Data.Types qualified as Data import Galley.Effects import Galley.Env -import Galley.Options import Imports import Polysemy import Polysemy.Error @@ -108,8 +105,12 @@ import Wire.API.Routes.MultiTablePaging qualified as Public import Wire.API.Team.Feature as Public import Wire.API.Team.Member (HiddenPerm (..), TeamMember) import Wire.API.User +import Wire.CodeStore +import Wire.CodeStore.Code (Code (codeConversation)) +import Wire.CodeStore.Code qualified as Data import Wire.ConversationStore qualified as E import Wire.ConversationStore.MLS.Types +import Wire.FeaturesConfigSubsystem import Wire.FederationAPIAccess qualified as E import Wire.HashPassword (HashPassword) import Wire.RateLimit @@ -640,8 +641,7 @@ getConversationByReusableCode :: Member (ErrorS 'ConvAccessDenied) r, Member (ErrorS 'GuestLinksDisabled) r, Member (ErrorS 'NotATeamMember) r, - Member TeamFeatureStore r, - Member (Input Opts) r, + Member FeaturesConfigSubsystem r, Member HashPassword r, Member RateLimit r, Member TeamSubsystem r @@ -668,8 +668,7 @@ getConversationByReusableCode lusr key value = do ensureGuestLinksEnabled :: forall r. ( Member (ErrorS 'GuestLinksDisabled) r, - Member TeamFeatureStore r, - Member (Input Opts) r + Member FeaturesConfigSubsystem r ) => Maybe TeamId -> Sem r () @@ -683,8 +682,7 @@ getConversationGuestLinksStatus :: ( Member ConversationStore r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'ConvAccessDenied) r, - Member (Input Opts) r, - Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member TeamSubsystem r ) => UserId -> @@ -698,13 +696,11 @@ getConversationGuestLinksStatus uid convId = do getConversationGuestLinksFeatureStatus :: forall r. - ( Member TeamFeatureStore r, - Member (Input Opts) r - ) => + (Member FeaturesConfigSubsystem r) => Maybe TeamId -> Sem r (LockableFeature GuestLinksConfig) -getConversationGuestLinksFeatureStatus Nothing = getFeatureForServer @GuestLinksConfig -getConversationGuestLinksFeatureStatus (Just tid) = getFeatureForTeam @GuestLinksConfig tid +getConversationGuestLinksFeatureStatus Nothing = getFeatureForServer +getConversationGuestLinksFeatureStatus (Just tid) = getFeatureForTeam tid -- | The same as 'getMLSSelfConversation', but it throws an error in case the -- backend is not configured for MLS (the proxy for it being the existance of diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index df79cc4504b..2ac49386349 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -128,9 +128,11 @@ import Wire.API.Team.SearchVisibility qualified as Public import Wire.API.User qualified as U import Wire.BrigAPIAccess qualified as Brig import Wire.BrigAPIAccess qualified as E +import Wire.CodeStore import Wire.ConversationStore qualified as E import Wire.ConversationSubsystem import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.FeaturesConfigSubsystem import Wire.ListItems qualified as E import Wire.NotificationSubsystem import Wire.Sem.Now @@ -707,11 +709,10 @@ deleteTeamMember :: Member (ErrorS 'TeamNotFound) r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS OperationDenied) r, - Member (Input Opts) r, Member Now r, Member NotificationSubsystem r, Member ConversationSubsystem r, - Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member TeamStore r, Member P.TinyLog r, Member (Input FanoutLimit) r, @@ -736,11 +737,10 @@ deleteNonBindingTeamMember :: Member (ErrorS 'TeamNotFound) r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS OperationDenied) r, - Member (Input Opts) r, Member Now r, Member NotificationSubsystem r, Member ConversationSubsystem r, - Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member TeamStore r, Member P.TinyLog r, Member (Input FanoutLimit) r, @@ -765,11 +765,10 @@ deleteTeamMember' :: Member (ErrorS 'TeamNotFound) r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS OperationDenied) r, - Member (Input Opts) r, Member Now r, Member NotificationSubsystem r, Member ConversationSubsystem r, - Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member TeamStore r, Member P.TinyLog r, Member (Input FanoutLimit) r, @@ -811,16 +810,14 @@ deleteTeamMember' lusr zcon tid remove mBody = do Journal.teamUpdate tid sizeAfterDelete $ filter (/= remove) owners pure TeamMemberDeleteAccepted else do - getFeatureForTeam @LimitedEventFanoutConfig tid - >>= ( \case - FeatureStatusEnabled -> do - admins <- E.getTeamAdmins tid - uncheckedDeleteTeamMember lusr (Just zcon) tid remove (Left admins) - FeatureStatusDisabled -> do - mems <- getTeamMembersForFanout tid - uncheckedDeleteTeamMember lusr (Just zcon) tid remove (Right mems) - ) - . (.status) + (feat :: LockableFeature LimitedEventFanoutConfig) <- getFeatureForTeam tid + case feat.status of + FeatureStatusEnabled -> do + admins <- E.getTeamAdmins tid + uncheckedDeleteTeamMember lusr (Just zcon) tid remove (Left admins) + FeatureStatusDisabled -> do + mems <- getTeamMembersForFanout tid + uncheckedDeleteTeamMember lusr (Just zcon) tid remove (Right mems) pure TeamMemberDeleteCompleted -- This function is "unchecked" because it does not validate that the user has the `RemoveTeamMember` permission. @@ -1310,10 +1307,9 @@ removeTeamCollaborator :: Member (ErrorS NotATeamMember) r, Member NotificationSubsystem r, Member ConversationSubsystem r, - Member (Input Opts) r, Member Now r, Member P.TinyLog r, - Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member TeamStore r, Member TeamCollaboratorsSubsystem r, Member (Input FanoutLimit) r, @@ -1330,7 +1326,7 @@ removeTeamCollaborator lusr tid rusr = do zusrMember <- TeamSubsystem.internalGetTeamMember (tUnqualified lusr) tid void $ permissionCheck RemoveTeamCollaborator zusrMember toNotify <- - getFeatureForTeam @LimitedEventFanoutConfig tid + (getFeatureForTeam @_ @LimitedEventFanoutConfig tid) >>= ( \case FeatureStatusEnabled -> Left <$> E.getTeamAdmins tid FeatureStatusDisabled -> Right <$> getTeamMembersForFanout tid diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 3804928ee57..4c9bf4b9797 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE UndecidableSuperClasses #-} {-# OPTIONS_GHC -Wno-ambiguous-fields #-} -- This file is part of the Wire Server implementation. @@ -48,7 +49,6 @@ import Galley.API.Util (assertTeamExists, getTeamMembersForFanout, permissionChe import Galley.App import Galley.Effects import Galley.Effects.SearchVisibilityStore qualified as SearchVisibilityData -import Galley.Effects.TeamFeatureStore import Galley.Env (FanoutLimit) import Galley.Options import Galley.Types.Teams @@ -67,30 +67,37 @@ import Wire.API.Federation.Error import Wire.API.Team.Feature import Wire.API.Team.Member import Wire.BrigAPIAccess (updateSearchVisibilityInbound) +import Wire.CodeStore import Wire.ConversationStore (MLSCommitLockStore) import Wire.ConversationSubsystem import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.FeaturesConfigSubsystem (FeaturesConfigSubsystem) +import Wire.FeaturesConfigSubsystem.Types (GetFeatureConfigEffects) +import Wire.FeaturesConfigSubsystem.Utils (resolveServerFeature) import Wire.NotificationSubsystem import Wire.Sem.Now (Now) import Wire.Sem.Paging import Wire.Sem.Paging.Cassandra import Wire.TeamCollaboratorsSubsystem +import Wire.TeamFeatureStore import Wire.TeamSubsystem (TeamSubsystem) import Wire.TeamSubsystem qualified as TeamSubsystem +type ComputeFeatureConstraints cfg r = (Member FeaturesConfigSubsystem r) + patchFeatureInternal :: forall cfg r. ( SetFeatureConfig cfg, ComputeFeatureConstraints cfg r, SetFeatureForTeamConstraints cfg r, Member (ErrorS 'TeamNotFound) r, - Member (Input Opts) r, Member TeamStore r, Member TeamFeatureStore r, Member P.TinyLog r, Member NotificationSubsystem r, Member (Input FanoutLimit) r, - Member TeamSubsystem r + Member TeamSubsystem r, + GetFeatureConfigEffects r ) => TeamId -> LockableFeaturePatch cfg -> @@ -98,12 +105,12 @@ patchFeatureInternal :: patchFeatureInternal tid patch = do assertTeamExists tid dbFeature <- getDbFeature tid - defFeature <- getFeatureForServer @cfg + (defFeature :: LockableFeature cfg) <- resolveServerFeature let dbFeatureWithDefaults = dbFeature.applyDbFeature defFeature let patchedFeature = applyPatch dbFeatureWithDefaults prepareFeature tid patchedFeature patchDbFeature tid patch - returnedFeature <- getFeatureForTeam @cfg tid + (returnedFeature :: LockableFeature cfg) <- getFeatureForTeam tid pushFeatureEvent @cfg tid (mkUpdateEvent tid returnedFeature) pure returnedFeature where @@ -123,7 +130,6 @@ setFeature :: Member (ErrorS 'NotATeamMember) r, Member (ErrorS OperationDenied) r, Member (Error TeamFeatureError) r, - Member (Input Opts) r, Member TeamFeatureStore r, Member P.TinyLog r, Member NotificationSubsystem r, @@ -146,7 +152,6 @@ setFeatureInternal :: SetFeatureForTeamConstraints cfg r, Member (ErrorS 'TeamNotFound) r, Member (Error TeamFeatureError) r, - Member (Input Opts) r, Member TeamStore r, Member TeamFeatureStore r, Member P.TinyLog r, @@ -167,7 +172,6 @@ setFeatureUnchecked :: ComputeFeatureConstraints cfg r, SetFeatureForTeamConstraints cfg r, Member (Error TeamFeatureError) r, - Member (Input Opts) r, Member TeamFeatureStore r, Member (P.Logger (Log.Msg -> Log.Msg)) r, Member NotificationSubsystem r, @@ -178,7 +182,7 @@ setFeatureUnchecked :: Feature cfg -> Sem r (LockableFeature cfg) setFeatureUnchecked tid feat = do - feat0 <- getFeatureForTeam @cfg tid + (feat0 :: LockableFeature cfg) <- getFeatureForTeam tid guardLockStatus feat0.lockStatus setFeatureForTeam @cfg tid (withLockStatus feat0.lockStatus feat) @@ -201,7 +205,6 @@ persistFeature :: forall cfg r. ( GetFeatureConfig cfg, ComputeFeatureConstraints cfg r, - Member (Input Opts) r, Member TeamFeatureStore r ) => TeamId -> @@ -209,7 +212,7 @@ persistFeature :: Sem r (LockableFeature cfg) persistFeature tid feat = do setDbFeature tid feat - getFeatureForTeam @cfg tid + getFeatureForTeam tid pushFeatureEvent :: forall cfg r. @@ -250,7 +253,6 @@ setFeatureForTeam :: ( SetFeatureConfig cfg, SetFeatureForTeamConstraints cfg r, ComputeFeatureConstraints cfg r, - Member (Input Opts) r, Member P.TinyLog r, Member NotificationSubsystem r, Member TeamFeatureStore r, @@ -403,10 +405,11 @@ instance SetFeatureConfig MLSConfig where SetFeatureForTeamConstraints MLSConfig (r :: EffectRow) = ( Member (Input Opts) r, Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member (Error TeamFeatureError) r ) prepareFeature tid feat = do - mlsMigrationConfig <- getFeatureForTeam @MlsMigrationConfig tid + (mlsMigrationConfig :: LockableFeature MlsMigrationConfig) <- getFeatureForTeam tid unless ( -- default protocol needs to be included in supported protocols feat.config.mlsDefaultProtocol `elem` feat.config.mlsSupportedProtocols @@ -440,10 +443,11 @@ instance SetFeatureConfig MlsMigrationConfig where SetFeatureForTeamConstraints MlsMigrationConfig (r :: EffectRow) = ( Member (Input Opts) r, Member (Error TeamFeatureError) r, - Member TeamFeatureStore r + Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r ) prepareFeature tid feat = do - mlsConfig <- getFeatureForTeam @MLSConfig tid + (mlsConfig :: LockableFeature MLSConfig) <- getFeatureForTeam tid unless ( -- when MLS migration is enabled, MLS needs to be enabled as well feat.status == FeatureStatusDisabled || mlsConfig.status == FeatureStatusEnabled diff --git a/services/galley/src/Galley/API/Teams/Features/Get.hs b/services/galley/src/Galley/API/Teams/Features/Get.hs index e99b035ccc9..ece1922543c 100644 --- a/services/galley/src/Galley/API/Teams/Features/Get.hs +++ b/services/galley/src/Galley/API/Teams/Features/Get.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE UndecidableSuperClasses #-} {-# OPTIONS_GHC -Wno-ambiguous-fields #-} -- This file is part of the Wire Server implementation. @@ -27,7 +26,6 @@ module Galley.API.Teams.Features.Get getSingleFeatureForUser, GetFeatureConfig (..), getFeatureForTeam, - getFeatureForServer, guardSecondFactorDisabled, DoAuth (..), featureEnabledForTeam, @@ -36,106 +34,34 @@ module Galley.API.Teams.Features.Get where import Control.Error (hush) -import Control.Lens -import Data.Default import Data.Id -import Data.Kind -import Data.Qualified (Local, tUnqualified) import Data.SOP import Data.Tagged -import Galley.API.LegalHold.Team import Galley.API.Util import Galley.Effects -import Galley.Effects.TeamFeatureStore -import Galley.Options -import Galley.Types.Teams import Imports import Polysemy import Polysemy.Error -import Polysemy.Input import Wire.API.Conversation (cnvmTeam) import Wire.API.Error import Wire.API.Error.Galley import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti qualified as Multi import Wire.API.Team.Feature -import Wire.BrigAPIAccess (getAccountConferenceCallingConfigClient) import Wire.ConversationStore as ConversationStore +import Wire.FeaturesConfigSubsystem +import Wire.FeaturesConfigSubsystem.Types +import Wire.TeamFeatureStore import Wire.TeamStore qualified as TeamStore import Wire.TeamSubsystem (TeamSubsystem) import Wire.TeamSubsystem qualified as TeamSubsystem data DoAuth = DoAuth UserId | DontDoAuth -type DefaultGetFeatureForUserConstraints cfg r = - ( Member (Input Opts) r, - Member TeamFeatureStore r, - ComputeFeatureConstraints cfg r - ) - --- | Don't export methods of this typeclass -class - ( IsFeatureConfig cfg, - GetFeatureDefaults (FeatureDefaults cfg), - NpProject cfg Features - ) => - GetFeatureConfig cfg - where - type GetFeatureForUserConstraints cfg (r :: EffectRow) :: Constraint - type - GetFeatureForUserConstraints cfg (r :: EffectRow) = - DefaultGetFeatureForUserConstraints cfg r - - type ComputeFeatureConstraints cfg (r :: EffectRow) :: Constraint - type ComputeFeatureConstraints cfg r = () - - getFeatureForUser :: - (GetFeatureForUserConstraints cfg r) => - UserId -> - Sem r (LockableFeature cfg) - default getFeatureForUser :: - (DefaultGetFeatureForUserConstraints cfg r) => - UserId -> - Sem r (LockableFeature cfg) - getFeatureForUser _ = getFeatureForServer - - computeFeature :: - (ComputeFeatureConstraints cfg r) => - TeamId -> - LockableFeature cfg -> - DbFeature cfg -> - Sem r (LockableFeature cfg) - default computeFeature :: - TeamId -> - LockableFeature cfg -> - DbFeature cfg -> - Sem r (LockableFeature cfg) - computeFeature _tid defFeature dbFeature = - pure $ - resolveDbFeature @cfg defFeature dbFeature - -getFeature :: - forall cfg r. - ( GetFeatureConfig cfg, - ComputeFeatureConstraints cfg r, - Member (Input Opts) r, - Member TeamFeatureStore r, - Member (ErrorS 'NotATeamMember) r, - Member TeamSubsystem r - ) => - UserId -> - TeamId -> - Sem r (LockableFeature cfg) -getFeature uid tid = do - void $ TeamSubsystem.internalGetTeamMember uid tid >>= noteS @'NotATeamMember - getFeatureForTeam @cfg tid - getFeatureInternal :: ( GetFeatureConfig cfg, - ComputeFeatureConstraints cfg r, - Member (Input Opts) r, Member (ErrorS 'TeamNotFound) r, - Member TeamFeatureStore r, - Member TeamStore r + Member TeamStore r, + Member FeaturesConfigSubsystem r ) => TeamId -> Sem r (LockableFeature cfg) @@ -162,47 +88,11 @@ getTeamAndCheckMembership uid = do assertTeamExists tid pure mTid -getAllTeamFeaturesForTeam :: - forall r. - ( Member (Input Opts) r, - Member (ErrorS 'NotATeamMember) r, - Member LegalHoldStore r, - Member TeamFeatureStore r, - Member TeamStore r, - Member (Input (FeatureDefaults LegalholdConfig)) r, - Member TeamSubsystem r - ) => - Local UserId -> - TeamId -> - Sem r AllTeamFeatures -getAllTeamFeaturesForTeam luid tid = do - void $ TeamSubsystem.internalGetTeamMember (tUnqualified luid) tid >>= noteS @'NotATeamMember - getAllTeamFeatures tid - -class - (GetFeatureConfig cfg, ComputeFeatureConstraints cfg r) => - GetAllFeaturesForServerConstraints r cfg - -instance - (GetFeatureConfig cfg, ComputeFeatureConstraints cfg r) => - GetAllFeaturesForServerConstraints r cfg - -getAllTeamFeaturesForServer :: - forall r. - (Member (Input Opts) r) => - Sem r AllTeamFeatures -getAllTeamFeaturesForServer = - hsequence' $ - hcpure (Proxy @GetFeatureConfig) $ - Comp getFeatureForServer - getAllTeamFeatures :: forall r. - ( Member (Input Opts) r, - Member LegalHoldStore r, - Member TeamFeatureStore r, - Member TeamStore r, - Member (Input (FeatureDefaults LegalholdConfig)) r + ( Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, + GetFeatureConfigEffects r ) => TeamId -> Sem r AllTeamFeatures @@ -212,28 +102,21 @@ getAllTeamFeatures tid = do hsequence' $ hcliftA2 (Proxy @(GetAllFeaturesForServerConstraints r)) compute defFeatures features where compute :: - (ComputeFeatureConstraints p r, GetFeatureConfig p) => + (GetFeatureConfig p) => LockableFeature p -> DbFeature p -> (Sem r :.: LockableFeature) p compute defFeature feat = Comp $ computeFeature tid defFeature feat -class (GetFeatureForUserConstraints cfg r, GetFeatureConfig cfg, ComputeFeatureConstraints cfg r) => GetAllTeamFeaturesForUserConstraints r cfg - -instance (GetFeatureForUserConstraints cfg r, GetFeatureConfig cfg, ComputeFeatureConstraints cfg r) => GetAllTeamFeaturesForUserConstraints r cfg - getAllTeamFeaturesForUser :: forall r. - ( Member BrigAPIAccess r, - Member (ErrorS 'NotATeamMember) r, + ( Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'TeamNotFound) r, - Member (ErrorS OperationDenied) r, - Member (Input Opts) r, - Member LegalHoldStore r, Member TeamFeatureStore r, Member TeamStore r, - Member (Input (FeatureDefaults LegalholdConfig)) r, - Member TeamSubsystem r + Member TeamSubsystem r, + Member FeaturesConfigSubsystem r, + GetFeatureConfigEffects r ) => UserId -> Sem r AllTeamFeatures @@ -246,191 +129,17 @@ getAllTeamFeaturesForUser uid = do getSingleFeatureForUser :: forall cfg r. ( GetFeatureConfig cfg, - Member (Input Opts) r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'TeamNotFound) r, Member TeamStore r, - Member TeamFeatureStore r, - GetFeatureForUserConstraints cfg r, - ComputeFeatureConstraints cfg r, - Member TeamSubsystem r + Member TeamSubsystem r, + Member FeaturesConfigSubsystem r ) => UserId -> Sem r (LockableFeature cfg) getSingleFeatureForUser uid = do mTid <- getTeamAndCheckMembership uid - getFeatureForTeamUser @cfg uid mTid - -getFeatureForTeam :: - forall cfg r. - ( GetFeatureConfig cfg, - ComputeFeatureConstraints cfg r, - Member (Input Opts) r, - Member TeamFeatureStore r - ) => - TeamId -> - Sem r (LockableFeature cfg) -getFeatureForTeam tid = do - dbFeature <- getDbFeature tid - defFeature <- getFeatureForServer - computeFeature @cfg - tid - defFeature - dbFeature - -getFeatureForTeamUser :: - forall cfg r. - ( GetFeatureConfig cfg, - GetFeatureForUserConstraints cfg r, - ComputeFeatureConstraints cfg r, - Member (Input Opts) r, - Member TeamFeatureStore r - ) => - UserId -> - Maybe TeamId -> - Sem r (LockableFeature cfg) -getFeatureForTeamUser uid Nothing = getFeatureForUser uid -getFeatureForTeamUser _ (Just tid) = getFeatureForTeam @cfg tid - -getFeatureForServer :: - forall cfg r. - ( GetFeatureDefaults (FeatureDefaults cfg), - NpProject cfg Features, - Member (Input Opts) r - ) => - Sem r (LockableFeature cfg) -getFeatureForServer = inputs $ view (settings . featureFlags . to (featureDefaults @cfg)) - -------------------------------------------------------------------------------- --- GetFeatureConfig instances - -instance GetFeatureConfig SSOConfig - -instance GetFeatureConfig SearchVisibilityAvailableConfig - -instance GetFeatureConfig ValidateSAMLEmailsConfig - -instance GetFeatureConfig DigitalSignaturesConfig - -instance GetFeatureConfig LegalholdConfig where - type - GetFeatureForUserConstraints LegalholdConfig (r :: EffectRow) = - ( Member (Input Opts) r, - Member TeamFeatureStore r, - Member LegalHoldStore r, - Member TeamStore r, - Member (Input (FeatureDefaults LegalholdConfig)) r, - Member (ErrorS OperationDenied) r, - Member (ErrorS 'NotATeamMember) r, - Member (ErrorS 'TeamNotFound) r - ) - type - ComputeFeatureConstraints LegalholdConfig r = - ( Member TeamStore r, - Member LegalHoldStore r, - Member (Input (FeatureDefaults LegalholdConfig)) r - ) - - computeFeature tid defFeature dbFeature = do - status <- computeLegalHoldFeatureStatus tid dbFeature - pure $ defFeature {status = status} - -instance GetFeatureConfig FileSharingConfig - -instance GetFeatureConfig AppLockConfig - -instance GetFeatureConfig ClassifiedDomainsConfig - --- | Conference calling gets enabled automatically once unlocked. To achieve --- that, the default feature status in the unlocked case is forced to be --- "enabled" before the database data is applied. --- --- Previously, we were assuming that this feature would be left as "unlocked", --- and the clients were simply setting the status field. Now, the pre-existing --- status field is reinterpreted as the lock status, which means that the --- status will be NULL in many cases. The defaulting logic in 'computeFeature' --- here makes sure that the status is aligned with the lock status in those --- situations. -instance GetFeatureConfig ConferenceCallingConfig where - type - GetFeatureForUserConstraints ConferenceCallingConfig r = - ( Member (Input Opts) r, - Member (ErrorS OperationDenied) r, - Member (ErrorS 'NotATeamMember) r, - Member (ErrorS 'TeamNotFound) r, - Member TeamStore r, - Member TeamFeatureStore r, - Member BrigAPIAccess r - ) - - getFeatureForUser uid = do - feat <- getAccountConferenceCallingConfigClient uid - pure $ withLockStatus (def @(LockableFeature ConferenceCallingConfig)).lockStatus feat - - computeFeature _tid defFeature dbFeature = - pure $ - let feat = applyDbFeature dbFeature defFeature {status = FeatureStatusEnabled} - in case feat.lockStatus of - LockStatusLocked -> defFeature {lockStatus = LockStatusLocked} - LockStatusUnlocked -> feat - -instance GetFeatureConfig SelfDeletingMessagesConfig - -instance GetFeatureConfig GuestLinksConfig - -instance GetFeatureConfig SndFactorPasswordChallengeConfig - -instance GetFeatureConfig SearchVisibilityInboundConfig - -instance GetFeatureConfig MLSConfig - -instance GetFeatureConfig ChannelsConfig - -instance GetFeatureConfig ExposeInvitationURLsToTeamAdminConfig where - type - ComputeFeatureConstraints ExposeInvitationURLsToTeamAdminConfig r = - (Member (Input Opts) r) - - -- the lock status of this feature is calculated from the allow list, not the database - computeFeature tid defFeature dbFeature = do - allowList <- input <&> view (settings . exposeInvitationURLsTeamAllowlist . to (fromMaybe [])) - let teamAllowed = tid `elem` allowList - lockStatus = if teamAllowed then LockStatusUnlocked else LockStatusLocked - pure $ resolveDbFeature defFeature (dbFeatureLockStatus lockStatus <> dbFeature) - -instance GetFeatureConfig OutlookCalIntegrationConfig - -instance GetFeatureConfig MlsE2EIdConfig - -instance GetFeatureConfig MlsMigrationConfig - -instance GetFeatureConfig EnforceFileDownloadLocationConfig - -instance GetFeatureConfig LimitedEventFanoutConfig - -instance GetFeatureConfig DomainRegistrationConfig - -instance GetFeatureConfig CellsConfig - -instance GetFeatureConfig CellsInternalConfig - -instance GetFeatureConfig AllowedGlobalOperationsConfig - -instance GetFeatureConfig AssetAuditLogConfig - -instance GetFeatureConfig ConsumableNotificationsConfig - -instance GetFeatureConfig ChatBubblesConfig - -instance GetFeatureConfig AppsConfig - -instance GetFeatureConfig SimplifiedUserConnectionRequestQRCodeConfig - -instance GetFeatureConfig StealthUsersConfig - -instance GetFeatureConfig MeetingsConfig - -instance GetFeatureConfig MeetingsPremiumConfig + getFeatureForTeamUser @_ @cfg uid mTid -- | If second factor auth is enabled, make sure that end-points that don't support it, but -- should, are blocked completely. (This is a workaround until we have 2FA for those @@ -439,11 +148,10 @@ instance GetFeatureConfig MeetingsPremiumConfig -- This function exists to resolve a cyclic dependency. guardSecondFactorDisabled :: forall r. - ( Member TeamFeatureStore r, - Member (Input Opts) r, - Member (ErrorS 'AccessDenied) r, + ( Member (ErrorS 'AccessDenied) r, Member TeamStore r, - Member ConversationStore r + Member ConversationStore r, + Member FeaturesConfigSubsystem r ) => UserId -> ConvId -> @@ -455,7 +163,7 @@ guardSecondFactorDisabled uid cid = do mapError (unTagged @'TeamNotFound @()) $ assertTeamExists tid pure tid - tf <- getFeatureForTeamUser @SndFactorPasswordChallengeConfig uid mTid + tf <- getFeatureForTeamUser @_ @SndFactorPasswordChallengeConfig uid mTid case tf.status of FeatureStatusDisabled -> pure () FeatureStatusEnabled -> throwS @'AccessDenied @@ -463,11 +171,9 @@ guardSecondFactorDisabled uid cid = do featureEnabledForTeam :: forall cfg r. ( GetFeatureConfig cfg, - Member (Input Opts) r, Member (ErrorS 'TeamNotFound) r, Member TeamStore r, - Member TeamFeatureStore r, - ComputeFeatureConstraints cfg r + Member FeaturesConfigSubsystem r ) => TeamId -> Sem r Bool diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index ee4220a500b..fd4e4606b8a 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -98,10 +98,8 @@ import Galley.API.Query qualified as Query import Galley.API.Teams.Features.Get import Galley.API.Util import Galley.App -import Galley.Data.Types import Galley.Effects import Galley.Effects.ClientStore qualified as E -import Galley.Effects.CodeStore qualified as E import Galley.Env import Galley.Options import Imports hiding (forkIO) @@ -134,10 +132,14 @@ import Wire.API.Team.Feature import Wire.API.Team.Member import Wire.API.User.Client import Wire.API.UserGroup +import Wire.CodeStore (CodeStore) +import Wire.CodeStore qualified as E +import Wire.CodeStore.Code import Wire.ConversationStore qualified as E import Wire.ConversationSubsystem import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) import Wire.ExternalAccess qualified as E +import Wire.FeaturesConfigSubsystem import Wire.FederationAPIAccess qualified as E import Wire.HashPassword as HashPassword import Wire.NotificationSubsystem @@ -530,7 +532,7 @@ addCodeUnqualifiedWithReqBody :: Member Now r, Member HashPassword r, Member (Input Opts) r, - Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member RateLimit r, Member TeamSubsystem r ) => @@ -556,7 +558,7 @@ addCodeUnqualified :: Member Now r, Member (Input Opts) r, Member HashPassword r, - Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member RateLimit r, Member TeamSubsystem r ) => @@ -584,7 +586,7 @@ addCode :: Member NotificationSubsystem r, Member Now r, Member (Input Opts) r, - Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member RateLimit r, Member TeamSubsystem r ) => @@ -603,10 +605,10 @@ addCode lusr mbZHost mZcon lcnv mReq = do ensureGuestsOrNonTeamMembersAllowed conv convUri <- getConversationCodeURI mbZHost key <- E.makeKey (tUnqualified lcnv) - E.getCode key ReusableCode >>= \case + E.getCode key >>= \case Nothing -> do ttl <- realToFrac . unGuestLinkTTLSeconds . fromMaybe defGuestLinkTTLSeconds . view (settings . guestLinkTTLSeconds) <$> input - code <- E.generateCode (tUnqualified lcnv) ReusableCode (Timeout ttl) + code <- E.generateCode (tUnqualified lcnv) (Timeout ttl) mPw <- for (mReq >>= (.password)) $ HashPassword.hashPassword8 (RateLimitUser (tUnqualified lusr)) E.createCode code mPw now <- Now.get @@ -668,7 +670,7 @@ rmCode lusr zcon lcnv = do ensureAccess conv CodeAccess let (bots, users) = localBotsAndUsers $ conv.localMembers key <- E.makeKey (tUnqualified lcnv) - E.deleteCode key ReusableCode + E.deleteCode key now <- Now.get let event = Event (tUntagged lcnv) Nothing (EventFromUser (tUntagged lusr)) now Nothing EdConvCodeDelete pushConversationEvent (Just zcon) conv event (qualifyAs lusr (map (.id_) users)) bots @@ -682,8 +684,7 @@ getCode :: Member (ErrorS 'ConvAccessDenied) r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'GuestLinksDisabled) r, - Member (Input Opts) r, - Member TeamFeatureStore r + Member FeaturesConfigSubsystem r ) => Maybe ZHostValue -> Local UserId -> @@ -696,7 +697,7 @@ getCode mbZHost lusr cnv = do ensureAccess conv CodeAccess ensureConvMember (conv.localMembers) (tUnqualified lusr) key <- E.makeKey cnv - (c, mPw) <- E.getCode key ReusableCode >>= noteS @'CodeNotFound + (c, mPw) <- E.getCode key >>= noteS @'CodeNotFound convUri <- getConversationCodeURI mbZHost pure $ mkConversationCodeInfo (isJust mPw) (codeKey c) (codeValue c) convUri @@ -704,11 +705,10 @@ checkReusableCode :: forall r. ( Member CodeStore r, Member ConversationStore r, - Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member (ErrorS 'CodeNotFound) r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'InvalidConversationPassword) r, - Member (Input Opts) r, Member HashPassword r, Member RateLimit r ) => @@ -748,6 +748,7 @@ updateConversationProtocolWithLocalUser :: Member Random r, Member ProposalStore r, Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member TeamCollaboratorsSubsystem r, Member E.MLSCommitLockStore r, Member TeamSubsystem r, @@ -835,8 +836,7 @@ joinConversationByReusableCode :: Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'TooManyMembers) r, Member ConversationSubsystem r, - Member (Input Opts) r, - Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member HashPassword r, Member RateLimit r, Member TeamSubsystem r, @@ -1921,8 +1921,7 @@ updateCellsState :: ( Member ConversationStore r, Member (ErrorS ConvNotFound) r, Member (ErrorS InvalidOperation) r, - Member (Input Opts) r, - Member TeamFeatureStore r + Member FeaturesConfigSubsystem r ) => ConvId -> CellsState -> @@ -1931,7 +1930,7 @@ updateCellsState cnv state = do when (state /= CellsDisabled) $ do conv <- E.getConversation cnv >>= noteS @ConvNotFound tid <- noteS @InvalidOperation conv.metadata.cnvmTeam - feat <- getFeatureForTeam @CellsConfig tid + (feat :: LockableFeature CellsConfig) <- getFeatureForTeam tid noteS @InvalidOperation $ guard (feat.status == FeatureStatusEnabled) E.setConversationCellsState cnv state diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index aa6a22995e4..d8a1143b9ef 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -42,10 +42,8 @@ import Data.Text qualified as T import Data.Time import Galley.API.Error import Galley.API.Mapping -import Galley.Data.Types qualified as DataTypes import Galley.Effects import Galley.Effects.ClientStore -import Galley.Effects.CodeStore import Galley.Env import Galley.Types.Clients (Clients, fromUserClients) import Galley.Types.Conversations.Roles @@ -86,6 +84,8 @@ import Wire.API.User.Auth.ReAuth import Wire.API.VersionInfo import Wire.BackendNotificationQueueAccess import Wire.BrigAPIAccess +import Wire.CodeStore +import Wire.CodeStore.Code as DataTypes import Wire.ConversationStore import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig (..)) import Wire.ExternalAccess @@ -750,7 +750,7 @@ verifyReusableCode :: Sem r DataTypes.Code verifyReusableCode rateLimitKey checkPw mPtpw convCode = do (c, mPw) <- - getCode (conversationKey convCode) DataTypes.ReusableCode + getCode (conversationKey convCode) >>= noteS @'CodeNotFound unless (DataTypes.codeValue c == conversationCode convCode) $ throwS @'CodeNotFound diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index 488d692aa7a..2035a64c1cf 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -54,7 +54,6 @@ import Data.Range import Data.Text qualified as Text import Galley.API.Error import Galley.Cassandra.Client -import Galley.Cassandra.Code import Galley.Cassandra.CustomBackend import Galley.Cassandra.SearchVisibility import Galley.Cassandra.Team @@ -63,7 +62,6 @@ import Galley.Cassandra.Team interpretTeamMemberStoreToCassandra, interpretTeamMemberStoreToCassandraWithPaging, ) -import Galley.Cassandra.TeamFeatures import Galley.Cassandra.TeamNotifications import Galley.Effects import Galley.Env @@ -108,11 +106,17 @@ import Wire.API.Team.Feature import Wire.AWS qualified as Aws import Wire.BackendNotificationQueueAccess.RabbitMq qualified as BackendNotificationQueueAccess import Wire.BrigAPIAccess.Rpc +import Wire.CodeStore.Cassandra +import Wire.CodeStore.DualWrite +import Wire.CodeStore.Postgres import Wire.ConversationStore.Cassandra import Wire.ConversationStore.Postgres import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig (..), interpretConversationSubsystem) import Wire.Error import Wire.ExternalAccess.External +import Wire.FeaturesConfigSubsystem +import Wire.FeaturesConfigSubsystem.Interpreter (runFeaturesConfigSubsystem) +import Wire.FeaturesConfigSubsystem.Types (ExposeInvitationURLsAllowlist (..)) import Wire.FederationAPIAccess.Interpreter import Wire.FireAndForget import Wire.GundeckAPIAccess (runGundeckAPIAccess) @@ -134,6 +138,7 @@ import Wire.ServiceStore.Cassandra (interpretServiceStoreToCassandra) import Wire.SparAPIAccess.Rpc import Wire.TeamCollaboratorsStore.Postgres (interpretTeamCollaboratorsStoreToPostgres) import Wire.TeamCollaboratorsSubsystem.Interpreter +import Wire.TeamFeatureStore.Cassandra import Wire.TeamJournal.Aws import Wire.TeamStore.Cassandra (interpretTeamStoreToCassandra) import Wire.TeamSubsystem.Interpreter @@ -145,6 +150,7 @@ type GalleyEffects0 = Input Hasql.Pool, Input Env, Input ConversationSubsystemConfig, + Error TeamFeatureStoreError, Error MigrationError, Error InvalidInput, Error ParseException, @@ -287,6 +293,11 @@ evalGalley e = CassandraStorage -> interpretConversationStoreToCassandra (e ^. cstate) MigrationToPostgresql -> interpretConversationStoreToCassandraAndPostgres (e ^. cstate) PostgresqlStorage -> interpretConversationStoreToPostgres + convCodesStoreInterpreter = + case (e ^. options . postgresMigration).conversationCodes of + CassandraStorage -> interpretCodeStoreToCassandra + MigrationToPostgresql -> interpretCodeStoreToCassandraAndPostgres + PostgresqlStorage -> interpretCodeStoreToPostgres localUnit = toLocalUnsafe (e ^. options . settings . federationDomain) () teamSubsystemConfig = TeamSubsystemConfig @@ -336,6 +347,7 @@ evalGalley e = . mapError toResponse . mapError toResponse . logAndMapError toResponse (Text.pack . show) "migration error" + . mapError mapTeamFeatureStoreError . runInputConst conversationSubsystemConfig . runInputConst e . runInputConst (e ^. hasqlPool) @@ -346,11 +358,13 @@ evalGalley e = . mapError toResponse -- DynError . interpretQueue (e ^. deleteQueue) . nowToIO + . runInputConst (e ^. convCodeURI) . runInputConst (e ^. options) . runInputConst localUnit . interpretTeamFeatureSpecialContext e - . runInputSem getAllTeamFeaturesForServer . runInputConst (currentFanoutLimit (e ^. options)) + . runInputSem (inputs @Opts $ view (O.settings . O.featureFlags)) + . runInputSem (inputs @Opts $ ExposeInvitationURLsAllowlist . fromMaybe [] . view (O.settings . O.exposeInvitationURLsTeamAllowlist)) . interpretInternalTeamListToCassandra . interpretTeamListToCassandra . interpretTeamMemberStoreToCassandraWithPaging lh @@ -371,7 +385,7 @@ evalGalley e = . runHashPassword e._options._settings._passwordHashingOptions . interpretRateLimit e._passwordHashingRateLimitEnv . interpretProposalStoreToCassandra - . interpretCodeStoreToCassandra + . convCodesStoreInterpreter . interpretClientStoreToCassandra . interpretTeamCollaboratorsStoreToPostgres . interpretFireAndForget @@ -384,6 +398,8 @@ evalGalley e = . runNotificationSubsystemGundeck (notificationSubsystemConfig e) . interpretSparAPIAccessToRpc (e ^. options . spar) . interpretTeamSubsystem teamSubsystemConfig + . runFeaturesConfigSubsystem + . runInputSem getAllTeamFeaturesForServer . interpretConversationSubsystem . interpretTeamCollaboratorsSubsystem where @@ -397,3 +413,6 @@ interpretTeamFeatureSpecialContext :: Env -> Sem (Input (FeatureDefaults Legalho interpretTeamFeatureSpecialContext e = runInputConst (e ^. options . settings . featureFlags . to npProject) + +mapTeamFeatureStoreError :: TeamFeatureStoreError -> InternalError +mapTeamFeatureStoreError (TeamFeatureStoreErrorInternalError msg) = InternalErrorWithDescription msg diff --git a/services/galley/src/Galley/Cassandra/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs index 3f9ca75a5a7..c6b8860ad86 100644 --- a/services/galley/src/Galley/Cassandra/Queries.hs +++ b/services/galley/src/Galley/Cassandra/Queries.hs @@ -29,9 +29,6 @@ module Galley.Cassandra.Queries ( selectCustomBackend, upsertCustomBackend, deleteCustomBackend, - insertCode, - lookupCode, - deleteCode, upsertMemberAddClient, upsertMemberRmClient, selectClients, @@ -56,27 +53,13 @@ import Data.Id import Data.LegalHold import Data.Misc import Data.Text.Lazy qualified as LT -import Galley.Data.Scope import Imports import Text.RawString.QQ -import Wire.API.Conversation.Code -import Wire.API.Password (Password) import Wire.API.Provider import Wire.API.Provider.Service import Wire.API.Team.SearchVisibility import Wire.API.User.Client.Prekey --- Conversations accessible by code ----------------------------------------- - -insertCode :: PrepQuery W (Key, Value, ConvId, Scope, Maybe Password, Int32) () -insertCode = "INSERT INTO conversation_codes (key, value, conversation, scope, password) VALUES (?, ?, ?, ?, ?) USING TTL ?" - -lookupCode :: PrepQuery R (Key, Scope) (Value, Int32, ConvId, Maybe Password) -lookupCode = "SELECT value, ttl(value), conversation, password FROM conversation_codes WHERE key = ? AND scope = ?" - -deleteCode :: PrepQuery W (Key, Scope) () -deleteCode = "DELETE FROM conversation_codes WHERE key = ? AND scope = ?" - -- Clients ------------------------------------------------------------------ selectClients :: PrepQuery R (Identity [UserId]) (UserId, C.Set ClientId) diff --git a/services/galley/src/Galley/Data/Scope.hs b/services/galley/src/Galley/Data/Scope.hs deleted file mode 100644 index 8d649e0a693..00000000000 --- a/services/galley/src/Galley/Data/Scope.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# LANGUAGE StrictData #-} - --- 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 Galley.Data.Scope where - -import Cassandra hiding (Value) -import Imports - -data Scope = ReusableCode - deriving (Eq, Show, Generic) - -instance Cql Scope where - ctype = Tagged IntColumn - - toCql ReusableCode = CqlInt 1 - - fromCql (CqlInt 1) = pure ReusableCode - fromCql _ = Left "unknown Scope" diff --git a/services/galley/src/Galley/Effects.hs b/services/galley/src/Galley/Effects.hs index 4b20074f9a9..af09983856f 100644 --- a/services/galley/src/Galley/Effects.hs +++ b/services/galley/src/Galley/Effects.hs @@ -32,7 +32,6 @@ module Galley.Effects -- * Store effects ClientStore, - CodeStore, ConversationStore, CustomBackendStore, LegalHoldStore, @@ -61,18 +60,20 @@ module Galley.Effects where import Data.Id +import Data.Map (Map) +import Data.Misc (HttpsUrl) import Data.Qualified +import Data.Text (Text) import Galley.Effects.ClientStore -import Galley.Effects.CodeStore import Galley.Effects.CustomBackendStore import Galley.Effects.Queue import Galley.Effects.SearchVisibilityStore -import Galley.Effects.TeamFeatureStore import Galley.Effects.TeamMemberStore import Galley.Effects.TeamNotificationStore import Galley.Env import Galley.Options import Galley.Types.Teams +import Imports (Either) import Polysemy import Polysemy.Error import Polysemy.Input @@ -82,9 +83,12 @@ import Wire.API.Federation.Client import Wire.API.Team.Feature import Wire.BackendNotificationQueueAccess import Wire.BrigAPIAccess +import Wire.CodeStore import Wire.ConversationStore (ConversationStore, MLSCommitLockStore) import Wire.ConversationSubsystem import Wire.ExternalAccess +import Wire.FeaturesConfigSubsystem (FeaturesConfigSubsystem) +import Wire.FeaturesConfigSubsystem.Types (ExposeInvitationURLsAllowlist) import Wire.FederationAPIAccess import Wire.FireAndForget import Wire.GundeckAPIAccess @@ -103,6 +107,7 @@ import Wire.ServiceStore import Wire.SparAPIAccess import Wire.TeamCollaboratorsStore (TeamCollaboratorsStore) import Wire.TeamCollaboratorsSubsystem (TeamCollaboratorsSubsystem) +import Wire.TeamFeatureStore import Wire.TeamJournal (TeamJournal) import Wire.TeamStore import Wire.TeamSubsystem (TeamSubsystem) @@ -112,6 +117,8 @@ import Wire.UserGroupStore type GalleyEffects1 = '[ TeamCollaboratorsSubsystem, ConversationSubsystem, + Input AllTeamFeatures, + FeaturesConfigSubsystem, TeamSubsystem, SparAPIAccess, NotificationSubsystem, @@ -145,11 +152,13 @@ type GalleyEffects1 = TeamMemberStore CassandraPaging, ListItems LegacyPaging TeamId, ListItems InternalPaging TeamId, + Input ExposeInvitationURLsAllowlist, + Input FeatureFlags, Input FanoutLimit, - Input AllTeamFeatures, Input (FeatureDefaults LegalholdConfig), Input (Local ()), Input Opts, + Input (Either HttpsUrl (Map Text HttpsUrl)), Now, Queue DeleteItem, Error DynError, diff --git a/services/galley/test/integration/API/MLS/Util.hs b/services/galley/test/integration/API/MLS/Util.hs index ef96d88d206..cd2c7bbaf35 100644 --- a/services/galley/test/integration/API/MLS/Util.hs +++ b/services/galley/test/integration/API/MLS/Util.hs @@ -871,7 +871,7 @@ mkBundle mp = do _ -> Left "expected welcome" ginfo <- note "group info unavailable" (mpGroupInfo mp) ginfoB <- first ("GroupInfo: " <>) $ decodeMLS' ginfo - pure $ CommitBundle commitB welcomeB ginfoB + pure $ CommitBundle commitB welcomeB ginfoB Nothing createBundle :: (HasCallStack, MonadIO m) => MessagePackage -> m ByteString createBundle mp = do diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 11077e53eec..a8f1fb51c8b 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -2390,34 +2390,34 @@ someClientId = ClientId 0xcc6e640e296e8bba -- | Changing these will break tests; all prekeys and client Id must match the same -- fingerprint -somePrekeys :: [Prekey] +somePrekeys :: [UncheckedPrekeyBundle] somePrekeys = - [ Prekey (PrekeyId 1) "pQABAQECoQBYIOjl7hw0D8YRNqkkBQETCxyr7/ywE/2R5RWcUPM+GJACA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 2) "pQABAQICoQBYIGoXawUQWQ9ZW+MXhvuo9ALOBUjLff8S5VdAokN29C1OA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 3) "pQABAQMCoQBYIEjdt+YWd3lHmG8pamULLMubAMZw556IO8kW7s1MLFytA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 4) "pQABAQQCoQBYIPIaOA3Xqfk4Lh2/pU88Owd2eW5eplHpywr+Mx4QGyiMA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 5) "pQABAQUCoQBYIHnafNR4Gh3ID71lYzToewEVag4EKskDFq+gaeraOlSJA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 6) "pQABAQYCoQBYIFXUkVftE7kK22waAzhOjOmJVex3EBTU8RHZFx2o1Ed8A6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 7) "pQABAQcCoQBYIDXdN8VlKb5lbgPmoDPLPyqNIEyShG4oT/DlW0peRRZUA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 8) "pQABAQgCoQBYIJH1ewvIVV3yGqQvdr/QM9HARzMgo5ksOTRyKEuN2aZzA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 9) "pQABAQkCoQBYIFcAnXdx0M1Q1hoDDfgMK9r+Zchn8YlVHHaQwQYhRk1dA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 10) "pQABAQoCoQBYIGs3vyxwmzEZ+qKNy4wpFkxc+Bgkb0D76ZEbxeeh/9DVA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 11) "pQABAQsCoQBYIGUiBeOJALP5dkMduUZ/u6MDhHNrsrBUa3f0YlSSWZbzA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 12) "pQABAQwCoQBYIMp6QNNTPDZgL3DSSD/QWWnBI7LsTZp2RhY/HLqnIwRZA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 13) "pQABAQ0CoQBYIJXSSUrE5RCNyB5pg+m6vGwK7RvJ+rs9dsdHitxnfDhuA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 14) "pQABAQ4CoQBYIHmtOX7jCKBHFDysb4H0z/QWoCSaEyjerZaT/HOP8bgDA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 15) "pQABAQ8CoQBYIIaMCTcPKj2HuYQ7i9ZaxUw9j5Bz8TPjoAaTZ5eB0w1kA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 16) "pQABARACoQBYIHWAOacKuWH81moJVveJ0FSfipWocfspOIBhaU6VLWUsA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 17) "pQABARECoQBYIA8XtUXtnMxQslULnNAeHBIivlLRe/+qdh2j6nTfDAchA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 18) "pQABARICoQBYIGgzg6SzgTTOgnk48pa6y2Rgjy004DkeBo4CMld3Jlr6A6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 19) "pQABARMCoQBYIEoEFiIpCHgn74CAD+GhIfIgbQtdCqQqkOXHWxRlG6Y6A6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 20) "pQABARQCoQBYINVEwTRxNSe0rxZxon4Rifz2l4rtQZn7mHtKYCiFAK9IA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 21) "pQABARUCoQBYIN3aeX2Ayi2rPFbiaYb+O2rdHUpFhzRs2j28pCmbGpflA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 22) "pQABARYCoQBYIJe5OJ17YKQrNmIH3sE++r++4Z5ld36axqAMjjQ3jtQWA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 23) "pQABARcCoQBYIASE94LjK6Raipk/lN/YewouqO+kcQGpxIqP+iW2hyHiA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", - Prekey (PrekeyId 24) "pQABARgYAqEAWCBZ222LpS6/99Btlw+83PihrA655skwsNevt//8oz5axQOhAKEAWCCy39UyMEgetquvTo7P19bcyfnWBzQMOEG1v+0wub0magT2", - Prekey (PrekeyId 25) "pQABARgZAqEAWCDGEwo61w4O8T8lyw0HdoOjGWBKQUNqo6+jSfrPR9alrAOhAKEAWCCy39UyMEgetquvTo7P19bcyfnWBzQMOEG1v+0wub0magT2", - Prekey (PrekeyId 26) "pQABARgaAqEAWCBMSQoQ6B35plC80i1O3AWlJSftCEbCbju97Iykg5+NWQOhAKEAWCCy39UyMEgetquvTo7P19bcyfnWBzQMOEG1v+0wub0magT2" + [ UncheckedPrekeyBundle (PrekeyId 1) "pQABAQECoQBYIOjl7hw0D8YRNqkkBQETCxyr7/ywE/2R5RWcUPM+GJACA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 2) "pQABAQICoQBYIGoXawUQWQ9ZW+MXhvuo9ALOBUjLff8S5VdAokN29C1OA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 3) "pQABAQMCoQBYIEjdt+YWd3lHmG8pamULLMubAMZw556IO8kW7s1MLFytA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 4) "pQABAQQCoQBYIPIaOA3Xqfk4Lh2/pU88Owd2eW5eplHpywr+Mx4QGyiMA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 5) "pQABAQUCoQBYIHnafNR4Gh3ID71lYzToewEVag4EKskDFq+gaeraOlSJA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 6) "pQABAQYCoQBYIFXUkVftE7kK22waAzhOjOmJVex3EBTU8RHZFx2o1Ed8A6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 7) "pQABAQcCoQBYIDXdN8VlKb5lbgPmoDPLPyqNIEyShG4oT/DlW0peRRZUA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 8) "pQABAQgCoQBYIJH1ewvIVV3yGqQvdr/QM9HARzMgo5ksOTRyKEuN2aZzA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 9) "pQABAQkCoQBYIFcAnXdx0M1Q1hoDDfgMK9r+Zchn8YlVHHaQwQYhRk1dA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 10) "pQABAQoCoQBYIGs3vyxwmzEZ+qKNy4wpFkxc+Bgkb0D76ZEbxeeh/9DVA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 11) "pQABAQsCoQBYIGUiBeOJALP5dkMduUZ/u6MDhHNrsrBUa3f0YlSSWZbzA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 12) "pQABAQwCoQBYIMp6QNNTPDZgL3DSSD/QWWnBI7LsTZp2RhY/HLqnIwRZA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 13) "pQABAQ0CoQBYIJXSSUrE5RCNyB5pg+m6vGwK7RvJ+rs9dsdHitxnfDhuA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 14) "pQABAQ4CoQBYIHmtOX7jCKBHFDysb4H0z/QWoCSaEyjerZaT/HOP8bgDA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 15) "pQABAQ8CoQBYIIaMCTcPKj2HuYQ7i9ZaxUw9j5Bz8TPjoAaTZ5eB0w1kA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 16) "pQABARACoQBYIHWAOacKuWH81moJVveJ0FSfipWocfspOIBhaU6VLWUsA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 17) "pQABARECoQBYIA8XtUXtnMxQslULnNAeHBIivlLRe/+qdh2j6nTfDAchA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 18) "pQABARICoQBYIGgzg6SzgTTOgnk48pa6y2Rgjy004DkeBo4CMld3Jlr6A6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 19) "pQABARMCoQBYIEoEFiIpCHgn74CAD+GhIfIgbQtdCqQqkOXHWxRlG6Y6A6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 20) "pQABARQCoQBYINVEwTRxNSe0rxZxon4Rifz2l4rtQZn7mHtKYCiFAK9IA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 21) "pQABARUCoQBYIN3aeX2Ayi2rPFbiaYb+O2rdHUpFhzRs2j28pCmbGpflA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 22) "pQABARYCoQBYIJe5OJ17YKQrNmIH3sE++r++4Z5ld36axqAMjjQ3jtQWA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 23) "pQABARcCoQBYIASE94LjK6Raipk/lN/YewouqO+kcQGpxIqP+iW2hyHiA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=", + UncheckedPrekeyBundle (PrekeyId 24) "pQABARgYAqEAWCBZ222LpS6/99Btlw+83PihrA655skwsNevt//8oz5axQOhAKEAWCCy39UyMEgetquvTo7P19bcyfnWBzQMOEG1v+0wub0magT2", + UncheckedPrekeyBundle (PrekeyId 25) "pQABARgZAqEAWCDGEwo61w4O8T8lyw0HdoOjGWBKQUNqo6+jSfrPR9alrAOhAKEAWCCy39UyMEgetquvTo7P19bcyfnWBzQMOEG1v+0wub0magT2", + UncheckedPrekeyBundle (PrekeyId 26) "pQABARgaAqEAWCBMSQoQ6B35plC80i1O3AWlJSftCEbCbju97Iykg5+NWQOhAKEAWCCy39UyMEgetquvTo7P19bcyfnWBzQMOEG1v+0wub0magT2" ] -- | Changing these will break tests; all prekeys and client Id must match the same diff --git a/services/spar/default.nix b/services/spar/default.nix index 4b4b7bf58b5..60ad6c717a3 100644 --- a/services/spar/default.nix +++ b/services/spar/default.nix @@ -22,6 +22,7 @@ , crypton-x509 , exceptions , extended +, filepath , gitignoreSource , hscim , HsOpenSSL @@ -212,6 +213,7 @@ mkDerivation { bytestring-conversion containers cookie + filepath hscim hspec imports diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index 6d26c0d0f07..f4252f1c4f2 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -562,6 +562,7 @@ test-suite spec Test.Spar.DataSpec Test.Spar.Intra.BrigSpec Test.Spar.Roundtrip.ByteString + Test.Spar.Saml.IdPSpec Test.Spar.Scim.UserSpec Test.Spar.ScimSpec Test.Spar.Sem.DefaultSsoCodeSpec @@ -633,6 +634,7 @@ test-suite spec , bytestring-conversion , containers , cookie + , filepath , hscim , hspec , imports diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index f5f9de0d1e9..f36f6f80660 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -42,6 +42,15 @@ module Spar.API IdpGetAll, IdpCreate, IdpDelete, + + -- * published to enable testing + + -- FUTUREWORK: This module should be split into two: Servant handler + -- subtilities and the functions that do the actual work. + idpCreate, + idpCreateV7, + idpDelete, + idpUpdate, ) where @@ -62,6 +71,9 @@ import Data.Text.Encoding.Error import qualified Data.Text.Lazy as T import Data.Text.Lazy.Encoding import Data.Time +import qualified Data.UUID as UUID +import qualified Data.X509 as X509 +import Data.X509.Extended import Imports import Network.Wai (Request, requestHeaders) import Network.Wai.Utilities.Request @@ -107,6 +119,7 @@ import qualified Spar.Sem.ScimUserTimesStore as ScimUserTimesStore import Spar.Sem.VerdictFormatStore (VerdictFormatStore) import qualified Spar.Sem.VerdictFormatStore as VerdictFormatStore import System.Logger (Msg) +import qualified System.Logger as Log import qualified URI.ByteString as URI import Wire.API.Routes.Internal.Spar import Wire.API.Routes.Named @@ -213,6 +226,7 @@ apiSSO opts = apiIDP :: ( Member Random r, Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member ScimTokenStore r, @@ -239,7 +253,7 @@ apiINTERNAL :: Member (Error SparError) r, Member SAMLUserStore r, Member ScimUserTimesStore r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member Random r, Member GalleyAccess r, Member BrigAccess r @@ -472,7 +486,7 @@ authContext e = authHandler e :. EmptyContext idpGet :: ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member IdPConfigStore r, @@ -505,7 +519,7 @@ idpGetRaw zusr idpid = do idpGetAll :: ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member IdPConfigStore r, @@ -519,7 +533,7 @@ idpGetAll zusr = withDebugLog "idpGetAll" (const Nothing) $ do idpGetAllByTeamId :: ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member IdPConfigStore r, @@ -542,7 +556,7 @@ idpGetAllByTeamId tid = do idpDelete :: forall r. ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member ScimTokenStore r, @@ -573,6 +587,11 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co do IdPConfigStore.deleteConfig idp IdPRawMetadataStore.delete idpid + logIdPAction + "IdP deleted" + idp + mbzusr + id pure NoContent where assertEmptyOrPurge :: TeamId -> Cas.Page (SAML.UserRef, UserId) -> Sem r () @@ -626,7 +645,7 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co -- (internal) https://wearezeta.atlassian.net/wiki/spaces/PAD/pages/1107001440/2024-03-27+scim+user+provisioning+and+saml2+sso+associating+scim+peers+and+saml2+idps idpCreate :: ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member ScimTokenStore r, @@ -636,13 +655,14 @@ idpCreate :: ) => SAML.Config -> TeamId -> + Maybe UserId -> Maybe ZHostValue -> IdPMetadataInfo -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Maybe (Range 1 32 Text) -> Sem r IdP -idpCreate samlConfig tid uncheckedMbHost (IdPMetadataValue rawIdpMetadata idpmeta) mReplaces (fromMaybe defWireIdPAPIVersion -> apiversion) mHandle = withDebugLog "idpCreateXML" (Just . show . (^. SAML.idpId)) $ do +idpCreate samlConfig tid zUser uncheckedMbHost (IdPMetadataValue rawIdpMetadata idpmeta) mReplaces (fromMaybe defWireIdPAPIVersion -> apiversion) mHandle = withDebugLog "idpCreateXML" (Just . show . (^. SAML.idpId)) $ do let mbHost = filterMultiIngressZHost (samlConfig._cfgDomainConfigs) uncheckedMbHost GalleyAccess.assertSSOEnabled tid guardMultiIngressDuplicateDomain tid mbHost @@ -653,6 +673,11 @@ idpCreate samlConfig tid uncheckedMbHost (IdPMetadataValue rawIdpMetadata idpmet IdPConfigStore.insertConfig idp forM_ mReplaces $ \replaces -> IdPConfigStore.setReplacedBy (Replaced replaces) (Replacing (idp ^. SAML.idpId)) + logIdPAction + "IdP created" + idp + zUser + (Log.field "replaces" (maybe "None" (UUID.toString . SAML.fromIdPId) mReplaces)) pure idp where -- Ensure that the domain is not in use by an existing IDP @@ -670,6 +695,19 @@ idpCreate samlConfig tid uncheckedMbHost (IdPMetadataValue rawIdpMetadata idpmet when (zHost `elem` domains) $ throwSparSem SparIdPDomainInUse +logIdPAction :: (Member (Logger (Msg -> Msg)) r) => String -> IdP -> Maybe UserId -> (Msg -> Msg) -> Sem r () +logIdPAction msg idp zUser additionalFields = + Logger.info $ + Log.msg (msg) + . Log.field "team" (idp ^. SAML.idpExtraInfo . team . to idToText) + . Log.field "idpId" (idp ^. SAML.idpId . to SAML.fromIdPId . to UUID.toString) + . Log.field "issuer" (idp ^. SAML.idpMetadata . SAML.edIssuer . SAML.fromIssuer . to URI.serializeURIRef') + . Log.field "domain" (idp ^. SAML.idpExtraInfo . domain . to (fromMaybe "None")) + . Log.field "user" (maybe "None" idToText zUser) + . Log.field "certificates" (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse . to (intercalate ";; " . map certToString . toList)) + . Log.field "idp-endpoint" (idp ^. SAML.idpMetadata . SAML.edRequestURI . to URI.serializeURIRef') + . additionalFields + -- | Only return a ZHost when multi-ingress is configured and the host value is a configured domain filterMultiIngressZHost :: Either SAML.MultiIngressDomainConfig (Map Domain SAML.MultiIngressDomainConfig) -> Maybe ZHostValue -> Maybe ZHostValue filterMultiIngressZHost (Right domainMap) (Just zHost) | (Domain zHost) `Map.member` domainMap = Just zHost @@ -677,7 +715,7 @@ filterMultiIngressZHost _ _ = Nothing idpCreateV7 :: ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member ScimTokenStore r, @@ -687,14 +725,15 @@ idpCreateV7 :: ) => SAML.Config -> TeamId -> + Maybe UserId -> IdPMetadataInfo -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Maybe (Range 1 32 Text) -> Sem r IdP -idpCreateV7 samlConfig tid idpmeta mReplaces mApiversion mHandle = do +idpCreateV7 samlConfig tid zUser idpmeta mReplaces mApiversion mHandle = do assertNoScimOrNoIdP - idpCreate samlConfig tid Nothing idpmeta mReplaces mApiversion mHandle + idpCreate samlConfig tid zUser Nothing idpmeta mReplaces mApiversion mHandle where -- In teams with a scim access token, only one IdP is allowed. The reason is that scim user -- data contains no information about the idp issuer, only the user name, so no valid saml @@ -736,7 +775,7 @@ validateNewIdP :: forall m r. (HasCallStack, m ~ Sem r) => ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member IdPConfigStore r, Member (Error SparError) r ) => @@ -760,8 +799,8 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces idpDomain idHandle = wit mbIdp <- case apiversion of WireIdPAPIV1 -> IdPConfigStore.getIdPByIssuerV1Maybe (_idpMetadata ^. SAML.edIssuer) WireIdPAPIV2 -> IdPConfigStore.getIdPByIssuerV2Maybe (_idpMetadata ^. SAML.edIssuer) teamId - Logger.log Logger.Debug $ show (apiversion, _idpMetadata, teamId, mReplaces) - Logger.log Logger.Debug $ show (_idpId, oldIssuersList, mbIdp) + Logger.log Logger.Debug . Log.msg $ show (apiversion, _idpMetadata, teamId, mReplaces) + Logger.log Logger.Debug . Log.msg $ show (_idpId, oldIssuersList, mbIdp) let failWithIdPClash :: m () failWithIdPClash = throwSparSem . SparNewIdPAlreadyInUse $ case apiversion of @@ -780,7 +819,7 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces idpDomain idHandle = wit -- 'IdPMetadataInfo' directly where convenient. idpUpdate :: ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member IdPConfigStore r, @@ -800,7 +839,7 @@ idpUpdate samlConfig zusr uncheckedMbHost (IdPMetadataValue raw xml) = idpUpdateXML :: ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member IdPConfigStore r, @@ -815,7 +854,7 @@ idpUpdateXML :: Maybe (Range 1 32 Text) -> Sem r IdP idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML" (Just . show . (^. SAML.idpId)) $ do - (teamid, idp) <- validateIdPUpdate zusr idpmeta idpid + (teamid, idp, previousIdP) <- validateIdPUpdate zusr idpmeta idpid GalleyAccess.assertSSOEnabled teamid guardMultiIngressDuplicateDomain teamid mDomain idpid IdPRawMetadataStore.store (idp ^. SAML.idpId) raw @@ -833,6 +872,7 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML WireIdPAPIV1 -> Nothing WireIdPAPIV2 -> Just teamid forM_ (idp'' ^. SAML.idpExtraInfo . oldIssuers) (flip IdPConfigStore.deleteIssuer mbteamid) + logIdPUpdate idp'' previousIdP pure idp'' where -- Ensure that the domain is not in use by an existing IDP @@ -854,6 +894,60 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML when otherIdpsOnSameDomain $ throwSparSem SparIdPDomainInUse + -- We cannot simply call `logIdPAction` here, because we need diffs for + -- some values (old vs. new) + logIdPUpdate :: (Member (Logger (Msg -> Msg)) r) => IdP -> IdP -> Sem r () + logIdPUpdate idp previousIdP = + let (removedCerts, newCerts) = + compareNonEmpty + (previousIdP ^. SAML.idpMetadata . SAML.edCertAuthnResponse) + (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse) + in Logger.info $ + Log.msg ("IdP updated" :: String) + . Log.field "team" (idp ^. SAML.idpExtraInfo . team . to idToText) + . Log.field "idpId" (idp ^. SAML.idpId . to SAML.fromIdPId . to UUID.toString) + . logChangeableScalar + "issuer" + URI.serializeURIRef' + (previousIdP ^. SAML.idpMetadata . SAML.edIssuer . SAML.fromIssuer) + (idp ^. SAML.idpMetadata . SAML.edIssuer . SAML.fromIssuer) + . logChangeableScalar + "domain" + (fromMaybe "None") + (previousIdP ^. SAML.idpExtraInfo . domain) + (idp ^. SAML.idpExtraInfo . domain) + . Log.field "user" (maybe "None" idToText zusr) + . logChangeableScalar + "idp-endpoint" + URI.serializeURIRef' + (previousIdP ^. SAML.idpMetadata . SAML.edRequestURI) + (idp ^. SAML.idpMetadata . SAML.edRequestURI) + . logCertField "certificates" (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse . to toList) + . logCertField "new-certificates" newCerts + . logCertField "removed-certificates" removedCerts + + logChangeableScalar :: (Eq a, Log.ToBytes b) => ByteString -> (a -> b) -> a -> a -> Msg -> Msg + logChangeableScalar baseFieldName toFieldVal old new + | old /= new = + Log.field ("old-" <> baseFieldName) (toFieldVal old) + . Log.field ("new-" <> baseFieldName) (toFieldVal new) + logChangeableScalar baseFieldName toFieldVal old _new = + Log.field baseFieldName (toFieldVal old) + + logCertField :: ByteString -> [X509.SignedCertificate] -> Msg -> Msg + logCertField fieldName certs + | not (null certs) = + Log.field fieldName ((intercalate ";; " . map certToString) certs) + logCertField _ _ = id + + compareNonEmpty :: (Eq a) => NonEmpty a -> NonEmpty a -> ([a], [a]) + compareNonEmpty xs ys = + let l = nub . toList $ xs + r = nub . toList $ ys + onlyL = l \\ r + onlyR = r \\ l + in (onlyL, onlyR) + -- | Check that: idp id is valid; calling user is admin in that idp's home team; team id in -- new metainfo doesn't change; new issuer (if changed) is not in use anywhere else (except as -- an earlier IdP under the same ID); request uri is https. Keep track of old issuer in extra @@ -862,7 +956,7 @@ validateIdPUpdate :: forall m r. (HasCallStack, m ~ Sem r) => ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member IdPConfigStore r, @@ -871,7 +965,7 @@ validateIdPUpdate :: Maybe UserId -> SAML.IdPMetadata -> SAML.IdPId -> - m (TeamId, IdP) + m (TeamId, IdP, IdP) validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateIdPUpdate" (Just . show . (_2 %~ (^. SAML.idpId))) $ do previousIdP <- IdPConfigStore.getConfig _idpId (_, teamId) <- authorizeIdP zusr previousIdP @@ -904,7 +998,7 @@ validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateIdPUpdate" (J let requri = _idpMetadata ^. SAML.edRequestURI enforceHttps requri - pure (teamId, SAML.IdPConfig {..}) + pure (teamId, SAML.IdPConfig {..}, previousIdP) where -- If the new issuer was previously used, it has to be removed from the list of old issuers, -- to prevent it from getting deleted in a later step @@ -919,12 +1013,12 @@ validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateIdPUpdate" (J . URI.serializeURIRef uri = _idpMetadata ^. SAML.edIssuer . SAML.fromIssuer -withDebugLog :: (Member (Logger String) r) => String -> (a -> Maybe String) -> Sem r a -> Sem r a +withDebugLog :: (Member (Logger (Msg -> Msg)) r) => String -> (a -> Maybe String) -> Sem r a -> Sem r a withDebugLog msg showval action = do - Logger.log Logger.Debug $ "entering " ++ msg + Logger.log Logger.Debug . Log.msg $ "entering " ++ msg val <- action let mshowedval = showval val - Logger.log Logger.Debug $ "leaving " ++ msg ++ mconcat [": " ++ fromJust mshowedval | isJust mshowedval] + Logger.log Logger.Debug . Log.msg $ "leaving " ++ msg ++ mconcat [": " ++ fromJust mshowedval | isJust mshowedval] pure val authorizeIdP :: diff --git a/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs b/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs index 131ae266814..a123f099de7 100644 --- a/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs +++ b/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs @@ -23,7 +23,9 @@ module Spar.Sem.SAMLUserStore.Mem ) where +import Cassandra (Page (..), emptyPage) import Control.Lens (view) +import qualified Data.Bifunctor import Data.Id import qualified Data.Map as M import Imports @@ -49,8 +51,15 @@ samlUserStoreToMem = (runState @(Map UserRefOrd UserId) mempty .) $ Delete _uid ur -> modify $ M.delete $ UserRefOrd ur -- 'GetAllByIssuerPaginated' and 'NextPage' are workarounds, please also see docs at -- 'Spar.Sem.SAMLUserStore.Cassandra.getAllSAMLUsersByIssuerPaginated' - GetAllByIssuerPaginated _is -> error "not implemented as this has a dependency to Cassandra" - NextPage _ -> error "not implemented as this has a dependency to Cassandra" + -- + -- This mock only returns one `Page` for all results. This should be fine + -- for tests with small test samples. + GetAllByIssuerPaginated is -> gets $ \userMap -> + let entries = + Data.Bifunctor.first unUserRefOrd + <$> M.assocs (M.filterWithKey (\ref _ -> eqIssuer is ref) userMap) + in emptyPage {result = entries} + NextPage _ -> pure emptyPage where eqIssuer :: SAML.Issuer -> UserRefOrd -> Bool eqIssuer is = (== is) . view uidTenant . unUserRefOrd diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs index 6c1735c98b3..6e76db52e8a 100644 --- a/services/spar/test-integration/Test/Spar/APISpec.hs +++ b/services/spar/test-integration/Test/Spar/APISpec.hs @@ -1624,8 +1624,8 @@ specReAuthSsoUserWithPassword = let actual = Vec.length <$> (preview _Array =<< responseJsonMaybe @Value r) lift $ actual `shouldBe` Just expected - prekey :: Prekey - prekey = Prekey (PrekeyId 1) "pQABAQECoQBYIOjl7hw0D8YRNqkkBQETCxyr7/ywE/2R5RWcUPM+GJACA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=" + prekey :: UncheckedPrekeyBundle + prekey = UncheckedPrekeyBundle (PrekeyId 1) "pQABAQECoQBYIOjl7hw0D8YRNqkkBQETCxyr7/ywE/2R5RWcUPM+GJACA6EAoQBYILLf1TIwSB62q69Ojs/X1tzJ+dYHNAw4QbW/7TC5vSZqBPY=" lPrekey :: LastPrekey lPrekey = lastPrekey "pQABARn//wKhAFggnCcZIK1pbtlJf4wRQ44h4w7/sfSgj5oWXMQaUGYAJ/sDoQChAFgglacihnqg/YQJHkuHNFU7QD6Pb3KN4FnubaCF2EVOgRkE9g==" @@ -1644,7 +1644,7 @@ specReAuthSsoUserWithPassword = ) pure $ c.clientId - defNewClient :: ClientType -> [Prekey] -> LastPrekey -> NewClient + defNewClient :: ClientType -> [UncheckedPrekeyBundle] -> LastPrekey -> NewClient defNewClient ty pks lpk = (newClient ty lpk) { newClientPassword = Just defPassword, diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs new file mode 100644 index 00000000000..ac0c67cf8e7 --- /dev/null +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -0,0 +1,479 @@ +module Test.Spar.Saml.IdPSpec where + +import Arbitrary () +import Data.Domain +import Data.Id (idToText, parseIdFromText) +import qualified Data.List.NonEmpty as NonEmptyL +import qualified Data.Map as Map +import Data.Range +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL +import qualified Data.Text.Lazy.IO as TL +import Imports +import Polysemy +import qualified Polysemy.Error +import Polysemy.TinyLog +import SAML2.WebSSO +import qualified SAML2.WebSSO as SAML +import Spar.API (idpCreate, idpCreateV7, idpDelete, idpUpdate) +import Spar.Error +import Spar.Sem.BrigAccess +import Spar.Sem.GalleyAccess +import Spar.Sem.IdPConfigStore +import Spar.Sem.IdPConfigStore.Mem +import Spar.Sem.IdPRawMetadataStore +import Spar.Sem.IdPRawMetadataStore.Mem +import Spar.Sem.SAMLUserStore +import Spar.Sem.SAMLUserStore.Mem +import Spar.Sem.ScimTokenStore +import Spar.Sem.ScimTokenStore.Mem +import System.FilePath (()) +import System.Logger (Msg) +import System.Logger.Class (Level (..)) +import Test.Hspec +import Test.QuickCheck +import qualified Text.XML.DSig as DSig +import URI.ByteString (parseURI, strictURIParserOptions) +import URI.ByteString.QQ (uri) +import Wire.API.User (User (..)) +import Wire.API.User.IdentityProvider (IdPMetadataInfo (..), WireIdPAPIVersion (..)) +import Wire.Sem.Logger.TinyLog (LogRecorder (..), newLogRecorder, recordLogs) +import Wire.Sem.Random +import Wire.Sem.Random.Null + +spec :: Spec +spec = + let tid = either error id $ parseIdFromText "6861026d-cdee-3da5-22fc-6612bb1360b8" + zUser = either error Just $ parseIdFromText "59128ccc-d38a-1d23-67d9-4f529ee7ca9f" + anyMultiIngressDomainCfg = + MultiIngressDomainConfig + { _cfgSPAppURI = [uri|https://example-sp.com/landing|], + _cfgSPSsoURI = [uri|https://example-sp.com/sso|], + _cfgContacts = [fallbackContact] + } + singleIngressSamlConfig = + Config + { -- The log level only matters for log output, not production. + -- Thus, we could put anything here, it just needs to be a valid + -- value. + _cfgLogLevel = Trace, + _cfgSPHost = "localhost", + _cfgSPPort = 8081, + _cfgDomainConfigs = Left anyMultiIngressDomainCfg + } + host = Just "backend.example.com" + miHost1AsText = "backend-1.example.com" + miDomain1 = either (error . show) id $ mkDomain miHost1AsText + miHost1 = Just miHost1AsText + miHost2AsText = "backend-2.example.com" + miDomain2 = either (error . show) id $ mkDomain miHost2AsText + miHost2 = Just miHost2AsText + multiIngressSamlConfig = + Config + { -- The log level only matters for log output, not production. + -- Thus, we could put anything here, it just needs to be a valid + -- value. + _cfgLogLevel = Trace, + _cfgSPHost = "localhost", + _cfgSPPort = 8081, + _cfgDomainConfigs = + Right $ + Map.fromList [(miDomain1, anyMultiIngressDomainCfg), (miDomain2, anyMultiIngressDomainCfg)] + } + idpHandle = Just $ unsafeRange "some-idp" + apiVersionV2 = Just WireIdPAPIV2 + issuerString = "https://accounts.accesscontrol.windows.net/auth" + issuer = + either (error . show) Issuer + . parseURI strictURIParserOptions + . fromString + $ issuerString + idpEndpointString = "https://idp-endpoint.example.com" + idpEndpoint = + either (error . show) id + . parseURI strictURIParserOptions + . fromString + $ idpEndpointString + in describe "SAML IdP change logging" $ do + describe "idp-create" $ do + it "should log IdP creation" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + let idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine = + ( Info, + "IdP created, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=None, user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> ", replaces=None" + <> "\n" + ) + + forM_ [(minBound :: WireIdPAPIVersion) .. maxBound] $ \apiVersion -> do + (logs, _res) <- + interpretWithLoggingMock + Nothing + (idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing (Just apiVersion) idpHandle) + logs `shouldContain` [expectedLogLine] + + (logsV7, _res) <- + interpretWithLoggingMock + Nothing + (idpCreateV7 singleIngressSamlConfig tid zUser idPMetadataInfo' Nothing (Just apiVersion) idpHandle) + logsV7 `shouldContain` [expectedLogLine] + + it "should log IdP creation with domain for multi-ingress" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + let idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine :: LByteString -> LogLine + expectedLogLine domainPart = + ( Info, + "IdP created, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=" + <> domainPart + <> ", user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> ", replaces=None" + <> "\n" + ) + expectedLogLineWithDomain = expectedLogLine . TL.encodeUtf8 . TL.fromStrict $ miHost1AsText + expectedLogLineWithoutDomain = expectedLogLine "None" + + forM_ [(minBound :: WireIdPAPIVersion) .. maxBound] $ \apiVersion -> do + (logs, _res) <- + interpretWithLoggingMock + Nothing + (idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo' Nothing (Just apiVersion) idpHandle) + logs `shouldContain` [expectedLogLineWithDomain] + + -- >=V7 does not bother with multi-ingress domains for IdPs as it can + -- only have one IdP per team anyways. + (logsV7, _res) <- + interpretWithLoggingMock + Nothing + (idpCreateV7 multiIngressSamlConfig tid zUser idPMetadataInfo' Nothing (Just apiVersion) idpHandle) + logsV7 `shouldContain` [expectedLogLineWithoutDomain] + + describe "idp-delete" $ do + it "should log IdP deletion" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine = + ( Info, + "IdP deleted, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=None, user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> "\n" + ) + + (logs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing apiVersionV2 idpHandle + idpDelete zUser (idp._idpId) Nothing + logs `shouldContain` [expectedLogLine] + + it "should log IdP deletion with domain for multi-ingress" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine = + ( Info, + "IdP deleted, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=" + <> (TL.encodeUtf8 . TL.fromStrict) miHost1AsText + <> ", user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> "\n" + ) + + (logs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo' Nothing apiVersionV2 idpHandle + idpDelete zUser (idp._idpId) Nothing + logs `shouldContain` [expectedLogLine] + + describe "idp-update" $ do + it "should log IdP update" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine = + ( Info, + "IdP updated, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=None, user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> "\n" + ) + + (logs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing apiVersionV2 idpHandle + idpUpdate singleIngressSamlConfig zUser host idPMetadataInfo' (idp._idpId) Nothing + logs `shouldContain` [expectedLogLine] + + it "should log IdP update with domain for multi-ingress" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine = + ( Info, + "IdP updated, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=" + <> (TL.encodeUtf8 . TL.fromStrict) miHost1AsText + <> ", user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> "\n" + ) + + (logs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo' Nothing apiVersionV2 idpHandle + idpUpdate multiIngressSamlConfig zUser miHost1 idPMetadataInfo' (idp._idpId) Nothing + logs `shouldContain` [expectedLogLine] + + it "should log IdP update with changed domain for multi-ingress" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine = + ( Info, + "IdP updated, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", old-domain=" + <> (TL.encodeUtf8 . TL.fromStrict) miHost1AsText + <> ", new-domain=" + <> (TL.encodeUtf8 . TL.fromStrict) miHost2AsText + <> ", user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> "\n" + ) + + (logs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo' Nothing apiVersionV2 idpHandle + idpUpdate multiIngressSamlConfig zUser miHost2 idPMetadataInfo' (idp._idpId) Nothing + logs `shouldContain` [expectedLogLine] + + it "should log IdP update (changed cert)" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + newKeyInfo <- readSampleIO "okta-keyinfo-1.xml" + let newIssuerString = "https://new.idp.example.com/auth" + newIssuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ newIssuerString + newIdpEndpointString = "https://new.idp.example.com/login" + newRequestURI = either (error . show) id . parseURI strictURIParserOptions . fromString $ newIdpEndpointString + idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + newCert = either (error . show) id $ DSig.parseKeyInfo False newKeyInfo + newIdPMetadata :: IdPMetadata = + IdPMetadata + { _edIssuer = newIssuer, + _edRequestURI = newRequestURI, + _edCertAuthnResponse = NonEmptyL.singleton newCert + } + idPMetadataInfo'' = IdPMetadataValue ((TL.toStrict . encode) newIdPMetadata) newIdPMetadata + expectedLogLine = + ( Info, + "IdP updated, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000" + <> ", old-issuer=" + <> fromString issuerString + <> ", new-issuer=" + <> fromString newIssuerString + <> ", domain=None, user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", old-idp-endpoint=" + <> fromString idpEndpointString + <> ", new-idp-endpoint=" + <> fromString newIdpEndpointString + <> ", certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34" + <> ", new-certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34" + <> ", removed-certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> "\n" + ) + + (logs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing apiVersionV2 idpHandle + idpUpdate singleIngressSamlConfig zUser host idPMetadataInfo'' (idp._idpId) Nothing + logs `shouldContain` [expectedLogLine] + +type LogLine = (Level, LByteString) + +interpretWithLoggingMock :: + Maybe User -> + Sem (Effs) a -> + IO ([LogLine], a) +interpretWithLoggingMock mbAccount action = do + lr <- newLogRecorder + a <- + runFinal + . embedToFinal @IO + . Polysemy.Error.errorToIOFinal + . recordLogs lr + . ignoringState idpRawMetadataStoreToMem + . ignoringState idPToMem + . ignoringState scimTokenStoreToMem + . brigAccessMock mbAccount + . galleyAccessMock + . ignoringState samlUserStoreToMem + . randomToNull + $ action + logs <- readIORef lr.recordedLogs + pure (logs, either (error . show) id a) + +galleyAccessMock :: Sem (GalleyAccess ': r) a -> Sem r a +galleyAccessMock = interpret $ \case + GetTeamMembers _teamId -> undefined + GetTeamMember _teamId _userId -> undefined + AssertHasPermission _teamId _perm _userId -> pure () + AssertSSOEnabled _teamId -> pure () + IsEmailValidationEnabledTeam _teamId -> undefined + UpdateTeamMember _userId _teamId _role -> undefined + +brigAccessMock :: Maybe User -> Sem (BrigAccess ': r) a -> Sem r a +brigAccessMock mbAccount = interpret $ \case + CreateSAML _userRef _userId _teamId _name _managedBy _mHandle _mRichInfo _mLocale _role -> undefined + CreateNoSAML _txt _email _userId _teamId _name _mLocale _role -> undefined + UpdateEmail _userId _email _activation -> undefined + GetAccount _havePendingInvitations _userId -> pure mbAccount + GetByHandle _handle -> undefined + GetByEmail _email -> undefined + SetName _userId _name -> undefined + SetHandle _userId _handle -> undefined + SetManagedBy _userId _managedBy -> undefined + SetSSOId _userId _ssoId -> undefined + SetRichInfo _userId _richInfo -> undefined + SetLocale _userId _mLocale -> undefined + GetRichInfo _userId -> undefined + CheckHandleAvailable _handle -> undefined + DeleteUser _userId -> undefined + EnsureReAuthorised _mUserId _mPassword _mCode _mAction -> undefined + SsoLogin _userId -> undefined + GetStatus _userId -> undefined + GetStatusMaybe _userId -> undefined + SetStatus _userId _status -> undefined + GetDefaultUserLocale -> undefined + CheckAdminGetTeamId _userId -> undefined + +ignoringState :: (Functor f) => (a -> f (c, b)) -> a -> f b +ignoringState f = fmap snd . f + +type Effs = + '[ Random, + SAMLUserStore, + GalleyAccess, + BrigAccess, + ScimTokenStore, + IdPConfigStore, + IdPRawMetadataStore, + Logger (Msg -> Msg), + Polysemy.Error.Error SparError, + Embed IO, + Final IO + ] + +readSampleIO :: (MonadIO m) => FilePath -> m TL.Text +readSampleIO fpath = + liftIO $ + TL.readFile $ + "test/resources" fpath diff --git a/services/spar/test/resources/okta-keyinfo-1.xml b/services/spar/test/resources/okta-keyinfo-1.xml new file mode 100644 index 00000000000..5eacdb59013 --- /dev/null +++ b/services/spar/test/resources/okta-keyinfo-1.xml @@ -0,0 +1,21 @@ + + +MIIDpDCCAoygAwIBAgIGAWSx7x1HMA0GCSqGSIb3DQEBCwUAMIGSMQswCQYDVQQGEwJVUzETMBEG +A1UECAwKQ2FsaWZvcm5pYTEWMBQGA1UEBwwNU2FuIEZyYW5jaXNjbzENMAsGA1UECgwET2t0YTEU +MBIGA1UECwwLU1NPUHJvdmlkZXIxEzARBgNVBAMMCmRldi01MDA1MDgxHDAaBgkqhkiG9w0BCQEW +DWluZm9Ab2t0YS5jb20wHhcNMTgwNzE5MDk0NTM1WhcNMjgwNzE5MDk0NjM0WjCBkjELMAkGA1UE +BhMCVVMxEzARBgNVBAgMCkNhbGlmb3JuaWExFjAUBgNVBAcMDVNhbiBGcmFuY2lzY28xDTALBgNV +BAoMBE9rdGExFDASBgNVBAsMC1NTT1Byb3ZpZGVyMRMwEQYDVQQDDApkZXYtNTAwNTA4MRwwGgYJ +KoZIhvcNAQkBFg1pbmZvQG9rdGEuY29tMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA +hUaQm/3dgPws1A5IjFK9ZQpj170vIqENuDG0tapAzkvk6+9vyhduGckHTeZF3k5MMlW9iix2Eg0q +a1oS/Wrq/aBf7+BH6y1MJlQnaKQ3hPL+OFvYzbnrN8k2uC2LivP7Y90dXwtN3P63rA4QSyDPYEMv +dKSubUKX/HNsUg4I2PwHmpfWBNgoMkqe0bxQILBv+84L62IYSd6k77XXnCFb/usHpG/gY6sJsTQ2 +aFl9FuJ51uf67AOj8RzPXstgtUaXbdJI0kAqKIb3j9Zv3mpPCy/GHnyB3PMalvtc1uaz1ZnwO2el +iqhwB6/8W6CPutFo1Bhq1glQIX+1OD7906iORwIDAQABMA0GCSqGSIb3DQEBCwUAA4IBAQB0h6vK +AywJwH3g0RnocOpBvT42QW57TZ3Wzm9gbg6dQL0rB+NHDx2V0VIh51E3YHL1os9W09MreM7I74D/ +fX27r1Q3+qAsL1v3CN8WIVh9eYitBCtF7DwZmL2UXTia+GWPrabO14qAztFmTXfqNuCZej7gJd/K +2r0KBiZtZ6o58WBREW2F70a6nN6Nk1yjzBkDTJMMf8OMXHphTaalMBXojN9W6HEDpGBE0qY7c70P +qvfUEzd8wHWcDxo6+3jajajelk0V4rg7Cqxccr+WwjYtENEuQypNG2mbI52iPZked0QWKy0WzhSM +w5wjJ+QDG31vJInAB2769C2KmhPDyNhU + +