diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index 1567a6bede7..c8be9f65d0f 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -4,7 +4,7 @@ - [ ] The **PR description** provides context as to why the change should occur and what the code contributes to that effect. This could also be a link to a JIRA ticket or a Github issue, if there is one. - [ ] If end-points have been added or changed: the **endpoint / config-flag checklist** (see Wire-employee only backend [wiki page](https://github.com/zinfra/backend-wiki/wiki/Checklists)) has been followed. - [ ] If a schema migration has been added, I ran **`make git-add-cassandra-schema`** to update the cassandra schema documentation. - - [ ] Section *Unreleased* of **CHANGELOG.md** contains the following bits of information: + - [ ] Section *Unreleased* of **CHANGELOG-draft.md** contains the following bits of information: - [ ] A line with the title and number of the PR in one or more suitable sub-sections. - [ ] If /a: measures to be taken by instance operators. - [ ] If /a: list of cassandra migrations. diff --git a/CHANGELOG-draft.md b/CHANGELOG-draft.md new file mode 100644 index 00000000000..88690e1fd8c --- /dev/null +++ b/CHANGELOG-draft.md @@ -0,0 +1,22 @@ +THIS FILE ACCUMULATES THE RELEASE NOTES FOR THE UPCOMING RELEASE. + + diff --git a/CHANGELOG.md b/CHANGELOG.md index 33b9e774942..7de7eb92c6e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,41 +1,42 @@ - -[please put all changes that only affect federation into this section to unclutter the rest of the release notes.] -[if something is both an API change and a feature, please mention it twice (you can abbreviate the second mention and add "see above").] +# [2021-08-27] ## Release Notes ## API Changes +* Deprecate `DELETE /conversations/:cnv/members/:usr` (#1697) +* Add `DELETE /conversations/:cnv/members/:domain/:usr` (#1697) + ## Features ## Bug fixes and other updates -## Documentation - -## Internal changes - ---> +* Fix case sensitivity in schema parser in hscim library (#1714) +* [helm charts] resolve a rate-limiting issue when using certificate-manager alongside wire-server and nginx-ingress-services helm charts (#1715) +## Documentation -# [unreleased] - -[please put all changes that only affect federation into this section to unclutter the rest of the release notes.] -[if something is both an API change and a feature, please mention it twice (you can abbreviate the second mention and add "see above").] - -## Release Notes - -## API Changes +* Improve Swagger for `DELETE /conversations/:cnv/members/:usr` (#1697) -## Features +## Internal changes -## Bug fixes and other updates +* Integration test script now displays output interactively (#1700) +* Fixed a few issues with error response documentation in Swagger (#1707) +* Make mapping between (team) permissions and roles more lenient (#1711) +* The `DELETE /conversations/:cnv/members/:usr` endpoint rewritten to Servant (#1697) +* Remove leftover auto-connect internal endpoint and code (#1716) +* Bump wire-webapp (#1720) +* Bump team-settings (#1721) +* Bump account-pages (#1666) -## Documentation +## Federation changes -## Internal changes +* Added client certificate support for server to server authentication (#1682) +* Implemented full server-to-server authentication (#1687) +* Add an endpoint for removing a qualified user from a local conversation (#1697) # [2021-08-16] @@ -72,7 +73,6 @@ This is a routine release requiring only the routine upgrade steps. * Added a mechanism to derive `AsUnion` instances automatically (#1693) * Integration test coverage (#1696, #1704) - # [2021-08-02] ## Release Notes @@ -124,7 +124,6 @@ Upgrade nginz (#1658) * Renamed `DomainHeader` type to `OriginDomainHeader` (#1689) * Added golden tests for protobuf serialisation / deserialisation (#1644). - # [2021-07-09] ## Release Notes diff --git a/Makefile b/Makefile index dec6ef464a1..3dc11425689 100644 --- a/Makefile +++ b/Makefile @@ -334,6 +334,10 @@ chart-%: .PHONY: charts-integration charts-integration: $(foreach chartName,$(CHARTS_INTEGRATION),chart-$(chartName)) +.PHONY: charts-serve +charts-serve: charts-integration + ./hack/bin/serve-charts.sh $(CHARTS_INTEGRATION) + # Usecase for this make target: # 1. for releases of helm charts # 2. for testing helm charts more generally diff --git a/charts/account-pages/values.yaml b/charts/account-pages/values.yaml index c042e3282bc..349b799298b 100644 --- a/charts/account-pages/values.yaml +++ b/charts/account-pages/values.yaml @@ -9,7 +9,7 @@ resources: cpu: "1" image: repository: quay.io/wire/account - tag: 2.1.6-7ee369-v0.27.5-production + tag: "2.2.1-v0.28.21-0-6bfd7c5" service: https: externalPort: 443 diff --git a/charts/federator/templates/ca.yaml b/charts/federator/templates/ca.yaml new file mode 100644 index 00000000000..8363507e1b2 --- /dev/null +++ b/charts/federator/templates/ca.yaml @@ -0,0 +1,15 @@ +apiVersion: v1 +kind: ConfigMap +metadata: + name: "federator-ca" + labels: + wireService: federator + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} +data: +{{- if .Values.remoteCAContents }} + ca.crt: {{ .Values.remoteCAContents | quote }} +{{- else }} + {} +{{- end }} diff --git a/charts/federator/templates/configmap-ca.yaml b/charts/federator/templates/configmap-ca.yaml deleted file mode 100644 index f73da24264a..00000000000 --- a/charts/federator/templates/configmap-ca.yaml +++ /dev/null @@ -1,14 +0,0 @@ -apiVersion: v1 -kind: Secret -metadata: - name: "federator-ca" - labels: - wireService: federator - chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} - release: {{ .Release.Name }} - heritage: {{ .Release.Service }} -data: - # TODO: add validation and fail early during templating: either contents should be provided; or explicitly system trust store enabled - {{- if .Values.remoteCAContents }} - remote-ca.pem: {{ .Values.remoteCAContents | b64enc | quote }} - {{- end }} diff --git a/charts/federator/templates/configmap.yaml b/charts/federator/templates/configmap.yaml index 50df2444def..da4623a738e 100644 --- a/charts/federator/templates/configmap.yaml +++ b/charts/federator/templates/configmap.yaml @@ -43,8 +43,10 @@ data: # Filepath to one or more PEM-encoded server certificates to use as a trust # store when making grpc requests to remote backends {{- if $.Values.remoteCAContents }} - remoteCAStore: "/etc/wire/federator/ca/remote-ca.pem" + remoteCAStore: "/etc/wire/federator/ca/ca.crt" {{- end }} + clientCertificate: "/etc/wire/federator/secrets/tls.crt" + clientPrivateKey: "/etc/wire/federator/secrets/tls.key" useSystemCAStore: {{ .useSystemCAStore }} federationStrategy: {{- if .federationStrategy.allowAll }} diff --git a/charts/federator/templates/deployment.yaml b/charts/federator/templates/deployment.yaml index 8c5bebe8326..c09a239710c 100644 --- a/charts/federator/templates/deployment.yaml +++ b/charts/federator/templates/deployment.yaml @@ -25,18 +25,34 @@ spec: annotations: # An annotation of the configmap checksum ensures changes to the configmap cause a redeployment upon `helm upgrade` checksum/configmap: {{ include (print .Template.BasePath "/configmap.yaml") . | sha256sum }} - checksum/configmap-ca: {{ include (print .Template.BasePath "/configmap-ca.yaml") . | sha256sum }} + {{- if not .Values.tls.shareFederatorSecret }} + checksum/secret: {{ include (print .Template.BasePath "/secret.yaml") . | sha256sum }} + {{- end }} fluentbit.io/parser: json spec: volumes: - name: "federator-config" configMap: name: "federator" - # federator-ca holds CA certificates to use as a trust store - # when making requests to remote backends - - name: "federator-ca" + + # federator-secrets contains the client certificate and the + # corresponding private key to use when making requests to remote + # backends. + # NOTE: if tls.useSharedFederatorSecret is set, we use the same secret + # as the one for the federator ingress + - name: "federator-secrets" secret: - secretName: "federator-ca" + secretName: {{ if .Values.tls.useSharedFederatorSecret -}} + "federator-certificate-secret" + {{- else if .Values.clientCertificateContents -}} + "federator-secret" + {{- else }} + {{ fail "must set .Values.tls.useSharedFederatorSecret to true or specify .Values.clientCertificateContents" }} + {{- end }} + + - name: "federator-ca" + configMap: + name: "federator-ca" containers: - name: federator image: "{{ .Values.image.repository }}:{{ .Values.image.tag }}" @@ -44,6 +60,8 @@ spec: volumeMounts: - name: "federator-config" mountPath: "/etc/wire/federator/conf" + - name: "federator-secrets" + mountPath: "/etc/wire/federator/secrets" - name: "federator-ca" mountPath: "/etc/wire/federator/ca" ports: diff --git a/charts/federator/templates/secret.yaml b/charts/federator/templates/secret.yaml new file mode 100644 index 00000000000..f1337b952d9 --- /dev/null +++ b/charts/federator/templates/secret.yaml @@ -0,0 +1,19 @@ +{{- if not .Values.tls.useSharedFederatorSecret -}} +apiVersion: v1 +kind: Secret +metadata: + name: "federator-secret" + labels: + wireService: federator + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} +type: kubernetes.io/tls +data: + {{- if .Values.clientPrivateKeyContents }} + tls.key: {{ .Values.clientPrivateKeyContents | b64enc | quote }} + {{- end -}} + {{- if .Values.clientCertificateContents }} + tls.crt: {{ .Values.clientCertificateContents | b64enc | quote }} + {{- end -}} +{{- end -}} diff --git a/charts/federator/templates/tests/configmap.yaml b/charts/federator/templates/tests/configmap.yaml index 7016c7d3c7f..31b26123dc9 100644 --- a/charts/federator/templates/tests/configmap.yaml +++ b/charts/federator/templates/tests/configmap.yaml @@ -19,3 +19,4 @@ data: nginxIngress: host: federation-test-helper.{{ .Release.Namespace }}.svc.cluster.local port: 443 + originDomain: federation-test-helper.{{ .Release.Namespace }}.svc.cluster.local diff --git a/charts/federator/templates/tests/federator-integration.yaml b/charts/federator/templates/tests/federator-integration.yaml index 6891e7dbc53..32e6eef09ec 100644 --- a/charts/federator/templates/tests/federator-integration.yaml +++ b/charts/federator/templates/tests/federator-integration.yaml @@ -13,10 +13,14 @@ spec: - name: "federator-config" configMap: name: "federator" + # integration tests need access to the client certificate private key + - name: "federator-secrets" + secret: + secretName: "federator-secret" # integration tests need access to the CA - name: "federator-ca" - secret: - secretName: "federator-ca" + configMap: + name: "federator-ca" containers: - name: integration command: ["federator-integration"] @@ -26,6 +30,8 @@ spec: mountPath: "/etc/wire/integration" - name: "federator-config" mountPath: "/etc/wire/federator/conf" + - name: "federator-secrets" + mountPath: "/etc/wire/federator/secrets" - name: "federator-ca" mountPath: "/etc/wire/federator/ca" restartPolicy: Never diff --git a/charts/federator/values.yaml b/charts/federator/values.yaml index a316fda763d..5a29356f21d 100644 --- a/charts/federator/values.yaml +++ b/charts/federator/values.yaml @@ -8,6 +8,11 @@ service: internalFederatorPort: 8080 externalFederatorPort: 8081 +tls: + # if enabled, federator will get its client certificate and private key from + # the secret used by the federator ingress + useSharedFederatorSecret: false + resources: # FUTUREWORK: come up with numbers which didn't appear out of thin air requests: @@ -30,6 +35,9 @@ config: # # Using custom CA doesn't automatically disable system CA store, it should # be disabled explicitly by setting useSystemCAStore to false. + # + # A client certificate and corresponding private key can be specified + # similarly to a custom CA store. useSystemCAStore: true federationStrategy: allowedDomains: [] diff --git a/charts/nginx-ingress-services/templates/ca_federator.yaml b/charts/nginx-ingress-services/templates/ca_federator.yaml new file mode 100644 index 00000000000..471a7ac8b38 --- /dev/null +++ b/charts/nginx-ingress-services/templates/ca_federator.yaml @@ -0,0 +1,19 @@ +{{- /* This is the CA used by the federator ingress to verify client +certificates. This does not need to be a secret in principle, but the ingress +controller requires it to be. Also, this could in principle be bundled with the +corresponding certificate (in secret_federator.yaml), but it is a separate +secret because cert-manager interferes with the ca.crt field when setting the +certificate in a secret. */ -}} + +{{- if .Values.federator.enabled -}} +apiVersion: v1 +kind: Secret +metadata: + name: federator-ca-secret + labels: + chart: "{{ .Chart.Name }}-{{ .Chart.Version }}" + release: "{{ .Release.Name }}" + heritage: "{{ .Release.Service }}" +data: + ca.crt: {{ .Values.secrets.tlsClientCA | b64enc | quote }} +{{- end -}} diff --git a/charts/nginx-ingress-services/templates/certificate.yaml b/charts/nginx-ingress-services/templates/certificate.yaml index bf2561d9d97..21975e93c71 100644 --- a/charts/nginx-ingress-services/templates/certificate.yaml +++ b/charts/nginx-ingress-services/templates/certificate.yaml @@ -36,7 +36,4 @@ spec: {{- if .Values.accountPages.enabled }} - {{ .Values.config.dns.accountPages }} {{- end }} - {{- if .Values.federator.enabled }} - - {{ .Values.config.dns.federator }} - {{- end }} {{- end -}} diff --git a/charts/nginx-ingress-services/templates/certificate_federator.yaml b/charts/nginx-ingress-services/templates/certificate_federator.yaml new file mode 100644 index 00000000000..50466af495d --- /dev/null +++ b/charts/nginx-ingress-services/templates/certificate_federator.yaml @@ -0,0 +1,34 @@ +{{- if and .Values.federator.enabled (not .Values.tls.enabled) }} +{{- fail "TLS is required by federator. Either disable federation or enable tls." }} +{{- end }} +{{- if and .Values.tls.enabled .Values.tls.useCertManager }} +apiVersion: cert-manager.io/v1alpha2 +kind: Certificate +metadata: + name: "federator-{{ include "nginx-ingress-services.zone" . | replace "." "-" }}-csr" + namespace: {{ .Release.Namespace }} + labels: + chart: "{{ .Chart.Name }}-{{ .Chart.Version }}" + release: "{{ .Release.Name }}" + heritage: "{{ .Release.Service }}" +spec: + issuerRef: + name: letsencrypt-http01 + kind: Issuer + usages: + - server auth + - client auth + duration: 2160h # 90d, Letsencrypt default; NOTE: changes are ignored by Letsencrypt + renewBefore: 360h # 15d + isCA: false + keyAlgorithm: ecdsa + keySize: 256 # hs-tls only supports p256 + keyEncoding: pkcs1 + secretName: federator-certificate-secret + # NOTE: disabled due to https://github.com/jetstack/cert-manager/issues/2978 + # TODO: enable when fixed (probably when cert-manager:v0.16 released) + #privateKey: + # rotationPolicy: Always + dnsNames: + - {{ .Values.config.dns.federator }} +{{- end -}} diff --git a/charts/nginx-ingress-services/templates/ingress_federator.yaml b/charts/nginx-ingress-services/templates/ingress_federator.yaml index ea375b0ec44..215671505ec 100644 --- a/charts/nginx-ingress-services/templates/ingress_federator.yaml +++ b/charts/nginx-ingress-services/templates/ingress_federator.yaml @@ -12,11 +12,15 @@ metadata: kubernetes.io/ingress.class: "nginx" nginx.ingress.kubernetes.io/ssl-redirect: "true" nginx.ingress.kubernetes.io/backend-protocol: "GRPC" + nginx.ingress.kubernetes.io/auth-tls-verify-client: "on" + nginx.ingress.kubernetes.io/auth-tls-secret: "{{ .Release.Namespace }}/federator-ca-secret" + nginx.ingress.kubernetes.io/configuration-snippet: | + grpc_set_header "X-SSL-Certificate" $ssl_client_escaped_cert; spec: tls: - hosts: - {{ .Values.config.dns.federator }} - secretName: {{ include "nginx-ingress-services.getCertificateSecretName" . | quote }} + secretName: "federator-certificate-secret" rules: - host: {{ .Values.config.dns.federator }} http: diff --git a/charts/nginx-ingress-services/templates/secret.yaml b/charts/nginx-ingress-services/templates/secret.yaml index e0472b0fb4e..e0fb43923b9 100644 --- a/charts/nginx-ingress-services/templates/secret.yaml +++ b/charts/nginx-ingress-services/templates/secret.yaml @@ -1,3 +1,4 @@ +{{- if not .Values.tls.useCertManager }} apiVersion: v1 kind: Secret metadata: @@ -7,19 +8,12 @@ metadata: release: "{{ .Release.Name }}" heritage: "{{ .Release.Service }}" type: kubernetes.io/tls -{{ if .Values.tls.useCertManager -}} -{{- /* NOTE: providing `data` (and empty strings) allows to manage this secret resource with Helm if cert-manager is used */ -}} data: - tls.crt: "" - tls.key: "" -{{- end -}} -{{- if (not .Values.tls.useCertManager) -}} -data: - {{- /* for_helm_linting is necessary only since the 'with' block below does not throw an error upon an empty .Values.secrets */}} + {{/* for_helm_linting is necessary only since the 'with' block below does not throw an error upon an empty .Values.secrets */}} for_helm_linting: {{ required "No .secrets found in configuration. Did you forget to helm -f path/to/secrets.yaml ?" .Values.secrets | quote | b64enc | quote }} {{- with .Values.secrets }} tls.crt: {{ .tlsWildcardCert | b64enc | quote }} tls.key: {{ .tlsWildcardKey | b64enc | quote }} - {{- end }} + {{- end -}} {{- end -}} diff --git a/charts/nginx-ingress-services/templates/secret_federator.yaml b/charts/nginx-ingress-services/templates/secret_federator.yaml new file mode 100644 index 00000000000..7cace049241 --- /dev/null +++ b/charts/nginx-ingress-services/templates/secret_federator.yaml @@ -0,0 +1,19 @@ +{{- if and .Values.federator.enabled (not .Values.tls.useCertManager) }} +apiVersion: v1 +kind: Secret +metadata: + name: federator-certificate-secret + labels: + chart: "{{ .Chart.Name }}-{{ .Chart.Version }}" + release: "{{ .Release.Name }}" + heritage: "{{ .Release.Service }}" +type: kubernetes.io/tls +data: + {{/* for_helm_linting is necessary only since the 'with' block below does not throw an error upon an empty .Values.secrets */}} + for_helm_linting: {{ required "No .secrets found in configuration. Did you forget to helm -f path/to/secrets.yaml ?" .Values.secrets | quote | b64enc | quote }} + + {{- with .Values.secrets }} + tls.crt: {{ .tlsWildcardCert | b64enc | quote }} + tls.key: {{ .tlsWildcardKey | b64enc | quote }} + {{- end -}} +{{- end -}} diff --git a/charts/nginx-ingress-services/values.yaml b/charts/nginx-ingress-services/values.yaml index fc87dbebccc..6a4c1a51d4a 100644 --- a/charts/nginx-ingress-services/values.yaml +++ b/charts/nginx-ingress-services/values.yaml @@ -75,6 +75,10 @@ service: # tlsWildcardKey: | # -----BEGIN PRIVATE KEY----- # -----END PRIVATE KEY----- +# tlsClientCA: | +# -----BEGIN PRIVATE KEY----- +# -----END PRIVATE KEY----- +# ^ CA to use to verify client certificates. # # For Services: # service: diff --git a/charts/team-settings/values.yaml b/charts/team-settings/values.yaml index 69f1f23d8f4..61f8968d85c 100644 --- a/charts/team-settings/values.yaml +++ b/charts/team-settings/values.yaml @@ -9,7 +9,7 @@ resources: cpu: "1" image: repository: quay.io/wire/team-settings - tag: "4.0.0-v0.28.18-0-0846c0a" + tag: "4.0.0-v0.28.21-b92fca-2" service: https: externalPort: 443 diff --git a/charts/webapp/values.yaml b/charts/webapp/values.yaml index d1058a30c4a..2eb37351576 100644 --- a/charts/webapp/values.yaml +++ b/charts/webapp/values.yaml @@ -9,7 +9,7 @@ resources: cpu: "1" image: repository: quay.io/wire/webapp - tag: 2021-06-01-production.0-v0.28.15-0a4d64 + tag: 2021-08-25-v0.28.24-master service: https: externalPort: 443 diff --git a/deploy/dockerephemeral/coredns-config/Corefile b/deploy/dockerephemeral/coredns-config/Corefile new file mode 100644 index 00000000000..7bf495f2e89 --- /dev/null +++ b/deploy/dockerephemeral/coredns-config/Corefile @@ -0,0 +1,4 @@ +example.com { + file /coredns-config/db.example.com + log +} \ No newline at end of file diff --git a/deploy/dockerephemeral/coredns-config/db.example.com b/deploy/dockerephemeral/coredns-config/db.example.com new file mode 100644 index 00000000000..941502a4321 --- /dev/null +++ b/deploy/dockerephemeral/coredns-config/db.example.com @@ -0,0 +1,15 @@ +$ORIGIN example.com. +@ 3600 IN SOA sns.dns.icann.org. noc.dns.icann.org. ( + 2017042745 ; serial + 7200 ; refresh (2 hours) + 3600 ; retry (1 hour) + 1209600 ; expire (2 weeks) + 3600 ; minimum (1 hour) + ) + + 3600 IN NS a.iana-servers.net. + 3600 IN NS b.iana-servers.net. + +www IN A 127.0.0.1 + IN AAAA ::1 +_wire-server-federator._tcp IN SRV 0 0 443 federator.integration.example.com. diff --git a/deploy/dockerephemeral/docker-compose.yaml b/deploy/dockerephemeral/docker-compose.yaml index 82f58f55953..f5c570af458 100644 --- a/deploy/dockerephemeral/docker-compose.yaml +++ b/deploy/dockerephemeral/docker-compose.yaml @@ -191,3 +191,14 @@ services: - ./:/scripts networks: - demo_wire + coredns: + image: docker.io/coredns/coredns:1.8.4 + volumes: + - ./coredns-config:/coredns-config + entrypoint: + - /coredns + - -conf + - /coredns-config/Corefile + ports: + - "9053:53" + - "9053:53/udp" diff --git a/deploy/services-demo/conf/nginz/nginx.conf b/deploy/services-demo/conf/nginz/nginx.conf index f4249995d7b..5d577caed68 100644 --- a/deploy/services-demo/conf/nginz/nginx.conf +++ b/deploy/services-demo/conf/nginz/nginx.conf @@ -130,6 +130,8 @@ http { ssl_certificate integration-leaf.pem; ssl_certificate_key integration-leaf-key.pem; + ssl_verify_client on; + ssl_client_certificate integration-ca.pem; ######## TLS/SSL block end ############## zauth_keystore resources/zauth/pubkeys.txt; @@ -163,7 +165,11 @@ http { location /wire.federator.Inward { set $sanitized_request $request; zauth off; + + grpc_set_header "X-SSL-Certificate" $ssl_client_escaped_cert; + grpc_pass grpc://federator_external; + # FUTUREWORK(federation): are any other settings # (e.g. timeouts, body size, buffers, headers,...) # useful/recommended/important-for-security?) diff --git a/docs/reference/config-options.md b/docs/reference/config-options.md index 8b34ab4829f..03bbec884fd 100644 --- a/docs/reference/config-options.md +++ b/docs/reference/config-options.md @@ -224,14 +224,49 @@ federator: ### Federation TLS Config When a federator connects with another federator, it does so over HTTPS. There -are two options to configure the CA for this: +are a few options to configure the CA for this: 1. `useSystemCAStore`: Boolean. If set to `True` it will use the system CA. -1. `remoteCAStore`: Maybe Filepath. This config option can be used to specify +2. `remoteCAStore`: Maybe Filepath. This config option can be used to specify multiple certificates from either a single file (multiple PEM formatted certificates concatenated) or directory (one certificate per file, file names are hashes from certificate). +3. `clientCertificate`: Maybe Filepath. A client certificate to use when + connecting to remote federators. If this option is omitted, no client + certificate is used. If it is provided, then the `clientPrivateKey` option + (see below) must be provided as well. +4. `clientPrivateKey`: Maybe Filepath. The private key corresponding to the + `clientCertificate` option above. It is an error to provide only a private key + without the corresponding certificate. -Both of these options can be specified, in this case the stores are concatenated -and used for verifying certificates. When `useSystemCAStore` is `False` and -`remoteCAStore` is not set, then all outbound connections will fail with TLS -error as there will be no CA to verify. +Both the `useSystemCAStore` and `remoteCAStore` options can be specified, in +which case the stores are concatenated and used for verifying certificates. +When `useSystemCAStore` is set to `false` and `remoteCAStore` is not provided, +all outbound connections will fail with a TLS error as there will be no CA for +verifying the server certificate. + +#### Examples + +Federate with anyone, no client certificates, use system CA store to verify +server certificates: + +```yaml +federator: + optSettings: + federationStrategy: + allowAll: + useSystemCAStore: true +``` + +Federate only with `server2.example.com`, use a client certificate and a +specific CA: + +```yaml +federator: + optSettings: + federationStrategy: + allowedDomains: + - server2.example.com + useSystemCAStore: false + clientCertificate: client.pem + clientPrivateKey: client-key.pem +``` diff --git a/docs/reference/user/activation.md b/docs/reference/user/activation.md index d0bd8356d33..60868cd5811 100644 --- a/docs/reference/user/activation.md +++ b/docs/reference/user/activation.md @@ -14,8 +14,6 @@ Non-activated users can not [connect](connection.md) to others, nor can connecti * A non-activated user cannot add other users to conversations. The only way to participate in a conversation is to either create a new conversation with link access or to use a link provided by another user. -* A non-activated user cannot get auto-connected to others as a result of an address book upload. - The only flow where it makes sense for non-activated users to exist is the [wireless flow](registration.md#RefRegistrationWireless) used for [guest rooms](https://wire.com/en/features/encrypted-guest-rooms/) ## API {#RefActivationApi} diff --git a/hack/bin/helm-template.sh b/hack/bin/helm-template.sh index 0cd1306f56e..d72684ce9ba 100755 --- a/hack/bin/helm-template.sh +++ b/hack/bin/helm-template.sh @@ -15,10 +15,14 @@ TOP_LEVEL="$DIR/../.." CHARTS_DIR="${TOP_LEVEL}/.local/charts" valuesfile="${DIR}/../helm_vars/${chart}/values.yaml" +certificatesfile="${DIR}/../helm_vars/${chart}/certificates.yaml" declare -a options=() if [ -f "$valuesfile" ]; then options+=(-f "$valuesfile") fi +if [ -f "$certificatesfile" ]; then + options+=(-f "$certificatesfile") +fi "$DIR/update.sh" "$CHARTS_DIR/$chart" helm template $"chart" "$CHARTS_DIR/$chart" ${options[*]} diff --git a/hack/bin/integration-test-logs.sh b/hack/bin/integration-test-logs.sh new file mode 100755 index 00000000000..8ba7dcd44e1 --- /dev/null +++ b/hack/bin/integration-test-logs.sh @@ -0,0 +1,13 @@ +#!/usr/bin/env bash +set -euo pipefail + +if [[ -z "$NAMESPACE" ]]; then + echo "NAMESPACE not set" + exit 1 +fi + +while IFS= read LINE; do + if [[ "$LINE" =~ ^Pod\ (.*)\ running$ ]]; then + kubectl -n "$NAMESPACE" logs "${BASH_REMATCH[1]}" -f + fi +done diff --git a/hack/bin/integration-test.sh b/hack/bin/integration-test.sh index 62ecfcfff4b..03470d2115c 100755 --- a/hack/bin/integration-test.sh +++ b/hack/bin/integration-test.sh @@ -1,8 +1,11 @@ #!/usr/bin/env bash +set -euo pipefail NAMESPACE=${NAMESPACE:-test-integration} echo "Running integration tests on wire-server" +DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" CHART=wire-server -helm test --logs -n "${NAMESPACE}" "${NAMESPACE}-${CHART}" --timeout 600s +helm test -n "${NAMESPACE}" "${NAMESPACE}-${CHART}" --timeout 600s | + "$DIR/integration-test-logs.sh" diff --git a/hack/bin/selfsigned-kubernetes.sh b/hack/bin/selfsigned-kubernetes.sh index df2d7f5252b..73b97762312 100755 --- a/hack/bin/selfsigned-kubernetes.sh +++ b/hack/bin/selfsigned-kubernetes.sh @@ -10,6 +10,7 @@ TEMP=${TEMP:-/tmp} CSR="$TEMP/csr.json" OUTPUTNAME_CA="integration-ca" OUTPUTNAME_LEAF_CERT="integration-leaf" +OUTPUTNAME_CLIENT_CERT="integration-client" DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" TOP_LEVEL="$DIR/../.." OUTPUT_CONFIG_FEDERATOR="$TOP_LEVEL/hack/helm_vars/wire-server/certificates.yaml" @@ -55,6 +56,9 @@ echo '{ # generate cert and key based on CA given comma-separated hostnames as SANs cfssl gencert -ca "$OUTPUTNAME_CA.pem" -ca-key "$OUTPUTNAME_CA-key.pem" -hostname="*.$FEDERATION_DOMAIN_BASE" "$CSR" | cfssljson -bare "$OUTPUTNAME_LEAF_CERT" +# generate client certificate and key +cfssl gencert -ca "$OUTPUTNAME_CA.pem" -ca-key "$OUTPUTNAME_CA-key.pem" -hostname="*.$FEDERATION_DOMAIN_BASE" "$CSR" | cfssljson -bare "$OUTPUTNAME_CLIENT_CERT" + # the following yaml override file is needed as an override to # nginx-ingress-services helm chart # for domain A, ingress@A needs cert+key for A @@ -64,6 +68,8 @@ cfssl gencert -ca "$OUTPUTNAME_CA.pem" -ca-key "$OUTPUTNAME_CA-key.pem" -hostnam sed -e 's/^/ /' $OUTPUTNAME_LEAF_CERT.pem echo " tlsWildcardKey: |" sed -e 's/^/ /' $OUTPUTNAME_LEAF_CERT-key.pem + echo " tlsClientCA: |" + sed -e 's/^/ /' $OUTPUTNAME_CA.pem } | tee "$OUTPUT_CONFIG_INGRESS" # the following yaml override file is needed as an override to @@ -75,10 +81,17 @@ cfssl gencert -ca "$OUTPUTNAME_CA.pem" -ca-key "$OUTPUTNAME_CA-key.pem" -hostnam echo "federator:" echo " remoteCAContents: |" sed -e 's/^/ /' $OUTPUTNAME_CA.pem + echo " clientCertificateContents: |" + sed -e 's/^/ /' $OUTPUTNAME_CLIENT_CERT.pem + echo " clientPrivateKeyContents: |" + sed -e 's/^/ /' $OUTPUTNAME_CLIENT_CERT-key.pem } | tee "$OUTPUT_CONFIG_FEDERATOR" # cleanup unneeded files rm "$OUTPUTNAME_LEAF_CERT.csr" rm "$OUTPUTNAME_LEAF_CERT.pem" rm "$OUTPUTNAME_LEAF_CERT-key.pem" +rm "$OUTPUTNAME_CLIENT_CERT.csr" +rm "$OUTPUTNAME_CLIENT_CERT.pem" +rm "$OUTPUTNAME_CLIENT_CERT-key.pem" rm "$CSR" diff --git a/hack/bin/serve-charts.sh b/hack/bin/serve-charts.sh new file mode 100755 index 00000000000..09172c43f10 --- /dev/null +++ b/hack/bin/serve-charts.sh @@ -0,0 +1,17 @@ +#!/usr/bin/env bash + +set -euo pipefail + +: ${HELM_SERVER_PORT:=4001} + +# get rid of all helm repositories +# We need to deal with helm repo list failing because of https://github.com/helm/helm/issues/10028 +(helm repo list -o json || echo '[]') | jq -r '.[] | .name' | xargs -I% helm repo remove % + +cd "$(dirname "$BASH_SOURCE[0]")/../../.local/charts" +for chart in $@; do + ../../hack/bin/update.sh "$chart" + helm package "$chart" +done +helm repo index . +python -m http.server $HELM_SERVER_PORT diff --git a/hack/helm_vars/nginx-ingress-services/values.yaml b/hack/helm_vars/nginx-ingress-services/values.yaml index 34208c0de1b..76aa0657e80 100644 --- a/hack/helm_vars/nginx-ingress-services/values.yaml +++ b/hack/helm_vars/nginx-ingress-services/values.yaml @@ -18,5 +18,5 @@ config: accountPages: account.integration.example.com # federator: dynamically set by hack/bin/integration-setup.sh -# the secrets/tlsWildcardCert and secrets/tlsWildcardKey are -# dynamically provided from hack/bin/selfsigned-kubernetes.sh +# secrets/tlsWildcardCert, secrets/tlsWildcardKey and secrets/tlsClientCA +# are dynamically generated by hack/bin/selfsigned-kubernetes.sh diff --git a/libs/api-client/src/Network/Wire/Client/API/Push.hs b/libs/api-client/src/Network/Wire/Client/API/Push.hs index df6e6b18f35..0a0dba80a97 100644 --- a/libs/api-client/src/Network/Wire/Client/API/Push.hs +++ b/libs/api-client/src/Network/Wire/Client/API/Push.hs @@ -79,7 +79,7 @@ import qualified System.Logger as Log import Wire.API.Connection (UserConnection (..)) import Wire.API.Conversation.Member (MemberUpdate (..)) import Wire.API.Event.Conversation hiding (Event, EventType) -import Wire.API.User (Name (..), User (..), userEmail) +import Wire.API.User (Name (..), User (..), UserIdList (..), userEmail) ------------------------------------------------------------------------------- diff --git a/libs/brig-types/src/Brig/Types/Intra.hs b/libs/brig-types/src/Brig/Types/Intra.hs index 1146c09c16b..7093688a1a9 100644 --- a/libs/brig-types/src/Brig/Types/Intra.hs +++ b/libs/brig-types/src/Brig/Types/Intra.hs @@ -174,7 +174,7 @@ instance ToJSON NewUserScimInvitation where -- UserList -- | Set of user ids, can be used for different purposes (e.g., used on the internal --- APIs for auto-connections, listing user's clients) +-- APIs for listing user's clients) data UserSet = UserSet { usUsrs :: !(Set UserId) } diff --git a/libs/dns-util/src/Wire/Network/DNS/Helper.hs b/libs/dns-util/src/Wire/Network/DNS/Helper.hs index 6d3b469d1d9..7529d57536e 100644 --- a/libs/dns-util/src/Wire/Network/DNS/Helper.hs +++ b/libs/dns-util/src/Wire/Network/DNS/Helper.hs @@ -22,8 +22,8 @@ import Network.DNS -- | Set up a thread-safe resolver with a global cache. Records will only be -- re-resolved after their TTLs expire -withCachingResolver :: (Resolver -> IO a) -> IO a -withCachingResolver action = do - let resolvConf = defaultResolvConf {resolvCache = Just defaultCacheConf} - resolvSeed <- makeResolvSeed resolvConf +withCachingResolver :: ResolvConf -> (Resolver -> IO a) -> IO a +withCachingResolver conf action = do + let confWithCaching = conf {resolvCache = Just defaultCacheConf} + resolvSeed <- makeResolvSeed confWithCaching withResolver resolvSeed action diff --git a/libs/galley-types/src/Galley/Types.hs b/libs/galley-types/src/Galley/Types.hs index 811bd657196..09edac1c768 100644 --- a/libs/galley-types/src/Galley/Types.hs +++ b/libs/galley-types/src/Galley/Types.hs @@ -41,6 +41,7 @@ module Galley.Types EventType (..), EventData (..), UserIdList (..), + QualifiedUserIdList (..), SimpleMember (..), SimpleMembers (..), MemberUpdateData (..), @@ -85,6 +86,7 @@ import Wire.API.Conversation.Typing import Wire.API.CustomBackend import Wire.API.Event.Conversation import Wire.API.Message +import Wire.API.User (UserIdList (..)) import Wire.API.User.Client -------------------------------------------------------------------------------- diff --git a/libs/galley-types/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs index 365358c333c..bcbc0ce3ecc 100644 --- a/libs/galley-types/src/Galley/Types/Teams.hs +++ b/libs/galley-types/src/Galley/Types/Teams.hs @@ -149,13 +149,26 @@ rolePermissions :: Role -> Permissions rolePermissions role = Permissions p p where p = rolePerms role permissionsRole :: Permissions -> Maybe Role -permissionsRole (Permissions p p') | p /= p' = Nothing -permissionsRole (Permissions p _) = permsRole p +permissionsRole (Permissions p p') = + if p /= p' + then do + -- we never did use @p /= p'@ for anything, fingers crossed that it doesn't occur anywhere + -- in the wild. but if it does, this implementation prevents privilege escalation. + let p'' = Set.intersection p p' + in permissionsRole (Permissions p'' p'') + else permsRole p where permsRole :: Set Perm -> Maybe Role permsRole perms = Maybe.listToMaybe - [role | role <- [minBound ..], rolePerms role == perms] + [ role + | role <- [minBound ..], + -- if a there is a role that is strictly less permissive than the perms set that + -- we encounter, we downgrade. this shouldn't happen in real life, but it has + -- happened to very old users on a staging environment, where a user (probably) + -- was create before the current publicly visible permissions had been stabilized. + rolePerms role `Set.isSubsetOf` perms + ] -- | Internal function for 'rolePermissions'. (It works iff the two sets in 'Permissions' are -- identical for every 'Role', otherwise it'll need to be specialized for the resp. sides.) diff --git a/libs/galley-types/test/unit/Test/Galley/Types.hs b/libs/galley-types/test/unit/Test/Galley/Types.hs index 96c3acabe95..73791c71a6e 100644 --- a/libs/galley-types/test/unit/Test/Galley/Types.hs +++ b/libs/galley-types/test/unit/Test/Galley/Types.hs @@ -1,6 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-orphans -Wno-incomplete-uni-patterns #-} -- This file is part of the Wire Server implementation. -- @@ -23,14 +23,15 @@ module Test.Galley.Types where import Control.Lens import Data.Set hiding (drop) +import qualified Data.Set as Set import Galley.Types.Teams import Galley.Types.Teams.Intra (GuardLegalholdPolicyConflicts) import Imports import Test.Galley.Roundtrip (testRoundTrip) -import Test.QuickCheck (Arbitrary (arbitrary)) import qualified Test.QuickCheck as QC import Test.Tasty import Test.Tasty.HUnit +import Test.Tasty.QuickCheck tests :: TestTree tests = @@ -54,7 +55,35 @@ tests = -- this test, and force future develpers to consider what permissions they want to set. assertBool "all covered" (all (roleHasPerm RoleExternalPartner) (ViewTeamFeature <$> [minBound ..])), testRoundTrip @FeatureFlags, - testRoundTrip @GuardLegalholdPolicyConflicts + testRoundTrip @GuardLegalholdPolicyConflicts, + testGroup + "permissionsRole, rolePermissions" + [ testCase "'Role' maps to expected permissions" $ do + assertEqual "role type changed" [minBound ..] [RoleOwner, RoleAdmin, RoleMember, RoleExternalPartner] + assertEqual "owner" (permissionsRole =<< newPermissions (intToPerms 8191) (intToPerms 8191)) (Just RoleOwner) + assertEqual "admin" (permissionsRole =<< newPermissions (intToPerms 5951) (intToPerms 5951)) (Just RoleAdmin) + assertEqual "member" (permissionsRole =<< newPermissions (intToPerms 1587) (intToPerms 1587)) (Just RoleMember) + assertEqual "external partner" (permissionsRole =<< newPermissions (intToPerms 1025) (intToPerms 1025)) (Just RoleExternalPartner), + testCase "Role <-> Permissions roundtrip" $ do + assertEqual "admin" (permissionsRole . rolePermissions <$> [minBound ..]) (Just <$> [minBound ..]), + testProperty "Random, incoherent 'Permission' values gracefully translate to subsets." $ + let fakeSort (w, w') = (w `Set.union` w', w') + in \(fakeSort -> (w, w')) -> do + let Just perms = newPermissions w w' + case permissionsRole perms of + Just role -> do + let perms' = rolePermissions role + assertEqual "eq" (perms' ^. self) (perms' ^. copy) + assertBool "self" ((perms' ^. self) `Set.isSubsetOf` (perms ^. self)) + assertBool "copy" ((perms' ^. copy) `Set.isSubsetOf` (perms ^. copy)) + Nothing -> do + let leastPermissions = rolePermissions maxBound + assertBool "no role for perms, but strictly more perms than max role" $ + not + ( (leastPermissions ^. self) `Set.isSubsetOf` w + && (leastPermissions ^. copy) `Set.isSubsetOf` w' + ) + ] ] instance Arbitrary FeatureFlags where diff --git a/libs/hscim/CHANGELOG b/libs/hscim/CHANGELOG index 24ba090e434..a9fcfb821fa 100644 --- a/libs/hscim/CHANGELOG +++ b/libs/hscim/CHANGELOG @@ -1,2 +1,5 @@ +0.3.6: + - fix serialization: json attributes in scim are case-insensitive + 0.3.4: - initial version diff --git a/libs/hscim/hscim.cabal b/libs/hscim/hscim.cabal index 870c476dbcf..d9c9a0732e6 100644 --- a/libs/hscim/hscim.cabal +++ b/libs/hscim/hscim.cabal @@ -4,10 +4,10 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: b8d0589f22bc168d16fa3a2b2800d9cc3b14b4d94bb911fe973ccf2a2025e5e5 +-- hash: 8daa0bcbe43125e8d9749dd38e62f67cb01f62a1bcd57a0391e684860203e60c name: hscim -version: 0.3.5 +version: 0.3.6 synopsis: hscim json schema and server implementation description: The README file will answer all the questions you might have category: Web @@ -173,9 +173,13 @@ test-suite spec Test.Class.UserSpec Test.FilterSpec Test.MiscSpec + Test.Schema.AuthenticationSchemeSpec + Test.Schema.GroupSpec Test.Schema.MetaSchemaSpec Test.Schema.PatchOpSpec + Test.Schema.ResourceSpec Test.Schema.UserSpec + Test.Schema.Util Paths_hscim hs-source-dirs: test diff --git a/libs/hscim/package.yaml b/libs/hscim/package.yaml index 1bd19369caa..9e4d5911cc7 100644 --- a/libs/hscim/package.yaml +++ b/libs/hscim/package.yaml @@ -1,5 +1,5 @@ name: hscim -version: 0.3.5 +version: 0.3.6 synopsis: hscim json schema and server implementation description: The README file will answer all the questions you might have homepage: https://github.com/wireapp/wire-server/libs/hscim/README.md diff --git a/libs/hscim/src/Web/Scim/Capabilities/MetaSchema.hs b/libs/hscim/src/Web/Scim/Capabilities/MetaSchema.hs index 600a6d69c4b..c9da11b4795 100644 --- a/libs/hscim/src/Web/Scim/Capabilities/MetaSchema.hs +++ b/libs/hscim/src/Web/Scim/Capabilities/MetaSchema.hs @@ -81,7 +81,7 @@ instance ToJSON BulkConfig where toJSON = genericToJSON serializeOptions instance FromJSON BulkConfig where - parseJSON = genericParseJSON serializeOptions + parseJSON = genericParseJSON parseOptions . jsonLower data FilterConfig = FilterConfig { maxResults :: Int @@ -92,7 +92,7 @@ instance ToJSON FilterConfig where toJSON = genericToJSON serializeOptions instance FromJSON FilterConfig where - parseJSON = genericParseJSON serializeOptions + parseJSON = genericParseJSON parseOptions . jsonLower data Configuration = Configuration { documentationUri :: Maybe URI, @@ -111,7 +111,7 @@ instance ToJSON Configuration where toJSON = genericToJSON serializeOptions instance FromJSON Configuration where - parseJSON = genericParseJSON serializeOptions + parseJSON = genericParseJSON parseOptions . jsonLower empty :: Configuration empty = diff --git a/libs/hscim/src/Web/Scim/Schema/AuthenticationScheme.hs b/libs/hscim/src/Web/Scim/Schema/AuthenticationScheme.hs index 24ec013f207..41c3eb07238 100644 --- a/libs/hscim/src/Web/Scim/Schema/AuthenticationScheme.hs +++ b/libs/hscim/src/Web/Scim/Schema/AuthenticationScheme.hs @@ -66,9 +66,8 @@ instance ToJSON AuthenticationSchemeEncoding where toJSON = genericToJSON serializeOptions instance FromJSON AuthenticationSchemeEncoding where - parseJSON = genericParseJSON serializeOptions - --- NB: "typ" will be converted to "type" thanks to 'serializeOptions' + -- NB: "typ" will be converted to "type" thanks to 'serializeOptions' + parseJSON = genericParseJSON parseOptions . jsonLower ---------------------------------------------------------------------------- -- Scheme encodings diff --git a/libs/hscim/src/Web/Scim/Schema/Common.hs b/libs/hscim/src/Web/Scim/Schema/Common.hs index 6a33c5f8979..80f25a4d30f 100644 --- a/libs/hscim/src/Web/Scim/Schema/Common.hs +++ b/libs/hscim/src/Web/Scim/Schema/Common.hs @@ -25,7 +25,6 @@ import qualified Data.CaseInsensitive as CI import qualified Data.Char as Char import qualified Data.HashMap.Lazy as HML import qualified Data.HashMap.Strict as HM -import Data.String (IsString) import Data.String.Conversions (cs) import Data.Text hiding (dropWhile) import qualified Network.URI as Network @@ -69,7 +68,7 @@ instance FromJSON ScimBool where _ -> fail $ "Expected true, false, \"true\", or \"false\" (case insensitive), but got " <> cs str parseJSON bad = fail $ "Expected true, false, \"true\", or \"false\" (case insensitive), but got " <> show bad -toKeyword :: (IsString p, Eq p) => p -> p +toKeyword :: String -> String toKeyword "typ" = "type" toKeyword "ref" = "$ref" toKeyword other = other @@ -81,20 +80,20 @@ serializeOptions = fieldLabelModifier = toKeyword } --- | Turn all keys in a JSON object to lowercase. -jsonLower :: Value -> Value -jsonLower (Object o) = Object . HM.fromList . fmap lowerPair . HM.toList $ o - where - lowerPair (key, val) = (fromKeyword . toLower $ key, val) -jsonLower x = x - -fromKeyword :: (IsString p, Eq p) => p -> p -fromKeyword "type" = "typ" -fromKeyword "$ref" = "ref" -fromKeyword other = other - parseOptions :: Options parseOptions = defaultOptions - { fieldLabelModifier = fmap Char.toLower + { fieldLabelModifier = toKeyword . fmap Char.toLower } + +-- | Turn all keys in a JSON object to lowercase recursively. This is applied to the aeson +-- 'Value' to be parsed; 'parseOptions' is applied to the keys passed to '(.:)' etc. +-- +-- (FUTUREWORK: The "recursively" part is a bit of a waste and could be dropped, but we would +-- have to spend more effort in making sure it is always called manually in nested parsers.) +jsonLower :: Value -> Value +jsonLower (Object o) = Object . HM.fromList . fmap lowerPair . HM.toList $ o + where + lowerPair (key, val) = (toLower key, jsonLower val) +jsonLower (Array x) = Array (jsonLower <$> x) +jsonLower x = x diff --git a/libs/hscim/src/Web/Scim/Schema/ResourceType.hs b/libs/hscim/src/Web/Scim/Schema/ResourceType.hs index a9ffd591b1e..06eba367b6e 100644 --- a/libs/hscim/src/Web/Scim/Schema/ResourceType.hs +++ b/libs/hscim/src/Web/Scim/Schema/ResourceType.hs @@ -32,7 +32,7 @@ import Prelude hiding (map) data ResourceType = UserResource | GroupResource - deriving (Show, Eq) + deriving (Show, Eq, Enum, Bounded) instance ToJSON ResourceType where toJSON UserResource = "User" diff --git a/libs/hscim/test/Test/Schema/AuthenticationSchemeSpec.hs b/libs/hscim/test/Test/Schema/AuthenticationSchemeSpec.hs new file mode 100644 index 00000000000..0501c6e6463 --- /dev/null +++ b/libs/hscim/test/Test/Schema/AuthenticationSchemeSpec.hs @@ -0,0 +1,50 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2020 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.Schema.AuthenticationSchemeSpec + ( spec, + ) +where + +import Data.Aeson +import HaskellWorks.Hspec.Hedgehog (require) +import Hedgehog +import qualified Hedgehog.Gen as Gen +import Test.Hspec +import Test.Schema.Util (genUri, mk_prop_caseInsensitive) +import qualified Web.Scim.Schema.AuthenticationScheme as AS + +prop_roundtrip :: Property +prop_roundtrip = property $ do + user <- forAll genAuthenticationSchemeEncoding + tripping user toJSON fromJSON + +spec :: Spec +spec = do + it "roundtrip" $ do + require prop_roundtrip + it "case-insensitive" $ do + require $ mk_prop_caseInsensitive genAuthenticationSchemeEncoding + +genAuthenticationSchemeEncoding :: Gen AS.AuthenticationSchemeEncoding +genAuthenticationSchemeEncoding = + AS.AuthenticationSchemeEncoding + <$> Gen.element ["typ1", "typ2"] + <*> Gen.element ["name1", "name2", "name3"] + <*> Gen.element ["desc ription"] + <*> Gen.maybe genUri + <*> Gen.maybe genUri diff --git a/libs/hscim/test/Test/Schema/GroupSpec.hs b/libs/hscim/test/Test/Schema/GroupSpec.hs new file mode 100644 index 00000000000..aa7341c23ac --- /dev/null +++ b/libs/hscim/test/Test/Schema/GroupSpec.hs @@ -0,0 +1,61 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2020 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.Schema.GroupSpec + ( spec, + ) +where + +import Data.Aeson +import Data.Text (Text) +import HaskellWorks.Hspec.Hedgehog (require) +import Hedgehog +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import Test.Hspec +import Test.Schema.Util (mk_prop_caseInsensitive) +import qualified Web.Scim.Class.Group as GroupClass + +prop_roundtrip :: Property +prop_roundtrip = property $ do + user <- forAll genGroup + tripping user toJSON fromJSON + +spec :: Spec +spec = do + it "roundtrip" $ do + require prop_roundtrip + it "case-insensitive" $ do + require $ mk_prop_caseInsensitive genGroup + require $ mk_prop_caseInsensitive genMember + +genMember :: Gen GroupClass.Member +genMember = + GroupClass.Member + <$> (Gen.text (Range.constant 0 20) Gen.unicode) + <*> (Gen.text (Range.constant 0 20) Gen.unicode) + <*> (Gen.text (Range.constant 0 20) Gen.unicode) + +genGroup :: Gen GroupClass.Group +genGroup = + GroupClass.Group + <$> Gen.list (Range.linear 0 10) genSchema + <*> (Gen.text (Range.constant 0 20) Gen.unicode) + <*> Gen.list (Range.linear 0 10) genMember + +genSchema :: Gen Text +genSchema = Gen.element ["schema1", "schema2", "schema3"] diff --git a/libs/hscim/test/Test/Schema/MetaSchemaSpec.hs b/libs/hscim/test/Test/Schema/MetaSchemaSpec.hs index 84328580826..1649622df37 100644 --- a/libs/hscim/test/Test/Schema/MetaSchemaSpec.hs +++ b/libs/hscim/test/Test/Schema/MetaSchemaSpec.hs @@ -26,16 +26,15 @@ module Test.Schema.MetaSchemaSpec where import Data.Aeson -import Data.Text (Text) import HaskellWorks.Hspec.Hedgehog (require) import Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range -import Network.URI.Static (uri) import Test.Hspec +import Test.Schema.Util (genSimpleText, genUri, mk_prop_caseInsensitive) import Web.Scim.Capabilities.MetaSchema import Web.Scim.Schema.AuthenticationScheme -import Web.Scim.Schema.Common (ScimBool (ScimBool), URI (..)) +import Web.Scim.Schema.Common (ScimBool (ScimBool)) import Web.Scim.Schema.Schema (Schema (..)) import Prelude hiding (filter) @@ -62,6 +61,8 @@ spec = do require (prop_roundtrip genAuthenticationSchemeEncoding) it "`Configuration` roundtrips" $ do require (prop_roundtrip genConfiguration) + it "`Configuration` satisfies the insane json-case-insensitivity rule." $ do + require $ mk_prop_caseInsensitive genConfiguration genConfiguration :: Gen Configuration genConfiguration = do @@ -99,9 +100,3 @@ genSupported :: forall a. Gen a -> Gen (Supported a) genSupported gen = do Supported <$> (ScimBool <$> Gen.bool) <*> gen - -genUri :: Gen URI -genUri = Gen.element [URI [uri|https://example.com|], URI [uri|gopher://glab.io|], URI [uri|ssh://nothing/blorg|]] - -genSimpleText :: Gen Text -genSimpleText = Gen.element ["one", "green", "sharp"] diff --git a/libs/hscim/test/Test/Schema/PatchOpSpec.hs b/libs/hscim/test/Test/Schema/PatchOpSpec.hs index 49d46331134..e51820597d9 100644 --- a/libs/hscim/test/Test/Schema/PatchOpSpec.hs +++ b/libs/hscim/test/Test/Schema/PatchOpSpec.hs @@ -36,6 +36,7 @@ import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Test.FilterSpec (genAttrPath, genSubAttr, genValuePath) import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy, xit) +import Test.Schema.Util (mk_prop_caseInsensitive) import Web.Scim.AttrName (AttrName (..)) import Web.Scim.Filter (AttrPath (..), CompValue (ValNull), CompareOp (OpEq), Filter (..), ValuePath (..)) import Web.Scim.Schema.PatchOp @@ -51,6 +52,9 @@ isSuccess (Error _) = False genPatchOp :: forall tag. UserTypes tag => Gen Value -> Gen (PatchOp tag) genPatchOp genValue = PatchOp <$> Gen.list (Range.constant 0 20) ((genOperation @tag) genValue) +genSimplePatchOp :: forall tag. UserTypes tag => Gen (PatchOp tag) +genSimplePatchOp = genPatchOp @tag (String <$> Gen.text (Range.constant 0 20) Gen.unicode) + genOperation :: forall tag. UserTypes tag => Gen Value -> Gen Operation genOperation genValue = Operation <$> Gen.enumBounded <*> Gen.maybe (genPath @tag) <*> Gen.maybe genValue @@ -71,7 +75,7 @@ prop_roundtrip_PatchOp = property $ do -- Just some strings for now. However, should be constrained to what the -- PatchOp is operating on in the future... We need better typed PatchOp for -- this. TODO(arianvp) - x <- forAll (genPatchOp @tag (String <$> Gen.text (Range.constant 0 20) Gen.unicode)) + x <- forAll (genSimplePatchOp @tag) tripping x toJSON fromJSON type PatchTestTag = TestTag () () () () @@ -115,6 +119,7 @@ spec = do --TODO(arianvp): We don't support arbitrary path names (yet) it "roundtrips Path" $ require $ prop_roundtrip @PatchTestTag it "roundtrips PatchOp" $ require $ prop_roundtrip_PatchOp @PatchTestTag + it "case-insensitive" $ require $ mk_prop_caseInsensitive (genSimplePatchOp @PatchTestTag) it "rejects invalid operations" $ do fromJSON @(PatchOp PatchTestTag) [scim| { diff --git a/libs/hscim/test/Test/Schema/ResourceSpec.hs b/libs/hscim/test/Test/Schema/ResourceSpec.hs new file mode 100644 index 00000000000..da7cf7350ec --- /dev/null +++ b/libs/hscim/test/Test/Schema/ResourceSpec.hs @@ -0,0 +1,65 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2020 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.Schema.ResourceSpec + ( spec, + ) +where + +import Data.Aeson +import HaskellWorks.Hspec.Hedgehog (require) +import Hedgehog +import qualified Hedgehog.Gen as Gen +import Test.Hspec +import Test.Schema.Util (genUri, mk_prop_caseInsensitive) +import Web.Scim.Schema.ResourceType +import qualified Web.Scim.Schema.Schema as Schema + +prop_roundtrip :: Property +prop_roundtrip = property $ do + user <- forAll genResource + tripping user toJSON fromJSON + +spec :: Spec +spec = do + it "roundtrip" $ do + require prop_roundtrip + it "case-insensitive" $ do + require $ mk_prop_caseInsensitive genResource + +genResource :: Gen Resource +genResource = + Resource + <$> Gen.element ["name1", "name2", "name3"] + <*> genUri + <*> genSchema + +genSchema :: Gen Schema.Schema +genSchema = + Gen.element + [ Schema.User20, + Schema.ServiceProviderConfig20, + Schema.Group20, + Schema.Schema20, + Schema.ResourceType20, + Schema.ListResponse20, + Schema.Error20, + Schema.PatchOp20, + Schema.CustomSchema "custom1", + Schema.CustomSchema "custom2", + Schema.CustomSchema "custom3" + ] diff --git a/libs/hscim/test/Test/Schema/UserSpec.hs b/libs/hscim/test/Test/Schema/UserSpec.hs index 0cefaa4fae5..d44075fcc68 100644 --- a/libs/hscim/test/Test/Schema/UserSpec.hs +++ b/libs/hscim/test/Test/Schema/UserSpec.hs @@ -28,7 +28,7 @@ import Data.Aeson import Data.Either (isLeft, isRight) import Data.Foldable (for_) import qualified Data.HashMap.Strict as HM -import Data.Text (Text, toLower, toUpper) +import Data.Text (Text, toLower) import HaskellWorks.Hspec.Hedgehog (require) import Hedgehog import qualified Hedgehog.Gen as Gen @@ -36,9 +36,13 @@ import qualified Hedgehog.Range as Range import Lens.Micro import Network.URI.Static (uri) import Test.Hspec +import Test.Schema.Util (genUri, mk_prop_caseInsensitive) import Text.Email.Validate (emailAddress) +import qualified Web.Scim.Class.User as UserClass import Web.Scim.Filter (AttrPath (..)) -import Web.Scim.Schema.Common (ScimBool (ScimBool), URI (..)) +import Web.Scim.Schema.Common (ScimBool (ScimBool), URI (..), WithId (..)) +import qualified Web.Scim.Schema.ListResponse as ListResponse +import Web.Scim.Schema.Meta (ETag (Strong, Weak), Meta (..), WithMeta (..)) import Web.Scim.Schema.PatchOp (Op (..), Operation (..), PatchOp (..), Patchable (..), Path (..)) import qualified Web.Scim.Schema.PatchOp as PatchOp import Web.Scim.Schema.Schema (Schema (..)) @@ -58,17 +62,6 @@ prop_roundtrip = property $ do user <- forAll genUser tripping user toJSON fromJSON --- TODO(arianvp): Note that this only tests the top-level fields. --- extrac this to a generic test and also do this for sub-properties -prop_caseInsensitive :: Property -prop_caseInsensitive = property $ do - user <- forAll genUser - let (Object user') = toJSON user - let user'' = HM.foldlWithKey' (\u k v -> HM.insert (toUpper k) v u) user' HM.empty - let user''' = HM.foldlWithKey' (\u k v -> HM.insert (toLower k) v u) user' HM.empty - fromJSON (Object user'') === Success user - fromJSON (Object user''') === Success user - type PatchTag = TestTag Text () () UserExtraPatch type UserExtraPatch = HM.HashMap Text Text @@ -136,7 +129,8 @@ spec = do it "treats 'null' and '[]' as absence of fields" $ eitherDecode (encode minimalUserJsonRedundant) `shouldBe` Right minimalUser it "allows casing variations in field names" $ do - require prop_caseInsensitive + require $ mk_prop_caseInsensitive (genUser) + require $ mk_prop_caseInsensitive (ListResponse.fromList . (: []) <$> genStoredUser) eitherDecode (encode minimalUserJsonNonCanonical) `shouldBe` Right minimalUser it "doesn't require the 'schemas' field" $ eitherDecode (encode minimalUserJsonNoSchemas) `shouldBe` Right minimalUser @@ -159,8 +153,20 @@ genName = <*> Gen.maybe (Gen.text (Range.constant 0 20) Gen.unicode) <*> Gen.maybe (Gen.text (Range.constant 0 20) Gen.unicode) -genUri :: Gen URI -genUri = Gen.element [URI [uri|https://example.com|], URI [uri|gopher://glab.io|], URI [uri|ssh://nothing/blorg|]] +genStoredUser :: Gen (UserClass.StoredUser (TestTag Text () () NoUserExtra)) +genStoredUser = do + m <- genMeta + i <- Gen.element @_ @Text ["wef", "asdf", "@", "#", "1"] + u <- genUser + pure $ WithMeta m (WithId i u) + +genMeta :: Gen Meta +genMeta = + Meta <$> Gen.enumBounded + <*> Gen.element [read "2021-08-23 13:13:31.450140036 UTC", read "2019-01-01 09:55:59 UTC"] + <*> Gen.element [read "2021-08-23 13:13:31.450140036 UTC", read "2022-01-01 09:55:59 UTC"] + <*> (Gen.element [Weak, Strong] <*> Gen.text (Range.constant 0 20) Gen.unicode) + <*> genUri -- TODO(arianvp) Generate the lists too, but first need better support for SCIM -- lists in the first place diff --git a/libs/hscim/test/Test/Schema/Util.hs b/libs/hscim/test/Test/Schema/Util.hs new file mode 100644 index 00000000000..b88eb82ffcb --- /dev/null +++ b/libs/hscim/test/Test/Schema/Util.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE QuasiQuotes #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2020 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.Schema.Util + ( mk_prop_caseInsensitive, + genUri, + genSimpleText, + ) +where + +import Data.Aeson +import qualified Data.HashMap.Strict as HM +import Data.Text (Text, toLower, toUpper) +import Hedgehog +import Hedgehog.Gen as Gen +import Network.URI.Static +import Web.Scim.Schema.Common (URI (..)) + +genUri :: Gen URI +genUri = Gen.element [URI [uri|https://example.com|], URI [uri|gopher://glab.io|], URI [uri|ssh://nothing/blorg|]] + +genSimpleText :: Gen Text +genSimpleText = Gen.element ["one", "green", "sharp"] + +mk_prop_caseInsensitive :: forall a. (ToJSON a, FromJSON a, Show a, Eq a) => Gen a -> Property +mk_prop_caseInsensitive gen = property $ do + val <- forAll gen + fromJSON (withCasing toUpper $ toJSON val) === Success val + fromJSON (withCasing toLower $ toJSON val) === Success val + where + withCasing :: (Text -> Text) -> Value -> Value + withCasing toCasing = \case + Object obj -> Object $ HM.foldlWithKey' (\u k v -> HM.insert (toCasing k) (withCasing toCasing v) u) HM.empty obj + Array arr -> Array $ withCasing toCasing <$> arr + same@(Number _) -> same + same@(String _) -> same + same@(Bool _) -> same + same@Null -> same diff --git a/libs/schema-profunctor/README.md b/libs/schema-profunctor/README.md index a2c34a9b238..282b9fdd263 100644 --- a/libs/schema-profunctor/README.md +++ b/libs/schema-profunctor/README.md @@ -189,7 +189,7 @@ to think of the prism `_Name` as a pair consisting of the constructor Text`, which checks if a detail is actually a name, and if so returns the actual name. -After tagging, the resulting shema is able to translate between a JSON +After tagging, the resulting schema is able to translate between a JSON value such as `"Bob"` and the corresponding haskell value `Name "Bob"`. @@ -200,7 +200,7 @@ cases one by one until it succeeds. Similarly, at the serialiser level, it tries every case until the underlying lens returns a `Just`. Finally, we add a name to the schema using the `named` -combinator. This does nothing to the JSON encoding-deconding part of +combinator. This does nothing to the JSON encoding-decoding part of the schema, and only affects the documentation. ### Enumerations @@ -237,7 +237,7 @@ accessSchema = enum @Text "Access" $ The `element` combinator takes two arguments: the value corresponding to a case alternative on the JSON side, and the corresponding value on the Haskell side. All the intermediate schemas returned by `element` are -joined together using the `Monoid` instance, and finaly passed to +joined together using the `Monoid` instance, and finally passed to `enum`, which takes care of creating the final schema. Note the `@Text` type annotation for `enum`, which is required when using `OverloadedStrings`. @@ -459,7 +459,7 @@ the `Alternative` instance that `SchemaP` relies on, but for the moment, if this behaviour is not desirable, then one can use the ad-hoc `optField` combinator to introduce optional fields. -For exapmle, the above schema can be implemented using `optField` as follow: +For example, the above schema can be implemented using `optField` as follow: ```haskell userSchema'' :: ValueSchema NamedSwaggerDoc User @@ -473,7 +473,7 @@ The argument after the field name determines how the `Nothing` case is rendered ### Redundant fields -Sometimes, JSON encoding of haskell types is not as straightfoward as +Sometimes, JSON encoding of haskell types is not as straightforward as in the previous examples. For example, for backward-compatibility reasons, it might be necessary to serialise an object with some extra redundant information, which is then ignored when parsing. diff --git a/libs/types-common/src/Data/Qualified.hs b/libs/types-common/src/Data/Qualified.hs index 96772f7f795..d1162100039 100644 --- a/libs/types-common/src/Data/Qualified.hs +++ b/libs/types-common/src/Data/Qualified.hs @@ -97,8 +97,8 @@ partitionRemote remotes = Map.assocs $ partitionQualified (unTagged <$> remotes) renderQualifiedId :: Qualified (Id a) -> Text renderQualifiedId = renderQualified (cs . UUID.toString . toUUID) -deprecatedSchema :: Text -> ValueSchema NamedSwaggerDoc a -> ValueSchema SwaggerDoc a -deprecatedSchema new = (doc . description ?~ ("Deprecated, use " <> new)) . unnamed +deprecatedSchema :: S.HasDescription doc (Maybe Text) => Text -> ValueSchema doc a -> ValueSchema doc a +deprecatedSchema new = doc . description ?~ ("Deprecated, use " <> new) qualifiedSchema :: Text -> diff --git a/libs/wire-api-federation/proto/router.proto b/libs/wire-api-federation/proto/router.proto index 6401e6bebeb..c6511364cfd 100644 --- a/libs/wire-api-federation/proto/router.proto +++ b/libs/wire-api-federation/proto/router.proto @@ -52,10 +52,11 @@ message OutwardError { message InwardError { enum ErrorType { IOther = 0; - IInvalidDomain = 1; + IAuthenticationFailed = 1; IFederationDeniedByRemote = 2; IInvalidEndpoint = 3; IForbiddenEndpoint = 4; + IDiscoveryFailed = 5; } ErrorType type = 1; diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs index 0706b534a5f..3606a4d05f5 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs @@ -29,13 +29,13 @@ import Test.QuickCheck (Arbitrary) import Wire.API.Arbitrary (GenericUniform (..)) import Wire.API.Federation.Client (FederationClientFailure, FederatorClient) import qualified Wire.API.Federation.GRPC.Types as Proto -import Wire.API.Federation.Util.Aeson (CustomEncoded (..)) import Wire.API.Message (UserClients) import Wire.API.User (UserProfile) import Wire.API.User.Client (PubClient, UserClientPrekeyMap) import Wire.API.User.Client.Prekey (ClientPrekey, PrekeyBundle) import Wire.API.User.Search import Wire.API.UserMap (UserMap) +import Wire.API.Util.Aeson (CustomEncoded (..)) newtype SearchRequest = SearchRequest {term :: Text} deriving (Show, Eq, Generic, Typeable) diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs index d8ad5bf815c..23871322981 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2020 Wire Swiss GmbH @@ -23,6 +21,7 @@ import Control.Monad.Except (MonadError (..)) import Data.Aeson (FromJSON, ToJSON) import Data.Id (ClientId, ConvId, UserId) import Data.Json.Util (Base64ByteString) +import Data.List.NonEmpty (NonEmpty) import Data.Misc (Milliseconds) import Data.Qualified (Qualified) import Data.Time.Clock (UTCTime) @@ -37,9 +36,10 @@ import Wire.API.Conversation.Role (RoleName) import Wire.API.Federation.Client (FederationClientFailure, FederatorClient) import Wire.API.Federation.Domain (OriginDomainHeader) import qualified Wire.API.Federation.GRPC.Types as Proto -import Wire.API.Federation.Util.Aeson (CustomEncoded (..)) import Wire.API.Message (MessageNotSent, MessageSendingStatus, PostOtrResponse, Priority) +import Wire.API.Routes.Public.Galley.Responses (RemoveFromConversationError) import Wire.API.User.Client (UserClientMap) +import Wire.API.Util.Aeson (CustomEncoded (..)) -- FUTUREWORK: data types, json instances, more endpoints. See -- https://wearezeta.atlassian.net/wiki/spaces/CORE/pages/356090113/Federation+Galley+Conversation+API @@ -68,6 +68,13 @@ data Api routes = Api :> "update-conversation-memberships" :> ReqBody '[JSON] ConversationMemberUpdate :> Post '[JSON] (), + leaveConversation :: + routes + :- "federation" + :> "leave-conversation" + :> OriginDomainHeader + :> ReqBody '[JSON] LeaveConversationRequest + :> Post '[JSON] LeaveConversationResponse, -- used to notify this backend that a new message has been posted to a -- remote conversation receiveMessage :: @@ -129,6 +136,15 @@ data RegisterConversation = MkRegisterConversation deriving stock (Eq, Show, Generic) deriving (ToJSON, FromJSON) via (CustomEncoded RegisterConversation) +-- | A conversation membership update, as given by ' ConversationMemberUpdate', +-- can be either a member addition or removal. +data ConversationMembersAction + = ConversationMembersActionAdd (NonEmpty (Qualified UserId, RoleName)) + | ConversationMembersActionRemove (NonEmpty (Qualified UserId)) + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform ConversationMembersAction) + deriving (ToJSON, FromJSON) via (CustomEncoded ConversationMembersAction) + data ConversationMemberUpdate = ConversationMemberUpdate { cmuTime :: UTCTime, cmuOrigUserId :: Qualified UserId, @@ -138,19 +154,24 @@ data ConversationMemberUpdate = ConversationMemberUpdate -- non-conversation owning backend to have an indexed mapping of -- conversation to users. cmuAlreadyPresentUsers :: [UserId], - -- | Users that got added to the conversation. - cmuUsersAdd :: [(Qualified UserId, RoleName)], - -- | Users that got removed from the conversation. This should probably be - -- Qualified, but as of now this is a stub. - -- - -- FUTUREWORK: Implement this when supporting removal of remote conversation - -- members. - cmuUsersRemove :: [UserId] + -- | Users that got either added to or removed from the conversation. + cmuAction :: ConversationMembersAction } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform ConversationMemberUpdate) deriving (ToJSON, FromJSON) via (CustomEncoded ConversationMemberUpdate) +data LeaveConversationRequest = LeaveConversationRequest + { -- | The conversation is assumed to be owned by the target domain, which + -- allows us to protect against relay attacks + lcConvId :: ConvId, + -- | The leaver is assumed to be owned by the origin domain, which allows us + -- to protect against spoofing attacks + lcLeaver :: UserId + } + deriving stock (Generic, Eq, Show) + deriving (ToJSON, FromJSON) via (CustomEncoded LeaveConversationRequest) + -- Note: this is parametric in the conversation type to allow it to be used -- both for conversations with a fixed known domain (e.g. as the argument of the -- federation RPC), and for conversations with an arbitrary Qualified or Remote id @@ -193,5 +214,12 @@ newtype MessageSendResponse = MessageSendResponse MessageSendingStatus ) +newtype LeaveConversationResponse = LeaveConversationResponse + {leaveResponse :: Either RemoveFromConversationError ()} + deriving stock (Eq, Show) + deriving + (ToJSON, FromJSON) + via (Either (CustomEncoded RemoveFromConversationError) ()) + clientRoutes :: (MonadError FederationClientFailure m, MonadIO m) => Api (AsClientT (FederatorClient 'Proto.Galley m)) clientRoutes = genericClient diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Error.hs b/libs/wire-api-federation/src/Wire/API/Federation/Error.hs index 0dcbd61ab9d..bc0ed03bed1 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Error.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Error.hs @@ -138,8 +138,9 @@ federationRemoteInwardError err = Wai.mkError status (LT.fromStrict label) (LT.f (status, label) = case Proto.inwardErrorType err of Proto.IInvalidEndpoint -> (HTTP.Status 531 "Version Mismatch", "inward-invalid-endpoint") Proto.IFederationDeniedByRemote -> (HTTP.Status 532 "Federation Denied", "federation-denied-by-remote") - Proto.IInvalidDomain -> (unexpectedFederationResponseStatus, "invalid-origin-domain") + Proto.IAuthenticationFailed -> (unexpectedFederationResponseStatus, "server-to-server-authentication-failed") Proto.IForbiddenEndpoint -> (unexpectedFederationResponseStatus, "forbidden-endpoint") + Proto.IDiscoveryFailed -> (HTTP.status500, "remote-discovery-failure") Proto.IOther -> (unexpectedFederationResponseStatus, "inward-other") federationRemoteError :: Proto.OutwardError -> Wai.Error diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Event.hs b/libs/wire-api-federation/src/Wire/API/Federation/Event.hs index 221d5509fca..fd1707b9c3d 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Event.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Event.hs @@ -38,7 +38,7 @@ import Data.Time import Imports import Test.QuickCheck (Arbitrary (arbitrary)) import qualified Test.QuickCheck as QC -import Wire.API.Federation.Util.Aeson (CustomEncoded (CustomEncoded)) +import Wire.API.Util.Aeson (CustomEncoded (CustomEncoded)) data AnyEvent = EventMemberJoin (ConversationEvent MemberJoin) diff --git a/libs/wire-api-federation/src/Wire/API/Federation/GRPC/Types.hs b/libs/wire-api-federation/src/Wire/API/Federation/GRPC/Types.hs index 7bfa9c2139c..034349f8d46 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/GRPC/Types.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/GRPC/Types.hs @@ -155,10 +155,11 @@ data InwardError = InwardError data InwardErrorType = IOther - | IInvalidDomain + | IAuthenticationFailed | IFederationDeniedByRemote | IInvalidEndpoint | IForbiddenEndpoint + | IDiscoveryFailed deriving (Typeable, Show, Eq, Generic, ToSchema Router "InwardError.ErrorType", FromSchema Router "InwardError.ErrorType") deriving (Arbitrary) via (GenericUniform InwardErrorType) diff --git a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationMemberUpdate.hs b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationMemberUpdate.hs new file mode 100644 index 00000000000..99636099eba --- /dev/null +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationMemberUpdate.hs @@ -0,0 +1,73 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2021 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Test.Wire.API.Federation.Golden.ConversationMemberUpdate where + +import Data.Domain (Domain (Domain)) +import Data.Id (Id (Id), UserId) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Qualified (Qualified (Qualified)) +import qualified Data.UUID as UUID +import Imports +import Wire.API.Conversation.Role (roleNameWireAdmin, roleNameWireMember) +import Wire.API.Federation.API.Galley (ConversationMemberUpdate (..), ConversationMembersAction (..)) + +qAlice, qBob :: Qualified UserId +qAlice = + Qualified + (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100004007"))) + (Domain "golden.example.com") +qBob = + Qualified + (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100005007"))) + (Domain "golden2.example.com") + +chad, dee :: UserId +chad = Id (fromJust (UUID.fromString "00000fff-0000-0000-0000-000100005007")) +dee = Id (fromJust (UUID.fromString "00000fff-0000-aaaa-0000-000100005007")) + +testObject_ConversationMemberUpdate1 :: ConversationMemberUpdate +testObject_ConversationMemberUpdate1 = + ConversationMemberUpdate + { cmuTime = read "1864-04-12 12:22:43.673 UTC", + cmuOrigUserId = + Qualified + (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000007"))) + (Domain "golden.example.com"), + cmuConvId = + Qualified + (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000006"))) + (Domain "golden2.example.com"), + cmuAlreadyPresentUsers = [], + cmuAction = ConversationMembersActionAdd ((qAlice, roleNameWireMember) :| [(qBob, roleNameWireAdmin)]) + } + +testObject_ConversationMemberUpdate2 :: ConversationMemberUpdate +testObject_ConversationMemberUpdate2 = + ConversationMemberUpdate + { cmuTime = read "1864-04-12 12:22:43.673 UTC", + cmuOrigUserId = + Qualified + (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000007"))) + (Domain "golden.example.com"), + cmuConvId = + Qualified + (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000006"))) + (Domain "golden2.example.com"), + cmuAlreadyPresentUsers = [chad, dee], + cmuAction = ConversationMembersActionRemove (qAlice :| [qBob]) + } diff --git a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GoldenSpec.hs b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GoldenSpec.hs index 934e36115a9..05d05f1c13f 100644 --- a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GoldenSpec.hs +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GoldenSpec.hs @@ -19,12 +19,15 @@ module Test.Wire.API.Federation.Golden.GoldenSpec where import Imports import Test.Hspec +import qualified Test.Wire.API.Federation.Golden.ConversationMemberUpdate as ConversationMemberUpdate +import qualified Test.Wire.API.Federation.Golden.LeaveConversationRequest as LeaveConversationRequest +import qualified Test.Wire.API.Federation.Golden.LeaveConversationResponse as LeaveConversationResponse import qualified Test.Wire.API.Federation.Golden.MessageSendResponse as MessageSendResponse import Test.Wire.API.Federation.Golden.Runner (testObjects) spec :: Spec spec = - describe "Golden tests" $ + describe "Golden tests" $ do testObjects [ (MessageSendResponse.testObject_MessageSendReponse1, "testObject_MessageSendReponse1.json"), (MessageSendResponse.testObject_MessageSendReponse2, "testObject_MessageSendReponse2.json"), @@ -32,3 +35,19 @@ spec = (MessageSendResponse.testObject_MessageSendReponse4, "testObject_MessageSendReponse4.json"), (MessageSendResponse.testObject_MessageSendReponse5, "testObject_MessageSendReponse5.json") ] + testObjects [(LeaveConversationRequest.testObject_LeaveConversationRequest1, "testObject_LeaveConversationRequest1.json")] + testObjects + [ (ConversationMemberUpdate.testObject_ConversationMemberUpdate1, "testObject_ConversationMemberUpdate1.json"), + (ConversationMemberUpdate.testObject_ConversationMemberUpdate2, "testObject_ConversationMemberUpdate2.json") + ] + testObjects + [ (LeaveConversationResponse.testObject_LeaveConversationResponse1, "testObject_LeaveConversationResponse1.json"), + (LeaveConversationResponse.testObject_LeaveConversationResponse2, "testObject_LeaveConversationResponse2.json"), + (LeaveConversationResponse.testObject_LeaveConversationResponse3, "testObject_LeaveConversationResponse3.json"), + (LeaveConversationResponse.testObject_LeaveConversationResponse4, "testObject_LeaveConversationResponse4.json"), + (LeaveConversationResponse.testObject_LeaveConversationResponse5, "testObject_LeaveConversationResponse5.json"), + (LeaveConversationResponse.testObject_LeaveConversationResponse6, "testObject_LeaveConversationResponse6.json"), + (LeaveConversationResponse.testObject_LeaveConversationResponse7, "testObject_LeaveConversationResponse7.json"), + (LeaveConversationResponse.testObject_LeaveConversationResponse8, "testObject_LeaveConversationResponse8.json"), + (LeaveConversationResponse.testObject_LeaveConversationResponse9, "testObject_LeaveConversationResponse9.json") + ] diff --git a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/LeaveConversationRequest.hs b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/LeaveConversationRequest.hs new file mode 100644 index 00000000000..4381e330e7d --- /dev/null +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/LeaveConversationRequest.hs @@ -0,0 +1,29 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2021 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Test.Wire.API.Federation.Golden.LeaveConversationRequest where + +import Data.Id (Id (Id)) +import Data.Maybe (fromJust) +import qualified Data.UUID as UUID +import Wire.API.Federation.API.Galley (LeaveConversationRequest (LeaveConversationRequest)) + +testObject_LeaveConversationRequest1 :: LeaveConversationRequest +testObject_LeaveConversationRequest1 = + LeaveConversationRequest + (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000002"))) + (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000001"))) diff --git a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/LeaveConversationResponse.hs b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/LeaveConversationResponse.hs new file mode 100644 index 00000000000..23b76814e67 --- /dev/null +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/LeaveConversationResponse.hs @@ -0,0 +1,32 @@ +module Test.Wire.API.Federation.Golden.LeaveConversationResponse where + +import Imports +import Wire.API.Federation.API.Galley (LeaveConversationResponse (LeaveConversationResponse)) +import Wire.API.Routes.Public.Galley.Responses (RemoveFromConversationError (..)) + +testObject_LeaveConversationResponse1 :: LeaveConversationResponse +testObject_LeaveConversationResponse1 = LeaveConversationResponse $ Right () + +testObject_LeaveConversationResponse2 :: LeaveConversationResponse +testObject_LeaveConversationResponse2 = LeaveConversationResponse $ Left RemoveFromConversationErrorRemovalNotAllowed + +testObject_LeaveConversationResponse3 :: LeaveConversationResponse +testObject_LeaveConversationResponse3 = LeaveConversationResponse $ Left RemoveFromConversationErrorManagedConvNotAllowed + +testObject_LeaveConversationResponse4 :: LeaveConversationResponse +testObject_LeaveConversationResponse4 = LeaveConversationResponse $ Left RemoveFromConversationErrorNotFound + +testObject_LeaveConversationResponse5 :: LeaveConversationResponse +testObject_LeaveConversationResponse5 = LeaveConversationResponse $ Left RemoveFromConversationErrorCustomRolesNotSupported + +testObject_LeaveConversationResponse6 :: LeaveConversationResponse +testObject_LeaveConversationResponse6 = LeaveConversationResponse $ Left RemoveFromConversationErrorSelfConv + +testObject_LeaveConversationResponse7 :: LeaveConversationResponse +testObject_LeaveConversationResponse7 = LeaveConversationResponse $ Left RemoveFromConversationErrorOne2OneConv + +testObject_LeaveConversationResponse8 :: LeaveConversationResponse +testObject_LeaveConversationResponse8 = LeaveConversationResponse $ Left RemoveFromConversationErrorConnectConv + +testObject_LeaveConversationResponse9 :: LeaveConversationResponse +testObject_LeaveConversationResponse9 = LeaveConversationResponse $ Left RemoveFromConversationErrorUnchanged diff --git a/libs/wire-api-federation/test/golden/testObject_ConversationMemberUpdate1.json b/libs/wire-api-federation/test/golden/testObject_ConversationMemberUpdate1.json new file mode 100644 index 00000000000..a564d6cb98c --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_ConversationMemberUpdate1.json @@ -0,0 +1,31 @@ +{ + "orig_user_id": { + "domain": "golden.example.com", + "id": "00000000-0000-0000-0000-000100000007" + }, + "already_present_users": [], + "time": "1864-04-12T12:22:43.673Z", + "action": { + "tag": "ConversationMembersActionAdd", + "contents": [ + [ + { + "domain": "golden.example.com", + "id": "00000000-0000-0000-0000-000100004007" + }, + "wire_member" + ], + [ + { + "domain": "golden2.example.com", + "id": "00000000-0000-0000-0000-000100005007" + }, + "wire_admin" + ] + ] + }, + "conv_id": { + "domain": "golden2.example.com", + "id": "00000000-0000-0000-0000-000100000006" + } +} \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_ConversationMemberUpdate2.json b/libs/wire-api-federation/test/golden/testObject_ConversationMemberUpdate2.json new file mode 100644 index 00000000000..bf0595e5cc2 --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_ConversationMemberUpdate2.json @@ -0,0 +1,28 @@ +{ + "orig_user_id": { + "domain": "golden.example.com", + "id": "00000000-0000-0000-0000-000100000007" + }, + "already_present_users": [ + "00000fff-0000-0000-0000-000100005007", + "00000fff-0000-aaaa-0000-000100005007" + ], + "time": "1864-04-12T12:22:43.673Z", + "action": { + "tag": "ConversationMembersActionRemove", + "contents": [ + { + "domain": "golden.example.com", + "id": "00000000-0000-0000-0000-000100004007" + }, + { + "domain": "golden2.example.com", + "id": "00000000-0000-0000-0000-000100005007" + } + ] + }, + "conv_id": { + "domain": "golden2.example.com", + "id": "00000000-0000-0000-0000-000100000006" + } +} \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_LeaveConversationRequest1.json b/libs/wire-api-federation/test/golden/testObject_LeaveConversationRequest1.json new file mode 100644 index 00000000000..7ea88f8fa4f --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_LeaveConversationRequest1.json @@ -0,0 +1,4 @@ +{ + "conv_id": "00000000-0000-0000-0000-000100000002", + "leaver": "00000000-0000-0000-0000-000100000001" +} \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse1.json b/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse1.json new file mode 100644 index 00000000000..5ce20f1d241 --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse1.json @@ -0,0 +1,3 @@ +{ + "Right": [] +} \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse2.json b/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse2.json new file mode 100644 index 00000000000..c834e9ec895 --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse2.json @@ -0,0 +1,3 @@ +{ + "Left": "RemoveFromConversationErrorRemovalNotAllowed" +} \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse3.json b/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse3.json new file mode 100644 index 00000000000..ccbfe9de985 --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse3.json @@ -0,0 +1,3 @@ +{ + "Left": "RemoveFromConversationErrorManagedConvNotAllowed" +} \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse4.json b/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse4.json new file mode 100644 index 00000000000..19ee7fe09cc --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse4.json @@ -0,0 +1,3 @@ +{ + "Left": "RemoveFromConversationErrorNotFound" +} \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse5.json b/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse5.json new file mode 100644 index 00000000000..fcfcc05ae7c --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse5.json @@ -0,0 +1,3 @@ +{ + "Left": "RemoveFromConversationErrorCustomRolesNotSupported" +} \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse6.json b/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse6.json new file mode 100644 index 00000000000..13ebfa75124 --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse6.json @@ -0,0 +1,3 @@ +{ + "Left": "RemoveFromConversationErrorSelfConv" +} \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse7.json b/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse7.json new file mode 100644 index 00000000000..a67023bc523 --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse7.json @@ -0,0 +1,3 @@ +{ + "Left": "RemoveFromConversationErrorOne2OneConv" +} \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse8.json b/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse8.json new file mode 100644 index 00000000000..fd7bd4385c8 --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse8.json @@ -0,0 +1,3 @@ +{ + "Left": "RemoveFromConversationErrorConnectConv" +} \ No newline at end of file diff --git a/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse9.json b/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse9.json new file mode 100644 index 00000000000..44100f6df71 --- /dev/null +++ b/libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse9.json @@ -0,0 +1,3 @@ +{ + "Left": "RemoveFromConversationErrorUnchanged" +} \ No newline at end of file diff --git a/libs/wire-api-federation/wire-api-federation.cabal b/libs/wire-api-federation/wire-api-federation.cabal index 6290e9b4f98..39c202fbc6c 100644 --- a/libs/wire-api-federation/wire-api-federation.cabal +++ b/libs/wire-api-federation/wire-api-federation.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 102318adcefa2e58fce37c3535b59007d867b60b9c48274b646b2c4fabf7c8cb +-- hash: 51e5ed505621b80d7d0ea96cc1555dd231292948d5961f0eaccc4efb1b08e0d0 name: wire-api-federation version: 0.1.0 @@ -32,7 +32,6 @@ library Wire.API.Federation.GRPC.Helper Wire.API.Federation.GRPC.Types Wire.API.Federation.Mock - Wire.API.Federation.Util.Aeson other-modules: Paths_wire_api_federation hs-source-dirs: @@ -78,7 +77,10 @@ test-suite spec other-modules: Test.Wire.API.Federation.API.BrigSpec Test.Wire.API.Federation.ClientSpec + Test.Wire.API.Federation.Golden.ConversationMemberUpdate Test.Wire.API.Federation.Golden.GoldenSpec + Test.Wire.API.Federation.Golden.LeaveConversationRequest + Test.Wire.API.Federation.Golden.LeaveConversationResponse Test.Wire.API.Federation.Golden.MessageSendResponse Test.Wire.API.Federation.Golden.Runner Test.Wire.API.Federation.GRPC.TypesSpec diff --git a/libs/wire-api/src/Wire/API/ErrorDescription.hs b/libs/wire-api/src/Wire/API/ErrorDescription.hs index 9856e050ca0..1c079f5137c 100644 --- a/libs/wire-api/src/Wire/API/ErrorDescription.hs +++ b/libs/wire-api/src/Wire/API/ErrorDescription.hs @@ -1,13 +1,13 @@ module Wire.API.ErrorDescription where -import Control.Lens (at, ix, over, (%~), (.~), (<>~), (?~)) -import Control.Lens.Combinators (_Just) +import Control.Lens (at, (%~), (.~), (<>~), (?~)) import qualified Data.Aeson as A import qualified Data.ByteString.Lazy as LBS import Data.SOP (I (..), NP (..), NS (..)) import Data.Schema import Data.Swagger (Swagger) -import qualified Data.Swagger as Swagger +import qualified Data.Swagger as S +import qualified Data.Swagger.Declare as S import qualified Data.Text as Text import GHC.TypeLits (KnownSymbol, Symbol, natVal, symbolVal) import GHC.TypeNats (Nat) @@ -51,51 +51,23 @@ errorDescriptionAddToSwagger :: Swagger -> Swagger errorDescriptionAddToSwagger = - over (Swagger.paths . traverse) overridePathItem + (S.allOperations . S.responses . S.responses . at status %~ Just . addRef) + . (S.definitions <>~ defs) where - addRef :: - Maybe (Swagger.Referenced Swagger.Response) -> - Maybe (Swagger.Referenced Swagger.Response) - addRef Nothing = - Just . Swagger.Inline $ - mempty - & Swagger.description .~ desc - & Swagger.schema ?~ Swagger.Inline (Swagger.toSchema (Proxy @(ErrorDescription code label desc))) - addRef (Just response) = - Just $ - response - -- add the description of this error to the response description - & Swagger._Inline . Swagger.description - <>~ ("\n\n" <> desc) - -- add the label of this error to the possible values of the corresponding enum - & Swagger._Inline . Swagger.schema . _Just . Swagger._Inline . Swagger.properties . ix "label" . Swagger._Inline . Swagger.enum_ . _Just - <>~ [A.toJSON (symbolVal (Proxy @label))] - - desc = - Text.pack (symbolVal (Proxy @desc)) - <> " (label: `" - <> Text.pack (symbolVal (Proxy @label)) - <> "`)" - - overridePathItem :: Swagger.PathItem -> Swagger.PathItem - overridePathItem = - over (Swagger.get . _Just) overrideOp - . over (Swagger.post . _Just) overrideOp - . over (Swagger.put . _Just) overrideOp - . over (Swagger.head_ . _Just) overrideOp - . over (Swagger.patch . _Just) overrideOp - . over (Swagger.delete . _Just) overrideOp - . over (Swagger.options . _Just) overrideOp - overrideOp :: Swagger.Operation -> Swagger.Operation - overrideOp = - Swagger.responses . Swagger.responses . at (fromInteger $ natVal (Proxy @code)) - %~ addRef + addRef :: Maybe (S.Referenced S.Response) -> S.Referenced S.Response + addRef Nothing = S.Inline resp + addRef (Just (S.Inline resp1)) = S.Inline (combineResponseSwagger resp1 resp) + addRef (Just r@(S.Ref _)) = r + + status = fromInteger (natVal (Proxy @code)) + (defs, resp) = + S.runDeclare (responseSwagger @(ErrorDescription code label desc)) mempty -- FUTUREWORK: Ponder about elevating label and messge to the type level. If all -- errors are static, there is probably no point in having them at value level. data ErrorDescription (statusCode :: Nat) (label :: Symbol) (desc :: Symbol) = ErrorDescription {edMessage :: Text} deriving stock (Show, Typeable) - deriving (A.ToJSON, A.FromJSON, Swagger.ToSchema) via Schema (ErrorDescription statusCode label desc) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema (ErrorDescription statusCode label desc) instance (KnownStatus statusCode, KnownSymbol label, KnownSymbol desc) => ToSchema (ErrorDescription statusCode label desc) where schema = @@ -110,7 +82,7 @@ instance (KnownStatus statusCode, KnownSymbol label, KnownSymbol desc) => ToSche code = natVal (Proxy @statusCode) desc = Text.pack (symbolVal (Proxy @desc)) addExample = - Swagger.schema . Swagger.example + S.schema . S.example ?~ A.toJSON (ErrorDescription @statusCode @label @desc desc) labelSchema :: ValueSchema SwaggerDoc Text labelSchema = unnamed $ enum @Text "Label" (element label label) @@ -149,7 +121,17 @@ instance (KnownStatus s, KnownSymbol label, KnownSymbol desc) => IsSwaggerResponse (ErrorDescription s label desc) where - responseSwagger = responseSwagger @(RespondWithErrorDescription s label desc) + responseSwagger = + pure $ + mempty + & S.description .~ desc + & S.schema ?~ S.Inline (S.toSchema (Proxy @(ErrorDescription s label desc))) + where + desc = + Text.pack (symbolVal (Proxy @desc)) + <> " (label: `" + <> Text.pack (symbolVal (Proxy @label)) + <> "`)" instance (ResponseType r ~ a, KnownSymbol desc) => @@ -193,14 +175,11 @@ instance where responseSwagger = pure $ - ResponseSwagger - { rsDescription = - Text.pack (symbolVal (Proxy @desc)) <> "\n\n" - <> "**Note**: This error has an empty body for legacy reasons", - rsStatus = statusVal (Proxy @s), - rsHeaders = mempty, - rsSchema = Nothing - } + mempty + & S.description + .~ ( Text.pack (symbolVal (Proxy @desc)) + <> "(**Note**: This error has an empty body for legacy reasons)" + ) instance ( ResponseType r ~ a, @@ -261,6 +240,11 @@ actionDenied a = ErrorDescription $ "Insufficient authorization (missing " <> Text.pack (show a) <> ")" +type ConvMemberRemovalDenied = ErrorDescription 403 "action-denied" "Insufficient authorization" + +convMemberRemovalDenied :: ConvMemberRemovalDenied +convMemberRemovalDenied = ErrorDescription "Insufficient authorization, cannot remove member from conversation" + type CodeNotFound = ErrorDescription 404 "no-conversation-code" "Conversation code not found" codeNotFound :: CodeNotFound @@ -309,3 +293,45 @@ type MissingLegalholdConsent = missingLegalholdConsent :: MissingLegalholdConsent missingLegalholdConsent = mkErrorDescription + +type ManagedRemovalNotAllowed = + ErrorDescription + 403 + "invalid-op" + "Users can not be removed from managed conversations." + +managedRemovalNotAllowed :: ManagedRemovalNotAllowed +managedRemovalNotAllowed = mkErrorDescription + +type CustomRolesNotSupported = + ErrorDescription + 400 + "bad-request" + "Custom roles not supported" + +customRolesNotSupported :: CustomRolesNotSupported +customRolesNotSupported = mkErrorDescription + +type InvalidOp desc = + ErrorDescription + 403 + "invalid-op" + desc + +invalidOpErrorDesc :: KnownSymbol desc => proxy desc -> InvalidOp desc +invalidOpErrorDesc = ErrorDescription . Text.pack . symbolVal + +type InvalidOpSelfConv = InvalidOp "invalid operation for self conversation" + +invalidOpSelfConv :: InvalidOpSelfConv +invalidOpSelfConv = mkErrorDescription + +type InvalidOpOne2OneConv = InvalidOp "invalid operation for 1:1 conversations" + +invalidOpOne2OneConv :: InvalidOpOne2OneConv +invalidOpOne2OneConv = mkErrorDescription + +type InvalidOpConnectConv = InvalidOp "invalid operation for connect conversation" + +invalidOpConnectConv :: InvalidOpConnectConv +invalidOpConnectConv = mkErrorDescription diff --git a/libs/wire-api/src/Wire/API/Event/Conversation.hs b/libs/wire-api/src/Wire/API/Event/Conversation.hs index e77ef7e4947..d9438e4051e 100644 --- a/libs/wire-api/src/Wire/API/Event/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Event/Conversation.hs @@ -40,7 +40,7 @@ module Wire.API.Event.Conversation ConversationCode (..), Conversation (..), TypingData (..), - UserIdList (..), + QualifiedUserIdList (..), -- * Swagger modelEvent, @@ -84,7 +84,7 @@ import Wire.API.Conversation import Wire.API.Conversation.Code (ConversationCode (..), modelConversationCode) import Wire.API.Conversation.Role import Wire.API.Conversation.Typing (TypingData (..), modelTyping) -import Wire.API.User (UserIdList (..)) +import Wire.API.User (QualifiedUserIdList (..)) -------------------------------------------------------------------------------- -- Event @@ -198,7 +198,7 @@ typeEventType = data EventData = EdMembersJoin SimpleMembers - | EdMembersLeave UserIdList + | EdMembersLeave QualifiedUserIdList | EdConnect Connect | EdConvReceiptModeUpdate ConversationReceiptModeUpdate | EdConvRename ConversationRename diff --git a/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs b/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs index 44d3e7a28f9..1eb1d56fcf5 100644 --- a/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs +++ b/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs @@ -32,10 +32,10 @@ module Wire.API.Routes.MultiVerb ResponseType, IsResponse (..), IsSwaggerResponse (..), + combineResponseSwagger, RenderOutput (..), roAddContentType, roResponse, - ResponseSwagger (..), ResponseTypes, IsResponseList (..), ) @@ -46,6 +46,7 @@ import Control.Lens hiding (Context) import qualified Data.ByteString.Lazy as LBS import Data.Containers.ListUtils import Data.HashMap.Strict.InsOrd (InsOrdHashMap) +import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap import Data.Proxy import Data.SOP import qualified Data.Sequence as Seq @@ -82,13 +83,6 @@ data Respond (s :: Nat) (desc :: Symbol) (a :: *) -- Includes status code and description. data RespondEmpty (s :: Nat) (desc :: Symbol) -data ResponseSwagger = ResponseSwagger - { rsDescription :: Text, - rsStatus :: Status, - rsHeaders :: InsOrdHashMap S.HeaderName S.Header, - rsSchema :: Maybe (S.Referenced S.Schema) - } - data RenderOutput = RenderOutput { roStatus :: Status, roBody :: LByteString, @@ -131,7 +125,7 @@ instance MonadPlus UnrenderResult where mplus m@(UnrenderSuccess _) _ = m class IsSwaggerResponse a where - responseSwagger :: Declare ResponseSwagger + responseSwagger :: Declare S.Response type family ResponseType a :: * @@ -173,12 +167,12 @@ instance (KnownStatus s, KnownSymbol desc, S.ToSchema a) => IsSwaggerResponse (Respond s desc a) where - responseSwagger = - ResponseSwagger desc status mempty . Just - <$> S.declareSchemaRef (Proxy @a) - where - desc = Text.pack (symbolVal (Proxy @desc)) - status = statusVal (Proxy @s) + responseSwagger = do + ref <- S.declareSchemaRef (Proxy @a) + pure $ + mempty + & S.description .~ Text.pack (symbolVal (Proxy @desc)) + & S.schema ?~ ref type instance ResponseType (RespondEmpty s desc) = () @@ -200,10 +194,10 @@ instance KnownStatus s => IsResponse cs (RespondEmpty s desc) where ) instance (KnownStatus s, KnownSymbol desc) => IsSwaggerResponse (RespondEmpty s desc) where - responseSwagger = pure $ ResponseSwagger desc status mempty Nothing - where - desc = Text.pack (symbolVal (Proxy @desc)) - status = statusVal (Proxy @s) + responseSwagger = + pure $ + mempty + & S.description .~ Text.pack (symbolVal (Proxy @desc)) -- | This type adds response headers to a 'MultiVerb' response. -- @@ -281,11 +275,11 @@ instance where responseSwagger = fmap - (\rs -> rs {rsHeaders = toAllResponseHeaders (Proxy @hs)}) + (S.headers .~ toAllResponseHeaders (Proxy @hs)) (responseSwagger @r) class IsSwaggerResponseList as where - responseListSwagger :: Declare [ResponseSwagger] + responseListSwagger :: Declare (InsOrdHashMap S.HttpStatusCode S.Response) type family ResponseTypes (as :: [*]) where ResponseTypes '[] = '[] @@ -303,7 +297,7 @@ instance IsResponseList cs '[] where responseListStatuses = [] instance IsSwaggerResponseList '[] where - responseListSwagger = pure [] + responseListSwagger = pure mempty instance ( IsResponse cs a, @@ -322,10 +316,33 @@ instance responseListStatuses = statusVal (Proxy @(ResponseStatus a)) : responseListStatuses @cs @as instance - (IsSwaggerResponse a, IsSwaggerResponseList as) => + ( IsSwaggerResponse a, + KnownNat (ResponseStatus a), + IsSwaggerResponseList as + ) => IsSwaggerResponseList (a ': as) where - responseListSwagger = (:) <$> responseSwagger @a <*> responseListSwagger @as + responseListSwagger = + InsOrdHashMap.insertWith + combineResponseSwagger + (fromIntegral (natVal (Proxy @(ResponseStatus a)))) + <$> responseSwagger @a + <*> responseListSwagger @as + +combineResponseSwagger :: S.Response -> S.Response -> S.Response +combineResponseSwagger r1 r2 = + r1 + & S.description <>~ ("\n\n" <> r2 ^. S.description) + & S.schema . _Just . S._Inline %~ flip combineSwaggerSchema (r2 ^. S.schema . _Just . S._Inline) + +combineSwaggerSchema :: S.Schema -> S.Schema -> S.Schema +combineSwaggerSchema s1 s2 + -- if they are both errors, merge label enums + | notNullOf (S.properties . ix "code") s1 + && notNullOf (S.properties . ix "code") s2 = + s1 & S.properties . ix "label" . S._Inline . S.enum_ . _Just + <>~ (s2 ^. S.properties . ix "label" . S._Inline . S.enum_ . _Just) + | otherwise = s1 -- | This type can be used in Servant to produce an endpoint which can return -- multiple values with various content types and status codes. It is similar to @@ -524,22 +541,13 @@ instance & method ?~ ( mempty & S.produces ?~ S.MimeList (nubOrd cs) - & S.responses .~ foldr addResponse mempty responses + & S.responses . S.responses .~ fmap S.Inline responses ) ) where method = S.swaggerMethod (Proxy @method) cs = allMime (Proxy @cs) (defs, responses) = S.runDeclare (responseListSwagger @as) mempty - addResponse :: ResponseSwagger -> S.Responses -> S.Responses - addResponse response = - at (statusCode (rsStatus response)) - .~ (Just . S.Inline) - ( mempty - & S.description .~ rsDescription response - & S.schema .~ rsSchema response - & S.headers .~ rsHeaders response - ) roResponse :: RenderOutput -> Wai.Response roResponse ro = Wai.responseLBS (roStatus ro) (roHeaders ro) (roBody ro) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index e93b561e200..53780ca0b8c 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -22,7 +22,7 @@ module Wire.API.Routes.Public.Galley where import qualified Data.Code as Code import Data.CommaSeparatedList -import Data.Id (ConvId, TeamId) +import Data.Id (ConvId, TeamId, UserId) import Data.Qualified (Qualified (..)) import Data.Range import Data.SOP (I (..), NS (..)) @@ -40,6 +40,7 @@ import qualified Wire.API.Event.Conversation as Public import Wire.API.Message import Wire.API.Routes.MultiVerb import Wire.API.Routes.Public (ZConn, ZUser) +import Wire.API.Routes.Public.Galley.Responses import Wire.API.Routes.QualifiedCapture import Wire.API.ServantProto (Proto, RawProto) import qualified Wire.API.Team.Conversation as Public @@ -250,6 +251,38 @@ data Api routes = Api :> "v2" :> ReqBody '[Servant.JSON] Public.InviteQualified :> MultiVerb 'POST '[Servant.JSON] UpdateResponses UpdateResult, + -- This endpoint can lead to the following events being sent: + -- - MemberLeave event to members + removeMemberUnqualified :: + routes + :- Summary "Remove a member from a conversation (deprecated)" + :> ZUser + :> ZConn + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> "members" + :> Capture' '[Description "Target User ID"] "usr" UserId + :> MultiVerb + 'DELETE + '[JSON] + RemoveFromConversationHTTPResponse + RemoveFromConversationResponse, + -- This endpoint can lead to the following events being sent: + -- - MemberLeave event to members + removeMember :: + routes + :- Summary "Remove a member from a conversation" + :> ZUser + :> ZConn + :> "conversations" + :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId + :> "members" + :> QualifiedCapture' '[Description "Target User ID"] "usr" UserId + :> MultiVerb + 'DELETE + '[JSON] + RemoveFromConversationHTTPResponse + RemoveFromConversationResponse, -- Team Conversations getTeamConversationRoles :: diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Responses.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Responses.hs new file mode 100644 index 00000000000..b54a649501b --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Responses.hs @@ -0,0 +1,93 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2021 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 . + +-- | The module provides Galley HTTP response types and corresponding handler +-- types. +module Wire.API.Routes.Public.Galley.Responses where + +import Data.Aeson (FromJSON, ToJSON) +import Data.SOP (I (..), NS (..), unI, unZ) +import qualified Generics.SOP as GSOP +import Imports +import Servant (type (.++)) +import Wire.API.ErrorDescription + ( ConvMemberRemovalDenied, + ConvNotFound, + CustomRolesNotSupported, + InvalidOpConnectConv, + InvalidOpOne2OneConv, + InvalidOpSelfConv, + ManagedRemovalNotAllowed, + ) +import qualified Wire.API.Event.Conversation as Public +import Wire.API.Routes.MultiVerb (AsUnion (..), GenericAsUnion (..), Respond, RespondEmpty, ResponseType, eitherFromUnion, eitherToUnion) +import Wire.API.Util.Aeson (CustomEncoded (CustomEncoded)) + +-- | These are just the "error" outcomes of the 'RemoveFromConversationResponses' type. +-- This is needed in using ExceptT to differentiate error outcomes from an +-- outcome reflecting a change. +data RemoveFromConversationError + = RemoveFromConversationErrorRemovalNotAllowed + | RemoveFromConversationErrorManagedConvNotAllowed + | RemoveFromConversationErrorNotFound + | RemoveFromConversationErrorCustomRolesNotSupported + | RemoveFromConversationErrorSelfConv + | RemoveFromConversationErrorOne2OneConv + | RemoveFromConversationErrorConnectConv + | RemoveFromConversationErrorUnchanged + deriving stock (Eq, Show, Generic) + deriving + (ToJSON, FromJSON) + via (CustomEncoded RemoveFromConversationError) + deriving + (AsUnion RemovalNotPerformedHTTPResponses) + via (GenericAsUnion RemovalNotPerformedHTTPResponses RemoveFromConversationError) + +instance GSOP.Generic RemoveFromConversationError + +type RemovalNotPerformedHTTPResponses = + '[ ConvMemberRemovalDenied, + ManagedRemovalNotAllowed, + ConvNotFound, + CustomRolesNotSupported, + InvalidOpSelfConv, + InvalidOpOne2OneConv, + InvalidOpConnectConv, + RespondEmpty 204 "No change" + ] + +type RemoveFromConversationHTTPResponse = + RemovalNotPerformedHTTPResponses + .++ '[Respond 200 "Member removed" Public.Event] + +type RemoveFromConversationResponse = Either RemoveFromConversationError Public.Event + +instance + ( rs ~ (RemovalNotPerformedHTTPResponses .++ '[r]), + Public.Event ~ ResponseType r + ) => + AsUnion rs RemoveFromConversationResponse + where + toUnion = + eitherToUnion + (toUnion @RemovalNotPerformedHTTPResponses) + (Z . I) + + fromUnion = + eitherFromUnion + (fromUnion @RemovalNotPerformedHTTPResponses) + (unI . unZ) diff --git a/libs/wire-api/src/Wire/API/Routes/QualifiedCapture.hs b/libs/wire-api/src/Wire/API/Routes/QualifiedCapture.hs index bb661cbb7d7..9e4f2ab24c6 100644 --- a/libs/wire-api/src/Wire/API/Routes/QualifiedCapture.hs +++ b/libs/wire-api/src/Wire/API/Routes/QualifiedCapture.hs @@ -44,7 +44,7 @@ data QualifiedCapture' (mods :: [*]) (capture :: Symbol) (a :: *) type QualifiedCapture capture a = QualifiedCapture' '[] capture a type WithDomain mods capture a api = - Capture "domain" Domain + Capture (AppendSymbol capture "_domain") Domain :> Capture' mods capture a :> api @@ -53,6 +53,7 @@ instance ToParamSchema a, HasSwagger api, KnownSymbol capture, + KnownSymbol (AppendSymbol capture "_domain"), KnownSymbol (FoldDescription mods) ) => HasSwagger (QualifiedCapture' mods capture a :> api) @@ -64,6 +65,7 @@ instance FromHttpApiData a, HasServer api context, SBoolI (FoldLenient mods), + KnownSymbol (AppendSymbol capture "_domain"), HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters ) => HasServer (QualifiedCapture' mods capture a :> api) context @@ -80,7 +82,11 @@ instance qualify handler domain value = handler (Qualified value domain) instance - (KnownSymbol capture, ToHttpApiData a, HasClient m api) => + ( KnownSymbol capture, + ToHttpApiData a, + HasClient m api, + KnownSymbol (AppendSymbol capture "_domain") + ) => HasClient m (QualifiedCapture' mods capture a :> api) where type diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index e7095dcd09c..24758723fe0 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -21,6 +21,7 @@ module Wire.API.User ( UserIdList (..), + QualifiedUserIdList (..), LimitedQualifiedUserIdList (..), -- Profiles UserProfile (..), @@ -142,8 +143,7 @@ import Wire.API.User.Profile -- needed due to backwards compatible reasons since old -- clients will break if we switch these types. Also, this -- definition represents better what information it carries -newtype UserIdList = UserIdList - {mUsers :: [UserId]} +newtype UserIdList = UserIdList {mUsers :: [UserId]} deriving stock (Eq, Show, Generic) deriving newtype (Arbitrary) deriving (FromJSON, ToJSON, S.ToSchema) via Schema UserIdList @@ -160,6 +160,21 @@ modelUserIdList = Doc.defineModel "UserIdList" $ do Doc.property "user_ids" (Doc.unique $ Doc.array Doc.bytes') $ Doc.description "the array of team conversations" +-------------------------------------------------------------------------------- +-- QualifiedUserIdList + +newtype QualifiedUserIdList = QualifiedUserIdList {qualifiedUserIdList :: [Qualified UserId]} + deriving stock (Eq, Show, Generic) + deriving newtype (Arbitrary) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema QualifiedUserIdList + +instance ToSchema QualifiedUserIdList where + schema = + object "QualifiedUserIdList" $ + QualifiedUserIdList + <$> qualifiedUserIdList .= field "qualified_user_ids" (array schema) + <* (fmap qUnqualified . qualifiedUserIdList) .= field "user_ids" (deprecatedSchema "qualified_user_ids" (array schema)) + -------------------------------------------------------------------------------- -- LimitedQualifiedUserIdList diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Util/Aeson.hs b/libs/wire-api/src/Wire/API/Util/Aeson.hs similarity index 97% rename from libs/wire-api-federation/src/Wire/API/Federation/Util/Aeson.hs rename to libs/wire-api/src/Wire/API/Util/Aeson.hs index af730fbdb14..794c83d6585 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Util/Aeson.hs +++ b/libs/wire-api/src/Wire/API/Util/Aeson.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.API.Federation.Util.Aeson +module Wire.API.Util.Aeson ( customEncodingOptions, CustomEncoded (..), ) diff --git a/libs/wire-api/test/golden/testObject_AddBotResponse_user_10.json b/libs/wire-api/test/golden/testObject_AddBotResponse_user_10.json index 55eb948dd15..474127089a5 100644 --- a/libs/wire-api/test/golden/testObject_AddBotResponse_user_10.json +++ b/libs/wire-api/test/golden/testObject_AddBotResponse_user_10.json @@ -7,7 +7,8 @@ "conversation": "00000002-0000-0004-0000-000400000001", "time": "1864-05-04T10:22:33.842Z", "data": { - "user_ids": [] + "user_ids": [], + "qualified_user_ids": [] }, "from": "00000002-0000-0001-0000-000200000000", "qualified_from": { diff --git a/libs/wire-api/test/golden/testObject_Event_user_18.json b/libs/wire-api/test/golden/testObject_Event_user_18.json index b0a9058eb0c..cc9cba5d5a9 100644 --- a/libs/wire-api/test/golden/testObject_Event_user_18.json +++ b/libs/wire-api/test/golden/testObject_Event_user_18.json @@ -32,6 +32,108 @@ "0000679a-0000-59cf-0000-279100003e58", "00005aba-0000-14f5-0000-5c2e0000642f", "000016b2-0000-56e8-0000-584600006914" + ], + "qualified_user_ids": [ + { + "domain": "faraway.example.com", + "id": "00003fab-0000-40b8-0000-3b0c000014ef" + }, + { + "domain": "faraway.example.com", + "id": "00001c48-0000-29ae-0000-62fc00001479" + }, + { + "domain": "faraway.example.com", + "id": "00003254-0000-4f74-0000-6fc400003a01" + }, + { + "domain": "faraway.example.com", + "id": "000051f3-0000-077d-0000-1b3d00003745" + }, + { + "domain": "faraway.example.com", + "id": "000073a6-0000-7dec-0000-673c00005911" + }, + { + "domain": "faraway.example.com", + "id": "0000535c-0000-3949-0000-14aa000076cb" + }, + { + "domain": "faraway.example.com", + "id": "0000095f-0000-696f-0000-5ee200000ace" + }, + { + "domain": "faraway.example.com", + "id": "00003861-0000-132e-0000-502500005207" + }, + { + "domain": "faraway.example.com", + "id": "00007be5-0000-251a-0000-469400006f8d" + }, + { + "domain": "faraway.example.com", + "id": "000078f6-0000-7e08-0000-56d10000390e" + }, + { + "domain": "faraway.example.com", + "id": "0000517f-0000-26ef-0000-24c100002ae0" + }, + { + "domain": "faraway.example.com", + "id": "000001c6-0000-16c9-0000-58ea00005d5e" + }, + { + "domain": "faraway.example.com", + "id": "0000485b-0000-208e-0000-272200005214" + }, + { + "domain": "faraway.example.com", + "id": "00004d24-0000-439c-0000-618c00001e77" + }, + { + "domain": "faraway.example.com", + "id": "000077b4-0000-74a4-0000-26570000353e" + }, + { + "domain": "faraway.example.com", + "id": "0000332a-0000-430c-0000-5fbc00001ca8" + }, + { + "domain": "faraway.example.com", + "id": "000059c9-0000-6597-0000-667a00005744" + }, + { + "domain": "faraway.example.com", + "id": "00005777-0000-7a37-0000-6e22000052d2" + }, + { + "domain": "faraway.example.com", + "id": "0000430d-0000-4970-0000-0a9c00007b88" + }, + { + "domain": "faraway.example.com", + "id": "0000530a-0000-305f-0000-71a0000035d4" + }, + { + "domain": "faraway.example.com", + "id": "000005b8-0000-2691-0000-3a6000007dfb" + }, + { + "domain": "faraway.example.com", + "id": "00003c9c-0000-0780-0000-7ad500001db8" + }, + { + "domain": "faraway.example.com", + "id": "0000679a-0000-59cf-0000-279100003e58" + }, + { + "domain": "faraway.example.com", + "id": "00005aba-0000-14f5-0000-5c2e0000642f" + }, + { + "domain": "faraway.example.com", + "id": "000016b2-0000-56e8-0000-584600006914" + } ] }, "from": "000043a6-0000-1627-0000-490300002017", diff --git a/libs/wire-api/test/golden/testObject_Event_user_20.json b/libs/wire-api/test/golden/testObject_Event_user_20.json index f44e65af7a9..8b10ea681c6 100644 --- a/libs/wire-api/test/golden/testObject_Event_user_20.json +++ b/libs/wire-api/test/golden/testObject_Event_user_20.json @@ -33,6 +33,112 @@ "0000357d-0000-2963-0000-7bb000002734", "00000f40-0000-657c-0000-7d25000019df", "00006350-0000-630b-0000-5f560000503e" + ], + "qualified_user_ids": [ + { + "domain": "faraway.example.com", + "id": "00002e78-0000-23d9-0000-1cba00005025" + }, + { + "domain": "faraway.example.com", + "id": "00003293-0000-6991-0000-533700000e73" + }, + { + "domain": "faraway.example.com", + "id": "000075b1-0000-2e89-0000-6262000067a9" + }, + { + "domain": "faraway.example.com", + "id": "00007f94-0000-39fc-0000-28c5000028ed" + }, + { + "domain": "faraway.example.com", + "id": "000041f3-0000-3886-0000-735900007499" + }, + { + "domain": "faraway.example.com", + "id": "00004014-0000-675c-0000-688600003ed7" + }, + { + "domain": "faraway.example.com", + "id": "00002e75-0000-74cd-0000-529a000008c7" + }, + { + "domain": "faraway.example.com", + "id": "00000cea-0000-4b67-0000-4a2600007dae" + }, + { + "domain": "faraway.example.com", + "id": "00006b72-0000-1fae-0000-6647000025d0" + }, + { + "domain": "faraway.example.com", + "id": "00003c64-0000-4b1f-0000-7bc900001c31" + }, + { + "domain": "faraway.example.com", + "id": "00002cd3-0000-4520-0000-0d8c00004a16" + }, + { + "domain": "faraway.example.com", + "id": "00003e8f-0000-66a2-0000-067600002d8f" + }, + { + "domain": "faraway.example.com", + "id": "00004544-0000-0ce2-0000-1c2300007fbc" + }, + { + "domain": "faraway.example.com", + "id": "000071ef-0000-44f4-0000-7dc500002e5f" + }, + { + "domain": "faraway.example.com", + "id": "00007e40-0000-7f3a-0000-45a300002aee" + }, + { + "domain": "faraway.example.com", + "id": "00006eec-0000-4bb0-0000-271000001e9f" + }, + { + "domain": "faraway.example.com", + "id": "00001893-0000-272e-0000-5ccc0000561f" + }, + { + "domain": "faraway.example.com", + "id": "00004d81-0000-2d5f-0000-43ec00005771" + }, + { + "domain": "faraway.example.com", + "id": "00002521-0000-1a18-0000-3bc200005ce2" + }, + { + "domain": "faraway.example.com", + "id": "000005f2-0000-3b01-0000-070000005296" + }, + { + "domain": "faraway.example.com", + "id": "0000411b-0000-224b-0000-32650000061a" + }, + { + "domain": "faraway.example.com", + "id": "00004880-0000-3a0b-0000-56b10000398a" + }, + { + "domain": "faraway.example.com", + "id": "00002d6b-0000-4f28-0000-11110000309a" + }, + { + "domain": "faraway.example.com", + "id": "0000357d-0000-2963-0000-7bb000002734" + }, + { + "domain": "faraway.example.com", + "id": "00000f40-0000-657c-0000-7d25000019df" + }, + { + "domain": "faraway.example.com", + "id": "00006350-0000-630b-0000-5f560000503e" + } ] }, "from": "00007547-0000-26d8-0000-52280000157c", diff --git a/libs/wire-api/test/golden/testObject_RemoveBotResponse_user_1.json b/libs/wire-api/test/golden/testObject_RemoveBotResponse_user_1.json index cd55aa0263c..3190b63742c 100644 --- a/libs/wire-api/test/golden/testObject_RemoveBotResponse_user_1.json +++ b/libs/wire-api/test/golden/testObject_RemoveBotResponse_user_1.json @@ -38,6 +38,128 @@ "00006c9f-0000-5750-0000-3d5c00000149", "00004772-0000-793d-0000-0b4d0000087f", "000074ee-0000-5b53-0000-640000005536" + ], + "qualified_user_ids": [ + { + "domain": "faraway.example.com", + "id": "000038c1-0000-4a9c-0000-511300004c8b" + }, + { + "domain": "faraway.example.com", + "id": "00003111-0000-2620-0000-1c8800000ea0" + }, + { + "domain": "faraway.example.com", + "id": "00000de2-0000-6a83-0000-094b00007b02" + }, + { + "domain": "faraway.example.com", + "id": "00001203-0000-7200-0000-7f8600001824" + }, + { + "domain": "faraway.example.com", + "id": "0000412f-0000-6e53-0000-6fde00001ffa" + }, + { + "domain": "faraway.example.com", + "id": "000035d8-0000-190b-0000-3f6a00004698" + }, + { + "domain": "faraway.example.com", + "id": "00004a5d-0000-1532-0000-7c0f000057a8" + }, + { + "domain": "faraway.example.com", + "id": "00001eda-0000-7b4f-0000-35d800001e6f" + }, + { + "domain": "faraway.example.com", + "id": "000079aa-0000-1359-0000-42b8000036a9" + }, + { + "domain": "faraway.example.com", + "id": "00001b31-0000-356b-0000-379b000048ef" + }, + { + "domain": "faraway.example.com", + "id": "0000649d-0000-04a0-0000-6dac00001c6d" + }, + { + "domain": "faraway.example.com", + "id": "00003a75-0000-6289-0000-274d00001220" + }, + { + "domain": "faraway.example.com", + "id": "00003ffb-0000-1dcc-0000-3ad40000209c" + }, + { + "domain": "faraway.example.com", + "id": "00007243-0000-40bf-0000-6cd1000079ca" + }, + { + "domain": "faraway.example.com", + "id": "000003ef-0000-0ac8-0000-1a060000698d" + }, + { + "domain": "faraway.example.com", + "id": "00005a61-0000-3900-0000-4b5d00007ea6" + }, + { + "domain": "faraway.example.com", + "id": "00001ebb-0000-22ef-0000-4df700007541" + }, + { + "domain": "faraway.example.com", + "id": "00005dc2-0000-68ba-0000-2bd0000010a8" + }, + { + "domain": "faraway.example.com", + "id": "00001e9c-0000-24ba-0000-0f8e000016b6" + }, + { + "domain": "faraway.example.com", + "id": "0000480d-0000-0b25-0000-6f8700001bcf" + }, + { + "domain": "faraway.example.com", + "id": "00006d2e-0000-7890-0000-77e600007c77" + }, + { + "domain": "faraway.example.com", + "id": "00005702-0000-2392-0000-643e00000389" + }, + { + "domain": "faraway.example.com", + "id": "000041a6-0000-52a9-0000-41ce00003ead" + }, + { + "domain": "faraway.example.com", + "id": "000026a1-0000-0fd3-0000-4aa2000012e7" + }, + { + "domain": "faraway.example.com", + "id": "00000820-0000-54c4-0000-48490000065b" + }, + { + "domain": "faraway.example.com", + "id": "000026ea-0000-4310-0000-7c61000078ea" + }, + { + "domain": "faraway.example.com", + "id": "00005134-0000-19cc-0000-32fe00006ccb" + }, + { + "domain": "faraway.example.com", + "id": "00006c9f-0000-5750-0000-3d5c00000149" + }, + { + "domain": "faraway.example.com", + "id": "00004772-0000-793d-0000-0b4d0000087f" + }, + { + "domain": "faraway.example.com", + "id": "000074ee-0000-5b53-0000-640000005536" + } ] }, "from": "00004166-0000-1e32-0000-52cb0000428d", diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_1.json b/libs/wire-api/test/golden/testObject_UserIdList_1.json similarity index 100% rename from libs/wire-api/test/golden/testObject_UserIdList_user_1.json rename to libs/wire-api/test/golden/testObject_UserIdList_1.json diff --git a/libs/wire-api/test/golden/testObject_UserIdList_2.json b/libs/wire-api/test/golden/testObject_UserIdList_2.json new file mode 100644 index 00000000000..0c863a34364 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_UserIdList_2.json @@ -0,0 +1,3 @@ +{ + "user_ids": [] +} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_10.json b/libs/wire-api/test/golden/testObject_UserIdList_user_10.json deleted file mode 100644 index 993468d01f1..00000000000 --- a/libs/wire-api/test/golden/testObject_UserIdList_user_10.json +++ /dev/null @@ -1,19 +0,0 @@ -{ - "user_ids": [ - "00007d3a-0000-274d-0000-60d30000649e", - "0000076b-0000-3498-0000-201000006c19", - "00001127-0000-360e-0000-200800005676", - "00004b6f-0000-117f-0000-753a000059af", - "00004e1e-0000-5c17-0000-2e9b00003c3c", - "000049f3-0000-357d-0000-08d100007d04", - "00007911-0000-165f-0000-65cf000042c4", - "00005806-0000-60de-0000-69a800001c33", - "00001f13-0000-136d-0000-09c700001d28", - "00002ad6-0000-0ac3-0000-487300006508", - "00001a5f-0000-2abd-0000-269b000060c8", - "0000353f-0000-2e6c-0000-2e34000054ed", - "00001e1c-0000-459c-0000-15e30000794b", - "0000438f-0000-648c-0000-74e80000312c", - "00001066-0000-6ae8-0000-0f6d0000425e" - ] -} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_11.json b/libs/wire-api/test/golden/testObject_UserIdList_user_11.json deleted file mode 100644 index 0aae3b013f5..00000000000 --- a/libs/wire-api/test/golden/testObject_UserIdList_user_11.json +++ /dev/null @@ -1,16 +0,0 @@ -{ - "user_ids": [ - "000065a9-0000-3824-0000-1ed6000057c6", - "00005b8d-0000-1869-0000-680700005032", - "0000365f-0000-551a-0000-7d0900001d6e", - "0000039c-0000-7b9d-0000-7aa000001451", - "00002513-0000-3d17-0000-421a00003bfc", - "000046d5-0000-732d-0000-59a200006a59", - "000014a8-0000-5605-0000-13e900001592", - "00000c47-0000-33b7-0000-22e800003986", - "00003535-0000-16cc-0000-3aff000023de", - "00007306-0000-331a-0000-35b700005dda", - "0000622d-0000-4ae3-0000-097d00004749", - "000079eb-0000-4569-0000-5f6300003edd" - ] -} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_12.json b/libs/wire-api/test/golden/testObject_UserIdList_user_12.json deleted file mode 100644 index 5a6e93fdf25..00000000000 --- a/libs/wire-api/test/golden/testObject_UserIdList_user_12.json +++ /dev/null @@ -1,8 +0,0 @@ -{ - "user_ids": [ - "00005029-0000-72f0-0000-336b00006f4f", - "00006963-0000-6a5c-0000-6324000004da", - "00006b5c-0000-0d3a-0000-67ee00004dc1", - "0000460c-0000-2a56-0000-675700006f01" - ] -} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_13.json b/libs/wire-api/test/golden/testObject_UserIdList_user_13.json deleted file mode 100644 index f009f37240c..00000000000 --- a/libs/wire-api/test/golden/testObject_UserIdList_user_13.json +++ /dev/null @@ -1,26 +0,0 @@ -{ - "user_ids": [ - "00007e2c-0000-5526-0000-56800000687c", - "000016e5-0000-1850-0000-292500002219", - "00001468-0000-5564-0000-543600003ac1", - "00006b03-0000-167e-0000-7b8e00002ee5", - "000043f5-0000-6b28-0000-0a7c00007696", - "000058e0-0000-6cd1-0000-234f0000285e", - "000063a3-0000-7ec0-0000-3fd8000016ba", - "00003b25-0000-41cc-0000-1dbd000043c3", - "00002d8e-0000-68eb-0000-6002000054eb", - "000010a2-0000-09ce-0000-1aa400001a6c", - "00003d21-0000-21dc-0000-6bff00004d6b", - "0000102e-0000-29ed-0000-1cff00005b6e", - "00002291-0000-26bb-0000-797c000059ac", - "00003e11-0000-5333-0000-5f6000000c6a", - "000029c2-0000-7b08-0000-081d000023b2", - "000042ac-0000-76e5-0000-2c5d00007bb7", - "00005cff-0000-7936-0000-718400003158", - "00000e72-0000-60bd-0000-1bbd000008a8", - "00004c5b-0000-7c3e-0000-613000002c7a", - "00004e00-0000-6f46-0000-241400001912", - "000040a6-0000-5656-0000-15c4000060c9", - "00001763-0000-1497-0000-0f0e0000100a" - ] -} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_14.json b/libs/wire-api/test/golden/testObject_UserIdList_user_14.json deleted file mode 100644 index 090845f1767..00000000000 --- a/libs/wire-api/test/golden/testObject_UserIdList_user_14.json +++ /dev/null @@ -1,7 +0,0 @@ -{ - "user_ids": [ - "00005371-0000-333e-0000-046b00003ee8", - "000066f7-0000-68de-0000-05a40000453a", - "00003195-0000-0b96-0000-688400007308" - ] -} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_15.json b/libs/wire-api/test/golden/testObject_UserIdList_user_15.json deleted file mode 100644 index 5622946f7d4..00000000000 --- a/libs/wire-api/test/golden/testObject_UserIdList_user_15.json +++ /dev/null @@ -1,26 +0,0 @@ -{ - "user_ids": [ - "0000383c-0000-2fc6-0000-355a00007abe", - "00006d0d-0000-0165-0000-0350000057e7", - "00006569-0000-5731-0000-14e600003715", - "000063bc-0000-17c0-0000-615500007af1", - "000067d2-0000-1718-0000-300900007c08", - "00004db5-0000-7e5c-0000-40cc00003bdc", - "00001670-0000-7f3c-0000-31ed00003328", - "00005de1-0000-248d-0000-5ea800000a69", - "00003fac-0000-25c3-0000-39400000248e", - "00007b41-0000-5aea-0000-445700006bda", - "00002087-0000-6b5a-0000-23570000290b", - "00006845-0000-7619-0000-310000001832", - "00006a49-0000-1378-0000-4e0e000049f5", - "00006036-0000-7f5e-0000-628400001f05", - "00001266-0000-3242-0000-194400005728", - "000079b9-0000-5069-0000-79830000595f", - "00005496-0000-3751-0000-54f600006784", - "0000400a-0000-7b4a-0000-559500007ef3", - "000061e1-0000-4949-0000-34b200006b28", - "000005e6-0000-1d9e-0000-1c3300001caf", - "00005e3b-0000-5b40-0000-01bb00006c1c", - "00007c72-0000-28d6-0000-11e300007b78" - ] -} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_16.json b/libs/wire-api/test/golden/testObject_UserIdList_user_16.json deleted file mode 100644 index ae91b1032c6..00000000000 --- a/libs/wire-api/test/golden/testObject_UserIdList_user_16.json +++ /dev/null @@ -1,13 +0,0 @@ -{ - "user_ids": [ - "000026c7-0000-0033-0000-2014000031e7", - "00003cdb-0000-53ee-0000-144200006978", - "00001249-0000-1c38-0000-18a5000004c8", - "00002679-0000-291d-0000-4ca000007e7d", - "00004619-0000-7bb1-0000-6c45000075a6", - "000059cf-0000-3ac0-0000-4894000010d4", - "000014cc-0000-22ec-0000-2d550000621a", - "00003881-0000-564d-0000-6622000055da", - "000043d4-0000-72b6-0000-6ae90000353a" - ] -} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_17.json b/libs/wire-api/test/golden/testObject_UserIdList_user_17.json deleted file mode 100644 index 96124598b54..00000000000 --- a/libs/wire-api/test/golden/testObject_UserIdList_user_17.json +++ /dev/null @@ -1,28 +0,0 @@ -{ - "user_ids": [ - "00002b7d-0000-5bc9-0000-035000007afb", - "000021be-0000-40a5-0000-5db300004d94", - "0000470a-0000-222a-0000-1568000003e3", - "00002450-0000-39d6-0000-4a67000052a8", - "00007d85-0000-3ef9-0000-2f0500000643", - "000052b0-0000-4b58-0000-543a00003878", - "00001990-0000-31fe-0000-5c93000049b8", - "00002581-0000-5a19-0000-4d8f00000e45", - "00006737-0000-2cce-0000-44d200003bbd", - "00000cf1-0000-28ff-0000-044b00006008", - "00007520-0000-7c57-0000-7bad00007dc1", - "00005377-0000-60ab-0000-04ca00005b16", - "000039ec-0000-76ff-0000-6b6c000068c0", - "00007cf6-0000-6c44-0000-2d1300007bfa", - "00000618-0000-2eb8-0000-252100006a8b", - "0000504e-0000-2e31-0000-2ea80000515e", - "000029f7-0000-14ba-0000-31be000077e6", - "00003583-0000-6dfa-0000-0f4b00004456", - "00000eb3-0000-194b-0000-70a500004525", - "00003776-0000-5375-0000-178300003d0e", - "000012bf-0000-2aca-0000-257b00007eae", - "00003a60-0000-4129-0000-5d53000038b2", - "000057c0-0000-5741-0000-540500006241", - "0000465b-0000-7f77-0000-4489000011dc" - ] -} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_18.json b/libs/wire-api/test/golden/testObject_UserIdList_user_18.json deleted file mode 100644 index 506c8b393db..00000000000 --- a/libs/wire-api/test/golden/testObject_UserIdList_user_18.json +++ /dev/null @@ -1,14 +0,0 @@ -{ - "user_ids": [ - "00005eaf-0000-0a0c-0000-708200004f52", - "00000a66-0000-0e2f-0000-50bd00000f87", - "000076cd-0000-6e88-0000-7770000063f6", - "0000778c-0000-5664-0000-794f0000043b", - "00007208-0000-3872-0000-02ed00000f4f", - "00005e23-0000-63aa-0000-79ce000057f7", - "000070c8-0000-7458-0000-60aa00001369", - "000066a6-0000-1ef7-0000-067a00004ffe", - "00007803-0000-07ad-0000-5b870000060e", - "0000378c-0000-3f22-0000-18dd00004d2e" - ] -} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_19.json b/libs/wire-api/test/golden/testObject_UserIdList_user_19.json deleted file mode 100644 index 9ac6e501cb3..00000000000 --- a/libs/wire-api/test/golden/testObject_UserIdList_user_19.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "user_ids": [ - "00000a5c-0000-1b8a-0000-40540000722c" - ] -} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_2.json b/libs/wire-api/test/golden/testObject_UserIdList_user_2.json deleted file mode 100644 index d28067479fb..00000000000 --- a/libs/wire-api/test/golden/testObject_UserIdList_user_2.json +++ /dev/null @@ -1,8 +0,0 @@ -{ - "user_ids": [ - "000065bd-0000-36ec-0000-6d69000056cd", - "000017b3-0000-4bb2-0000-70df00006059", - "00000ef4-0000-64ca-0000-53a2000040ba", - "00004d4c-0000-595a-0000-7f410000146a" - ] -} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_20.json b/libs/wire-api/test/golden/testObject_UserIdList_user_20.json deleted file mode 100644 index 4513e7e7db4..00000000000 --- a/libs/wire-api/test/golden/testObject_UserIdList_user_20.json +++ /dev/null @@ -1,22 +0,0 @@ -{ - "user_ids": [ - "00002a17-0000-1192-0000-1abc00002c72", - "00007465-0000-4fc4-0000-65d800005f03", - "000070d0-0000-39dd-0000-77e500002b92", - "00006ab3-0000-39de-0000-46bb00005b6f", - "0000574d-0000-70b6-0000-4d7f00002f31", - "0000354b-0000-19be-0000-01a60000559c", - "00005874-0000-10bf-0000-2103000005c6", - "00006ff2-0000-27ae-0000-277300004981", - "00004ed4-0000-7160-0000-6c8800000920", - "0000670f-0000-0657-0000-6b4400002b61", - "000078e9-0000-1cd5-0000-545c00004e6d", - "000072b4-0000-0476-0000-23e900005e9f", - "00001462-0000-5092-0000-183800005cf3", - "000012f0-0000-7993-0000-787b00003a59", - "000046b4-0000-2d69-0000-1d91000065dc", - "000040f4-0000-3b05-0000-002800001adf", - "00006feb-0000-20d6-0000-69b700006097", - "000013e5-0000-185e-0000-39f300007306" - ] -} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_3.json b/libs/wire-api/test/golden/testObject_UserIdList_user_3.json deleted file mode 100644 index fc1eb0f25a3..00000000000 --- a/libs/wire-api/test/golden/testObject_UserIdList_user_3.json +++ /dev/null @@ -1,8 +0,0 @@ -{ - "user_ids": [ - "00007725-0000-1cfb-0000-5ccd00005f2b", - "00005045-0000-7682-0000-32cf000006db", - "000058aa-0000-2239-0000-246700006d6f", - "00006294-0000-1e40-0000-32a100003817" - ] -} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_4.json b/libs/wire-api/test/golden/testObject_UserIdList_user_4.json deleted file mode 100644 index 48fed1c5497..00000000000 --- a/libs/wire-api/test/golden/testObject_UserIdList_user_4.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "user_ids": [ - "00003024-0000-5b6f-0000-5b5a00000e85" - ] -} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_5.json b/libs/wire-api/test/golden/testObject_UserIdList_user_5.json deleted file mode 100644 index dc65812cf80..00000000000 --- a/libs/wire-api/test/golden/testObject_UserIdList_user_5.json +++ /dev/null @@ -1,21 +0,0 @@ -{ - "user_ids": [ - "00007801-0000-01b3-0000-0d2f00005be3", - "000003ce-0000-1a79-0000-752700005b02", - "00001f7c-0000-059d-0000-39ee000073cc", - "00004418-0000-5515-0000-298000006573", - "0000799e-0000-6e81-0000-653000006f06", - "00002130-0000-005e-0000-4e7800007786", - "00000325-0000-28f9-0000-0cf9000001d7", - "0000644b-0000-32a4-0000-760000003737", - "00000532-0000-631a-0000-2270000040e8", - "00001158-0000-50f3-0000-064300001f60", - "00001777-0000-6e74-0000-121400005612", - "00005a0f-0000-4797-0000-238500005185", - "00007112-0000-45ce-0000-797000001a8b", - "00006734-0000-45ec-0000-09a3000033e0", - "00004c31-0000-4fcd-0000-6b570000114a", - "000044b0-0000-77f3-0000-560800001772", - "0000452d-0000-5f1d-0000-27d400002f2e" - ] -} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_6.json b/libs/wire-api/test/golden/testObject_UserIdList_user_6.json deleted file mode 100644 index 3a23e3d9b63..00000000000 --- a/libs/wire-api/test/golden/testObject_UserIdList_user_6.json +++ /dev/null @@ -1,12 +0,0 @@ -{ - "user_ids": [ - "00005e38-0000-026b-0000-71b500006886", - "00000d99-0000-0db3-0000-2fdb00003e84", - "00001e6f-0000-0335-0000-779200001e18", - "000076f4-0000-5ca9-0000-38c000007caa", - "00003f84-0000-22f1-0000-13a0000072a0", - "00000c2a-0000-231b-0000-02db000071ac", - "00000875-0000-2878-0000-3de200003108", - "000041be-0000-3438-0000-4d7c0000794d" - ] -} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_7.json b/libs/wire-api/test/golden/testObject_UserIdList_user_7.json deleted file mode 100644 index 302f0856ad3..00000000000 --- a/libs/wire-api/test/golden/testObject_UserIdList_user_7.json +++ /dev/null @@ -1,32 +0,0 @@ -{ - "user_ids": [ - "00002171-0000-52a2-0000-797e00000c42", - "0000703d-0000-74d7-0000-22dc00004f28", - "00006668-0000-7583-0000-5a310000383a", - "00004545-0000-6a1e-0000-50bb00000663", - "000029af-0000-4b5b-0000-016100007494", - "00006ce2-0000-6ff4-0000-41f20000578a", - "00001901-0000-279b-0000-108100002ccf", - "00000e0a-0000-300a-0000-0d52000076df", - "00002c4e-0000-6562-0000-227f00001576", - "000016c3-0000-26d3-0000-422400003b01", - "000031d0-0000-2a7d-0000-132e000010f6", - "00004896-0000-01b7-0000-700e00007564", - "00004d3c-0000-7dd8-0000-217e00006aef", - "000027bc-0000-158f-0000-65d100002c2e", - "00003cf9-0000-7625-0000-199500004ccd", - "00005d7b-0000-32e6-0000-1cc40000120f", - "00004d0c-0000-4875-0000-1b8600001b22", - "00007ff8-0000-3356-0000-4910000043cf", - "000027c1-0000-1e7a-0000-00e40000144a", - "00005246-0000-6305-0000-41ed000000ae", - "00006f45-0000-37b9-0000-16be00001949", - "00006c17-0000-389d-0000-3b5e000038ff", - "00001dd7-0000-1cf0-0000-7ea700005304", - "000042ed-0000-56be-0000-592c00005fbb", - "00006dc6-0000-5604-0000-5d8f00004873", - "000069e4-0000-77dd-0000-4bea000005dd", - "00006905-0000-4b28-0000-4f8000006bc4", - "00002b89-0000-6331-0000-2454000078ed" - ] -} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_8.json b/libs/wire-api/test/golden/testObject_UserIdList_user_8.json deleted file mode 100644 index 52f8c6aaa98..00000000000 --- a/libs/wire-api/test/golden/testObject_UserIdList_user_8.json +++ /dev/null @@ -1,17 +0,0 @@ -{ - "user_ids": [ - "00006018-0000-11b4-0000-5ec9000055b8", - "00003821-0000-3e6a-0000-3aa700004795", - "0000568c-0000-0356-0000-256800003649", - "00006785-0000-22d1-0000-28b600005ad4", - "00004e5a-0000-4a75-0000-7cd9000070f3", - "00004f38-0000-634b-0000-592a000052ce", - "000018ef-0000-6096-0000-4c27000077a9", - "00006b68-0000-1635-0000-00f500005881", - "0000705a-0000-4cd5-0000-52b800003a1e", - "00003472-0000-10e6-0000-1d090000296f", - "000067de-0000-6f44-0000-737200006fa5", - "000052d9-0000-5da4-0000-1fd500001ed9", - "0000360d-0000-6b29-0000-077400006824" - ] -} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_UserIdList_user_9.json b/libs/wire-api/test/golden/testObject_UserIdList_user_9.json deleted file mode 100644 index 87dfa614f3f..00000000000 --- a/libs/wire-api/test/golden/testObject_UserIdList_user_9.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "user_ids": [ - "0000570a-0000-5a69-0000-1c9800004362" - ] -} \ No newline at end of file diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated.hs index 0f2cb4f60c6..bf496bf2b29 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated.hs @@ -232,7 +232,6 @@ import qualified Test.Wire.API.Golden.Generated.UserClients_user import qualified Test.Wire.API.Golden.Generated.UserConnectionList_user import qualified Test.Wire.API.Golden.Generated.UserConnection_user import qualified Test.Wire.API.Golden.Generated.UserHandleInfo_user -import qualified Test.Wire.API.Golden.Generated.UserIdList_user import qualified Test.Wire.API.Golden.Generated.UserIdentity_user import qualified Test.Wire.API.Golden.Generated.UserLegalHoldStatusResponse_team import qualified Test.Wire.API.Golden.Generated.UserProfile_user @@ -410,8 +409,6 @@ tests = testObjects [(Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_1, "testObject_NewUser_user_1.json"), (Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_2, "testObject_NewUser_user_2.json"), (Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_3, "testObject_NewUser_user_3.json"), (Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_4, "testObject_NewUser_user_4.json"), (Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_5, "testObject_NewUser_user_5.json"), (Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_6, "testObject_NewUser_user_6.json"), (Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_7, "testObject_NewUser_user_7.json"), (Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_8, "testObject_NewUser_user_8.json"), (Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_9, "testObject_NewUser_user_9.json"), (Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_10, "testObject_NewUser_user_10.json"), (Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_11, "testObject_NewUser_user_11.json"), (Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_12, "testObject_NewUser_user_12.json"), (Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_13, "testObject_NewUser_user_13.json"), (Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_14, "testObject_NewUser_user_14.json"), (Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_15, "testObject_NewUser_user_15.json"), (Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_16, "testObject_NewUser_user_16.json"), (Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_17, "testObject_NewUser_user_17.json"), (Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_18, "testObject_NewUser_user_18.json"), (Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_19, "testObject_NewUser_user_19.json"), (Test.Wire.API.Golden.Generated.NewUser_user.testObject_NewUser_user_20, "testObject_NewUser_user_20.json")], testCase ("Golden: NewUserPublic_user") $ testObjects [(Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_1, "testObject_NewUserPublic_user_1.json"), (Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_2, "testObject_NewUserPublic_user_2.json"), (Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_3, "testObject_NewUserPublic_user_3.json"), (Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_4, "testObject_NewUserPublic_user_4.json"), (Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_5, "testObject_NewUserPublic_user_5.json"), (Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_6, "testObject_NewUserPublic_user_6.json"), (Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_7, "testObject_NewUserPublic_user_7.json"), (Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_8, "testObject_NewUserPublic_user_8.json"), (Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_9, "testObject_NewUserPublic_user_9.json"), (Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_10, "testObject_NewUserPublic_user_10.json"), (Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_11, "testObject_NewUserPublic_user_11.json"), (Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_12, "testObject_NewUserPublic_user_12.json"), (Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_13, "testObject_NewUserPublic_user_13.json"), (Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_14, "testObject_NewUserPublic_user_14.json"), (Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_15, "testObject_NewUserPublic_user_15.json"), (Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_16, "testObject_NewUserPublic_user_16.json"), (Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_17, "testObject_NewUserPublic_user_17.json"), (Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_18, "testObject_NewUserPublic_user_18.json"), (Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_19, "testObject_NewUserPublic_user_19.json"), (Test.Wire.API.Golden.Generated.NewUserPublic_user.testObject_NewUserPublic_user_20, "testObject_NewUserPublic_user_20.json")], - testCase ("Golden: UserIdList_user") $ - testObjects [(Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_1, "testObject_UserIdList_user_1.json"), (Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_2, "testObject_UserIdList_user_2.json"), (Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_3, "testObject_UserIdList_user_3.json"), (Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_4, "testObject_UserIdList_user_4.json"), (Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_5, "testObject_UserIdList_user_5.json"), (Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_6, "testObject_UserIdList_user_6.json"), (Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_7, "testObject_UserIdList_user_7.json"), (Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_8, "testObject_UserIdList_user_8.json"), (Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_9, "testObject_UserIdList_user_9.json"), (Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_10, "testObject_UserIdList_user_10.json"), (Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_11, "testObject_UserIdList_user_11.json"), (Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_12, "testObject_UserIdList_user_12.json"), (Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_13, "testObject_UserIdList_user_13.json"), (Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_14, "testObject_UserIdList_user_14.json"), (Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_15, "testObject_UserIdList_user_15.json"), (Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_16, "testObject_UserIdList_user_16.json"), (Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_17, "testObject_UserIdList_user_17.json"), (Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_18, "testObject_UserIdList_user_18.json"), (Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_19, "testObject_UserIdList_user_19.json"), (Test.Wire.API.Golden.Generated.UserIdList_user.testObject_UserIdList_user_20, "testObject_UserIdList_user_20.json")], testCase ("Golden: LimitedQualifiedUserIdList_2020_user") $ testObjects [(Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_1, "testObject_LimitedQualifiedUserIdList_2020_user_1.json"), (Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_2, "testObject_LimitedQualifiedUserIdList_2020_user_2.json"), (Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_3, "testObject_LimitedQualifiedUserIdList_2020_user_3.json"), (Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_4, "testObject_LimitedQualifiedUserIdList_2020_user_4.json"), (Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_5, "testObject_LimitedQualifiedUserIdList_2020_user_5.json"), (Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_6, "testObject_LimitedQualifiedUserIdList_2020_user_6.json"), (Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_7, "testObject_LimitedQualifiedUserIdList_2020_user_7.json"), (Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_8, "testObject_LimitedQualifiedUserIdList_2020_user_8.json"), (Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_9, "testObject_LimitedQualifiedUserIdList_2020_user_9.json"), (Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_10, "testObject_LimitedQualifiedUserIdList_2020_user_10.json"), (Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_11, "testObject_LimitedQualifiedUserIdList_2020_user_11.json"), (Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_12, "testObject_LimitedQualifiedUserIdList_2020_user_12.json"), (Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_13, "testObject_LimitedQualifiedUserIdList_2020_user_13.json"), (Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_14, "testObject_LimitedQualifiedUserIdList_2020_user_14.json"), (Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_15, "testObject_LimitedQualifiedUserIdList_2020_user_15.json"), (Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_16, "testObject_LimitedQualifiedUserIdList_2020_user_16.json"), (Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_17, "testObject_LimitedQualifiedUserIdList_2020_user_17.json"), (Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_18, "testObject_LimitedQualifiedUserIdList_2020_user_18.json"), (Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_19, "testObject_LimitedQualifiedUserIdList_2020_user_19.json"), (Test.Wire.API.Golden.Generated.LimitedQualifiedUserIdList_2020_user.testObject_LimitedQualifiedUserIdList_2020_user_20, "testObject_LimitedQualifiedUserIdList_2020_user_20.json")], testCase ("Golden: UserProfile_user") $ diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/AddBotResponse_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/AddBotResponse_user.hs index 920eaddff69..f13a8fdacb9 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/AddBotResponse_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/AddBotResponse_user.hs @@ -137,9 +137,9 @@ import Wire.API.Event.Conversation misOtrMutedStatus, misTarget ), + QualifiedUserIdList (QualifiedUserIdList, qualifiedUserIdList), SimpleMember (..), SimpleMembers (SimpleMembers, mMembers), - UserIdList (UserIdList, mUsers), ) import Wire.API.Provider.Service (ServiceRef (ServiceRef, _serviceRefId, _serviceRefProvider)) import Wire.API.User @@ -494,7 +494,7 @@ testObject_AddBotResponse_user_10 = (Qualified (Id (fromJust (UUID.fromString "00000002-0000-0004-0000-000400000001"))) (Domain "faraway.example.com")) (Qualified (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000200000000"))) (Domain "faraway.example.com")) (read "1864-05-04 10:22:33.842 UTC") - ((EdMembersLeave (UserIdList {mUsers = []}))) + ((EdMembersLeave (QualifiedUserIdList {qualifiedUserIdList = []}))) ) } diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Event_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Event_user.hs index 13f57ce30b6..b18ded4f611 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Event_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Event_user.hs @@ -64,9 +64,9 @@ import Wire.API.Event.Conversation otrRecipient, otrSender ), + QualifiedUserIdList (QualifiedUserIdList, qualifiedUserIdList), SimpleMember (..), SimpleMembers (SimpleMembers, mMembers), - UserIdList (UserIdList, mUsers), ) import Wire.API.Provider.Service (ServiceRef (ServiceRef, _serviceRefId, _serviceRefProvider)) @@ -432,33 +432,33 @@ testObject_Event_user_18 = (Qualified (Id (fromJust (UUID.fromString "000043a6-0000-1627-0000-490300002017"))) (Domain "faraway.example.com")) (read "1864-04-12 01:28:25.705 UTC") ( ( EdMembersLeave - ( UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "00003fab-0000-40b8-0000-3b0c000014ef"))), - (Id (fromJust (UUID.fromString "00001c48-0000-29ae-0000-62fc00001479"))), - (Id (fromJust (UUID.fromString "00003254-0000-4f74-0000-6fc400003a01"))), - (Id (fromJust (UUID.fromString "000051f3-0000-077d-0000-1b3d00003745"))), - (Id (fromJust (UUID.fromString "000073a6-0000-7dec-0000-673c00005911"))), - (Id (fromJust (UUID.fromString "0000535c-0000-3949-0000-14aa000076cb"))), - (Id (fromJust (UUID.fromString "0000095f-0000-696f-0000-5ee200000ace"))), - (Id (fromJust (UUID.fromString "00003861-0000-132e-0000-502500005207"))), - (Id (fromJust (UUID.fromString "00007be5-0000-251a-0000-469400006f8d"))), - (Id (fromJust (UUID.fromString "000078f6-0000-7e08-0000-56d10000390e"))), - (Id (fromJust (UUID.fromString "0000517f-0000-26ef-0000-24c100002ae0"))), - (Id (fromJust (UUID.fromString "000001c6-0000-16c9-0000-58ea00005d5e"))), - (Id (fromJust (UUID.fromString "0000485b-0000-208e-0000-272200005214"))), - (Id (fromJust (UUID.fromString "00004d24-0000-439c-0000-618c00001e77"))), - (Id (fromJust (UUID.fromString "000077b4-0000-74a4-0000-26570000353e"))), - (Id (fromJust (UUID.fromString "0000332a-0000-430c-0000-5fbc00001ca8"))), - (Id (fromJust (UUID.fromString "000059c9-0000-6597-0000-667a00005744"))), - (Id (fromJust (UUID.fromString "00005777-0000-7a37-0000-6e22000052d2"))), - (Id (fromJust (UUID.fromString "0000430d-0000-4970-0000-0a9c00007b88"))), - (Id (fromJust (UUID.fromString "0000530a-0000-305f-0000-71a0000035d4"))), - (Id (fromJust (UUID.fromString "000005b8-0000-2691-0000-3a6000007dfb"))), - (Id (fromJust (UUID.fromString "00003c9c-0000-0780-0000-7ad500001db8"))), - (Id (fromJust (UUID.fromString "0000679a-0000-59cf-0000-279100003e58"))), - (Id (fromJust (UUID.fromString "00005aba-0000-14f5-0000-5c2e0000642f"))), - (Id (fromJust (UUID.fromString "000016b2-0000-56e8-0000-584600006914"))) + ( QualifiedUserIdList + { qualifiedUserIdList = + [ (Qualified (Id (fromJust (UUID.fromString "00003fab-0000-40b8-0000-3b0c000014ef"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00001c48-0000-29ae-0000-62fc00001479"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00003254-0000-4f74-0000-6fc400003a01"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "000051f3-0000-077d-0000-1b3d00003745"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "000073a6-0000-7dec-0000-673c00005911"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "0000535c-0000-3949-0000-14aa000076cb"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "0000095f-0000-696f-0000-5ee200000ace"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00003861-0000-132e-0000-502500005207"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00007be5-0000-251a-0000-469400006f8d"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "000078f6-0000-7e08-0000-56d10000390e"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "0000517f-0000-26ef-0000-24c100002ae0"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "000001c6-0000-16c9-0000-58ea00005d5e"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "0000485b-0000-208e-0000-272200005214"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00004d24-0000-439c-0000-618c00001e77"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "000077b4-0000-74a4-0000-26570000353e"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "0000332a-0000-430c-0000-5fbc00001ca8"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "000059c9-0000-6597-0000-667a00005744"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00005777-0000-7a37-0000-6e22000052d2"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "0000430d-0000-4970-0000-0a9c00007b88"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "0000530a-0000-305f-0000-71a0000035d4"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "000005b8-0000-2691-0000-3a6000007dfb"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00003c9c-0000-0780-0000-7ad500001db8"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "0000679a-0000-59cf-0000-279100003e58"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00005aba-0000-14f5-0000-5c2e0000642f"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "000016b2-0000-56e8-0000-584600006914"))) (Domain "faraway.example.com")) ] } ) @@ -581,34 +581,34 @@ testObject_Event_user_20 = (Qualified (Id (fromJust (UUID.fromString "00007547-0000-26d8-0000-52280000157c"))) (Domain "faraway.example.com")) (read "1864-04-21 23:40:54.462 UTC") ( ( EdMembersLeave - ( UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "00002e78-0000-23d9-0000-1cba00005025"))), - (Id (fromJust (UUID.fromString "00003293-0000-6991-0000-533700000e73"))), - (Id (fromJust (UUID.fromString "000075b1-0000-2e89-0000-6262000067a9"))), - (Id (fromJust (UUID.fromString "00007f94-0000-39fc-0000-28c5000028ed"))), - (Id (fromJust (UUID.fromString "000041f3-0000-3886-0000-735900007499"))), - (Id (fromJust (UUID.fromString "00004014-0000-675c-0000-688600003ed7"))), - (Id (fromJust (UUID.fromString "00002e75-0000-74cd-0000-529a000008c7"))), - (Id (fromJust (UUID.fromString "00000cea-0000-4b67-0000-4a2600007dae"))), - (Id (fromJust (UUID.fromString "00006b72-0000-1fae-0000-6647000025d0"))), - (Id (fromJust (UUID.fromString "00003c64-0000-4b1f-0000-7bc900001c31"))), - (Id (fromJust (UUID.fromString "00002cd3-0000-4520-0000-0d8c00004a16"))), - (Id (fromJust (UUID.fromString "00003e8f-0000-66a2-0000-067600002d8f"))), - (Id (fromJust (UUID.fromString "00004544-0000-0ce2-0000-1c2300007fbc"))), - (Id (fromJust (UUID.fromString "000071ef-0000-44f4-0000-7dc500002e5f"))), - (Id (fromJust (UUID.fromString "00007e40-0000-7f3a-0000-45a300002aee"))), - (Id (fromJust (UUID.fromString "00006eec-0000-4bb0-0000-271000001e9f"))), - (Id (fromJust (UUID.fromString "00001893-0000-272e-0000-5ccc0000561f"))), - (Id (fromJust (UUID.fromString "00004d81-0000-2d5f-0000-43ec00005771"))), - (Id (fromJust (UUID.fromString "00002521-0000-1a18-0000-3bc200005ce2"))), - (Id (fromJust (UUID.fromString "000005f2-0000-3b01-0000-070000005296"))), - (Id (fromJust (UUID.fromString "0000411b-0000-224b-0000-32650000061a"))), - (Id (fromJust (UUID.fromString "00004880-0000-3a0b-0000-56b10000398a"))), - (Id (fromJust (UUID.fromString "00002d6b-0000-4f28-0000-11110000309a"))), - (Id (fromJust (UUID.fromString "0000357d-0000-2963-0000-7bb000002734"))), - (Id (fromJust (UUID.fromString "00000f40-0000-657c-0000-7d25000019df"))), - (Id (fromJust (UUID.fromString "00006350-0000-630b-0000-5f560000503e"))) + ( QualifiedUserIdList + { qualifiedUserIdList = + [ (Qualified (Id (fromJust (UUID.fromString "00002e78-0000-23d9-0000-1cba00005025"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00003293-0000-6991-0000-533700000e73"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "000075b1-0000-2e89-0000-6262000067a9"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00007f94-0000-39fc-0000-28c5000028ed"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "000041f3-0000-3886-0000-735900007499"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00004014-0000-675c-0000-688600003ed7"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00002e75-0000-74cd-0000-529a000008c7"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00000cea-0000-4b67-0000-4a2600007dae"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00006b72-0000-1fae-0000-6647000025d0"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00003c64-0000-4b1f-0000-7bc900001c31"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00002cd3-0000-4520-0000-0d8c00004a16"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00003e8f-0000-66a2-0000-067600002d8f"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00004544-0000-0ce2-0000-1c2300007fbc"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "000071ef-0000-44f4-0000-7dc500002e5f"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00007e40-0000-7f3a-0000-45a300002aee"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00006eec-0000-4bb0-0000-271000001e9f"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00001893-0000-272e-0000-5ccc0000561f"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00004d81-0000-2d5f-0000-43ec00005771"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00002521-0000-1a18-0000-3bc200005ce2"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "000005f2-0000-3b01-0000-070000005296"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "0000411b-0000-224b-0000-32650000061a"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00004880-0000-3a0b-0000-56b10000398a"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00002d6b-0000-4f28-0000-11110000309a"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "0000357d-0000-2963-0000-7bb000002734"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00000f40-0000-657c-0000-7d25000019df"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00006350-0000-630b-0000-5f560000503e"))) (Domain "faraway.example.com")) ] } ) diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/RemoveBotResponse_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/RemoveBotResponse_user.hs index ee3cffb3dec..6006a747463 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/RemoveBotResponse_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/RemoveBotResponse_user.hs @@ -96,9 +96,9 @@ import Wire.API.Event.Conversation otrRecipient, otrSender ), + QualifiedUserIdList (QualifiedUserIdList, qualifiedUserIdList), SimpleMember (..), SimpleMembers (SimpleMembers, mMembers), - UserIdList (UserIdList, mUsers), ) testObject_RemoveBotResponse_user_1 :: RemoveBotResponse @@ -111,38 +111,38 @@ testObject_RemoveBotResponse_user_1 = (Qualified (Id (fromJust (UUID.fromString "00004166-0000-1e32-0000-52cb0000428d"))) (Domain "faraway.example.com")) (read "1864-05-07 01:13:35.741 UTC") ( ( EdMembersLeave - ( UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "000038c1-0000-4a9c-0000-511300004c8b"))), - (Id (fromJust (UUID.fromString "00003111-0000-2620-0000-1c8800000ea0"))), - (Id (fromJust (UUID.fromString "00000de2-0000-6a83-0000-094b00007b02"))), - (Id (fromJust (UUID.fromString "00001203-0000-7200-0000-7f8600001824"))), - (Id (fromJust (UUID.fromString "0000412f-0000-6e53-0000-6fde00001ffa"))), - (Id (fromJust (UUID.fromString "000035d8-0000-190b-0000-3f6a00004698"))), - (Id (fromJust (UUID.fromString "00004a5d-0000-1532-0000-7c0f000057a8"))), - (Id (fromJust (UUID.fromString "00001eda-0000-7b4f-0000-35d800001e6f"))), - (Id (fromJust (UUID.fromString "000079aa-0000-1359-0000-42b8000036a9"))), - (Id (fromJust (UUID.fromString "00001b31-0000-356b-0000-379b000048ef"))), - (Id (fromJust (UUID.fromString "0000649d-0000-04a0-0000-6dac00001c6d"))), - (Id (fromJust (UUID.fromString "00003a75-0000-6289-0000-274d00001220"))), - (Id (fromJust (UUID.fromString "00003ffb-0000-1dcc-0000-3ad40000209c"))), - (Id (fromJust (UUID.fromString "00007243-0000-40bf-0000-6cd1000079ca"))), - (Id (fromJust (UUID.fromString "000003ef-0000-0ac8-0000-1a060000698d"))), - (Id (fromJust (UUID.fromString "00005a61-0000-3900-0000-4b5d00007ea6"))), - (Id (fromJust (UUID.fromString "00001ebb-0000-22ef-0000-4df700007541"))), - (Id (fromJust (UUID.fromString "00005dc2-0000-68ba-0000-2bd0000010a8"))), - (Id (fromJust (UUID.fromString "00001e9c-0000-24ba-0000-0f8e000016b6"))), - (Id (fromJust (UUID.fromString "0000480d-0000-0b25-0000-6f8700001bcf"))), - (Id (fromJust (UUID.fromString "00006d2e-0000-7890-0000-77e600007c77"))), - (Id (fromJust (UUID.fromString "00005702-0000-2392-0000-643e00000389"))), - (Id (fromJust (UUID.fromString "000041a6-0000-52a9-0000-41ce00003ead"))), - (Id (fromJust (UUID.fromString "000026a1-0000-0fd3-0000-4aa2000012e7"))), - (Id (fromJust (UUID.fromString "00000820-0000-54c4-0000-48490000065b"))), - (Id (fromJust (UUID.fromString "000026ea-0000-4310-0000-7c61000078ea"))), - (Id (fromJust (UUID.fromString "00005134-0000-19cc-0000-32fe00006ccb"))), - (Id (fromJust (UUID.fromString "00006c9f-0000-5750-0000-3d5c00000149"))), - (Id (fromJust (UUID.fromString "00004772-0000-793d-0000-0b4d0000087f"))), - (Id (fromJust (UUID.fromString "000074ee-0000-5b53-0000-640000005536"))) + ( QualifiedUserIdList + { qualifiedUserIdList = + [ (Qualified (Id (fromJust (UUID.fromString "000038c1-0000-4a9c-0000-511300004c8b"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00003111-0000-2620-0000-1c8800000ea0"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00000de2-0000-6a83-0000-094b00007b02"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00001203-0000-7200-0000-7f8600001824"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "0000412f-0000-6e53-0000-6fde00001ffa"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "000035d8-0000-190b-0000-3f6a00004698"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00004a5d-0000-1532-0000-7c0f000057a8"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00001eda-0000-7b4f-0000-35d800001e6f"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "000079aa-0000-1359-0000-42b8000036a9"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00001b31-0000-356b-0000-379b000048ef"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "0000649d-0000-04a0-0000-6dac00001c6d"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00003a75-0000-6289-0000-274d00001220"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00003ffb-0000-1dcc-0000-3ad40000209c"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00007243-0000-40bf-0000-6cd1000079ca"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "000003ef-0000-0ac8-0000-1a060000698d"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00005a61-0000-3900-0000-4b5d00007ea6"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00001ebb-0000-22ef-0000-4df700007541"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00005dc2-0000-68ba-0000-2bd0000010a8"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00001e9c-0000-24ba-0000-0f8e000016b6"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "0000480d-0000-0b25-0000-6f8700001bcf"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00006d2e-0000-7890-0000-77e600007c77"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00005702-0000-2392-0000-643e00000389"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "000041a6-0000-52a9-0000-41ce00003ead"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "000026a1-0000-0fd3-0000-4aa2000012e7"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00000820-0000-54c4-0000-48490000065b"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "000026ea-0000-4310-0000-7c61000078ea"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00005134-0000-19cc-0000-32fe00006ccb"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00006c9f-0000-5750-0000-3d5c00000149"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "00004772-0000-793d-0000-0b4d0000087f"))) (Domain "faraway.example.com")), + (Qualified (Id (fromJust (UUID.fromString "000074ee-0000-5b53-0000-640000005536"))) (Domain "faraway.example.com")) ] } ) diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/UserIdList_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/UserIdList_user.hs deleted file mode 100644 index 0b09a00279a..00000000000 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/UserIdList_user.hs +++ /dev/null @@ -1,379 +0,0 @@ -{-# LANGUAGE OverloadedLists #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2021 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . -module Test.Wire.API.Golden.Generated.UserIdList_user where - -import Data.Id (Id (Id)) -import qualified Data.UUID as UUID (fromString) -import Imports (fromJust) -import Wire.API.Event.Conversation (UserIdList (..)) - -testObject_UserIdList_user_1 :: UserIdList -testObject_UserIdList_user_1 = - UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "0000304a-0000-0d5e-0000-3fac00003993"))), - (Id (fromJust (UUID.fromString "00003c90-0000-2207-0000-5249000018b1"))), - (Id (fromJust (UUID.fromString "000016ee-0000-1c33-0000-6684000050e6"))), - (Id (fromJust (UUID.fromString "0000366d-0000-7f19-0000-4153000039a6"))), - (Id (fromJust (UUID.fromString "00002f85-0000-30dc-0000-4cb700001c44"))), - (Id (fromJust (UUID.fromString "000056c8-0000-0828-0000-0a31000012b6"))), - (Id (fromJust (UUID.fromString "00001d2d-0000-74ae-0000-44fc00000eba"))), - (Id (fromJust (UUID.fromString "00001b2c-0000-651e-0000-12d9000068dd"))), - (Id (fromJust (UUID.fromString "00006a07-0000-7703-0000-6c1000002889"))), - (Id (fromJust (UUID.fromString "00001e50-0000-2dd8-0000-0c7a000053f0"))), - (Id (fromJust (UUID.fromString "00003842-0000-2193-0000-275c00004421"))) - ] - } - -testObject_UserIdList_user_2 :: UserIdList -testObject_UserIdList_user_2 = - UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "000065bd-0000-36ec-0000-6d69000056cd"))), - (Id (fromJust (UUID.fromString "000017b3-0000-4bb2-0000-70df00006059"))), - (Id (fromJust (UUID.fromString "00000ef4-0000-64ca-0000-53a2000040ba"))), - (Id (fromJust (UUID.fromString "00004d4c-0000-595a-0000-7f410000146a"))) - ] - } - -testObject_UserIdList_user_3 :: UserIdList -testObject_UserIdList_user_3 = - UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "00007725-0000-1cfb-0000-5ccd00005f2b"))), - (Id (fromJust (UUID.fromString "00005045-0000-7682-0000-32cf000006db"))), - (Id (fromJust (UUID.fromString "000058aa-0000-2239-0000-246700006d6f"))), - (Id (fromJust (UUID.fromString "00006294-0000-1e40-0000-32a100003817"))) - ] - } - -testObject_UserIdList_user_4 :: UserIdList -testObject_UserIdList_user_4 = - UserIdList {mUsers = [(Id (fromJust (UUID.fromString "00003024-0000-5b6f-0000-5b5a00000e85")))]} - -testObject_UserIdList_user_5 :: UserIdList -testObject_UserIdList_user_5 = - UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "00007801-0000-01b3-0000-0d2f00005be3"))), - (Id (fromJust (UUID.fromString "000003ce-0000-1a79-0000-752700005b02"))), - (Id (fromJust (UUID.fromString "00001f7c-0000-059d-0000-39ee000073cc"))), - (Id (fromJust (UUID.fromString "00004418-0000-5515-0000-298000006573"))), - (Id (fromJust (UUID.fromString "0000799e-0000-6e81-0000-653000006f06"))), - (Id (fromJust (UUID.fromString "00002130-0000-005e-0000-4e7800007786"))), - (Id (fromJust (UUID.fromString "00000325-0000-28f9-0000-0cf9000001d7"))), - (Id (fromJust (UUID.fromString "0000644b-0000-32a4-0000-760000003737"))), - (Id (fromJust (UUID.fromString "00000532-0000-631a-0000-2270000040e8"))), - (Id (fromJust (UUID.fromString "00001158-0000-50f3-0000-064300001f60"))), - (Id (fromJust (UUID.fromString "00001777-0000-6e74-0000-121400005612"))), - (Id (fromJust (UUID.fromString "00005a0f-0000-4797-0000-238500005185"))), - (Id (fromJust (UUID.fromString "00007112-0000-45ce-0000-797000001a8b"))), - (Id (fromJust (UUID.fromString "00006734-0000-45ec-0000-09a3000033e0"))), - (Id (fromJust (UUID.fromString "00004c31-0000-4fcd-0000-6b570000114a"))), - (Id (fromJust (UUID.fromString "000044b0-0000-77f3-0000-560800001772"))), - (Id (fromJust (UUID.fromString "0000452d-0000-5f1d-0000-27d400002f2e"))) - ] - } - -testObject_UserIdList_user_6 :: UserIdList -testObject_UserIdList_user_6 = - UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "00005e38-0000-026b-0000-71b500006886"))), - (Id (fromJust (UUID.fromString "00000d99-0000-0db3-0000-2fdb00003e84"))), - (Id (fromJust (UUID.fromString "00001e6f-0000-0335-0000-779200001e18"))), - (Id (fromJust (UUID.fromString "000076f4-0000-5ca9-0000-38c000007caa"))), - (Id (fromJust (UUID.fromString "00003f84-0000-22f1-0000-13a0000072a0"))), - (Id (fromJust (UUID.fromString "00000c2a-0000-231b-0000-02db000071ac"))), - (Id (fromJust (UUID.fromString "00000875-0000-2878-0000-3de200003108"))), - (Id (fromJust (UUID.fromString "000041be-0000-3438-0000-4d7c0000794d"))) - ] - } - -testObject_UserIdList_user_7 :: UserIdList -testObject_UserIdList_user_7 = - UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "00002171-0000-52a2-0000-797e00000c42"))), - (Id (fromJust (UUID.fromString "0000703d-0000-74d7-0000-22dc00004f28"))), - (Id (fromJust (UUID.fromString "00006668-0000-7583-0000-5a310000383a"))), - (Id (fromJust (UUID.fromString "00004545-0000-6a1e-0000-50bb00000663"))), - (Id (fromJust (UUID.fromString "000029af-0000-4b5b-0000-016100007494"))), - (Id (fromJust (UUID.fromString "00006ce2-0000-6ff4-0000-41f20000578a"))), - (Id (fromJust (UUID.fromString "00001901-0000-279b-0000-108100002ccf"))), - (Id (fromJust (UUID.fromString "00000e0a-0000-300a-0000-0d52000076df"))), - (Id (fromJust (UUID.fromString "00002c4e-0000-6562-0000-227f00001576"))), - (Id (fromJust (UUID.fromString "000016c3-0000-26d3-0000-422400003b01"))), - (Id (fromJust (UUID.fromString "000031d0-0000-2a7d-0000-132e000010f6"))), - (Id (fromJust (UUID.fromString "00004896-0000-01b7-0000-700e00007564"))), - (Id (fromJust (UUID.fromString "00004d3c-0000-7dd8-0000-217e00006aef"))), - (Id (fromJust (UUID.fromString "000027bc-0000-158f-0000-65d100002c2e"))), - (Id (fromJust (UUID.fromString "00003cf9-0000-7625-0000-199500004ccd"))), - (Id (fromJust (UUID.fromString "00005d7b-0000-32e6-0000-1cc40000120f"))), - (Id (fromJust (UUID.fromString "00004d0c-0000-4875-0000-1b8600001b22"))), - (Id (fromJust (UUID.fromString "00007ff8-0000-3356-0000-4910000043cf"))), - (Id (fromJust (UUID.fromString "000027c1-0000-1e7a-0000-00e40000144a"))), - (Id (fromJust (UUID.fromString "00005246-0000-6305-0000-41ed000000ae"))), - (Id (fromJust (UUID.fromString "00006f45-0000-37b9-0000-16be00001949"))), - (Id (fromJust (UUID.fromString "00006c17-0000-389d-0000-3b5e000038ff"))), - (Id (fromJust (UUID.fromString "00001dd7-0000-1cf0-0000-7ea700005304"))), - (Id (fromJust (UUID.fromString "000042ed-0000-56be-0000-592c00005fbb"))), - (Id (fromJust (UUID.fromString "00006dc6-0000-5604-0000-5d8f00004873"))), - (Id (fromJust (UUID.fromString "000069e4-0000-77dd-0000-4bea000005dd"))), - (Id (fromJust (UUID.fromString "00006905-0000-4b28-0000-4f8000006bc4"))), - (Id (fromJust (UUID.fromString "00002b89-0000-6331-0000-2454000078ed"))) - ] - } - -testObject_UserIdList_user_8 :: UserIdList -testObject_UserIdList_user_8 = - UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "00006018-0000-11b4-0000-5ec9000055b8"))), - (Id (fromJust (UUID.fromString "00003821-0000-3e6a-0000-3aa700004795"))), - (Id (fromJust (UUID.fromString "0000568c-0000-0356-0000-256800003649"))), - (Id (fromJust (UUID.fromString "00006785-0000-22d1-0000-28b600005ad4"))), - (Id (fromJust (UUID.fromString "00004e5a-0000-4a75-0000-7cd9000070f3"))), - (Id (fromJust (UUID.fromString "00004f38-0000-634b-0000-592a000052ce"))), - (Id (fromJust (UUID.fromString "000018ef-0000-6096-0000-4c27000077a9"))), - (Id (fromJust (UUID.fromString "00006b68-0000-1635-0000-00f500005881"))), - (Id (fromJust (UUID.fromString "0000705a-0000-4cd5-0000-52b800003a1e"))), - (Id (fromJust (UUID.fromString "00003472-0000-10e6-0000-1d090000296f"))), - (Id (fromJust (UUID.fromString "000067de-0000-6f44-0000-737200006fa5"))), - (Id (fromJust (UUID.fromString "000052d9-0000-5da4-0000-1fd500001ed9"))), - (Id (fromJust (UUID.fromString "0000360d-0000-6b29-0000-077400006824"))) - ] - } - -testObject_UserIdList_user_9 :: UserIdList -testObject_UserIdList_user_9 = - UserIdList {mUsers = [(Id (fromJust (UUID.fromString "0000570a-0000-5a69-0000-1c9800004362")))]} - -testObject_UserIdList_user_10 :: UserIdList -testObject_UserIdList_user_10 = - UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "00007d3a-0000-274d-0000-60d30000649e"))), - (Id (fromJust (UUID.fromString "0000076b-0000-3498-0000-201000006c19"))), - (Id (fromJust (UUID.fromString "00001127-0000-360e-0000-200800005676"))), - (Id (fromJust (UUID.fromString "00004b6f-0000-117f-0000-753a000059af"))), - (Id (fromJust (UUID.fromString "00004e1e-0000-5c17-0000-2e9b00003c3c"))), - (Id (fromJust (UUID.fromString "000049f3-0000-357d-0000-08d100007d04"))), - (Id (fromJust (UUID.fromString "00007911-0000-165f-0000-65cf000042c4"))), - (Id (fromJust (UUID.fromString "00005806-0000-60de-0000-69a800001c33"))), - (Id (fromJust (UUID.fromString "00001f13-0000-136d-0000-09c700001d28"))), - (Id (fromJust (UUID.fromString "00002ad6-0000-0ac3-0000-487300006508"))), - (Id (fromJust (UUID.fromString "00001a5f-0000-2abd-0000-269b000060c8"))), - (Id (fromJust (UUID.fromString "0000353f-0000-2e6c-0000-2e34000054ed"))), - (Id (fromJust (UUID.fromString "00001e1c-0000-459c-0000-15e30000794b"))), - (Id (fromJust (UUID.fromString "0000438f-0000-648c-0000-74e80000312c"))), - (Id (fromJust (UUID.fromString "00001066-0000-6ae8-0000-0f6d0000425e"))) - ] - } - -testObject_UserIdList_user_11 :: UserIdList -testObject_UserIdList_user_11 = - UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "000065a9-0000-3824-0000-1ed6000057c6"))), - (Id (fromJust (UUID.fromString "00005b8d-0000-1869-0000-680700005032"))), - (Id (fromJust (UUID.fromString "0000365f-0000-551a-0000-7d0900001d6e"))), - (Id (fromJust (UUID.fromString "0000039c-0000-7b9d-0000-7aa000001451"))), - (Id (fromJust (UUID.fromString "00002513-0000-3d17-0000-421a00003bfc"))), - (Id (fromJust (UUID.fromString "000046d5-0000-732d-0000-59a200006a59"))), - (Id (fromJust (UUID.fromString "000014a8-0000-5605-0000-13e900001592"))), - (Id (fromJust (UUID.fromString "00000c47-0000-33b7-0000-22e800003986"))), - (Id (fromJust (UUID.fromString "00003535-0000-16cc-0000-3aff000023de"))), - (Id (fromJust (UUID.fromString "00007306-0000-331a-0000-35b700005dda"))), - (Id (fromJust (UUID.fromString "0000622d-0000-4ae3-0000-097d00004749"))), - (Id (fromJust (UUID.fromString "000079eb-0000-4569-0000-5f6300003edd"))) - ] - } - -testObject_UserIdList_user_12 :: UserIdList -testObject_UserIdList_user_12 = - UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "00005029-0000-72f0-0000-336b00006f4f"))), - (Id (fromJust (UUID.fromString "00006963-0000-6a5c-0000-6324000004da"))), - (Id (fromJust (UUID.fromString "00006b5c-0000-0d3a-0000-67ee00004dc1"))), - (Id (fromJust (UUID.fromString "0000460c-0000-2a56-0000-675700006f01"))) - ] - } - -testObject_UserIdList_user_13 :: UserIdList -testObject_UserIdList_user_13 = - UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "00007e2c-0000-5526-0000-56800000687c"))), - (Id (fromJust (UUID.fromString "000016e5-0000-1850-0000-292500002219"))), - (Id (fromJust (UUID.fromString "00001468-0000-5564-0000-543600003ac1"))), - (Id (fromJust (UUID.fromString "00006b03-0000-167e-0000-7b8e00002ee5"))), - (Id (fromJust (UUID.fromString "000043f5-0000-6b28-0000-0a7c00007696"))), - (Id (fromJust (UUID.fromString "000058e0-0000-6cd1-0000-234f0000285e"))), - (Id (fromJust (UUID.fromString "000063a3-0000-7ec0-0000-3fd8000016ba"))), - (Id (fromJust (UUID.fromString "00003b25-0000-41cc-0000-1dbd000043c3"))), - (Id (fromJust (UUID.fromString "00002d8e-0000-68eb-0000-6002000054eb"))), - (Id (fromJust (UUID.fromString "000010a2-0000-09ce-0000-1aa400001a6c"))), - (Id (fromJust (UUID.fromString "00003d21-0000-21dc-0000-6bff00004d6b"))), - (Id (fromJust (UUID.fromString "0000102e-0000-29ed-0000-1cff00005b6e"))), - (Id (fromJust (UUID.fromString "00002291-0000-26bb-0000-797c000059ac"))), - (Id (fromJust (UUID.fromString "00003e11-0000-5333-0000-5f6000000c6a"))), - (Id (fromJust (UUID.fromString "000029c2-0000-7b08-0000-081d000023b2"))), - (Id (fromJust (UUID.fromString "000042ac-0000-76e5-0000-2c5d00007bb7"))), - (Id (fromJust (UUID.fromString "00005cff-0000-7936-0000-718400003158"))), - (Id (fromJust (UUID.fromString "00000e72-0000-60bd-0000-1bbd000008a8"))), - (Id (fromJust (UUID.fromString "00004c5b-0000-7c3e-0000-613000002c7a"))), - (Id (fromJust (UUID.fromString "00004e00-0000-6f46-0000-241400001912"))), - (Id (fromJust (UUID.fromString "000040a6-0000-5656-0000-15c4000060c9"))), - (Id (fromJust (UUID.fromString "00001763-0000-1497-0000-0f0e0000100a"))) - ] - } - -testObject_UserIdList_user_14 :: UserIdList -testObject_UserIdList_user_14 = - UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "00005371-0000-333e-0000-046b00003ee8"))), - (Id (fromJust (UUID.fromString "000066f7-0000-68de-0000-05a40000453a"))), - (Id (fromJust (UUID.fromString "00003195-0000-0b96-0000-688400007308"))) - ] - } - -testObject_UserIdList_user_15 :: UserIdList -testObject_UserIdList_user_15 = - UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "0000383c-0000-2fc6-0000-355a00007abe"))), - (Id (fromJust (UUID.fromString "00006d0d-0000-0165-0000-0350000057e7"))), - (Id (fromJust (UUID.fromString "00006569-0000-5731-0000-14e600003715"))), - (Id (fromJust (UUID.fromString "000063bc-0000-17c0-0000-615500007af1"))), - (Id (fromJust (UUID.fromString "000067d2-0000-1718-0000-300900007c08"))), - (Id (fromJust (UUID.fromString "00004db5-0000-7e5c-0000-40cc00003bdc"))), - (Id (fromJust (UUID.fromString "00001670-0000-7f3c-0000-31ed00003328"))), - (Id (fromJust (UUID.fromString "00005de1-0000-248d-0000-5ea800000a69"))), - (Id (fromJust (UUID.fromString "00003fac-0000-25c3-0000-39400000248e"))), - (Id (fromJust (UUID.fromString "00007b41-0000-5aea-0000-445700006bda"))), - (Id (fromJust (UUID.fromString "00002087-0000-6b5a-0000-23570000290b"))), - (Id (fromJust (UUID.fromString "00006845-0000-7619-0000-310000001832"))), - (Id (fromJust (UUID.fromString "00006a49-0000-1378-0000-4e0e000049f5"))), - (Id (fromJust (UUID.fromString "00006036-0000-7f5e-0000-628400001f05"))), - (Id (fromJust (UUID.fromString "00001266-0000-3242-0000-194400005728"))), - (Id (fromJust (UUID.fromString "000079b9-0000-5069-0000-79830000595f"))), - (Id (fromJust (UUID.fromString "00005496-0000-3751-0000-54f600006784"))), - (Id (fromJust (UUID.fromString "0000400a-0000-7b4a-0000-559500007ef3"))), - (Id (fromJust (UUID.fromString "000061e1-0000-4949-0000-34b200006b28"))), - (Id (fromJust (UUID.fromString "000005e6-0000-1d9e-0000-1c3300001caf"))), - (Id (fromJust (UUID.fromString "00005e3b-0000-5b40-0000-01bb00006c1c"))), - (Id (fromJust (UUID.fromString "00007c72-0000-28d6-0000-11e300007b78"))) - ] - } - -testObject_UserIdList_user_16 :: UserIdList -testObject_UserIdList_user_16 = - UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "000026c7-0000-0033-0000-2014000031e7"))), - (Id (fromJust (UUID.fromString "00003cdb-0000-53ee-0000-144200006978"))), - (Id (fromJust (UUID.fromString "00001249-0000-1c38-0000-18a5000004c8"))), - (Id (fromJust (UUID.fromString "00002679-0000-291d-0000-4ca000007e7d"))), - (Id (fromJust (UUID.fromString "00004619-0000-7bb1-0000-6c45000075a6"))), - (Id (fromJust (UUID.fromString "000059cf-0000-3ac0-0000-4894000010d4"))), - (Id (fromJust (UUID.fromString "000014cc-0000-22ec-0000-2d550000621a"))), - (Id (fromJust (UUID.fromString "00003881-0000-564d-0000-6622000055da"))), - (Id (fromJust (UUID.fromString "000043d4-0000-72b6-0000-6ae90000353a"))) - ] - } - -testObject_UserIdList_user_17 :: UserIdList -testObject_UserIdList_user_17 = - UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "00002b7d-0000-5bc9-0000-035000007afb"))), - (Id (fromJust (UUID.fromString "000021be-0000-40a5-0000-5db300004d94"))), - (Id (fromJust (UUID.fromString "0000470a-0000-222a-0000-1568000003e3"))), - (Id (fromJust (UUID.fromString "00002450-0000-39d6-0000-4a67000052a8"))), - (Id (fromJust (UUID.fromString "00007d85-0000-3ef9-0000-2f0500000643"))), - (Id (fromJust (UUID.fromString "000052b0-0000-4b58-0000-543a00003878"))), - (Id (fromJust (UUID.fromString "00001990-0000-31fe-0000-5c93000049b8"))), - (Id (fromJust (UUID.fromString "00002581-0000-5a19-0000-4d8f00000e45"))), - (Id (fromJust (UUID.fromString "00006737-0000-2cce-0000-44d200003bbd"))), - (Id (fromJust (UUID.fromString "00000cf1-0000-28ff-0000-044b00006008"))), - (Id (fromJust (UUID.fromString "00007520-0000-7c57-0000-7bad00007dc1"))), - (Id (fromJust (UUID.fromString "00005377-0000-60ab-0000-04ca00005b16"))), - (Id (fromJust (UUID.fromString "000039ec-0000-76ff-0000-6b6c000068c0"))), - (Id (fromJust (UUID.fromString "00007cf6-0000-6c44-0000-2d1300007bfa"))), - (Id (fromJust (UUID.fromString "00000618-0000-2eb8-0000-252100006a8b"))), - (Id (fromJust (UUID.fromString "0000504e-0000-2e31-0000-2ea80000515e"))), - (Id (fromJust (UUID.fromString "000029f7-0000-14ba-0000-31be000077e6"))), - (Id (fromJust (UUID.fromString "00003583-0000-6dfa-0000-0f4b00004456"))), - (Id (fromJust (UUID.fromString "00000eb3-0000-194b-0000-70a500004525"))), - (Id (fromJust (UUID.fromString "00003776-0000-5375-0000-178300003d0e"))), - (Id (fromJust (UUID.fromString "000012bf-0000-2aca-0000-257b00007eae"))), - (Id (fromJust (UUID.fromString "00003a60-0000-4129-0000-5d53000038b2"))), - (Id (fromJust (UUID.fromString "000057c0-0000-5741-0000-540500006241"))), - (Id (fromJust (UUID.fromString "0000465b-0000-7f77-0000-4489000011dc"))) - ] - } - -testObject_UserIdList_user_18 :: UserIdList -testObject_UserIdList_user_18 = - UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "00005eaf-0000-0a0c-0000-708200004f52"))), - (Id (fromJust (UUID.fromString "00000a66-0000-0e2f-0000-50bd00000f87"))), - (Id (fromJust (UUID.fromString "000076cd-0000-6e88-0000-7770000063f6"))), - (Id (fromJust (UUID.fromString "0000778c-0000-5664-0000-794f0000043b"))), - (Id (fromJust (UUID.fromString "00007208-0000-3872-0000-02ed00000f4f"))), - (Id (fromJust (UUID.fromString "00005e23-0000-63aa-0000-79ce000057f7"))), - (Id (fromJust (UUID.fromString "000070c8-0000-7458-0000-60aa00001369"))), - (Id (fromJust (UUID.fromString "000066a6-0000-1ef7-0000-067a00004ffe"))), - (Id (fromJust (UUID.fromString "00007803-0000-07ad-0000-5b870000060e"))), - (Id (fromJust (UUID.fromString "0000378c-0000-3f22-0000-18dd00004d2e"))) - ] - } - -testObject_UserIdList_user_19 :: UserIdList -testObject_UserIdList_user_19 = - UserIdList {mUsers = [(Id (fromJust (UUID.fromString "00000a5c-0000-1b8a-0000-40540000722c")))]} - -testObject_UserIdList_user_20 :: UserIdList -testObject_UserIdList_user_20 = - UserIdList - { mUsers = - [ (Id (fromJust (UUID.fromString "00002a17-0000-1192-0000-1abc00002c72"))), - (Id (fromJust (UUID.fromString "00007465-0000-4fc4-0000-65d800005f03"))), - (Id (fromJust (UUID.fromString "000070d0-0000-39dd-0000-77e500002b92"))), - (Id (fromJust (UUID.fromString "00006ab3-0000-39de-0000-46bb00005b6f"))), - (Id (fromJust (UUID.fromString "0000574d-0000-70b6-0000-4d7f00002f31"))), - (Id (fromJust (UUID.fromString "0000354b-0000-19be-0000-01a60000559c"))), - (Id (fromJust (UUID.fromString "00005874-0000-10bf-0000-2103000005c6"))), - (Id (fromJust (UUID.fromString "00006ff2-0000-27ae-0000-277300004981"))), - (Id (fromJust (UUID.fromString "00004ed4-0000-7160-0000-6c8800000920"))), - (Id (fromJust (UUID.fromString "0000670f-0000-0657-0000-6b4400002b61"))), - (Id (fromJust (UUID.fromString "000078e9-0000-1cd5-0000-545c00004e6d"))), - (Id (fromJust (UUID.fromString "000072b4-0000-0476-0000-23e900005e9f"))), - (Id (fromJust (UUID.fromString "00001462-0000-5092-0000-183800005cf3"))), - (Id (fromJust (UUID.fromString "000012f0-0000-7993-0000-787b00003a59"))), - (Id (fromJust (UUID.fromString "000046b4-0000-2d69-0000-1d91000065dc"))), - (Id (fromJust (UUID.fromString "000040f4-0000-3b05-0000-002800001adf"))), - (Id (fromJust (UUID.fromString "00006feb-0000-20d6-0000-69b700006097"))), - (Id (fromJust (UUID.fromString "000013e5-0000-185e-0000-39f300007306"))) - ] - } diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual.hs index bd7fd0d8b03..e13083c4dce 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual.hs @@ -29,6 +29,7 @@ import Test.Wire.API.Golden.Manual.FeatureConfigEvent import Test.Wire.API.Golden.Manual.GetPaginatedConversationIds import Test.Wire.API.Golden.Manual.QualifiedUserClientPrekeyMap import Test.Wire.API.Golden.Manual.UserClientPrekeyMap +import Test.Wire.API.Golden.Manual.UserIdList import Test.Wire.API.Golden.Runner tests :: TestTree @@ -88,5 +89,10 @@ tests = [ (testObject_FeatureConfigEvent_1, "testObject_FeatureConfigEvent_1.json"), (testObject_FeatureConfigEvent_2, "testObject_FeatureConfigEvent_2.json"), (testObject_FeatureConfigEvent_3, "testObject_FeatureConfigEvent_3.json") + ], + testCase "UserIdsList" $ + testObjects + [ (testObject_UserIdList_1, "testObject_UserIdList_1.json"), + (testObject_UserIdList_2, "testObject_UserIdList_2.json") ] ] diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/UserIdList.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/UserIdList.hs new file mode 100644 index 00000000000..ab184f7bcf5 --- /dev/null +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/UserIdList.hs @@ -0,0 +1,26 @@ +module Test.Wire.API.Golden.Manual.UserIdList where + +import Data.Id (Id (Id)) +import qualified Data.UUID as UUID +import Imports +import Wire.API.User (UserIdList (..)) + +testObject_UserIdList_1 :: UserIdList +testObject_UserIdList_1 = + UserIdList + [ Id (fromJust (UUID.fromString "0000304a-0000-0d5e-0000-3fac00003993")), + Id (fromJust (UUID.fromString "00003c90-0000-2207-0000-5249000018b1")), + Id (fromJust (UUID.fromString "000016ee-0000-1c33-0000-6684000050e6")), + Id (fromJust (UUID.fromString "0000366d-0000-7f19-0000-4153000039a6")), + Id (fromJust (UUID.fromString "00002f85-0000-30dc-0000-4cb700001c44")), + Id (fromJust (UUID.fromString "000056c8-0000-0828-0000-0a31000012b6")), + Id (fromJust (UUID.fromString "00001d2d-0000-74ae-0000-44fc00000eba")), + Id (fromJust (UUID.fromString "00001b2c-0000-651e-0000-12d9000068dd")), + Id (fromJust (UUID.fromString "00006a07-0000-7703-0000-6c1000002889")), + Id (fromJust (UUID.fromString "00001e50-0000-2dd8-0000-0c7a000053f0")), + Id (fromJust (UUID.fromString "00003842-0000-2193-0000-275c00004421")) + ] + +testObject_UserIdList_2 :: UserIdList +testObject_UserIdList_2 = + UserIdList [] diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 76a60c29555..a70062305e8 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 9152de17654638a8439538e5d42de1b136055ce828561a44f3ca3e3b3d28fdba +-- hash: 2e4bca56fcdff432834ff4ef0e7678b73cafc509219dd2b1b0f6308dca6a2588 name: wire-api version: 0.1.0 @@ -52,6 +52,7 @@ library Wire.API.Routes.Public Wire.API.Routes.Public.Brig Wire.API.Routes.Public.Galley + Wire.API.Routes.Public.Galley.Responses Wire.API.Routes.Public.LegalHold Wire.API.Routes.Public.Spar Wire.API.Routes.QualifiedCapture @@ -85,6 +86,7 @@ library Wire.API.User.Scim Wire.API.User.Search Wire.API.UserMap + Wire.API.Util.Aeson Wire.API.Wrapped other-modules: Paths_wire_api @@ -385,7 +387,6 @@ test-suite wire-api-tests Test.Wire.API.Golden.Generated.UserConnectionList_user Test.Wire.API.Golden.Generated.UserHandleInfo_user Test.Wire.API.Golden.Generated.UserIdentity_user - Test.Wire.API.Golden.Generated.UserIdList_user Test.Wire.API.Golden.Generated.UserLegalHoldStatusResponse_team Test.Wire.API.Golden.Generated.UserProfile_user Test.Wire.API.Golden.Generated.UserSSOId_user @@ -406,6 +407,7 @@ test-suite wire-api-tests Test.Wire.API.Golden.Manual.ListConversations Test.Wire.API.Golden.Manual.QualifiedUserClientPrekeyMap Test.Wire.API.Golden.Manual.UserClientPrekeyMap + Test.Wire.API.Golden.Manual.UserIdList Test.Wire.API.Golden.Protobuf Test.Wire.API.Golden.Runner Test.Wire.API.Roundtrip.Aeson diff --git a/services/brig/src/Brig/API/Connection.hs b/services/brig/src/Brig/API/Connection.hs index bebd60ecd10..47144bcad1c 100644 --- a/services/brig/src/Brig/API/Connection.hs +++ b/services/brig/src/Brig/API/Connection.hs @@ -22,7 +22,6 @@ -- User connection logic. module Brig.API.Connection ( -- * Connections - autoConnect, createConnection, updateConnection, UpdateConnectionsInternal (..), @@ -45,7 +44,6 @@ import qualified Brig.Data.User as Data import qualified Brig.IO.Intra as Intra import Brig.Options (setUserMaxConnections) import Brig.Types -import Brig.Types.Intra import Brig.Types.User.Event import Control.Error import Control.Lens (view) @@ -54,9 +52,7 @@ import Data.Id as Id import qualified Data.LegalHold as LH import Data.Proxy (Proxy (Proxy)) import Data.Range -import qualified Data.Set as Set import Galley.Types (ConvType (..), cnvType) -import qualified Galley.Types.Teams as Team import Imports import qualified System.Logger.Class as Log import System.Logger.Message @@ -420,51 +416,6 @@ updateConnectionInternal = \case SentWithHistory -> SentWithHistory CancelledWithHistory -> CancelledWithHistory -autoConnect :: - UserId -> - Set UserId -> - Maybe ConnId -> - ExceptT ConnectionError AppIO [UserConnection] -autoConnect from (Set.toList -> to) conn = do - selfActive <- lift $ Data.isActivated from - -- FIXME: checkLimit from - -- Checking the limit here is currently a too heavy operation - -- for this code path and needs to be optimised / rethought. - unless selfActive $ - throwE ConnectNoIdentity - othersActive <- lift $ Data.filterActive to - nonTeamMembers <- filterOutTeamMembers othersActive - lift $ connectAll nonTeamMembers - where - filterOutTeamMembers us = do - -- FUTUREWORK: This is only used for test purposes. If getTeamContacts is truncated - -- tests might fail in strange ways. Maybe we want to fail hard if this - -- returns a truncated list. I think the whole function can be removed. - mems <- lift $ Intra.getTeamContacts from - return $ maybe us (Team.notTeamMember us . view Team.teamMembers) mems - connectAll activeOthers = do - others <- selectOthers activeOthers - convs <- mapM (createConv from) others - self <- Data.lookupName from - ucs <- Data.connectUsers from convs - let events = map (toEvent self) ucs - forM_ events $ Intra.onConnectionEvent from conn - return ucs - -- Assumption: if there's an existing connection, don't touch it. - -- The exception to this rule _could_ be a sent/pending connection - -- but for sure we would not override states like `blocked` and `ignored` - -- For simplicity, let's just not touch them. - selectOthers usrs = do - existing <- map csFrom <$> Data.lookupConnectionStatus usrs [from] - return $ filter (`notElem` existing) usrs - createConv s o = do - c <- Intra.createConnectConv s o Nothing Nothing conn - _ <- Intra.acceptConnectConv o conn c - return (o, c) - -- Note: The events sent to the users who got auto-connected to 'from' - -- get the user name of the user whom they got connected to included. - toEvent self uc = ConnectionUpdated uc Nothing (mfilter (const $ ucFrom uc /= from) self) - lookupConnections :: UserId -> Maybe UserId -> Range 1 500 Int32 -> AppIO UserConnectionList lookupConnections from start size = do rs <- Data.lookupConnections from start size diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 8ddce1cd3d1..825c58a7121 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -124,20 +124,6 @@ sitemap = do get "/i/status" (continue $ const $ return empty) true head "/i/status" (continue $ const $ return empty) true - -- This endpoint can lead to the following events being sent: - -- - ConnectionUpdated event to the user and all users connecting with - -- - ConvCreate event to the user for each connect conversation that did not exist before - -- (via galley) - -- - ConvConnect event to the user for each connection that was not already accepted by the - -- other - -- - MemberJoin event to the user and other for each connection that was not already - -- accepted by the other - post "/i/users/:uid/auto-connect" (continue autoConnectH) $ - accept "application" "json" - .&. capture "uid" - .&. opt zauthConnId - .&. jsonRequest @UserSet - -- This endpoint can lead to the following events being sent: -- - UserActivated event to created user, if it is a team invitation or user has an SSO ID -- - UserIdentityUpdated event to created user, if email or phone get activated @@ -346,21 +332,6 @@ internalListFullClients :: UserSet -> AppIO UserClientsFull internalListFullClients (UserSet usrs) = UserClientsFull <$> Data.lookupClientsBulk (Set.toList usrs) -autoConnectH :: JSON ::: UserId ::: Maybe ConnId ::: JsonRequest UserSet -> Handler Response -autoConnectH (_ ::: uid ::: conn ::: req) = do - json <$> (autoConnect uid conn =<< parseJsonBody req) - -autoConnect :: UserId -> Maybe ConnId -> UserSet -> Handler [UserConnection] -autoConnect uid conn (UserSet to) = do - let num = Set.size to - when (num < 1) $ - throwStd $ - badRequest "No users given for auto-connect." - when (num > 25) $ - throwStd $ - badRequest "Too many users given for auto-connect (> 25)." - API.autoConnect uid to conn !>> connError - createUserNoVerifyH :: JSON ::: JsonRequest NewUser -> Handler Response createUserNoVerifyH (_ ::: req) = do CreateUserNoVerifyResponse uid prof <- createUserNoVerify =<< parseJsonBody req diff --git a/services/brig/src/Brig/Data/Connection.hs b/services/brig/src/Brig/Data/Connection.hs index 1988b94a5a3..6f53afde9ed 100644 --- a/services/brig/src/Brig/Data/Connection.hs +++ b/services/brig/src/Brig/Data/Connection.hs @@ -19,7 +19,6 @@ module Brig.Data.Connection ( module T, - connectUsers, insertConnection, updateConnection, lookupConnection, @@ -50,20 +49,6 @@ import Imports import UnliftIO.Async (pooledMapConcurrentlyN_) import Wire.API.Connection -connectUsers :: UserId -> [(UserId, ConvId)] -> AppIO [UserConnection] -connectUsers from to = do - now <- toUTCTimeMillis <$> liftIO getCurrentTime - retry x5 . batch $ do - setType BatchLogged - setConsistency Quorum - forM_ to $ \(u, c) -> do - addPrepQuery connectionInsert (from, u, AcceptedWithHistory, now, Nothing, c) - addPrepQuery connectionInsert (u, from, AcceptedWithHistory, now, Nothing, c) - return . concat . (`map` to) $ \(u, c) -> - [ UserConnection from u Accepted now Nothing (Just c), - UserConnection u from Accepted now Nothing (Just c) - ] - insertConnection :: -- | From UserId -> diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index 29571b6a182..277058debf1 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/services/brig/test/integration/API/Provider.hs @@ -66,7 +66,7 @@ import Data.Time.Clock import Data.Timeout (TimedOut (..), Timeout, TimeoutUnit (..), (#)) import qualified Data.UUID as UUID import qualified Data.ZAuth.Token as ZAuth -import Galley.Types (Access (..), AccessRole (..), ConvMembers (..), Conversation (..), ConversationAccessUpdate (..), Event (..), EventData (..), EventType (..), NewConv (..), NewConvUnmanaged (..), OtherMember (..), OtrMessage (..), SimpleMember (..), SimpleMembers (..), UserIdList (..)) +import Galley.Types (Access (..), AccessRole (..), ConvMembers (..), Conversation (..), ConversationAccessUpdate (..), Event (..), EventData (..), EventType (..), NewConv (..), NewConvUnmanaged (..), OtherMember (..), OtrMessage (..), QualifiedUserIdList (..), SimpleMember (..), SimpleMembers (..)) import Galley.Types.Bot (ServiceRef, newServiceRef, serviceRefId, serviceRefProvider) import Galley.Types.Conversations.Roles (roleNameWireAdmin) import qualified Galley.Types.Teams as Team @@ -514,8 +514,8 @@ testDeleteService config db brig galley cannon = withTestService config db brig _ <- waitFor (5 # Second) not (isMember galley buid2 cid) getBotConv galley bid1 cid !!! const 404 === statusCode getBotConv galley bid2 cid !!! const 404 === statusCode - wsAssertMemberLeave ws qcid qbuid1 [buid1] - wsAssertMemberLeave ws qcid qbuid2 [buid2] + wsAssertMemberLeave ws qcid qbuid1 [qbuid1] + wsAssertMemberLeave ws qcid qbuid2 [qbuid2] -- The service should not be available getService brig pid sid !!! const 404 === statusCode @@ -624,8 +624,8 @@ testBotTeamOnlyConv config db brig galley cannon = withTestService config db bri quid1 (ConversationAccessUpdate [InviteAccess] TeamAccessRole) qcid - svcAssertMemberLeave buf qbuid [buid] qcid - wsAssertMemberLeave ws qcid qbuid [buid] + svcAssertMemberLeave buf qbuid [qbuid] qcid + wsAssertMemberLeave ws qcid qbuid [qbuid] where setAccessRole uid cid role = updateConversationAccess galley uid cid [InviteAccess] role @@ -898,8 +898,8 @@ testWhitelistKickout localDomain config db brig galley cannon = do _ <- waitFor (2 # Second) not (isMember galley buid cid) getBotConv galley bid cid !!! const 404 === statusCode - wsAssertMemberLeave ws qcid qowner [buid] - svcAssertMemberLeave buf qowner [buid] qcid + wsAssertMemberLeave ws qcid qowner [qbuid] + svcAssertMemberLeave buf qowner [qbuid] qcid -- The bot should not get any further events liftIO $ timeout (2 # Second) (readChan buf) >>= \case @@ -1685,7 +1685,7 @@ wsAssertMemberJoin ws conv usr new = void $ evtFrom e @?= usr evtData e @?= EdMembersJoin (SimpleMembers (fmap (\u -> SimpleMember u roleNameWireAdmin) new)) -wsAssertMemberLeave :: MonadIO m => WS.WebSocket -> Qualified ConvId -> Qualified UserId -> [UserId] -> m () +wsAssertMemberLeave :: MonadIO m => WS.WebSocket -> Qualified ConvId -> Qualified UserId -> [Qualified UserId] -> m () wsAssertMemberLeave ws conv usr old = void $ liftIO $ WS.assertMatch (5 # Second) ws $ @@ -1695,7 +1695,7 @@ wsAssertMemberLeave ws conv usr old = void $ evtConv e @?= conv evtType e @?= MemberLeave evtFrom e @?= usr - evtData e @?= EdMembersLeave (UserIdList old) + evtData e @?= EdMembersLeave (QualifiedUserIdList old) wsAssertConvDelete :: MonadIO m => WS.WebSocket -> Qualified ConvId -> Qualified UserId -> m () wsAssertConvDelete ws conv from = void $ @@ -1733,12 +1733,12 @@ svcAssertMemberJoin buf usr new cnv = liftIO $ do assertEqual "event data" (EdMembersJoin msg) (evtData e) _ -> assertFailure "Event timeout (TestBotMessage: member-join)" -svcAssertMemberLeave :: MonadIO m => Chan TestBotEvent -> Qualified UserId -> [UserId] -> Qualified ConvId -> m () +svcAssertMemberLeave :: MonadIO m => Chan TestBotEvent -> Qualified UserId -> [Qualified UserId] -> Qualified ConvId -> m () svcAssertMemberLeave buf usr gone cnv = liftIO $ do evt <- timeout (5 # Second) $ readChan buf case evt of Just (TestBotMessage e) -> do - let msg = UserIdList gone + let msg = QualifiedUserIdList gone assertEqual "event type" MemberLeave (evtType e) assertEqual "conv" cnv (evtConv e) assertEqual "user" usr (evtFrom e) @@ -1920,9 +1920,9 @@ testAddRemoveBotUtil localDomain pid sid cid u1 u2 h sref buf brig galley cannon let Just ev = rsRemoveBotEvent <$> responseJsonMaybe _rs liftIO $ assertEqual "bot event" MemberLeave (evtType ev) -- Events for both users - forM_ [ws1, ws2] $ \ws -> wsAssertMemberLeave ws qcid quid2 [buid] + forM_ [ws1, ws2] $ \ws -> wsAssertMemberLeave ws qcid quid2 [Qualified buid localDomain] -- Event for the bot - svcAssertMemberLeave buf quid2 [buid] qcid + svcAssertMemberLeave buf quid2 [Qualified buid localDomain] qcid -- Empty 204 response if the bot is not in the conversation removeBot brig uid2 cid bid !!! const 204 === statusCode -- Check that the bot no longer has access to the conversation @@ -1982,7 +1982,7 @@ testMessageBotUtil quid uc cid pid sid sref buf brig galley cannon = do _ <- waitFor (5 # Second) not (isMember galley buid cid) getBotConv galley bid cid !!! const 404 === statusCode - wsAssertMemberLeave ws qcid qbuid [buid] + wsAssertMemberLeave ws qcid qbuid [qbuid] prepareBotUsersTeam :: HasCallStack => diff --git a/services/brig/test/integration/API/User/Connection.hs b/services/brig/test/integration/API/User/Connection.hs index e1c476d02ba..b9f5c768316 100644 --- a/services/brig/test/integration/API/User/Connection.hs +++ b/services/brig/test/integration/API/User/Connection.hs @@ -29,16 +29,12 @@ import qualified Brig.Options as Opt import Brig.Types import Brig.Types.Intra import Control.Arrow ((&&&)) -import Data.Aeson import Data.ByteString.Conversion import Data.Id hiding (client) import qualified Data.UUID.V4 as UUID -import Data.Vector (Vector) -import qualified Data.Vector as Vec import Galley.Types import Imports import qualified Network.Wai.Utilities.Error as Error -import Safe hiding (at) import Test.Tasty hiding (Timeout) import Test.Tasty.HUnit import Util @@ -61,11 +57,7 @@ tests cl _at _conf p b _c g = test p "put /connections/:id bad update" $ testBadUpdateConnection b, test p "put /connections/:id noop" $ testUpdateConnectionNoop b, test p "get /connections - 200 (paging)" $ testConnectionPaging b, - test p "post /connections - 400 (max conns)" $ testConnectionLimit b cl, - -- FUTUREWORK: auto-connect may be out of use, check and if possible remove! - test p "post /i/users/auto-connect" $ testAutoConnectionOK b g, - test p "post /i/users/auto-connect - existing conn" $ testAutoConnectionNoChanges b, - test p "post /i/users/auto-connect - 400 (bad range)" $ testAutoConnectionBadRequest b + test p "post /connections - 400 (max conns)" $ testConnectionLimit b cl ] testCreateConnectionInvalidUser :: Brig -> Http () @@ -364,57 +356,3 @@ testConnectionLimit brig (ConnectionLimit l) = do assertLimited = do const 403 === statusCode const (Just "connection-limit") === fmap Error.label . responseJsonMaybe - -testAutoConnectionOK :: Brig -> Galley -> Http () -testAutoConnectionOK brig galley = do - uid1 <- userId <$> randomUser brig - uid2 <- userId <$> randomUser brig - bdy <- - postAutoConnection brig uid1 [uid2] do - b <- responseBody r - Vec.length <$> (decode b :: Maybe (Vector UserConnection)) - assertConnections brig uid1 [ConnectionStatus uid1 uid2 Accepted] - assertConnections brig uid2 [ConnectionStatus uid2 uid1 Accepted] - case responseJsonMaybe bdy >>= headMay >>= ucConvId of - Nothing -> liftIO $ assertFailure "incomplete connection" - Just cnv -> do - getConversation galley uid1 cnv !!! do - const 200 === statusCode - const (Just One2OneConv) === fmap cnvType . responseJsonMaybe - getConversation galley uid2 cnv !!! do - const 200 === statusCode - const (Just One2OneConv) === fmap cnvType . responseJsonMaybe - -testAutoConnectionNoChanges :: Brig -> Http () -testAutoConnectionNoChanges brig = do - uid1 <- userId <$> randomUser brig - uid2 <- userId <$> randomUser brig - postConnection brig uid1 uid2 !!! const 201 === statusCode - -- This is effectively a no-op - postAutoConnection brig uid1 [uid2] !!! do - const 200 === statusCode - const (Just 0) === \r -> do - b <- responseBody r - Vec.length <$> (decode b :: Maybe (Vector UserConnection)) - -testAutoConnectionBadRequest :: Brig -> Http () -testAutoConnectionBadRequest brig = do - uid1 <- userId <$> randomUser brig - -- no users - postAutoConnection brig uid1 [] !!! const 400 === statusCode - -- too many users - uids <- replicateM 26 (liftIO $ Id <$> UUID.nextRandom) - postAutoConnection brig uid1 uids !!! const 400 === statusCode - -- unactivated / unverified self user - uid2 <- userId <$> createAnonUser "foo2" brig - postAutoConnection brig uid2 (take 1 uids) !!! do - const 403 === statusCode - const (Just "no-identity") === fmap Error.label . responseJsonMaybe - -- unactivated / unverified target users simply get filtered out - postAutoConnection brig uid1 [uid2] !!! do - const 200 === statusCode - const (Just 0) === \r -> do - b <- responseBody r - Vec.length <$> (decode b :: Maybe (Vector UserConnection)) diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index a74cdf81458..fd09bb6c81c 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -42,7 +42,6 @@ import Data.Handle (Handle (Handle)) import Data.Id hiding (client) import Data.Misc (PlainTextPassword (..)) import Data.Range (unsafeRange) -import qualified Data.Set as Set import qualified Data.Text.Ascii as Ascii import qualified Data.Vector as Vec import Imports @@ -246,17 +245,6 @@ listConnections brig u = . path "connections" . zUser u -postAutoConnection :: Brig -> UserId -> [UserId] -> (MonadIO m, MonadHttp m) => m ResponseLBS -postAutoConnection brig from to = - post $ - brig - . paths ["/i/users", toByteString' from, "auto-connect"] - . contentJson - . body payload - . zConn "conn" - where - payload = RequestBodyLBS . encode $ UserSet (Set.fromList to) - setProperty :: Brig -> UserId -> ByteString -> Value -> (MonadIO m, MonadHttp m) => m ResponseLBS setProperty brig u k v = put $ diff --git a/services/brig/test/integration/Federation/End2end.hs b/services/brig/test/integration/Federation/End2end.hs index c8bd07c3ed3..ad66dad6c99 100644 --- a/services/brig/test/integration/Federation/End2end.hs +++ b/services/brig/test/integration/Federation/End2end.hs @@ -90,6 +90,8 @@ spec _brigOpts mg brig galley cannon _federator brigTwo galleyTwo = test mg "list user clients" $ testListUserClients brig brigTwo, test mg "list own conversations" $ testListConversations brig brigTwo galley galleyTwo, test mg "add remote users to local conversation" $ testAddRemoteUsersToLocalConv brig galley brigTwo galleyTwo, + test mg "remove remote user from a local conversation" $ testRemoveRemoteUserFromLocalConv brig galley brigTwo galleyTwo, + test mg "leave a remote conversation" $ leaveRemoteConversation brig galley brigTwo galleyTwo, test mg "include remote users to new conversation" $ testRemoteUsersInNewConv brig galley brigTwo galleyTwo, test mg "send a message to a remote user" $ testSendMessage brig brigTwo galleyTwo cannon, test mg "send a message in a remote conversation" $ testSendMessageToRemoteConv brig brigTwo galley galleyTwo cannon @@ -274,6 +276,80 @@ testAddRemoteUsersToLocalConv brig1 galley1 brig2 galley2 = do expected' = [OtherMember (userQualifiedId alice) Nothing roleNameWireAdmin] liftIO $ actual' @?= expected' +testRemoveRemoteUserFromLocalConv :: Brig -> Galley -> Brig -> Galley -> Http () +testRemoveRemoteUserFromLocalConv brig1 galley1 brig2 galley2 = do + alice <- randomUser brig1 + bob <- randomUser brig2 + let aliceId = userQualifiedId alice + let bobId = userQualifiedId bob + + convId <- cnvQualifiedId . responseJsonUnsafe <$> createConversation galley1 (userId alice) [bobId] + + aliceConvBeforeDelete :: Conversation <- responseJsonUnsafe <$> getConversationQualified galley1 (userId alice) convId + liftIO $ map omQualifiedId (cmOthers (cnvMembers aliceConvBeforeDelete)) @?= [bobId] + + bobConvBeforeDelete :: Conversation <- responseJsonUnsafe <$> getConversationQualified galley2 (userId bob) convId + liftIO $ map omQualifiedId (cmOthers (cnvMembers bobConvBeforeDelete)) @?= [aliceId] + + -- Alice kicks Bob out of the conversation + delete + ( galley1 + . paths + [ "conversations", + (toByteString' . qDomain) convId, + (toByteString' . qUnqualified) convId, + "members", + (toByteString' . qDomain) bobId, + (toByteString' . qUnqualified) bobId + ] + . zUser (userId alice) + . zConn "conn" + ) + !!! const 200 === statusCode + + aliceConvAfterDelete :: Conversation <- responseJsonUnsafe <$> getConversationQualified galley1 (userId alice) convId + liftIO $ map omQualifiedId (cmOthers (cnvMembers aliceConvAfterDelete)) @?= [] + + getConversationQualified galley2 (userId bob) convId + !!! const 404 === statusCode + +leaveRemoteConversation :: Brig -> Galley -> Brig -> Galley -> Http () +leaveRemoteConversation brig1 galley1 brig2 galley2 = do + alice <- randomUser brig1 + bob <- randomUser brig2 + let aliceId = userQualifiedId alice + let bobId = userQualifiedId bob + + convId <- cnvQualifiedId . responseJsonUnsafe <$> createConversation galley1 (userId alice) [bobId] + + aliceConvBeforeDelete :: Conversation <- responseJsonUnsafe <$> getConversationQualified galley1 (userId alice) convId + liftIO $ map omQualifiedId (cmOthers (cnvMembers aliceConvBeforeDelete)) @?= [bobId] + + bobConvBeforeDelete :: Conversation <- responseJsonUnsafe <$> getConversationQualified galley2 (userId bob) convId + liftIO $ map omQualifiedId (cmOthers (cnvMembers bobConvBeforeDelete)) @?= [aliceId] + + -- Bob leaves the conversation + delete + ( galley2 + . paths + [ "conversations", + (toByteString' . qDomain) convId, + (toByteString' . qUnqualified) convId, + "members", + (toByteString' . qDomain) bobId, + (toByteString' . qUnqualified) bobId + ] + . zUser (userId bob) + . zConn "conn" + ) + !!! const 200 === statusCode + + aliceConvAfterDelete :: Conversation <- responseJsonUnsafe <$> getConversationQualified galley1 (userId alice) convId + liftIO $ map omQualifiedId (cmOthers (cnvMembers aliceConvAfterDelete)) @?= [] + + getConversationQualified galley2 (userId bob) convId + !!! const 404 === statusCode + -- | This creates a new conversation with a remote user. The test checks that -- Galleys on both ends of the federation see the same conversation members. testRemoteUsersInNewConv :: Brig -> Galley -> Brig -> Galley -> Http () @@ -324,7 +400,6 @@ testListUserClients brig1 brig2 = do -- - conversation can be queried and shows members (galley1) -- - conversation can be queried and shows members (galley2 via qualified get conversation endpoint) -- - testListConversations :: Brig -> Brig -> Galley -> Galley -> Http () testListConversations brig1 brig2 galley1 galley2 = do alice <- randomUser brig1 diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index 6e2679fd437..c904204c408 100644 --- a/services/brig/test/integration/Util.hs +++ b/services/brig/test/integration/Util.hs @@ -53,7 +53,7 @@ import Data.Id import Data.List1 (List1) import qualified Data.List1 as List1 import Data.Misc (PlainTextPassword (..)) -import Data.Qualified (Qualified) +import Data.Qualified (Qualified (qDomain, qUnqualified)) import qualified Data.Text as Text import qualified Data.Text.Ascii as Ascii import Data.Text.Encoding (encodeUtf8) @@ -537,6 +537,13 @@ getConversation galley usr cnv = . paths ["conversations", toByteString' cnv] . zAuthAccess usr "conn" +getConversationQualified :: (MonadIO m, MonadHttp m) => Galley -> UserId -> Qualified ConvId -> m ResponseLBS +getConversationQualified galley usr cnv = + get $ + galley + . paths ["conversations", toByteString' (qDomain cnv), toByteString' (qUnqualified cnv)] + . zAuthAccess usr "conn" + createConversation :: (MonadIO m, MonadHttp m) => Galley -> UserId -> [Qualified UserId] -> m ResponseLBS createConversation galley zusr usersToAdd = do let conv = NewConvUnmanaged $ NewConv [] usersToAdd (Just "gossip") mempty Nothing Nothing Nothing Nothing roleNameWireAdmin diff --git a/services/federator/Makefile b/services/federator/Makefile index 6b3ace808e4..ab00a615232 100644 --- a/services/federator/Makefile +++ b/services/federator/Makefile @@ -34,7 +34,7 @@ i-list: $(EXE_IT) -s $(NAME).integration.yaml -i ../integration.yaml -l i-%: - INTEGRATION_USE_NGINZ=$(INTEGRATION_USE_NGINZ) ../integration.sh $(EXE_IT) -s $(NAME).integration.yaml -i ../integration.yaml -p "$*" $(WIRE_INTEGRATION_TEST_OPTIONS) + INTEGRATION_USE_NGINZ=$(INTEGRATION_USE_NGINZ) ../integration.sh $(EXE_IT) -s $(NAME).integration.yaml -i ../integration.yaml -m "$*" $(WIRE_INTEGRATION_TEST_OPTIONS) .PHONY: integration integration: fast i diff --git a/services/federator/federator.cabal b/services/federator/federator.cabal index 5f5836d0f9b..30ce16ef3d6 100644 --- a/services/federator/federator.cabal +++ b/services/federator/federator.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 7ae942605e2cd7ddc1fc423b068b429970064332a02e90994295385a0722d1b9 +-- hash: aef5b26595440dc41b2afea5b58468827dd4bdc290b406e49e8e2263ad2a81ad name: federator version: 1.0.0 @@ -17,13 +17,19 @@ license: AGPL-3 build-type: Simple extra-source-files: test/resources/integration-ca.pem + test/resources/integration-leaf-key.pem + test/resources/integration-leaf.pem + test/resources/unit/example.com.pem test/resources/unit/gen-certs.sh + test/resources/unit/invalid.pem test/resources/unit/localhost-dot-key.pem test/resources/unit/localhost-dot.pem test/resources/unit/localhost-key.pem test/resources/unit/localhost.example.com-key.pem test/resources/unit/localhost.example.com.pem test/resources/unit/localhost.pem + test/resources/unit/second-federator.example.com-key.pem + test/resources/unit/second-federator.example.com.pem test/resources/unit/unit-ca-key.pem test/resources/unit/unit-ca.pem @@ -73,6 +79,7 @@ library , mu-grpc-server , mu-rpc , network-uri + , pem , polysemy , polysemy-wire-zoo , retry @@ -86,7 +93,9 @@ library , unliftio , uri-bytestring , uuid + , wai , wai-utilities + , warp , wire-api , wire-api-federation , x509 @@ -131,6 +140,7 @@ executable federator , mu-grpc-server , mu-rpc , network-uri + , pem , polysemy , polysemy-wire-zoo , retry @@ -144,7 +154,9 @@ executable federator , unliftio , uri-bytestring , uuid + , wai , wai-utilities + , warp , wire-api , wire-api-federation , x509 @@ -196,6 +208,7 @@ executable federator-integration , mu-rpc , network-uri , optparse-applicative + , pem , polysemy , polysemy-wire-zoo , random @@ -212,7 +225,9 @@ executable federator-integration , unliftio , uri-bytestring , uuid + , wai , wai-utilities + , warp , wire-api , wire-api-federation , x509 @@ -256,6 +271,7 @@ test-suite federator-tests , http2-client , http2-client-grpc , imports + , interpolate , lens , metrics-core , metrics-wai @@ -264,6 +280,7 @@ test-suite federator-tests , mu-grpc-server , mu-rpc , network-uri + , pem , polysemy , polysemy-mocks , polysemy-wire-zoo diff --git a/services/federator/federator.integration.yaml b/services/federator/federator.integration.yaml index 9afe9b38575..5e450f0efc0 100644 --- a/services/federator/federator.integration.yaml +++ b/services/federator/federator.integration.yaml @@ -32,3 +32,8 @@ optSettings: # - example.com useSystemCAStore: true + + clientCertificate: "test/resources/integration-leaf.pem" + clientPrivateKey: "test/resources/integration-leaf-key.pem" + dnsHost: "127.0.0.1" + dnsPort: 9053 diff --git a/services/federator/package.yaml b/services/federator/package.yaml index acc6c7280d3..ceff6710be0 100644 --- a/services/federator/package.yaml +++ b/services/federator/package.yaml @@ -11,19 +11,22 @@ license: AGPL-3 extra-source-files: test/resources/**/* dependencies: - aeson -- http-types -- either - base - bilge - bytestring - data-default - dns - dns-util +- either - exceptions - extended -- http-client +- HsOpenSSL +- HsOpenSSL-x509-system - http2-client - http2-client-grpc +- http-client +- http-client-openssl +- http-types - imports - lens - metrics-core @@ -32,29 +35,29 @@ dependencies: - mu-grpc-client - mu-grpc-server - mu-rpc +- network-uri +- pem +- polysemy +- polysemy-wire-zoo +- retry - servant - servant-server - string-conversions - text -- tls -- x509-store -- x509-system - tinylog +- tls - types-common +- unliftio +- uri-bytestring - uuid +- wai +- wai-utilities +- warp - wire-api - wire-api-federation -- polysemy -- polysemy-wire-zoo -- retry -- HsOpenSSL -- HsOpenSSL-x509-system -- http-client-openssl -- unliftio -- wai-utilities -- network-uri -- uri-bytestring - x509 +- x509-store +- x509-system - x509-validation library: @@ -98,6 +101,7 @@ tests: dependencies: - bytestring - federator + - interpolate - polysemy-mocks - streaming-commons - tasty diff --git a/services/federator/src/Federator/Discovery.hs b/services/federator/src/Federator/Discovery.hs index d792de335dd..3d90175418c 100644 --- a/services/federator/src/Federator/Discovery.hs +++ b/services/federator/src/Federator/Discovery.hs @@ -18,11 +18,13 @@ module Federator.Discovery where import Data.Domain (Domain, domainText) +import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NonEmpty import Data.String.Conversions (cs) import Imports import qualified Network.DNS as DNS import Polysemy +import qualified Polysemy.Error as Polysemy import Polysemy.TinyLog (TinyLog) import qualified Polysemy.TinyLog as TinyLog import qualified System.Logger.Class as Log @@ -37,28 +39,46 @@ data LookupError data DiscoverFederator m a where DiscoverFederator :: Domain -> DiscoverFederator m (Either LookupError SrvTarget) + DiscoverAllFederators :: Domain -> DiscoverFederator m (Either LookupError (NonEmpty SrvTarget)) makeSem ''DiscoverFederator +discoverFederatorWithError :: + Members '[DiscoverFederator, Polysemy.Error LookupError] r => + Domain -> + Sem r SrvTarget +discoverFederatorWithError = Polysemy.fromEither <=< discoverFederator + +discoverAllFederatorsWithError :: + Members '[DiscoverFederator, Polysemy.Error LookupError] r => + Domain -> + Sem r (NonEmpty SrvTarget) +discoverAllFederatorsWithError = Polysemy.fromEither <=< discoverAllFederators + runFederatorDiscovery :: Members '[DNSLookup, TinyLog] r => Sem (DiscoverFederator ': r) a -> Sem r a -runFederatorDiscovery = interpret $ \(DiscoverFederator d) -> - -- FUTUREWORK(federation): This string conversation is probably wrong, we should encode this - -- using IDNA encoding or expect domain to be bytestring everywhere - let domainSrv = cs $ "_wire-server-federator._tcp." <> domainText d - in lookupDomainByDNS domainSrv +runFederatorDiscovery = interpret $ \case + DiscoverFederator d -> + -- FUTUREWORK(federation): orderSrvResult and try the list in order this + -- will make it not federator specific and then we can move this whole + -- function to dns-util + NonEmpty.head <$$> lookupDomainByDNS (domainSrv d) + DiscoverAllFederators d -> lookupDomainByDNS (domainSrv d) + where + -- FUTUREWORK(federation): This string conversion is wrong, we should encode + -- this using IDNA encoding or expect domain to be bytestring everywhere + domainSrv d = cs $ "_wire-server-federator._tcp." <> domainText d -lookupDomainByDNS :: Members '[DNSLookup, TinyLog] r => ByteString -> Sem r (Either LookupError SrvTarget) +lookupDomainByDNS :: Members '[DNSLookup, TinyLog] r => ByteString -> Sem r (Either LookupError (NonEmpty SrvTarget)) lookupDomainByDNS domainSrv = do res <- Lookup.lookupSRV domainSrv case res of - SrvAvailable entries -> do - -- FUTUREWORK(federation): orderSrvResult and try the list in order this will make it - -- not federator specific and then we can move this whole function to - -- dns-util - pure $ Right $ srvTarget $ NonEmpty.head entries - SrvNotAvailable -> pure $ Left $ LookupErrorSrvNotAvailable domainSrv - -- Name error also means that the record is not available - SrvResponseError DNS.NameError -> pure $ Left $ LookupErrorSrvNotAvailable domainSrv + SrvAvailable entries -> + pure $ Right $ srvTarget <$> entries + SrvNotAvailable -> + pure $ Left $ LookupErrorSrvNotAvailable domainSrv + SrvResponseError DNS.NameError -> + -- Name error also means that the record is not available + pure $ Left $ LookupErrorSrvNotAvailable domainSrv SrvResponseError err -> do TinyLog.err $ Log.msg ("DNS Lookup failed" :: ByteString) . Log.field "error" (show err) pure $ Left $ LookupErrorDNSError domainSrv diff --git a/services/federator/src/Federator/Env.hs b/services/federator/src/Federator/Env.hs index e9d24574994..71d1f17817c 100644 --- a/services/federator/src/Federator/Env.hs +++ b/services/federator/src/Federator/Env.hs @@ -28,9 +28,15 @@ import Data.X509.CertificateStore import Federator.Options (RunSettings) import Network.DNS.Resolver (Resolver) import qualified Network.HTTP.Client as HTTP +import qualified Network.TLS as TLS import qualified System.Logger.Class as LC import Wire.API.Federation.GRPC.Types +data TLSSettings = TLSSettings + { _caStore :: CertificateStore, + _creds :: TLS.Credential + } + data Env = Env { _metrics :: Metrics, _applog :: LC.Logger, @@ -39,7 +45,8 @@ data Env = Env _runSettings :: RunSettings, _service :: Component -> RPC.Request, _httpManager :: HTTP.Manager, - _caStore :: CertificateStore + _tls :: TLSSettings } +makeLenses ''TLSSettings makeLenses ''Env diff --git a/services/federator/src/Federator/ExternalServer.hs b/services/federator/src/Federator/ExternalServer.hs index 199d8edd0e2..40039d2b37c 100644 --- a/services/federator/src/Federator/ExternalServer.hs +++ b/services/federator/src/Federator/ExternalServer.hs @@ -23,22 +23,26 @@ module Federator.ExternalServer where import Control.Lens (view) import Data.Aeson (decode) +import Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as LBS import Data.String.Conversions (cs) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Federator.App (Federator, runAppT) -import Federator.Env (Env, applog, runSettings) +import Federator.Discovery +import Federator.Env (Env, applog, dnsResolver, runSettings) import Federator.Options (RunSettings) import Federator.Service (Service, interpretService, serviceCall) import Federator.Utils.PolysemyServerError (absorbServerError) import Federator.Validation import Imports -import Mu.GRpc.Server (msgProtoBuf, runGRpcAppTrans) +import Mu.GRpc.Server (gRpcAppTrans, msgProtoBuf) import Mu.Server (ServerError, ServerErrorIO, SingleServerT, singleService) import qualified Mu.Server as Mu -import qualified Network.HTTP.Types.Status as HTTP -import qualified Network.Wai.Utilities.Error as WaiError +import qualified Network.HTTP.Types as HTTP +import qualified Network.Wai as Wai +import qualified Network.Wai.Handler.Warp as Wai +import qualified Network.Wai.Utilities.Error as Wai import Polysemy import qualified Polysemy.Error as Polysemy import Polysemy.IO (embedToMonadIO) @@ -47,32 +51,32 @@ import Polysemy.TinyLog (TinyLog) import qualified Polysemy.TinyLog as Log import qualified System.Logger.Message as Log import Wire.API.Federation.GRPC.Types +import Wire.Network.DNS.Effect as Polysemy -- FUTUREWORK(federation): Versioning of the federation API. See -- https://higherkindness.io/mu-haskell/registry/ for some mu-haskell support -- for versioning schemas here. -- https://wearezeta.atlassian.net/wiki/spaces/CORE/pages/224166764/Limiting+access+to+federation+endpoints --- --- FUTUREWORK(federation): implement server2server authentication! --- (current validation only checks parsing and compares to allowList) -callLocal :: (Members '[Service, Embed IO, TinyLog, Polysemy.Reader RunSettings] r) => Request -> Sem r InwardResponse -callLocal = runInwardError . callLocal' - where - runInwardError :: Sem (Polysemy.Error InwardError ': r) ByteString -> Sem r InwardResponse - runInwardError action = toResponse <$> Polysemy.runError action - - toResponse :: Either InwardError ByteString -> InwardResponse - toResponse (Left err) = InwardResponseError err - toResponse (Right bs) = InwardResponseBody bs - -callLocal' :: (Members '[Service, Embed IO, TinyLog, Polysemy.Reader RunSettings, Polysemy.Error InwardError] r) => Request -> Sem r ByteString -callLocal' req@Request {..} = do +callLocal :: + ( Members + '[ Service, + Embed IO, + TinyLog, + DiscoverFederator, + Polysemy.Reader RunSettings + ] + r + ) => + Maybe ByteString -> + Request -> + Sem r InwardResponse +callLocal mcert req@Request {..} = runInwardError $ do Log.debug $ Log.msg ("Inward Request" :: ByteString) . Log.field "request" (show req) - validatedDomain <- validateDomain originDomain + validatedDomain <- validateDomain mcert originDomain validatedPath <- sanitizePath path Log.debug $ Log.msg ("Path validation" :: ByteString) @@ -85,21 +89,47 @@ callLocal' req@Request {..} = do case HTTP.statusCode resStatus of 200 -> pure $ maybe mempty LBS.toStrict resBody 404 -> - case WaiError.label <$> (decode =<< resBody) of + case Wai.label <$> (decode =<< resBody) of Just "no-endpoint" -> throwInward IInvalidEndpoint (cs $ "component " <> show component <> "does not have an endpoint " <> cs validatedPath) _ -> throwInward IOther (cs $ show resStatus) code -> do let description = "Invalid HTTP status from component: " <> Text.pack (show code) <> " " <> Text.decodeUtf8 (HTTP.statusMessage resStatus) <> " Response body: " <> maybe mempty cs resBody throwInward IOther description + where + runInwardError :: Sem (Polysemy.Error InwardError ': r) ByteString -> Sem r InwardResponse + runInwardError action = toResponse <$> Polysemy.runError action + + toResponse :: Either InwardError ByteString -> InwardResponse + toResponse (Left err) = InwardResponseError err + toResponse (Right bs) = InwardResponseBody bs + +routeToInternal :: + (Members '[Service, Embed IO, Polysemy.Error ServerError, TinyLog, DiscoverFederator, Polysemy.Reader RunSettings] r) => + Maybe ByteString -> + SingleServerT info Inward (Sem r) _ +routeToInternal cert = singleService (Mu.method @"call" (callLocal cert)) -routeToInternal :: (Members '[Service, Embed IO, Polysemy.Error ServerError, TinyLog, Polysemy.Reader RunSettings] r) => SingleServerT info Inward (Sem r) _ -routeToInternal = singleService (Mu.method @"call" callLocal) +lookupCertificate :: Wai.Request -> Maybe ByteString +lookupCertificate req = HTTP.urlDecode True <$> lookup "X-SSL-Certificate" (Wai.requestHeaders req) serveInward :: Env -> Int -> IO () serveInward env port = do - runGRpcAppTrans msgProtoBuf port transformer routeToInternal + let app req = gRpcAppTrans msgProtoBuf transformer (routeToInternal (lookupCertificate req)) req + Wai.run port app where - transformer :: Sem '[TinyLog, Embed IO, Polysemy.Error ServerError, Service, Polysemy.Reader RunSettings, Embed Federator] a -> ServerErrorIO a + transformer :: + Sem + '[ DiscoverFederator, + DNSLookup, + TinyLog, + Embed IO, + Polysemy.Error ServerError, + Service, + Polysemy.Reader RunSettings, + Embed Federator + ] + a -> + ServerErrorIO a transformer action = runAppT env . runM @Federator @@ -108,4 +138,6 @@ serveInward env port = do . absorbServerError . embedToMonadIO @Federator . Log.runTinyLog (view applog env) + . Polysemy.runDNSLookupWithResolver (view dnsResolver env) + . runFederatorDiscovery $ action diff --git a/services/federator/src/Federator/InternalServer.hs b/services/federator/src/Federator/InternalServer.hs index 1a95a1d3f16..49d77c860b0 100644 --- a/services/federator/src/Federator/InternalServer.hs +++ b/services/federator/src/Federator/InternalServer.hs @@ -28,7 +28,7 @@ import qualified Data.Text.Encoding as Text import Data.X509.CertificateStore import Federator.App (Federator, runAppT) import Federator.Discovery (DiscoverFederator, LookupError (LookupErrorDNSError, LookupErrorSrvNotAvailable), runFederatorDiscovery) -import Federator.Env (Env, applog, caStore, dnsResolver, runSettings) +import Federator.Env (Env, TLSSettings, applog, caStore, dnsResolver, runSettings, tls) import Federator.Options (RunSettings) import Federator.Remote (Remote, RemoteError (..), discoverAndCall, interpretRemote) import Federator.Utils.PolysemyServerError (absorbServerError) @@ -104,7 +104,7 @@ serveOutward env port = do Polysemy.Error ServerError, Embed IO, Polysemy.Reader RunSettings, - Polysemy.Reader CertificateStore, + Polysemy.Reader TLSSettings, Embed Federator ] a -> @@ -112,7 +112,7 @@ serveOutward env port = do transformer action = runAppT env . runM -- Embed Federator - . Polysemy.runReader (view caStore env) -- Reader CertificateStore + . Polysemy.runReader (view tls env) -- Reader TLSSettings . Polysemy.runReader (view runSettings env) -- Reader RunSettings . embedToMonadIO @Federator -- Embed IO . absorbServerError diff --git a/services/federator/src/Federator/Options.hs b/services/federator/src/Federator/Options.hs index 42f5b11c898..6df11978d84 100644 --- a/services/federator/src/Federator/Options.hs +++ b/services/federator/src/Federator/Options.hs @@ -62,9 +62,13 @@ data RunSettings = RunSettings { -- | Would you like to federate with everyone or only with a select set of other wire-server installations? federationStrategy :: FederationStrategy, useSystemCAStore :: Bool, - remoteCAStore :: Maybe FilePath + remoteCAStore :: Maybe FilePath, + clientCertificate :: FilePath, + clientPrivateKey :: FilePath, + dnsHost :: Maybe String, + dnsPort :: Maybe Word16 } - deriving (Show, Generic) + deriving (Eq, Show, Generic) instance FromJSON RunSettings diff --git a/services/federator/src/Federator/Remote.hs b/services/federator/src/Federator/Remote.hs index 3339f103171..f61595350b1 100644 --- a/services/federator/src/Federator/Remote.hs +++ b/services/federator/src/Federator/Remote.hs @@ -17,23 +17,32 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Federator.Remote where +module Federator.Remote + ( Remote, + RemoteError (..), + discoverAndCall, + interpretRemote, + mkGrpcClient, + blessedCiphers, + ) +where +import Control.Lens ((^.)) import Data.Default (def) import Data.Domain (Domain, domainText) import Data.String.Conversions (cs) import qualified Data.X509 as X509 -import Data.X509.CertificateStore import qualified Data.X509.Validation as X509 import Federator.Discovery (DiscoverFederator, LookupError, discoverFederator) +import Federator.Env (TLSSettings, caStore, creds) import Federator.Options +import Federator.Validation import Imports import Mu.GRpc.Client.Optics (GRpcReply) import Mu.GRpc.Client.Record (GRpcMessageProtocol (MsgProtoBuf)) import Mu.GRpc.Client.TyApps (gRpcCall) import Network.GRPC.Client.Helpers -import Network.TLS -import qualified Network.TLS as TLS +import Network.TLS as TLS import qualified Network.TLS.Extra.Cipher as TLS import Polysemy import qualified Polysemy.Error as Polysemy @@ -57,7 +66,7 @@ data Remote m a where makeSem ''Remote interpretRemote :: - (Members [Embed IO, DiscoverFederator, TinyLog, Polysemy.Reader RunSettings, Polysemy.Reader CertificateStore] r) => + (Members [Embed IO, DiscoverFederator, TinyLog, Polysemy.Reader RunSettings, Polysemy.Reader TLSSettings] r) => Sem (Remote ': r) a -> Sem r a interpretRemote = interpret $ \case @@ -81,14 +90,31 @@ callInward :: MonadIO m => GrpcClient -> Request -> m (GRpcReply InwardResponse) callInward client request = liftIO $ gRpcCall @'MsgProtoBuf @Inward @"Inward" @"call" client request +-- FUTUREWORK: get review on blessed ciphers +blessedCiphers :: [Cipher] +blessedCiphers = + [ TLS.cipher_TLS13_AES128CCM8_SHA256, + TLS.cipher_TLS13_AES128CCM_SHA256, + TLS.cipher_TLS13_AES128GCM_SHA256, + TLS.cipher_TLS13_AES256GCM_SHA384, + TLS.cipher_TLS13_CHACHA20POLY1305_SHA256, + -- For TLS 1.2 (copied from default nginx ingress config): + TLS.cipher_ECDHE_ECDSA_AES256GCM_SHA384, + TLS.cipher_ECDHE_RSA_AES256GCM_SHA384, + TLS.cipher_ECDHE_RSA_AES128GCM_SHA256, + TLS.cipher_ECDHE_ECDSA_AES128GCM_SHA256, + TLS.cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256, + TLS.cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256 + ] + -- FUTUREWORK(federation): Consider using HsOpenSSL instead of tls for better -- security and to avoid having to depend on cryptonite and override validation -- hooks. This might involve forking http2-client: https://github.com/lucasdicioccio/http2-client/issues/76 --- FUTUREWORK(federation): Allow a configurable trust store to be used in TLS certificate validation +-- FUTUREWORK(federation): Use openssl -- See also https://github.com/lucasdicioccio/http2-client/issues/76 -- FUTUREWORK(federation): Cache this client and use it for many requests mkGrpcClient :: - Members '[Embed IO, TinyLog, Polysemy.Reader CertificateStore] r => + Members '[Embed IO, TinyLog, Polysemy.Reader TLSSettings] r => SrvTarget -> Sem r (Either RemoteError GrpcClient) mkGrpcClient target@(SrvTarget host port) = logAndReturn target $ do @@ -99,37 +125,13 @@ mkGrpcClient target@(SrvTarget host port) = logAndReturn target $ do -- and use it when making a request let cfg = grpcClientConfigSimple (cs host) (fromInteger $ toInteger port) True - -- FUTUREWORK: get review on blessed ciphers - let blessed_ciphers = - [ TLS.cipher_TLS13_AES128CCM8_SHA256, - TLS.cipher_TLS13_AES128CCM_SHA256, - TLS.cipher_TLS13_AES128GCM_SHA256, - TLS.cipher_TLS13_AES256GCM_SHA384, - TLS.cipher_TLS13_CHACHA20POLY1305_SHA256, - -- For TLS 1.2 (copied from default nginx ingress config): - TLS.cipher_ECDHE_ECDSA_AES256GCM_SHA384, - TLS.cipher_ECDHE_RSA_AES256GCM_SHA384, - TLS.cipher_ECDHE_RSA_AES128GCM_SHA256, - TLS.cipher_ECDHE_ECDSA_AES128GCM_SHA256, - TLS.cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256, - TLS.cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256 - ] - - caStore <- Polysemy.ask - - -- validate the hostname without a trailing dot as the certificate is not - -- expected to have the trailing dot. - let stripDot hostname - | "." `isSuffixOf` hostname = take (length hostname - 1) hostname - | otherwise = hostname - let validateName hostname cert = - TLS.hookValidateName X509.defaultHooks (stripDot hostname) cert + settings <- Polysemy.ask let tlsConfig = (defaultParamsClient (cs host) (cs $ show port)) { TLS.clientSupported = def - { TLS.supportedCiphers = blessed_ciphers, + { TLS.supportedCiphers = blessedCiphers, -- FUTUREWORK: Figure out if we can drop TLS 1.2 TLS.supportedVersions = [TLS.TLS12, TLS.TLS13] }, @@ -138,11 +140,11 @@ mkGrpcClient target@(SrvTarget host port) = logAndReturn target $ do { TLS.onServerCertificate = X509.validate X509.HashSHA256 - (X509.defaultHooks {TLS.hookValidateName = validateName}) - X509.defaultChecks + (X509.defaultHooks {X509.hookValidateName = validateDomainName}) + X509.defaultChecks, + TLS.onCertificateRequest = \_ -> pure (Just (settings ^. creds)) }, - -- FUTUREWORK: use onCertificateRequest to provide client certificates - TLS.clientShared = def {TLS.sharedCAStore = caStore} + TLS.clientShared = def {TLS.sharedCAStore = settings ^. caStore} } let cfg' = cfg {_grpcClientConfigTLS = Just tlsConfig} Polysemy.mapError (RemoteErrorClientFailure target) diff --git a/services/federator/src/Federator/Run.hs b/services/federator/src/Federator/Run.hs index 6faa0be985b..5f3c52db448 100644 --- a/services/federator/src/Federator/Run.hs +++ b/services/federator/src/Federator/Run.hs @@ -26,17 +26,19 @@ module Federator.Run -- * App Environment newEnv, - mkCAStore, + mkTLSSettings, + FederationSetupError (..), closeEnv, ) where import qualified Bilge as RPC -import Control.Exception (throw) +import Control.Exception (handle, throw) import Control.Lens ((^.)) import Data.Default (def) import qualified Data.Metrics.Middleware as Metrics import Data.Text.Encoding (encodeUtf8) +import qualified Data.X509 as X509 import Data.X509.CertificateStore import Federator.Env import Federator.ExternalServer (serveInward) @@ -45,6 +47,7 @@ import Federator.Options as Opt import Imports import qualified Network.DNS as DNS import qualified Network.HTTP.Client as HTTP +import qualified Network.TLS as TLS import qualified Polysemy import qualified Polysemy.Error as Polysemy import qualified System.Logger.Class as Log @@ -65,8 +68,9 @@ import qualified Wire.Network.DNS.Helper as DNS -- "merged" using Servant's 'Raw' type (like in 'brig') with servant's http -- endpoints and exposed on the same port. run :: Opts -> IO () -run opts = - DNS.withCachingResolver $ \res -> +run opts = do + let resolvConf = mkResolvConf (optSettings opts) DNS.defaultResolvConf + DNS.withCachingResolver resolvConf $ \res -> bracket (newEnv opts res) closeEnv $ \env -> do let externalServer = serveInward env portExternal internalServer = serveOutward env portInternal @@ -80,13 +84,24 @@ run opts = endpointExternal = federatorExternal opts portExternal = fromIntegral $ endpointExternal ^. epPort + mkResolvConf :: RunSettings -> DNS.ResolvConf -> DNS.ResolvConf + mkResolvConf settings conf = + case (dnsHost settings, dnsPort settings) of + (Just host, Nothing) -> + conf {DNS.resolvInfo = DNS.RCHostName host} + (Just host, Just port) -> + conf {DNS.resolvInfo = DNS.RCHostPort host (fromIntegral port)} + (_, _) -> conf + ------------------------------------------------------------------------------- -- Environment -newtype InvalidCAStore = InvalidCAStore FilePath +data FederationSetupError + = InvalidCAStore FilePath + | InvalidClientCertificate String deriving (Show) -instance Exception InvalidCAStore +instance Exception FederationSetupError newEnv :: Opts -> DNS.Resolver -> IO Env newEnv o _dnsResolver = do @@ -97,7 +112,7 @@ newEnv o _dnsResolver = do let _service Brig = mkEndpoint (Opt.brig o) _service Galley = mkEndpoint (Opt.galley o) _httpManager <- initHttpManager - _caStore <- mkCAStore _runSettings + _tls <- mkTLSSettings _runSettings return Env {..} where mkEndpoint s = RPC.host (encodeUtf8 (s ^. epHost)) . RPC.port (s ^. epPort) $ RPC.empty @@ -113,17 +128,32 @@ mkCAStore settings = do else pure mempty pure (customCAStore <> systemCAStore) +mkCreds :: RunSettings -> IO TLS.Credential +mkCreds settings = + handle h $ + TLS.credentialLoadX509 (clientCertificate settings) (clientPrivateKey settings) + >>= \case + Left e -> throw (InvalidClientCertificate e) + Right (X509.CertificateChain [], _) -> + throw (InvalidClientCertificate "could not read client certificate") + Right x -> pure x + where + h :: IOException -> IO a + h = throw . InvalidClientCertificate . show + +mkTLSSettings :: RunSettings -> IO TLSSettings +mkTLSSettings settings = + TLSSettings + <$> mkCAStore settings + <*> mkCreds settings + closeEnv :: Env -> IO () closeEnv e = do Log.flush $ e ^. applog Log.close $ e ^. applog --- | Copied (and adjusted) from brig, do we want to put this somehwere common? --- FUTUREWORK(federation): review certificate and protocol security setting for this TLS --- manager initHttpManager :: IO HTTP.Manager initHttpManager = - -- See Note [SSL context] HTTP.newManager HTTP.defaultManagerSettings { HTTP.managerConnCount = 1024, diff --git a/services/federator/src/Federator/Validation.hs b/services/federator/src/Federator/Validation.hs index 71499347416..27f135c960f 100644 --- a/services/federator/src/Federator/Validation.hs +++ b/services/federator/src/Federator/Validation.hs @@ -20,19 +20,30 @@ module Federator.Validation validateDomain, throwInward, sanitizePath, + validateDomainName, ) where +import Data.Bifunctor (first) import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as B8 import Data.Domain (Domain, domainText, mkDomain) +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.PEM as X509 import Data.String.Conversions (cs) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import qualified Data.X509 as X509 +import qualified Data.X509.Validation as X509 +import Federator.Discovery import Federator.Options import Imports -import Polysemy (Members, Sem) +import Polysemy (Member, Members, Sem) import qualified Polysemy.Error as Polysemy import qualified Polysemy.Reader as Polysemy import URI.ByteString import Wire.API.Federation.GRPC.Types +import Wire.Network.DNS.SRV (SrvTarget (..)) -- | Validates an already-parsed domain against the allowList using the federator -- startup configuration. @@ -43,12 +54,53 @@ federateWith targetDomain = do AllowAll -> True AllowList (AllowedDomains domains) -> targetDomain `elem` domains --- | Validates an unknown domain string against the allowList using the federator startup configuration -validateDomain :: Members '[Polysemy.Reader RunSettings, Polysemy.Error InwardError] r => Text -> Sem r Domain -validateDomain unparsedDomain = do +decodeCertificate :: + Member (Polysemy.Error InwardError) r => + ByteString -> + Sem r X509.Certificate +decodeCertificate = + Polysemy.fromEither + . first (InwardError IAuthenticationFailed . Text.pack) + . ( (pure . X509.getCertificate) + <=< X509.decodeSignedCertificate + <=< (pure . X509.pemContent) + <=< expectOne "certificate" + <=< X509.pemParseBS + ) + where + expectOne :: String -> [a] -> Either String a + expectOne label [] = Left $ "no " <> label <> " found" + expectOne _ [x] = pure x + expectOne label _ = Left $ "found multiple " <> label <> "s" + +-- | Validates an unknown domain string against the allowList using the +-- federator startup configuration and checks that it matches the names reported +-- by the client certificate +validateDomain :: + Members + '[ Polysemy.Reader RunSettings, + Polysemy.Error InwardError, + DiscoverFederator + ] + r => + Maybe ByteString -> + Text -> + Sem r Domain +validateDomain Nothing _ = throwInward IAuthenticationFailed "no client certificate provided" +validateDomain (Just encodedCertificate) unparsedDomain = do targetDomain <- case mkDomain unparsedDomain of - Left parseErr -> throwInward IInvalidDomain (errDomainParsing parseErr) + Left parseErr -> throwInward IAuthenticationFailed (errDomainParsing parseErr) Right d -> pure d + + -- run discovery to find the hostname of the client federator + certificate <- decodeCertificate encodedCertificate + hostnames <- + srvTargetDomain + <$$> Polysemy.mapError (InwardError IDiscoveryFailed . errDiscovery) (discoverAllFederatorsWithError targetDomain) + let validationErrors = (\h -> validateDomainName (B8.unpack h) certificate) <$> hostnames + unless (any null validationErrors) $ + throwInward IAuthenticationFailed ("none of the domain names match the certificate, errrors: " <> (Text.pack . show . NonEmpty.toList $ validationErrors)) + passAllowList <- federateWith targetDomain if passAllowList then pure targetDomain @@ -60,6 +112,10 @@ validateDomain unparsedDomain = do errAllowList :: Domain -> Text errAllowList domain = "Origin domain [" <> domainText domain <> "] not in the federation allow list" + errDiscovery :: LookupError -> Text + errDiscovery (LookupErrorSrvNotAvailable msg) = "srv record not found: " <> Text.decodeUtf8 msg + errDiscovery (LookupErrorDNSError msg) = "DNS error: " <> Text.decodeUtf8 msg + throwInward :: Members '[Polysemy.Error InwardError] r => InwardErrorType -> Text -> Sem r a throwInward errType errMsg = Polysemy.throw $ InwardError errType errMsg @@ -107,3 +163,15 @@ sanitizePath originalPath = do throwInward IForbiddenEndpoint ("disallowed path: " <> cs originalPath) pure normalized + +-- | Match a hostname against the domain names of a certificate. +-- +-- We strip the trailing dot from the domain, as the certificate is not +-- expected to have the trailing dot. +validateDomainName :: String -> X509.Certificate -> [X509.FailedReason] +validateDomainName hostname = + X509.hookValidateName X509.defaultHooks (stripDot hostname) + where + stripDot h + | "." `isSuffixOf` h = take (length h - 1) h + | otherwise = h diff --git a/services/federator/test/integration/Test/Federator/IngressSpec.hs b/services/federator/test/integration/Test/Federator/IngressSpec.hs index 07491211a4a..36cff85675a 100644 --- a/services/federator/test/integration/Test/Federator/IngressSpec.hs +++ b/services/federator/test/integration/Test/Federator/IngressSpec.hs @@ -18,16 +18,22 @@ module Test.Federator.IngressSpec where import Bilge -import Control.Lens (view) +import Control.Lens (view, (^.)) import Data.Aeson import qualified Data.ByteString.Lazy as LBS +import Data.Default (def) import Data.Handle import Data.LegalHold (UserLegalHoldStatus (UserLegalHoldNoConsent)) import Data.String.Conversions (cs) +import qualified Data.X509 as X509 +import qualified Data.X509.Validation as X509 +import Federator.Env (caStore) import Federator.Options -import Federator.Remote (mkGrpcClient) +import Federator.Remote (blessedCiphers, mkGrpcClient) import Imports import Mu.GRpc.Client.TyApps +import Network.GRPC.Client.Helpers (_grpcClientConfigTLS) +import qualified Network.TLS as TLS import qualified Polysemy import qualified Polysemy.Reader as Polysemy import Polysemy.TinyLog (discardLogs) @@ -35,6 +41,7 @@ import Test.Federator.Util import Test.Hspec import Test.Tasty.HUnit (assertFailure) import Util.Options (Endpoint (Endpoint)) +import Wire.API.Federation.GRPC.Client (createGrpcClient) import Wire.API.Federation.GRPC.Types hiding (body, path) import qualified Wire.API.Federation.GRPC.Types as GRPC import Wire.API.User @@ -54,21 +61,61 @@ spec env = bdy <- asInwardBody =<< inwardBrigCallViaIngress "federation/get-user-by-handle" (encode hdl) liftIO $ bdy `shouldBe` expectedProfile + it "should not be accessible without a client certificate" $ + runTestFederator env $ do + brig <- view teBrig <$> ask + user <- randomUser brig + hdl <- randomHandle + _ <- putHandle brig (userId user) hdl + + -- Create a client which has the right CA but not client certs + Endpoint ingressHost ingressPort <- cfgNginxIngress . view teTstOpts <$> ask + tlsSettings <- view teTLSSettings + let cfg = grpcClientConfigSimple (cs ingressHost) (fromInteger $ toInteger ingressPort) True + tlsConfig = + (TLS.defaultParamsClient (cs ingressHost) (cs $ show ingressPort)) + { TLS.clientSupported = + def + { TLS.supportedCiphers = blessedCiphers, + -- FUTUREWORK: Figure out if we can drop TLS 1.2 + TLS.supportedVersions = [TLS.TLS12, TLS.TLS13] + }, + TLS.clientShared = def {TLS.sharedCAStore = tlsSettings ^. caStore}, + TLS.clientHooks = + def + { TLS.onServerCertificate = + X509.validate X509.HashSHA256 X509.defaultHooks X509.defaultChecks + } + } + let cfg' = cfg {_grpcClientConfigTLS = Just tlsConfig} + Right client <- createGrpcClient cfg' + grpcReply <- inwardBrigCallViaIngressWithClient client "federation/get-user-by-handle" (encode hdl) + liftIO $ case grpcReply of + -- FUTUREWORK: Make it more obvious from nginx that this error is due + -- to mTLS failure. + GRpcErrorString err -> err `shouldBe` "GRPC status indicates failure: status-code=INTERNAL, status-message=\"HTTP Status 400\"" + _ -> assertFailure $ "Expect HTTP 400, got: " <> show grpcReply + inwardBrigCallViaIngress :: (MonadIO m, MonadHttp m, MonadReader TestEnv m, HasCallStack) => ByteString -> LBS.ByteString -> m (GRpcReply InwardResponse) inwardBrigCallViaIngress requestPath payload = do Endpoint ingressHost ingressPort <- cfgNginxIngress . view teTstOpts <$> ask let target = SrvTarget (cs ingressHost) ingressPort runSettings <- optSettings . view teOpts <$> ask - caStore <- view teCAStore <$> ask - c <- liftIO . Polysemy.runM . discardLogs . Polysemy.runReader caStore . Polysemy.runReader runSettings $ mkGrpcClient target + tlsSettings <- view teTLSSettings + c <- liftIO . Polysemy.runM . discardLogs . Polysemy.runReader tlsSettings . Polysemy.runReader runSettings $ mkGrpcClient target client <- case c of Left clientErr -> liftIO $ assertFailure (show clientErr) Right cli -> pure cli + inwardBrigCallViaIngressWithClient client requestPath payload + +inwardBrigCallViaIngressWithClient :: (MonadIO m, MonadHttp m, MonadReader TestEnv m, HasCallStack) => GrpcClient -> ByteString -> LBS.ByteString -> m (GRpcReply InwardResponse) +inwardBrigCallViaIngressWithClient client requestPath payload = do + originDomain <- cfgOriginDomain <$> view teTstOpts let brigCall = GRPC.Request { GRPC.component = Brig, GRPC.path = requestPath, GRPC.body = LBS.toStrict payload, - GRPC.originDomain = "foo.example.com" + GRPC.originDomain = originDomain } liftIO $ gRpcCall @'MsgProtoBuf @Inward @"Inward" @"call" client brigCall diff --git a/services/federator/test/integration/Test/Federator/InwardSpec.hs b/services/federator/test/integration/Test/Federator/InwardSpec.hs index 5d35841e223..8d285f47c7a 100644 --- a/services/federator/test/integration/Test/Federator/InwardSpec.hs +++ b/services/federator/test/integration/Test/Federator/InwardSpec.hs @@ -21,12 +21,16 @@ import Bilge import Control.Lens (view) import Data.Aeson import qualified Data.Aeson.Types as Aeson +import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import Data.Handle import Data.LegalHold (UserLegalHoldStatus (UserLegalHoldNoConsent)) import qualified Data.Text as Text +import Federator.Options import Imports import Mu.GRpc.Client.TyApps +import Network.GRPC.Client.Helpers +import qualified Network.HTTP.Types as HTTP import Test.Federator.Util import Test.Hspec import Test.Tasty.HUnit (assertFailure) @@ -93,6 +97,19 @@ spec env = err <- asInwardErrorUnsafe <$> inwardBrigCall "federation/../i/users" (encode o) expectErr IForbiddenEndpoint err + -- Matching client certificates against domain names is better tested in + -- unit tests. + it "should reject requests without a client certificate" $ + runTestFederator env $ do + brig <- view teBrig <$> ask + user <- randomUser brig + hdl <- randomHandle + _ <- putHandle brig (userId user) hdl + + client <- viewFederatorExternalClientWithoutCert + err <- asInwardError =<< inwardBrigCallWithClient client "federation/get-user-by-handle" (encode hdl) + expectErr IAuthenticationFailed err + -- Utility functions -- expectErr :: InwardErrorType -> InwardError -> TestFederator IO () @@ -104,19 +121,38 @@ expectErr expectedType err = inwardBrigCall :: (MonadIO m, MonadHttp m, MonadReader TestEnv m, HasCallStack) => ByteString -> LBS.ByteString -> m (GRpcReply InwardResponse) inwardBrigCall requestPath payload = do c <- viewFederatorExternalClient + inwardBrigCallWithClient c requestPath payload + +inwardBrigCallWithClient :: (MonadIO m, MonadHttp m, MonadReader TestEnv m, HasCallStack) => GrpcClient -> ByteString -> LBS.ByteString -> m (GRpcReply InwardResponse) +inwardBrigCallWithClient c requestPath payload = do + originDomain <- cfgOriginDomain <$> view teTstOpts let brigCall = GRPC.Request { GRPC.component = Brig, GRPC.path = requestPath, GRPC.body = LBS.toStrict payload, - GRPC.originDomain = "foo.example.com" + GRPC.originDomain = originDomain } liftIO $ gRpcCall @'MsgProtoBuf @Inward @"Inward" @"call" c brigCall viewFederatorExternalClient :: (MonadIO m, MonadHttp m, MonadReader TestEnv m, HasCallStack) => m GrpcClient viewFederatorExternalClient = do - Endpoint fedHost fedPort <- cfgFederatorExternal . view teTstOpts <$> ask - client <- createGrpcClient (grpcClientConfigSimple (Text.unpack fedHost) (fromIntegral fedPort) False) + Endpoint fedHost fedPort <- cfgFederatorExternal <$> view teTstOpts + exampleCert <- liftIO . BS.readFile . clientCertificate . optSettings =<< view teOpts + let cfg = + (grpcClientConfigSimple (Text.unpack fedHost) (fromIntegral fedPort) False) + { _grpcClientConfigHeaders = [("X-SSL-Certificate", HTTP.urlEncode True exampleCert)] + } + client <- createGrpcClient cfg + case client of + Left clientErr -> liftIO $ assertFailure (show clientErr) + Right cli -> pure cli + +viewFederatorExternalClientWithoutCert :: (MonadIO m, MonadHttp m, MonadReader TestEnv m, HasCallStack) => m GrpcClient +viewFederatorExternalClientWithoutCert = do + Endpoint fedHost fedPort <- cfgFederatorExternal <$> view teTstOpts + let cfg = grpcClientConfigSimple (Text.unpack fedHost) (fromIntegral fedPort) False + client <- createGrpcClient cfg case client of Left clientErr -> liftIO $ assertFailure (show clientErr) Right cli -> pure cli diff --git a/services/federator/test/integration/Test/Federator/Util.hs b/services/federator/test/integration/Test/Federator/Util.hs index ddd2e1e3c38..fd052265cff 100644 --- a/services/federator/test/integration/Test/Federator/Util.hs +++ b/services/federator/test/integration/Test/Federator/Util.hs @@ -42,10 +42,10 @@ import Data.String.Conversions import qualified Data.Text as Text import qualified Data.UUID as UUID import qualified Data.UUID.V4 as UUID -import Data.X509.CertificateStore import qualified Data.Yaml as Yaml +import Federator.Env (TLSSettings (..)) import Federator.Options -import Federator.Run (mkCAStore) +import Federator.Run (mkTLSSettings) import Imports import Mu.GRpc.Client.TyApps import qualified Options.Applicative as OPA @@ -86,7 +86,7 @@ runTestFederator env = flip runReaderT env . unwrapTestFederator -- | See 'mkEnv' about what's in here. data TestEnv = TestEnv { _teMgr :: Manager, - _teCAStore :: CertificateStore, + _teTLSSettings :: TLSSettings, _teBrig :: BrigReq, -- | federator config _teOpts :: Opts, @@ -99,7 +99,8 @@ type Select = TestEnv -> (Request -> Request) data IntegrationConfig = IntegrationConfig { cfgBrig :: Endpoint, cfgFederatorExternal :: Endpoint, - cfgNginxIngress :: Endpoint + cfgNginxIngress :: Endpoint, + cfgOriginDomain :: Text } deriving (Show, Generic) @@ -143,7 +144,7 @@ mkEnv :: HasCallStack => IntegrationConfig -> Opts -> IO TestEnv mkEnv _teTstOpts _teOpts = do _teMgr :: Manager <- newManager defaultManagerSettings let _teBrig = endpointToReq (cfgBrig _teTstOpts) - _teCAStore <- mkCAStore (optSettings _teOpts) + _teTLSSettings <- mkTLSSettings (optSettings _teOpts) pure TestEnv {..} destroyEnv :: HasCallStack => TestEnv -> IO () diff --git a/services/federator/test/resources/integration-leaf-key.pem b/services/federator/test/resources/integration-leaf-key.pem new file mode 120000 index 00000000000..f5d4e842e4e --- /dev/null +++ b/services/federator/test/resources/integration-leaf-key.pem @@ -0,0 +1 @@ +../../../../deploy/services-demo/conf/nginz/integration-leaf-key.pem \ No newline at end of file diff --git a/services/federator/test/resources/integration-leaf.pem b/services/federator/test/resources/integration-leaf.pem new file mode 120000 index 00000000000..8e5558292cc --- /dev/null +++ b/services/federator/test/resources/integration-leaf.pem @@ -0,0 +1 @@ +../../../../deploy/services-demo/conf/nginz/integration-leaf.pem \ No newline at end of file diff --git a/services/federator/test/resources/unit/example.com.pem b/services/federator/test/resources/unit/example.com.pem new file mode 100644 index 00000000000..1b6f15da449 --- /dev/null +++ b/services/federator/test/resources/unit/example.com.pem @@ -0,0 +1,20 @@ +-----BEGIN CERTIFICATE----- +MIIDPzCCAiegAwIBAgITJfjqKfI5bb9m9K/ziFP689I9FjANBgkqhkiG9w0BAQsF +ADAZMRcwFQYDVQQDEw5jYS5leGFtcGxlLmNvbTAeFw0yMTA3MzAwNzIxMDBaFw0y +MjA3MzAwNzIxMDBaMBoxGDAWBgNVBAMTD2Zvby5leGFtcGxlLmNvbTCCASIwDQYJ +KoZIhvcNAQEBBQADggEPADCCAQoCggEBAMjdlmRJtCOoioptBHAHIfauSa3MN+Fe +rXlBDGLBdI5umS3r7k6+wsfeLelrvySFw7F9kqaVzooMe1nOdDsizfdgMbwwBFyt +iYZ3Krt8VgzOp/XvPRXk/nxPQMJ6sHVeXT43HYPdv4DaKYvm0cRjG28wmarD4sFc +hLk9elTajCbJPnnp6zEQRVfyMzzO4voZDYJXO8gfauxH5TFF9Jd22jSk7F2k1ZJW +fDoQjtkDdRj09k0/JQZqs/0JX4umol9TkuchVUZKF0fqwUV2lacG2iIaA8xZXWw2 +jTHQyIRa1hdr4Rbbcr9u+b2SLdzodXSj+OooTTLSlpvpsT/wPiYqkhUCAwEAAaN/ +MH0wDgYDVR0PAQH/BAQDAgWgMB0GA1UdJQQWMBQGCCsGAQUFBwMBBggrBgEFBQcD +AjAMBgNVHRMBAf8EAjAAMB0GA1UdDgQWBBTHNzz9HOzcnNE2j9HsihLBYHdMwzAf +BgNVHSMEGDAWgBRSyQ3PD6SrFBhYt97Cvq+V4Ive1zANBgkqhkiG9w0BAQsFAAOC +AQEAOxfO3nLHkyMk9pB60Uz6g+H6JvhtgeBRrtSVE8U4g/dhkrqz4S46icw76B/1 +zbZ9oS+tZ/TZ1nGWqk84Qtl24qPJp9/IkqPmfFIgA9eWPCLRzNuSjGJg4LPEaNBH +fUNI9n5T3odbLQIuZCEXsnwCParrILJKOXtjqjPHSLdk301NZ5m7tqD3Rj5kDlak +J6aRpftgVawMS17RDh5Qs1W0R5rhyup/pX7Gf/XWfY2dTmHlg0SYhHc5bkVuaWCZ +jp+i9BFj2VKpuwZKNxPdCmyoy+tChfKuF4WddZu3fC1CxJgL93U+e2zSzj5sJ0iH +r6IEm35GKHhRQiqQe17f3j94Qw== +-----END CERTIFICATE----- diff --git a/services/federator/test/resources/unit/gen-certs.sh b/services/federator/test/resources/unit/gen-certs.sh index f02d3983c91..1069c1283ec 100755 --- a/services/federator/test/resources/unit/gen-certs.sh +++ b/services/federator/test/resources/unit/gen-certs.sh @@ -10,11 +10,13 @@ DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)" set -e TEMP=${TEMP:-"$(mktemp -d)"} +REGENERATE=${REGENERATE:-0} CSR="$TEMP/csr.json" OUTPUTNAME_CA="$DIR/unit-ca" OUTPUTNAME_LOCALHOST_CERT="$DIR/localhost" OUTPUTNAME_LOCALHOST_DOT_CERT="$DIR/localhost-dot" OUTPUTNAME_EXAMPLE_COM_CERT="$DIR/localhost.example.com" +OUTPUTNAME_SECOND_EXAMPLE_COM_CERT="$DIR/second-federator.example.com" command -v cfssl >/dev/null 2>&1 || { echo >&2 "cfssl is not installed, aborting. See https://github.com/cloudflare/cfssl"; exit 1; } command -v cfssljson >/dev/null 2>&1 || { echo >&2 "cfssljson is not installed, aborting. See https://github.com/cloudflare/cfssl"; exit 1; } @@ -28,7 +30,9 @@ echo '{ }' >"$CSR" # generate CA key and cert -cfssl gencert -initca "$CSR" | cfssljson -bare "$OUTPUTNAME_CA" +if [[ ! -f "$OUTPUTNAME_CA.pem" ]] || [[ "$REGENERATE" -eq "1" ]]; then + cfssl gencert -initca "$CSR" | cfssljson -bare "$OUTPUTNAME_CA" +fi echo '{ "key": { @@ -37,13 +41,24 @@ echo '{ } }' >"$CSR" -# generate cert and key based on CA given comma-separated hostnames as SANs -cfssl gencert -ca "$OUTPUTNAME_CA.pem" -ca-key "$OUTPUTNAME_CA-key.pem" -hostname="localhost" "$CSR" | cfssljson -bare "$OUTPUTNAME_LOCALHOST_CERT" -cfssl gencert -ca "$OUTPUTNAME_CA.pem" -ca-key "$OUTPUTNAME_CA-key.pem" -hostname="localhost." "$CSR" | cfssljson -bare "$OUTPUTNAME_LOCALHOST_DOT_CERT" -cfssl gencert -ca "$OUTPUTNAME_CA.pem" -ca-key "$OUTPUTNAME_CA-key.pem" -hostname="localhost.example.com" "$CSR" | cfssljson -bare "$OUTPUTNAME_EXAMPLE_COM_CERT" +generate() { + local hostname=$1 + local file=$2 + + if [[ ! -f "$file.pem" ]] || [[ "$REGENERATE" -eq "1" ]]; then + cfssl gencert -ca "$OUTPUTNAME_CA.pem" -ca-key "$OUTPUTNAME_CA-key.pem" -hostname="$hostname" "$CSR" | cfssljson -bare "$file" + fi +} + +generate cert and key based on CA given comma-separated hostnames as SANs +generate "localhost" "$OUTPUTNAME_LOCALHOST_CERT" +generate "localhost." "$OUTPUTNAME_LOCALHOST_DOT_CERT" +generate "localhost.example.com" "$OUTPUTNAME_EXAMPLE_COM_CERT" +generate "second-federator.example.com" "$OUTPUTNAME_SECOND_EXAMPLE_COM_CERT" # cleanup unneeded files -rm "$OUTPUTNAME_CA.csr" -rm "$OUTPUTNAME_LOCALHOST_CERT.csr" -rm "$OUTPUTNAME_LOCALHOST_DOT_CERT.csr" -rm "$OUTPUTNAME_EXAMPLE_COM_CERT.csr" +rm -f "$OUTPUTNAME_CA.csr" +rm -f "$OUTPUTNAME_LOCALHOST_CERT.csr" +rm -f "$OUTPUTNAME_LOCALHOST_DOT_CERT.csr" +rm -f "$OUTPUTNAME_EXAMPLE_COM_CERT.csr" +rm -f "$OUTPUTNAME_SECOND_EXAMPLE_COM_CERT.csr" diff --git a/services/federator/test/resources/unit/invalid.pem b/services/federator/test/resources/unit/invalid.pem new file mode 100644 index 00000000000..2716bf650ca --- /dev/null +++ b/services/federator/test/resources/unit/invalid.pem @@ -0,0 +1 @@ +not a certificate diff --git a/services/federator/test/resources/unit/second-federator.example.com-key.pem b/services/federator/test/resources/unit/second-federator.example.com-key.pem new file mode 100644 index 00000000000..a97fc007466 --- /dev/null +++ b/services/federator/test/resources/unit/second-federator.example.com-key.pem @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEpAIBAAKCAQEA1gS4/wcHU41HOQaFfMVP/JwP1LId+4jkfGPUspR0zH7TcJqq +SISenSd0bEW4rf51Uw78YhPPS3L978LPjFCswiQTNuPz3R5tjQ/WwIkoPs560/1b +Kbon8NIE03uhGIv7txPC520UmfBr5B5s50Mr5MoNeG63Kg0IUP5AssrjiLR6qaLI +M8TqTvIDaX7swNIbFcCAx7TA3lXrEy6IjyFPZD83/6jRZwr1E4fqMkB4/TdbVT+b +t7VDgEfPa1oTBRwZuXz9yLqpgpWJQdiR27YAHqF9j72heZMutypS7lfsjGKYXxy+ +/Xjf9U148IAG3TZGXocKuw3EEtKL1TSFCiQ4dQIDAQABAoIBAQC6G3U74ELQt0Q+ +JJuj+nkp9BQYI6PK/imiubVWbZ57zbXUb8qwMRM1GgA1vxNvypz/00JJj2xt8ds8 +ya1uGSGB2ZkT3HpNyI3/YsyetSbYJvnMqr7BtG3TDu6/cPyPufr0Iy0Tzllh3B4W +SxbsrA7Zb5LzLWP+H0MiG1bro17lmmTU12d3orVulGjRmLeu3OA1lrC2ypfNvuJd +NzxLAtpCLJ2fE/FnszG6SFG0eeAz16HWU6jG7xI+Ml+0k+OUBM8YOJq2gVdxpit8 +mXELhQ7/3v7gGYrMKN5oyKKoEMtqcu2Tjv7Tk9NaoY+7M75RBN5/lpjcO9iYqimg +qqP1jZfBAoGBAPIfHouK9Mr5G1hiIdjSUm68IOSuUJ3nmKEaLCXBEZcr32kny6Ap +OQoCfNPE4I5CugFMAhF3OBegbyshWuWoti2PBaQKcmxl6oUrWv8i76C3HtCP+Db/ +cRkilFXQiYSp5Nw02lr3MaDbH1FYqfW9qpdMj66VTtUA1gEqyDKPglgdAoGBAOJJ +ODQlmbOKAnDkn9m1P/1WzGcdGswYf5Fy/w4aNHVmvvMmKW291vqTSylqeYb/fN41 +mMkw/f9DUtxodFijLnxtRdgnElpL8ZkxP/G7iqBkAbczNju+VRogvbf44BkCIaFv +dfUUAMM4KjWD0ndpeExqGooWiquGqKEmJmfXmeI5AoGBAL2evY9PrlNgMJhRkmx6 +m3B6CdDO6/gerxxMoRKYWCxqgbebIRA3+KHsPNKlN7BydbYaTuxa0CVA0o+Wuddu +/+5COoq0W9SlJLxSrhtuwvi9MXbpqd14xJyIxl9GyMyLOd9zzSa8vbNaqPZOWB1L +A1Um8sgpyulqlC+pz8w5ND3JAoGAPGELJSbvRy/JDPSEDqRFScTyT4U9lD3pNBc6 +JToqyzS6OMjy/vxLs5q/0HI/sRzU5bnpZa2z6Hu/TV51xPztt3e0zkNGq19ePOEe +TdMb30YwCwEYNILJ1GnuFXvL2ABwltHV6KoItg5zfMoKy6AR4FnjcPsozzHkJvO2 +BblKr0kCgYAHyHuNB4yLhy88Gg+0GHEk8njyrGCw3AXZhknzBhttxDCorQXMhdw8 +L1mLsgx/bolgWRZzS0BhYohYQs35mSeE8ap8C52hmXopeczTu8JdMnC18fH8CFPV +SMyig4kC34o2S9sai2ww+HszeHleymG1Yhywo2lOZ5zIJ8Wgtu2Zag== +-----END RSA PRIVATE KEY----- diff --git a/services/federator/test/resources/unit/second-federator.example.com.pem b/services/federator/test/resources/unit/second-federator.example.com.pem new file mode 100644 index 00000000000..de61ac026f1 --- /dev/null +++ b/services/federator/test/resources/unit/second-federator.example.com.pem @@ -0,0 +1,20 @@ +-----BEGIN CERTIFICATE----- +MIIDVDCCAjygAwIBAgIUS94TS/SILceFcHCkflKc2k3QSSQwDQYJKoZIhvcNAQEL +BQAwGTEXMBUGA1UEAxMOY2EuZXhhbXBsZS5jb20wHhcNMjEwODE4MTAwNzAwWhcN +MjIwODE4MTAwNzAwWjAAMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA +1gS4/wcHU41HOQaFfMVP/JwP1LId+4jkfGPUspR0zH7TcJqqSISenSd0bEW4rf51 +Uw78YhPPS3L978LPjFCswiQTNuPz3R5tjQ/WwIkoPs560/1bKbon8NIE03uhGIv7 +txPC520UmfBr5B5s50Mr5MoNeG63Kg0IUP5AssrjiLR6qaLIM8TqTvIDaX7swNIb +FcCAx7TA3lXrEy6IjyFPZD83/6jRZwr1E4fqMkB4/TdbVT+bt7VDgEfPa1oTBRwZ +uXz9yLqpgpWJQdiR27YAHqF9j72heZMutypS7lfsjGKYXxy+/Xjf9U148IAG3TZG +XocKuw3EEtKL1TSFCiQ4dQIDAQABo4GsMIGpMA4GA1UdDwEB/wQEAwIFoDAdBgNV +HSUEFjAUBggrBgEFBQcDAQYIKwYBBQUHAwIwDAYDVR0TAQH/BAIwADAdBgNVHQ4E +FgQUkTFlks+O/A9XShFQThjcmNwuSKYwHwYDVR0jBBgwFoAUz2uNyRBHMR6k8WqX +xJBP4C8QgykwKgYDVR0RAQH/BCAwHoIcc2Vjb25kLWZlZGVyYXRvci5leGFtcGxl +LmNvbTANBgkqhkiG9w0BAQsFAAOCAQEAk08EaC6PWeHYcNB0pn/rgnp/WODGoaws +YWTNtNzH6CD9JZOg3KtUs9EszgJPUuRRwL7GKUeG0DyQPvJBW+YMWdWG1fDuTRX2 +irBDIysj8j1FKd+cearKoTPMJlrV553zLmU999dtxWfObJyOy6/Fvm2Ow4LiS6RT +DjqnNVrqUxl+Cgh82zyOBG9GlkeZzUzUb82Qae46S9zKHOYQgSHRM5dCsUlxMpSY +nV/1yqK90w+5v8j1dNt59j1xuS3R7dwNNB68YazW8X71RgiE0LWXcH6YZ8XNTKxn +AtmlIghn0Jliv3kc22G1xbDxHeXiejkHFg1PwZbL37UEB/MW2uVKCQ== +-----END CERTIFICATE----- diff --git a/services/federator/test/unit/Test/Federator/ExternalServer.hs b/services/federator/test/unit/Test/Federator/ExternalServer.hs index bcd08702c02..1ced5c1083b 100644 --- a/services/federator/test/unit/Test/Federator/ExternalServer.hs +++ b/services/federator/test/unit/Test/Federator/ExternalServer.hs @@ -19,16 +19,18 @@ module Test.Federator.ExternalServer where -import Data.Domain (Domain (..)) +import qualified Data.ByteString as BS +import Data.Domain import Data.String.Conversions (cs) import Federator.ExternalServer (callLocal) -import Federator.Options (FederationStrategy (AllowAll), RunSettings (..)) import Federator.Service (Service) import Imports import qualified Network.HTTP.Types as HTTP import Polysemy (embed, runM) import qualified Polysemy.Reader as Polysemy import qualified Polysemy.TinyLog as TinyLog +import Test.Federator.Options (noClientCertSettings) +import Test.Federator.Validation (mockDiscoveryTrivial) import Test.Polysemy.Mock (Mock (mock), evalMock) import Test.Polysemy.Mock.TH (genMock) import Test.Tasty (TestTree, testGroup) @@ -53,7 +55,13 @@ requestBrigSuccess = mockServiceCallReturns @IO (\_ _ _ _ -> pure (HTTP.ok200, Just "response body")) let request = Request Brig "/federation/get-user-by-handle" "\"foo\"" exampleDomain - res :: InwardResponse <- mock @Service @IO . TinyLog.discardLogs . Polysemy.runReader allowAllSettings $ callLocal request + exampleCert <- embed $ BS.readFile "test/resources/unit/localhost.example.com.pem" + res :: InwardResponse <- + mock @Service @IO + . TinyLog.discardLogs + . mockDiscoveryTrivial + . Polysemy.runReader noClientCertSettings + $ callLocal (Just exampleCert) request actualCalls <- mockServiceCallCalls @IO let expectedCall = (Brig, "federation/get-user-by-handle", "\"foo\"", aValidDomain) embed $ assertEqual "one call to brig should be made" [expectedCall] actualCalls @@ -66,7 +74,13 @@ requestBrigFailure = mockServiceCallReturns @IO (\_ _ _ _ -> pure (HTTP.notFound404, Just "response body")) let request = Request Brig "/federation/get-user-by-handle" "\"foo\"" exampleDomain - res <- mock @Service @IO . TinyLog.discardLogs . Polysemy.runReader allowAllSettings $ callLocal request + exampleCert <- embed $ BS.readFile "test/resources/unit/localhost.example.com.pem" + res <- + mock @Service @IO + . TinyLog.discardLogs + . mockDiscoveryTrivial + . Polysemy.runReader noClientCertSettings + $ callLocal (Just exampleCert) request actualCalls <- mockServiceCallCalls @IO let expectedCall = (Brig, "federation/get-user-by-handle", "\"foo\"", aValidDomain) @@ -82,17 +96,20 @@ requestGalleySuccess = mockServiceCallReturns @IO (\_ _ _ _ -> pure (HTTP.ok200, Just "response body")) let request = Request Galley "federation/get-conversations" "{}" exampleDomain - res :: InwardResponse <- mock @Service @IO . TinyLog.discardLogs . Polysemy.runReader allowAllSettings $ callLocal request + exampleCert <- embed $ BS.readFile "test/resources/unit/localhost.example.com.pem" + res :: InwardResponse <- + mock @Service @IO + . TinyLog.discardLogs + . mockDiscoveryTrivial + . Polysemy.runReader noClientCertSettings + $ callLocal (Just exampleCert) request actualCalls <- mockServiceCallCalls @IO let expectedCall = (Galley, "federation/get-conversations", "{}", aValidDomain) embed $ assertEqual "one call to brig should be made" [expectedCall] actualCalls embed $ assertEqual "response should be success with correct body" (InwardResponseBody "response body") res -allowAllSettings :: RunSettings -allowAllSettings = RunSettings AllowAll True Nothing - exampleDomain :: Text -exampleDomain = "some.example.com" +exampleDomain = "localhost.example.com" aValidDomain :: Domain aValidDomain = Domain exampleDomain diff --git a/services/federator/test/unit/Test/Federator/InternalServer.hs b/services/federator/test/unit/Test/Federator/InternalServer.hs index 6b363eeb6fe..6b691de7c56 100644 --- a/services/federator/test/unit/Test/Federator/InternalServer.hs +++ b/services/federator/test/unit/Test/Federator/InternalServer.hs @@ -29,6 +29,7 @@ import Mu.GRpc.Client.Record import Network.HTTP2.Client (TooMuchConcurrency (TooMuchConcurrency)) import Polysemy (embed, runM) import qualified Polysemy.Reader as Polysemy +import Test.Federator.Options (noClientCertSettings) import Test.Polysemy.Mock (Mock (mock), evalMock) import Test.Polysemy.Mock.TH (genMock) import Test.Tasty (TestTree, testGroup) @@ -53,10 +54,7 @@ tests = settingsWithAllowList :: [Domain] -> RunSettings settingsWithAllowList domains = - RunSettings (AllowList (AllowedDomains domains)) True Nothing - -allowAllSettings :: RunSettings -allowAllSettings = RunSettings AllowAll True Nothing + noClientCertSettings {federationStrategy = AllowList (AllowedDomains domains)} federatedRequestSuccess :: TestTree federatedRequestSuccess = @@ -65,7 +63,9 @@ federatedRequestSuccess = mockDiscoverAndCallReturns @IO (const $ pure (Right (GRpcOk (InwardResponseBody "success!")))) let federatedRequest = FederatedRequest validDomainText (Just validLocalPart) - res <- mock @Remote @IO . Polysemy.runReader allowAllSettings $ callOutward federatedRequest + res <- + mock @Remote @IO . Polysemy.runReader noClientCertSettings $ + callOutward federatedRequest actualCalls <- mockDiscoverAndCallCalls @IO let expectedCall = ValidatedFederatedRequest (Domain validDomainText) validLocalPart @@ -81,7 +81,7 @@ federatedRequestFailureTMC = mockDiscoverAndCallReturns @IO (const $ pure (Right (GRpcTooMuchConcurrency (TooMuchConcurrency 2)))) let federatedRequest = FederatedRequest validDomainText (Just validLocalPart) - res <- mock @Remote @IO . Polysemy.runReader allowAllSettings $ callOutward federatedRequest + res <- mock @Remote @IO . Polysemy.runReader noClientCertSettings $ callOutward federatedRequest actualCalls <- mockDiscoverAndCallCalls @IO let expectedCall = ValidatedFederatedRequest (Domain validDomainText) validLocalPart @@ -96,7 +96,7 @@ federatedRequestFailureErrCode = mockDiscoverAndCallReturns @IO (const $ pure (Right (GRpcErrorCode 77))) -- TODO: Maybe use some legit HTTP2 error code? let federatedRequest = FederatedRequest validDomainText (Just validLocalPart) - res <- mock @Remote @IO . Polysemy.runReader allowAllSettings $ callOutward federatedRequest + res <- mock @Remote @IO . Polysemy.runReader noClientCertSettings $ callOutward federatedRequest actualCalls <- mockDiscoverAndCallCalls @IO let expectedCall = ValidatedFederatedRequest (Domain validDomainText) validLocalPart @@ -111,7 +111,7 @@ federatedRequestFailureErrStr = mockDiscoverAndCallReturns @IO (const $ pure (Right (GRpcErrorString "some grpc error"))) let federatedRequest = FederatedRequest validDomainText (Just validLocalPart) - res <- mock @Remote @IO . Polysemy.runReader allowAllSettings $ callOutward federatedRequest + res <- mock @Remote @IO . Polysemy.runReader noClientCertSettings $ callOutward federatedRequest actualCalls <- mockDiscoverAndCallCalls @IO let expectedCall = ValidatedFederatedRequest (Domain validDomainText) validLocalPart @@ -126,7 +126,7 @@ federatedRequestFailureNoRemote = mockDiscoverAndCallReturns @IO (const $ pure (Left $ RemoteErrorDiscoveryFailure (Domain "example.com") (LookupErrorSrvNotAvailable "_something._tcp.example.com"))) let federatedRequest = FederatedRequest validDomainText (Just validLocalPart) - res <- mock @Remote @IO . Polysemy.runReader allowAllSettings $ callOutward federatedRequest + res <- mock @Remote @IO . Polysemy.runReader noClientCertSettings $ callOutward federatedRequest actualCalls <- mockDiscoverAndCallCalls @IO let expectedCall = ValidatedFederatedRequest (Domain validDomainText) validLocalPart @@ -141,7 +141,7 @@ federatedRequestFailureDNS = mockDiscoverAndCallReturns @IO (const $ pure (Left $ RemoteErrorDiscoveryFailure (Domain "example.com") (LookupErrorDNSError "No route to 1.1.1.1"))) let federatedRequest = FederatedRequest validDomainText (Just validLocalPart) - res <- mock @Remote @IO . Polysemy.runReader allowAllSettings $ callOutward federatedRequest + res <- mock @Remote @IO . Polysemy.runReader noClientCertSettings $ callOutward federatedRequest actualCalls <- mockDiscoverAndCallCalls @IO let expectedCall = ValidatedFederatedRequest (Domain validDomainText) validLocalPart diff --git a/services/federator/test/unit/Test/Federator/Options.hs b/services/federator/test/unit/Test/Federator/Options.hs index d05a62d10c5..6e23016abf3 100644 --- a/services/federator/test/unit/Test/Federator/Options.hs +++ b/services/federator/test/unit/Test/Federator/Options.hs @@ -21,21 +21,43 @@ module Test.Federator.Options where +import Control.Exception (try) +import Control.Lens import Data.Aeson (FromJSON) import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Char8 as B8 import Data.ByteString.Lazy (toStrict) -import Data.Domain (mkDomain) +import Data.Domain (Domain (..), mkDomain) +import Data.String.Interpolate as QQ import qualified Data.Yaml as Yaml +import Federator.Env import Federator.Options +import Federator.Run import Imports import Test.Tasty import Test.Tasty.HUnit +defRunSettings :: FilePath -> FilePath -> RunSettings +defRunSettings client key = + RunSettings + { federationStrategy = AllowAll, + useSystemCAStore = True, + remoteCAStore = Nothing, + clientCertificate = client, + clientPrivateKey = key, + dnsHost = Nothing, + dnsPort = Nothing + } + +noClientCertSettings :: RunSettings +noClientCertSettings = defRunSettings "invalid-cert" "invalid-private-key" + tests :: TestTree tests = testGroup "Options" - [ parseFederationStrategy + [ parseFederationStrategy, + testSettings ] parseFederationStrategy :: TestTree @@ -45,13 +67,15 @@ parseFederationStrategy = "allowAll: null" assertParsesAs (withAllowList []) $ "allowedDomains: []" - assertParsesAs (withAllowList ["test.org"]) $ - "allowedDomains:\n\ - \ - test.org" - assertParsesAs (withAllowList ["example.com", "wire.com"]) $ - "allowedDomains:\n\ - \ - example.com\n\ - \ - wire.com" + assertParsesAs (withAllowList ["test.org"]) . B8.pack $ + [QQ.i| + allowedDomains: + - test.org|] + assertParsesAs (withAllowList ["example.com", "wire.com"]) . B8.pack $ + [QQ.i| + allowedDomains: + - example.com + - wire.com|] -- manual roundtrip example AllowAll let allowA = toStrict $ Aeson.encode AllowAll assertParsesAs AllowAll $ allowA @@ -63,7 +87,142 @@ parseFederationStrategy = withAllowList = AllowList . AllowedDomains . map (either error id . mkDomain) +testSettings :: TestTree +testSettings = + testGroup + "settings" + [ testCase "parse configuration example (open federation)" $ do + assertParsesAs + (defRunSettings "client.pem" "client-key.pem") + ( B8.pack + [QQ.i| + federationStrategy: + allowAll: + clientCertificate: client.pem + clientPrivateKey: client-key.pem + useSystemCAStore: true|] + ), + testCase "parse configuration example (closed federation)" $ do + let settings = + (defRunSettings "client.pem" "client-key.pem") + { federationStrategy = + AllowList + ( AllowedDomains [Domain "server2.example.com"] + ), + useSystemCAStore = False + } + assertParsesAs settings . B8.pack $ + [QQ.i| + federationStrategy: + allowedDomains: + - server2.example.com + useSystemCAStore: false + clientCertificate: client.pem + clientPrivateKey: client-key.pem|], + testCase "succefully read client credentials" $ do + let settings = + defRunSettings + "test/resources/unit/localhost.pem" + "test/resources/unit/localhost-key.pem" + assertParsesAs settings . B8.pack $ + [QQ.i| + useSystemCAStore: true + federationStrategy: + allowAll: null + clientCertificate: test/resources/unit/localhost.pem + clientPrivateKey: test/resources/unit/localhost-key.pem|] + void (mkTLSSettings settings), + testCase "fail on missing client credentials" $ + assertParseFailure @RunSettings . B8.pack $ + [QQ.i| + useSystemCAStore: true + federationStrategy: + allowAll: null|], + testCase "fail on missing client private key" $ do + assertParseFailure @RunSettings . B8.pack $ + [QQ.i| + useSystemCAStore: true + federationStrategy: + allowAll: null + clientCertificate: test/resources/unit/localhost.pem|], + testCase "fail on missing certificate" $ do + assertParseFailure @RunSettings . B8.pack $ + [QQ.i| + useSystemCAStore: true + federationStrategy: + allowAll: null + clientPrivateKey: test/resources/unit/localhost-key.pem|], + testCase "fail on non-existent certificate" $ do + let settings = defRunSettings "non-existent" "non-existent" + assertParsesAs settings . B8.pack $ + [QQ.i| + useSystemCAStore: true + federationStrategy: + allowAll: null + clientCertificate: non-existent + clientPrivateKey: non-existent|] + try @FederationSetupError (mkTLSSettings settings) >>= \case + Left (InvalidClientCertificate _) -> pure () + Left e -> + assertFailure $ + "expected invalid client certificate exception, got: " + <> show e + Right tlsSettings -> + assertFailure $ + "expected failure for non-existing client certificate, got: " + <> show (tlsSettings ^. creds), + testCase "fail on invalid certificate" $ do + let settings = + defRunSettings + "test/resources/unit/invalid.pem" + "test/resources/unit/localhost-key.pem" + assertParsesAs settings . B8.pack $ + [QQ.i| + useSystemCAStore: true + federationStrategy: + allowAll: null + clientCertificate: test/resources/unit/invalid.pem + clientPrivateKey: test/resources/unit/localhost-key.pem|] + try @FederationSetupError (mkTLSSettings settings) >>= \case + Left (InvalidClientCertificate _) -> pure () + Left e -> + assertFailure $ + "expected invalid client certificate exception, got: " + <> show e + Right tlsSettings -> + assertFailure $ + "expected failure for invalid client certificate, got: " + <> show (tlsSettings ^. creds), + testCase "fail on invalid private key" $ do + let settings = + defRunSettings + "test/resources/unit/localhost.pem" + "test/resources/unit/invalid.pem" + assertParsesAs settings . B8.pack $ + [QQ.i| + useSystemCAStore: true + federationStrategy: + allowAll: null + clientCertificate: test/resources/unit/localhost.pem + clientPrivateKey: test/resources/unit/invalid.pem|] + try @FederationSetupError (mkTLSSettings settings) >>= \case + Left (InvalidClientCertificate _) -> pure () + Left e -> + assertFailure $ + "expected invalid client certificate exception, got: " + <> show e + Right tlsSettings -> + assertFailure $ + "expected failure for invalid private key, got: " + <> show (tlsSettings ^. creds) + ] + assertParsesAs :: (HasCallStack, Eq a, FromJSON a, Show a) => a -> ByteString -> Assertion assertParsesAs v bs = assertEqual "YAML parsing" (Right v) $ either (Left . show) Right (Yaml.decodeEither' bs) + +assertParseFailure :: forall a. (FromJSON a, Show a) => ByteString -> Assertion +assertParseFailure bs = case Yaml.decodeEither' bs of + Left _ -> pure () + Right (x :: a) -> assertFailure $ "expected YAML parsing failure, got: " <> show x diff --git a/services/federator/test/unit/Test/Federator/Remote.hs b/services/federator/test/unit/Test/Federator/Remote.hs index e83869a8051..51392236e25 100644 --- a/services/federator/test/unit/Test/Federator/Remote.hs +++ b/services/federator/test/unit/Test/Federator/Remote.hs @@ -5,7 +5,7 @@ module Test.Federator.Remote where import Data.Streaming.Network (bindRandomPortTCP) import Federator.Options import Federator.Remote -import Federator.Run (mkCAStore) +import Federator.Run (mkTLSSettings) import Imports import Network.HTTP.Types (status200) import Network.Wai @@ -14,6 +14,7 @@ import qualified Network.Wai.Handler.WarpTLS as WarpTLS import qualified Polysemy import qualified Polysemy.Reader as Polysemy import qualified Polysemy.TinyLog as TinyLog +import Test.Federator.Options (defRunSettings) import Test.Tasty import Test.Tasty.HUnit import UnliftIO (bracket, timeout) @@ -31,30 +32,40 @@ tests = ] ] +settings :: RunSettings +settings = + ( defRunSettings + "test/resources/unit/localhost.pem" + "test/resources/unit/localhost-key.pem" + ) + { useSystemCAStore = False, + remoteCAStore = Just "test/resources/unit/unit-ca.pem" + } + testValidatesCertificateSuccess :: TestTree testValidatesCertificateSuccess = testGroup "can get response with valid certificate" [ testCase "when hostname=localhost and certificate-for=localhost" $ do bracket (startMockServer certForLocalhost) (\(serverThread, _) -> Async.cancel serverThread) $ \(_, port) -> do - caStore <- mkCAStore (RunSettings AllowAll False (Just "test/resources/unit/unit-ca.pem")) - eitherClient <- Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader caStore $ mkGrpcClient (SrvTarget "localhost" (fromIntegral port)) + tlsSettings <- mkTLSSettings settings + eitherClient <- Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader tlsSettings $ mkGrpcClient (SrvTarget "localhost" (fromIntegral port)) case eitherClient of Left err -> assertFailure $ "Unexpected error: " <> show err Right _ -> pure (), testCase "when hostname=localhost. and certificate-for=localhost" $ do bracket (startMockServer certForLocalhost) (\(serverThread, _) -> Async.cancel serverThread) $ \(_, port) -> do - caStore <- mkCAStore (RunSettings AllowAll False (Just "test/resources/unit/unit-ca.pem")) - eitherClient <- Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader caStore $ mkGrpcClient (SrvTarget "localhost." (fromIntegral port)) + tlsSettings <- mkTLSSettings settings + eitherClient <- Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader tlsSettings $ mkGrpcClient (SrvTarget "localhost." (fromIntegral port)) case eitherClient of Left err -> assertFailure $ "Unexpected error: " <> show err Right _ -> pure (), -- This is a limitation of the TLS library, this test just exists to document that. testCase "when hostname=localhost. and certificate-for=localhost." $ do bracket (startMockServer certForLocalhostDot) (\(serverThread, _) -> Async.cancel serverThread) $ \(_, port) -> do - caStore <- mkCAStore (RunSettings AllowAll False (Just "test/resources/unit/unit-ca.pem")) + tlsSettings <- mkTLSSettings settings eitherClient <- - Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader caStore $ + Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader tlsSettings $ mkGrpcClient (SrvTarget "localhost." (fromIntegral port)) case eitherClient of Left _ -> pure () @@ -67,9 +78,9 @@ testValidatesCertificateWrongHostname = "refuses to connect with server" [ testCase "when the server's certificate doesn't match the hostname" $ bracket (startMockServer certForWrongDomain) (Async.cancel . fst) $ \(_, port) -> do - caStore <- mkCAStore (RunSettings AllowAll False (Just "test/resources/unit/unit-ca.pem")) + tlsSettings <- mkTLSSettings settings eitherClient <- - Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader caStore $ + Polysemy.runM . TinyLog.discardLogs . Polysemy.runReader tlsSettings $ mkGrpcClient (SrvTarget "localhost." (fromIntegral port)) case eitherClient of Left (RemoteErrorTLSException _ _) -> pure () @@ -90,14 +101,14 @@ startMockServer :: MonadIO m => WarpTLS.TLSSettings -> m (Async.Async (), Warp.P startMockServer tlsSettings = liftIO $ do (port, sock) <- bindRandomPortTCP "*6" serverStarted <- newEmptyMVar - let settings = + let wsettings = Warp.defaultSettings & Warp.setPort port & Warp.setGracefulCloseTimeout2 0 -- Defaults to 2 seconds, causes server stop to take very long & Warp.setBeforeMainLoop (putMVar serverStarted ()) app _req respond = respond $ responseLBS status200 [] "dragons be here" - serverThread <- Async.async $ WarpTLS.runTLSSocket tlsSettings settings sock app + serverThread <- Async.async $ WarpTLS.runTLSSocket tlsSettings wsettings sock app serverStartedSignal <- timeout 10_000_000 (takeMVar serverStarted) case serverStartedSignal of Nothing -> do diff --git a/services/federator/test/unit/Test/Federator/Validation.hs b/services/federator/test/unit/Test/Federator/Validation.hs index 02927ace864..a79cc36dd0b 100644 --- a/services/federator/test/unit/Test/Federator/Validation.hs +++ b/services/federator/test/unit/Test/Federator/Validation.hs @@ -20,22 +20,43 @@ module Test.Federator.Validation where import qualified Data.ByteString as BS -import Data.Domain (Domain (..)) -import Data.Either.Combinators (mapLeft) +import Data.Domain (Domain (..), domainText) +import Data.List.NonEmpty (NonEmpty (..)) import Data.String.Conversions +import qualified Data.Text.Encoding as Text +import Federator.Discovery (DiscoverFederator (..), LookupError (..)) import Federator.Options -import Federator.Remote (Remote) import Federator.Validation import Imports -import Polysemy (runM) -import Polysemy.Embed +import Polysemy (Sem, run) +import qualified Polysemy import qualified Polysemy.Error as Polysemy import qualified Polysemy.Reader as Polysemy import Test.Federator.InternalServer () -import Test.Polysemy.Mock (evalMock) +import Test.Federator.Options (noClientCertSettings) import Test.Tasty import Test.Tasty.HUnit import Wire.API.Federation.GRPC.Types +import Wire.Network.DNS.SRV (SrvTarget (..)) + +mockDiscoveryTrivial :: Sem (DiscoverFederator ': r) x -> Sem r x +mockDiscoveryTrivial = Polysemy.interpret $ \case + DiscoverFederator dom -> pure . Right $ SrvTarget (Text.encodeUtf8 (domainText dom)) 443 + DiscoverAllFederators dom -> pure . Right $ SrvTarget (Text.encodeUtf8 (domainText dom)) 443 :| [] + +mockDiscoveryMapping :: HasCallStack => Domain -> NonEmpty ByteString -> Sem (DiscoverFederator ': r) x -> Sem r x +mockDiscoveryMapping origin targets = Polysemy.interpret $ \case + DiscoverFederator _ -> error "Not mocked" + DiscoverAllFederators dom -> + pure $ + if dom == origin + then Right $ fmap (`SrvTarget` 443) targets + else Left $ LookupErrorSrvNotAvailable "invalid origin domain" + +mockDiscoveryFailure :: HasCallStack => Sem (DiscoverFederator ': r) x -> Sem r x +mockDiscoveryFailure = Polysemy.interpret $ \case + DiscoverFederator _ -> error "Not mocked" + DiscoverAllFederators _ -> pure . Left $ LookupErrorDNSError "mock DNS error" tests :: TestTree tests = @@ -47,7 +68,14 @@ tests = testGroup "validateDomain" $ [ validateDomainAllowListFailSemantic, validateDomainAllowListFail, - validateDomainAllowListSuccess + validateDomainAllowListSuccess, + validateDomainCertMissing, + validateDomainCertInvalid, + validateDomainCertWrongDomain, + validateDomainCertCN, + validateDomainMultipleFederators, + validateDomainDiscoveryFailed, + validateDomainNonIdentitySRV ], testGroup "validatePath - Success" validatePathSuccess, testGroup "validatePath - Normalize" validatePathNormalize, @@ -56,46 +84,141 @@ tests = federateWithAllowListSuccess :: TestTree federateWithAllowListSuccess = - testCase "should give True when target domain is in the list" $ - -- removing evalMock @Remote doesn't seem to work, but why? - runM . evalMock @Remote @IO $ do - let settings = settingsWithAllowList [Domain "hello.world"] - res <- Polysemy.runReader settings $ federateWith (Domain "hello.world") - embed $ assertBool "federating should be allowed" res + testCase "should give True when target domain is in the list" $ do + let settings = settingsWithAllowList [Domain "hello.world"] + res = run . Polysemy.runReader settings $ federateWith (Domain "hello.world") + assertBool "federating should be allowed" res federateWithAllowListFail :: TestTree federateWithAllowListFail = - testCase "should give False when target domain is not in the list" $ - runM . evalMock @Remote @IO $ do - let settings = settingsWithAllowList [Domain "only.other.domain"] - res <- Polysemy.runReader settings $ federateWith (Domain "hello.world") - embed $ assertBool "federating should not be allowed" (not res) + testCase "should give False when target domain is not in the list" $ do + let settings = settingsWithAllowList [Domain "only.other.domain"] + res = run . Polysemy.runReader settings $ federateWith (Domain "hello.world") + assertBool "federating should not be allowed" (not res) validateDomainAllowListFailSemantic :: TestTree validateDomainAllowListFailSemantic = - testCase "semantic validation" $ - runM . evalMock @Remote @IO $ do - let settings = settingsWithAllowList [Domain "only.other.domain"] - res :: Either InwardError Domain <- Polysemy.runError . Polysemy.runReader settings $ validateDomain ("invalid//.><-semantic-&@-domain" :: Text) - embed $ assertEqual "semantic parse failure" (Left IInvalidDomain) (mapLeft inwardErrorType res) + testCase "semantic validation" $ do + exampleCert <- BS.readFile "test/resources/unit/localhost.pem" + let settings = settingsWithAllowList [Domain "only.other.domain"] + res :: Either InwardError Domain = + run + . Polysemy.runError + . mockDiscoveryTrivial + . Polysemy.runReader settings + $ validateDomain (Just exampleCert) ("invalid//.><-semantic-&@-domain" :: Text) + res @?= Left (InwardError IAuthenticationFailed "Domain parse failure for [invalid//.><-semantic-&@-domain]: Failed reading: Invalid domain name: cannot be dotless domain") validateDomainAllowListFail :: TestTree validateDomainAllowListFail = - testCase "allow list validation" $ - runM . evalMock @Remote @IO $ do - let settings = settingsWithAllowList [Domain "only.other.domain"] - res :: Either InwardError Domain <- Polysemy.runError . Polysemy.runReader settings $ validateDomain ("hello.world" :: Text) - embed $ assertEqual "allow list:" (Left IFederationDeniedByRemote) (mapLeft inwardErrorType res) + testCase "allow list validation" $ do + exampleCert <- BS.readFile "test/resources/unit/localhost.example.com.pem" + let settings = settingsWithAllowList [Domain "only.other.domain"] + res :: Either InwardError Domain = + run + . Polysemy.runError + . mockDiscoveryTrivial + . Polysemy.runReader settings + $ validateDomain (Just exampleCert) ("localhost.example.com" :: Text) + res @?= Left (InwardError IFederationDeniedByRemote "Origin domain [localhost.example.com] not in the federation allow list") validateDomainAllowListSuccess :: TestTree validateDomainAllowListSuccess = - testCase "should give parsed domain if in the allow list" $ - -- removing evalMock @Remote doesn't seem to work, but why? - runM . evalMock @Remote @IO $ do - let domain = Domain "hello.world" - let settings = settingsWithAllowList [domain] - res :: Either InwardError Domain <- Polysemy.runError . Polysemy.runReader settings $ validateDomain ("hello.world" :: Text) - embed $ assertEqual "validateDomain should give 'hello.world' as domain" (Right domain) res + testCase "should give parsed domain if in the allow list" $ do + exampleCert <- BS.readFile "test/resources/unit/localhost.example.com.pem" + let domain = Domain "localhost.example.com" + settings = settingsWithAllowList [domain] + res :: Either InwardError Domain = + run + . Polysemy.runError + . mockDiscoveryTrivial + . Polysemy.runReader settings + $ validateDomain (Just exampleCert) (domainText domain) + assertEqual "validateDomain should give 'localhost.example.com' as domain" (Right domain) res + +validateDomainCertMissing :: TestTree +validateDomainCertMissing = + testCase "should fail if no client certificate is provided" $ do + let res :: Either InwardError Domain = + run . Polysemy.runError + . mockDiscoveryTrivial + . Polysemy.runReader noClientCertSettings + $ validateDomain Nothing "foo.example.com" + res @?= Left (InwardError IAuthenticationFailed "no client certificate provided") + +validateDomainCertInvalid :: TestTree +validateDomainCertInvalid = + testCase "should fail if the client certificate is invalid" $ do + let res :: Either InwardError Domain = + run . Polysemy.runError + . mockDiscoveryTrivial + . Polysemy.runReader noClientCertSettings + $ validateDomain (Just "not a certificate") "foo.example.com" + res @?= Left (InwardError IAuthenticationFailed "no certificate found") + +validateDomainCertWrongDomain :: TestTree +validateDomainCertWrongDomain = + testCase "should fail if the client certificate has a wrong domain" $ do + exampleCert <- BS.readFile "test/resources/unit/localhost.example.com.pem" + let res :: Either InwardError Domain = + run . Polysemy.runError + . mockDiscoveryTrivial + . Polysemy.runReader noClientCertSettings + $ validateDomain (Just exampleCert) "foo.example.com" + res @?= Left (InwardError IAuthenticationFailed "none of the domain names match the certificate, errrors: [[NameMismatch \"foo.example.com\"]]") + +validateDomainCertCN :: TestTree +validateDomainCertCN = + testCase "should succeed if the certificate has subject CN but no SAN" $ do + exampleCert <- BS.readFile "test/resources/unit/example.com.pem" + let domain = Domain "foo.example.com" + res :: Either InwardError Domain = + run . Polysemy.runError + . mockDiscoveryTrivial + . Polysemy.runReader noClientCertSettings + $ validateDomain (Just exampleCert) (domainText domain) + res @?= Right domain + +validateDomainMultipleFederators :: TestTree +validateDomainMultipleFederators = + testCase "should succedd if certificate matches any of the given federators" $ do + localhostExampleCert <- BS.readFile "test/resources/unit/localhost.example.com.pem" + secondExampleCert <- BS.readFile "test/resources/unit/second-federator.example.com.pem" + let runValidation = + run + . Polysemy.runError + . mockDiscoveryMapping domain ("localhost.example.com" :| ["second-federator.example.com"]) + . Polysemy.runReader noClientCertSettings + domain = Domain "foo.example.com" + resFirst :: Either InwardError Domain = + runValidation $ validateDomain (Just localhostExampleCert) (domainText domain) + resFirst @?= Right domain + let resSecond :: Either InwardError Domain = + runValidation $ validateDomain (Just secondExampleCert) (domainText domain) + resSecond @?= Right domain + +validateDomainDiscoveryFailed :: TestTree +validateDomainDiscoveryFailed = + testCase "should fail if discovery fails" $ do + exampleCert <- BS.readFile "test/resources/unit/example.com.pem" + let res :: Either InwardError Domain = + run . Polysemy.runError + . mockDiscoveryFailure + . Polysemy.runReader noClientCertSettings + $ validateDomain (Just exampleCert) "example.com" + res @?= Left (InwardError IDiscoveryFailed "DNS error: mock DNS error") + +validateDomainNonIdentitySRV :: TestTree +validateDomainNonIdentitySRV = + testCase "should run discovery to look up the federator domain" $ do + exampleCert <- BS.readFile "test/resources/unit/localhost.example.com.pem" + let domain = Domain "foo.example.com" + res :: Either InwardError Domain = + run . Polysemy.runError + . mockDiscoveryMapping domain ("localhost.example.com" :| []) + . Polysemy.runReader noClientCertSettings + $ validateDomain (Just exampleCert) (domainText domain) + res @?= Right domain validatePathSuccess :: [TestTree] validatePathSuccess = do @@ -107,8 +230,7 @@ validatePathSuccess = do where expectOk :: ByteString -> TestTree expectOk path = testCase ("should allow " <> cs path) $ do - res <- runSanitize path - res @?= Right path + runSanitize path @?= Right path validatePathNormalize :: [TestTree] validatePathNormalize = do @@ -122,8 +244,7 @@ validatePathNormalize = do expectNormalized :: (ByteString, ByteString) -> TestTree expectNormalized (input, output) = do testCase ("Should allow " <> cs input <> " and normalize to " <> cs output) $ do - res <- runSanitize input - res @?= Right output + runSanitize input @?= Right output validatePathForbidden :: [TestTree] validatePathForbidden = do @@ -161,20 +282,19 @@ validatePathForbidden = do expectForbidden :: ByteString -> TestTree expectForbidden input = do testCase ("Should forbid '" <> cs (BS.take 40 input) <> "'") $ do - res <- runSanitize input + let res = runSanitize input expectErr IForbiddenEndpoint res -runSanitize :: ByteString -> IO (Either InwardError ByteString) -runSanitize = runM . evalMock @Remote @IO . Polysemy.runError @InwardError . sanitizePath +runSanitize :: ByteString -> Either InwardError ByteString +runSanitize = run . Polysemy.runError @InwardError . sanitizePath expectErr :: InwardErrorType -> Either InwardError ByteString -> IO () expectErr expectedType (Right bdy) = do assertFailure $ "expected error '" <> show expectedType <> "' but got a valid body: " <> show bdy expectErr expectedType (Left err) = - unless (inwardErrorType err == expectedType) - . liftIO - $ assertFailure $ "expected type '" <> show expectedType <> "' but got " <> show err + unless (inwardErrorType err == expectedType) $ do + assertFailure $ "expected type '" <> show expectedType <> "' but got " <> show err settingsWithAllowList :: [Domain] -> RunSettings settingsWithAllowList domains = - RunSettings (AllowList (AllowedDomains domains)) False Nothing + noClientCertSettings {federationStrategy = AllowList (AllowedDomains domains)} diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index fc5676dabe9..691df1e42ae 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -17,10 +17,12 @@ module Galley.API.Federation where import Control.Monad.Catch (throwM) +import Control.Monad.Except (runExceptT) import Data.Containers.ListUtils (nubOrd) import Data.Domain import Data.Id (ConvId) import Data.Json.Util (Base64ByteString (..)) +import Data.List1 (list1) import Data.Qualified (Qualified (..)) import Data.Tagged import qualified Data.Text.Lazy as LT @@ -41,6 +43,8 @@ import Wire.API.Federation.API.Galley ( ConversationMemberUpdate (..), GetConversationsRequest (..), GetConversationsResponse (..), + LeaveConversationRequest (..), + LeaveConversationResponse (..), MessageSendRequest (..), MessageSendResponse (..), RegisterConversation (..), @@ -56,6 +60,7 @@ federationSitemap = { FederationAPIGalley.registerConversation = registerConversation, FederationAPIGalley.getConversations = getConversations, FederationAPIGalley.updateConversationMemberships = updateConversationMemberships, + FederationAPIGalley.leaveConversation = leaveConversation, FederationAPIGalley.receiveMessage = receiveMessage, FederationAPIGalley.sendMessage = sendMessage } @@ -87,28 +92,56 @@ getConversations (GetConversationsRequest qUid gcrConvIds) = do let convViews = Mapping.conversationViewMaybeQualified domain qUid <$> convs pure $ GetConversationsResponse . catMaybes $ convViews --- FUTUREWORK: also remove users from conversation +-- | Update the local database with information on conversation members joining +-- or leaving. Finally, push out notifications to local users. updateConversationMemberships :: ConversationMemberUpdate -> Galley () updateConversationMemberships cmu = do localDomain <- viewFederationDomain - let localUsers = filter ((== localDomain) . qDomain . fst) (cmuUsersAdd cmu) - localUserIds = map (qUnqualified . fst) localUsers - when (not (null localUsers)) $ do - Data.addLocalMembersToRemoteConv localUserIds (cmuConvId cmu) - let mems = SimpleMembers (map (uncurry SimpleMember) (cmuUsersAdd cmu)) - let event = + let users = case cmuAction cmu of + FederationAPIGalley.ConversationMembersActionAdd toAdd -> fst <$> toAdd + FederationAPIGalley.ConversationMembersActionRemove toRemove -> toRemove + localUsers = filter ((== localDomain) . qDomain) . toList $ users + localUserIds = qUnqualified <$> localUsers + targets = nubOrd $ cmuAlreadyPresentUsers cmu <> localUserIds + event <- case cmuAction cmu of + FederationAPIGalley.ConversationMembersActionAdd toAdd -> do + unless (null localUsers) $ + Data.addLocalMembersToRemoteConv localUserIds (cmuConvId cmu) + let mems = SimpleMembers (map (uncurry SimpleMember) . toList $ toAdd) + pure $ Event MemberJoin (cmuConvId cmu) (cmuOrigUserId cmu) (cmuTime cmu) (EdMembersJoin mems) - - -- send notifications - let targets = nubOrd $ cmuAlreadyPresentUsers cmu <> localUserIds + FederationAPIGalley.ConversationMembersActionRemove toRemove -> do + case localUserIds of + [] -> pure () + (h : t) -> + Data.removeLocalMembersFromRemoteConv + (cmuConvId cmu) + (list1 h t) + pure $ + Event + MemberLeave + (cmuConvId cmu) + (cmuOrigUserId cmu) + (cmuTime cmu) + (EdMembersLeave . QualifiedUserIdList . toList $ toRemove) -- FUTUREWORK: support bots? + -- send notifications pushConversationEvent Nothing event targets [] +leaveConversation :: + Domain -> + LeaveConversationRequest -> + Galley LeaveConversationResponse +leaveConversation requestingDomain lc = do + let leaver = Qualified (lcLeaver lc) requestingDomain + fmap LeaveConversationResponse . runExceptT . void $ + API.removeMemberFromLocalConv leaver Nothing (lcConvId lc) leaver + -- FUTUREWORK: report errors to the originating backend receiveMessage :: Domain -> RemoteMessage ConvId -> Galley () receiveMessage domain = diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 0e596c588ee..f78cdbfc294 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -30,7 +30,8 @@ import Control.Exception.Safe (catchAny) import Control.Lens hiding ((.=)) import Control.Monad.Catch (MonadCatch) import Data.Id as Id -import Data.List1 (List1, list1, maybeList1) +import Data.List1 (maybeList1) +import Data.Qualified (Qualified (Qualified)) import Data.Range import Data.String.Conversions (cs) import GHC.TypeLits (AppendSymbol) @@ -436,15 +437,14 @@ rmUser user conn = do tids <- Data.teamIdsForPagination user Nothing (rcast n) leaveTeams tids cids <- Data.conversationIdRowsForPagination user Nothing (rcast n) - let u = list1 user [] - leaveConversations u cids + leaveConversations user cids Data.eraseClients user where leaveTeams tids = for_ (Cql.result tids) $ \tid -> do mems <- Data.teamMembersForFanout tid uncheckedDeleteTeamMember user conn tid user mems leaveTeams =<< Cql.liftClient (Cql.nextPage tids) - leaveConversations :: List1 UserId -> Cql.Page ConvId -> Galley () + leaveConversations :: UserId -> Cql.Page ConvId -> Galley () leaveConversations u ids = do localDomain <- viewFederationDomain cc <- Data.conversations (Cql.result ids) @@ -455,9 +455,9 @@ rmUser user conn = do RegularConv | user `isMember` Data.convLocalMembers c -> do -- FUTUREWORK: deal with remote members, too, see removeMembers - e <- Data.removeLocalMembers localDomain c user u + e <- Data.removeLocalMembersFromLocalConv localDomain c (Qualified user localDomain) (pure u) return $ - (Intra.newPushLocal ListComplete user (Intra.ConvEvent e) (Intra.recipient <$> Data.convLocalMembers c)) + Intra.newPushLocal ListComplete user (Intra.ConvEvent e) (Intra.recipient <$> Data.convLocalMembers c) <&> set Intra.pushConn conn . set Intra.pushRoute Intra.RouteDirect | otherwise -> return Nothing diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 125b30e4b4d..d4f91209865 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -46,6 +46,7 @@ import Data.LegalHold (UserLegalHoldStatus (..), defUserLegalHoldStatus) import Data.List.Split (chunksOf) import Data.Misc import Data.Proxy (Proxy (Proxy)) +import Data.Qualified (Qualified (Qualified)) import Data.Range (toRange) import Galley.API.Error import Galley.API.Query (iterateConversations) @@ -486,6 +487,7 @@ handleGroupConvPolicyConflicts uid hypotheticalLHStatus = void $ iterateConversations uid (toRange (Proxy @500)) $ \convs -> do for_ (filter ((== RegularConv) . Data.convType) convs) $ \conv -> do + localDomain <- viewFederationDomain let FutureWork _convRemoteMembers' = FutureWork @'LegalholdPlusFederationNotImplemented Data.convRemoteMembers membersAndLHStatus :: [(LocalMember, UserLegalHoldStatus)] <- do @@ -502,12 +504,13 @@ handleGroupConvPolicyConflicts uid hypotheticalLHStatus = mems uidsLHStatus + let qconv = Data.convId conv `Qualified` localDomain if any ((== ConsentGiven) . consentGiven . snd) (filter ((== roleNameWireAdmin) . memConvRoleName . fst) membersAndLHStatus) then do for_ (filter ((== ConsentNotGiven) . consentGiven . snd) membersAndLHStatus) $ \(memberNoConsent, _) -> do - removeMember (memId memberNoConsent) Nothing (Data.convId conv) (memId memberNoConsent) + removeMember (memId memberNoConsent `Qualified` localDomain) Nothing qconv (Qualified (memId memberNoConsent) localDomain) else do for_ (filter (userLHEnabled . snd) membersAndLHStatus) $ \(legalholder, _) -> do - removeMember (memId legalholder) Nothing (Data.convId conv) (memId legalholder) + removeMember (memId legalholder `Qualified` localDomain) Nothing qconv (Qualified (memId legalholder) localDomain) diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index b256288b0ac..cba48a48c78 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -89,6 +89,8 @@ servantSitemap = GalleyAPI.createSelfConversation = Create.createSelfConversation, GalleyAPI.createOne2OneConversation = Create.createOne2OneConversation, GalleyAPI.addMembersToConversationV2 = Update.addMembers, + GalleyAPI.removeMemberUnqualified = Update.removeMemberUnqualified, + GalleyAPI.removeMember = Update.removeMemberQualified, GalleyAPI.getTeamConversationRoles = Teams.getTeamConversationRoles, GalleyAPI.getTeamConversations = Teams.getTeamConversations, GalleyAPI.getTeamConversation = Teams.getTeamConversation, @@ -806,25 +808,6 @@ sitemap = do description "JSON body" errorResponse (Error.errorDescriptionToWai Error.convNotFound) - -- This endpoint can lead to the following events being sent: - -- - MemberLeave event to members - delete "/conversations/:cnv/members/:usr" (continue Update.removeMemberH) $ - zauthUserId - .&. zauthConnId - .&. capture "cnv" - .&. capture "usr" - document "DELETE" "removeMember" $ do - summary "Remove member from conversation" - parameter Path "cnv" bytes' $ - description "Conversation ID" - parameter Path "usr" bytes' $ - description "Target User ID" - returns (ref Public.modelEvent) - response 200 "Member removed" end - response 204 "No change" end - errorResponse (Error.errorDescriptionToWai Error.convNotFound) - errorResponse $ Error.invalidOp "Conversation type does not allow removing members" - -- This endpoint can lead to the following events being sent: -- - OtrMessageAdd event to recipients post "/broadcast/otr/messages" (continue Update.postOtrBroadcastH) $ diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 8dfbc7476f1..62b1181d5d7 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -352,7 +352,7 @@ uncheckedDeleteTeam zusr zcon tid = do localDomain <- viewFederationDomain let qconvId = Qualified (c ^. conversationId) localDomain qorig = Qualified zusr localDomain - (bots, convMembs) <- botsAndUsers <$> Data.members (c ^. conversationId) + (bots, convMembs) <- localBotsAndUsers <$> Data.members (c ^. conversationId) -- Only nonTeamMembers need to get any events, since on team deletion, -- all team users are deleted immediately after these events are sent -- and will thus never be able to see these events in practice. @@ -715,7 +715,7 @@ uncheckedDeleteTeamMember zusr zcon tid remove mems = do -- notify all team members. pushMemberLeaveEvent :: UTCTime -> Galley () pushMemberLeaveEvent now = do - let e = newEvent MemberLeave tid now & eventData .~ Just (EdMemberLeave remove) + let e = newEvent MemberLeave tid now & eventData ?~ EdMemberLeave remove let r = list1 (userRecipient zusr) (membersToRecipients (Just zusr) (mems ^. teamMembers)) push1 $ newPushLocal1 (mems ^. teamMemberListType) zusr (TeamEvent e) r & pushConn .~ zcon -- notify all conversation members not in this team. @@ -724,8 +724,9 @@ uncheckedDeleteTeamMember zusr zcon tid remove mems = do -- This may not make sense if that list has been truncated. In such cases, we still want to -- remove the user from conversations but never send out any events. We assume that clients -- handle nicely these missing events, regardless of whether they are in the same team or not + localDomain <- viewFederationDomain let tmids = Set.fromList $ map (view userId) (mems ^. teamMembers) - let edata = Conv.EdMembersLeave (Conv.UserIdList [remove]) + let edata = Conv.EdMembersLeave (Conv.QualifiedUserIdList [Qualified remove localDomain]) cc <- Data.teamConversations tid for_ cc $ \c -> Data.conversation (c ^. conversationId) >>= \conv -> @@ -739,7 +740,7 @@ uncheckedDeleteTeamMember zusr zcon tid remove mems = do localDomain <- viewFederationDomain let qconvId = Qualified (Data.convId dc) localDomain qusr = Qualified zusr localDomain - let (bots, users) = botsAndUsers (Data.convLocalMembers dc) + let (bots, users) = localBotsAndUsers (Data.convLocalMembers dc) let x = filter (\m -> not (Conv.memId m `Set.member` exceptTo)) users let y = Conv.Event Conv.MemberLeave qconvId qusr now edata for_ (newPushLocal (mems ^. teamMemberListType) zusr (ConvEvent y) (recipient <$> x)) $ \p -> @@ -765,8 +766,8 @@ deleteTeamConversation zusr zcon tid cid = do localDomain <- viewFederationDomain let qconvId = Qualified cid localDomain qusr = Qualified zusr localDomain - (bots, cmems) <- botsAndUsers <$> Data.members cid - ensureActionAllowed Roles.DeleteConversation =<< getSelfMember zusr cmems + (bots, cmems) <- localBotsAndUsers <$> Data.members cid + ensureActionAllowedThrowing Roles.DeleteConversation =<< getSelfMemberFromLocalsLegacy zusr cmems flip Data.deleteCode Data.ReusableCode =<< Data.mkKey cid now <- liftIO getCurrentTime let ce = Conv.Event Conv.ConvDelete qconvId qusr now Conv.EdConvDelete diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 9da41f6fe85..8c84414a569 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2020 Wire Swiss GmbH @@ -39,8 +37,10 @@ module Galley.API.Update addMembers, updateSelfMemberH, updateOtherMemberH, - removeMemberH, removeMember, + removeMemberQualified, + removeMemberUnqualified, + removeMemberFromLocalConv, -- * Talking postProteusMessage, @@ -60,14 +60,19 @@ module Galley.API.Update where import qualified Brig.Types.User as User +import Control.Arrow ((&&&)) import Control.Lens import Control.Monad.Catch import Control.Monad.State +import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE, withExceptT) import Data.ByteString.Conversion (toByteString') import Data.Code +import Data.Domain (Domain) +import Data.Either.Extra (mapRight) import Data.Id import Data.Json.Util (fromBase64TextLenient, toUTCTimeMillis) import Data.List.Extra (nubOrd) +import Data.List.NonEmpty (NonEmpty (..)) import Data.List1 import qualified Data.Map.Strict as Map import Data.Misc (FutureWork (FutureWork)) @@ -94,6 +99,7 @@ import Galley.Types import Galley.Types.Bot hiding (addBot) import Galley.Types.Clients (Clients) import qualified Galley.Types.Clients as Clients +import Galley.Types.Conversations.Members (RemoteMember (rmConvRoleName, rmId)) import Galley.Types.Conversations.Roles (Action (..), RoleName, roleNameWireMember) import Galley.Types.Teams hiding (Event, EventData (..), EventType (..), self) import Galley.Validation @@ -109,7 +115,8 @@ import qualified Wire.API.Conversation as Public import qualified Wire.API.Conversation.Code as Public import Wire.API.Conversation.Role (roleNameWireAdmin) import Wire.API.ErrorDescription - ( codeNotFound, + ( ConvNotFound, + codeNotFound, convNotFound, missingLegalholdConsent, unknownClient, @@ -117,14 +124,16 @@ import Wire.API.ErrorDescription import qualified Wire.API.ErrorDescription as Public import qualified Wire.API.Event.Conversation as Public import Wire.API.Federation.API.Galley (RemoteMessage (..)) +import qualified Wire.API.Federation.API.Galley as FederatedGalley import qualified Wire.API.Message as Public import Wire.API.Routes.Public.Galley (UpdateResult (..)) +import Wire.API.Routes.Public.Galley.Responses import Wire.API.ServantProto (RawProto (..)) import Wire.API.Team.LegalHold (LegalholdProtectee (..)) import Wire.API.User.Client acceptConvH :: UserId ::: Maybe ConnId ::: ConvId -> Galley Response -acceptConvH (usr ::: conn ::: cnv) = do +acceptConvH (usr ::: conn ::: cnv) = setStatus status200 . json <$> acceptConv usr conn cnv acceptConv :: UserId -> Maybe ConnId -> ConvId -> Galley Conversation @@ -134,7 +143,7 @@ acceptConv usr conn cnv = do conversationView usr conv' blockConvH :: UserId ::: ConvId -> Galley Response -blockConvH (zusr ::: cnv) = do +blockConvH (zusr ::: cnv) = empty <$ blockConv zusr cnv blockConv :: UserId -> ConvId -> Galley () @@ -147,7 +156,7 @@ blockConv zusr cnv = do when (zusr `isMember` mems) $ Data.removeMember zusr cnv unblockConvH :: UserId ::: Maybe ConnId ::: ConvId -> Galley Response -unblockConvH (usr ::: conn ::: cnv) = do +unblockConvH (usr ::: conn ::: cnv) = setStatus status200 . json <$> unblockConv usr conn cnv unblockConv :: UserId -> Maybe ConnId -> ConvId -> Galley Conversation @@ -181,13 +190,13 @@ updateConversationAccess usr zcon cnv update = do when (PrivateAccess `elem` targetAccess || PrivateAccessRole == targetRole) $ throwM invalidTargetAccess -- The user who initiated access change has to be a conversation member - (bots, users) <- botsAndUsers <$> Data.members cnv + (bots, users) <- localBotsAndUsers <$> Data.members cnv ensureConvMember users usr conv <- Data.conversation cnv >>= ifNothing (errorDescriptionToWai convNotFound) -- The conversation has to be a group conversation - ensureGroupConv conv - self <- getSelfMember usr users - ensureActionAllowed ModifyConversationAccess self + ensureGroupConvThrowing conv + self <- getSelfMemberFromLocalsLegacy usr users + ensureActionAllowedThrowing ModifyConversationAccess self -- Team conversations incur another round of checks case Data.convTeam conv of Just tid -> checkTeamConv tid self @@ -218,7 +227,7 @@ updateConversationAccess usr zcon cnv update = do throwM invalidManagedConvOp -- Access mode change might result in members being removed from the -- conversation, so the user must have the necessary permission flag - ensureActionAllowed RemoveConversationMember self + ensureActionAllowedThrowing RemoveConversationMember self uncheckedUpdateConversationAccess :: ConversationAccessUpdate -> @@ -273,7 +282,7 @@ uncheckedUpdateConversationAccess body usr zcon conv (currentAccess, targetAcces [] -> return () x : xs -> do -- FUTUREWORK: deal with remote members, too, see removeMembers - e <- Data.removeLocalMembers localDomain conv usr (list1 x xs) + e <- Data.removeLocalMembersFromLocalConv localDomain conv (Qualified usr localDomain) (x :| xs) -- push event to all clients, including zconn -- since updateConversationAccess generates a second (member removal) event here for_ (newPushLocal ListComplete usr (ConvEvent e) (recipient <$> users)) $ \p -> push1 p @@ -296,8 +305,8 @@ updateConversationReceiptMode usr zcon cnv receiptModeUpdate@(Public.Conversatio localDomain <- viewFederationDomain let qcnv = Qualified cnv localDomain qusr = Qualified usr localDomain - (bots, users) <- botsAndUsers <$> Data.members cnv - ensureActionAllowed ModifyConversationReceiptMode =<< getSelfMember usr users + (bots, users) <- localBotsAndUsers <$> Data.members cnv + ensureActionAllowedThrowing ModifyConversationReceiptMode =<< getSelfMemberFromLocalsLegacy usr users current <- Data.lookupReceiptMode cnv if current == Just target then pure Unchanged @@ -322,10 +331,11 @@ updateConversationMessageTimer usr zcon cnv timerUpdate@(Public.ConversationMess let qcnv = Qualified cnv localDomain qusr = Qualified usr localDomain -- checks and balances - (bots, users) <- botsAndUsers <$> Data.members cnv - ensureActionAllowed ModifyConversationMessageTimer =<< getSelfMember usr users + (bots, users) <- localBotsAndUsers <$> Data.members cnv + ensureActionAllowedThrowing ModifyConversationMessageTimer + =<< getSelfMemberFromLocalsLegacy usr users conv <- Data.conversation cnv >>= ifNothing (errorDescriptionToWai convNotFound) - ensureGroupConv conv + ensureGroupConvThrowing conv let currentTimer = Data.convMessageTimer conv if currentTimer == target then pure Unchanged @@ -340,7 +350,7 @@ updateConversationMessageTimer usr zcon cnv timerUpdate@(Public.ConversationMess pure timerEvent addCodeH :: UserId ::: ConnId ::: ConvId -> Galley Response -addCodeH (usr ::: zcon ::: cnv) = do +addCodeH (usr ::: zcon ::: cnv) = addCode usr zcon cnv <&> \case CodeAdded event -> json event & setStatus status201 CodeAlreadyExisted conversationCode -> json conversationCode & setStatus status200 @@ -357,7 +367,7 @@ addCode usr zcon cnv = do conv <- Data.conversation cnv >>= ifNothing (errorDescriptionToWai convNotFound) ensureConvMember (Data.convLocalMembers conv) usr ensureAccess conv CodeAccess - let (bots, users) = botsAndUsers $ Data.convLocalMembers conv + let (bots, users) = localBotsAndUsers $ Data.convLocalMembers conv key <- mkKey cnv mCode <- Data.lookupCode key ReusableCode case mCode of @@ -379,7 +389,7 @@ addCode usr zcon cnv = do return $ mkConversationCode (codeKey code) (codeValue code) urlPrefix rmCodeH :: UserId ::: ConnId ::: ConvId -> Galley Response -rmCodeH (usr ::: zcon ::: cnv) = do +rmCodeH (usr ::: zcon ::: cnv) = setStatus status200 . json <$> rmCode usr zcon cnv rmCode :: UserId -> ConnId -> ConvId -> Galley Public.Event @@ -390,7 +400,7 @@ rmCode usr zcon cnv = do conv <- Data.conversation cnv >>= ifNothing (errorDescriptionToWai convNotFound) ensureConvMember (Data.convLocalMembers conv) usr ensureAccess conv CodeAccess - let (bots, users) = botsAndUsers $ Data.convLocalMembers conv + let (bots, users) = localBotsAndUsers $ Data.convLocalMembers conv key <- mkKey cnv Data.deleteCode key ReusableCode now <- liftIO getCurrentTime @@ -399,7 +409,7 @@ rmCode usr zcon cnv = do pure event getCodeH :: UserId ::: ConvId -> Galley Response -getCodeH (usr ::: cnv) = do +getCodeH (usr ::: cnv) = setStatus status200 . json <$> getCode usr cnv getCode :: UserId -> ConvId -> Galley Public.ConversationCode @@ -425,7 +435,7 @@ checkReusableCodeH req = do pure empty checkReusableCode :: Public.ConversationCode -> Galley () -checkReusableCode convCode = do +checkReusableCode convCode = void $ verifyReusableCode convCode joinConversationByReusableCodeH :: UserId ::: ConnId ::: JsonRequest Public.ConversationCode -> Galley Response @@ -455,7 +465,7 @@ joinConversation zusr zcon cnv access = do -- NOTE: When joining conversations, all users become members -- as this is our desired behavior for these types of conversations -- where there is no way to control who joins, etc. - let mems = botsAndUsers (Data.convLocalMembers conv) + let mems = localBotsAndUsers (Data.convLocalMembers conv) let rMems = Data.convRemoteMembers conv addToConversation mems rMems (zusr, roleNameWireMember) zcon ((,roleNameWireMember) <$> newUsers) [] conv @@ -482,10 +492,10 @@ addMembersH (zusr ::: zcon ::: cid ::: req) = do addMembers :: UserId -> ConnId -> ConvId -> Public.InviteQualified -> Galley UpdateResult addMembers zusr zcon convId invite = do conv <- Data.conversation convId >>= ifNothing (errorDescriptionToWai convNotFound) - let mems = botsAndUsers (Data.convLocalMembers conv) + let mems = localBotsAndUsers (Data.convLocalMembers conv) let rMems = Data.convRemoteMembers conv - self <- getSelfMember zusr (snd mems) - ensureActionAllowed AddConversationMember self + self <- getSelfMemberFromLocalsLegacy zusr (snd mems) + ensureActionAllowedThrowing AddConversationMember self let invitedUsers = toList $ Public.invQUsers invite domain <- viewFederationDomain let (invitedRemotes, invitedLocals) = partitionRemoteOrLocalIds' domain invitedUsers @@ -498,10 +508,13 @@ addMembers zusr zcon convId invite = do checkRemoteUsersExist newRemotes checkLHPolicyConflictsLocal conv newLocals checkLHPolicyConflictsRemote (FutureWork newRemotes) - addToConversation mems rMems (zusr, memConvRoleName self) zcon ((,invQRoleName invite) <$> newLocals) ((,invQRoleName invite) <$> newRemotes) conv + addToConversation mems rMems (zusr, memConvRoleName self) zcon (withRoles newLocals) (withRoles newRemotes) conv where userIsMember u = (^. userId . to (== u)) + withRoles :: [a] -> [(a, RoleName)] + withRoles = map (,invQRoleName invite) + checkLocals :: Data.Conversation -> Maybe TeamId -> [UserId] -> Galley () checkLocals conv (Just tid) newUsers = do tms <- Data.teamMembersLimited tid newUsers @@ -540,11 +553,13 @@ addMembers zusr zcon convId invite = do ) convUsersLHStatus then do - for_ convUsersLHStatus $ \(mem, status) -> do + localDomain <- viewFederationDomain + for_ convUsersLHStatus $ \(mem, status) -> when (consentGiven status == ConsentNotGiven) $ - void $ removeMember (memId mem) Nothing (Data.convId conv) (memId mem) - else do - throwErrorDescription missingLegalholdConsent + let qvictim = Qualified (memId mem) localDomain + in void $ + removeMember (memId mem `Qualified` localDomain) Nothing (Data.convId conv `Qualified` localDomain) qvictim + else throwErrorDescription missingLegalholdConsent checkLHPolicyConflictsRemote :: FutureWork 'LegalholdPlusFederationNotImplemented [Remote UserId] -> Galley () checkLHPolicyConflictsRemote _remotes = pure () @@ -558,7 +573,7 @@ updateSelfMemberH (zusr ::: zcon ::: cid ::: req) = do updateSelfMember :: UserId -> ConnId -> ConvId -> Public.MemberUpdate -> Galley () updateSelfMember zusr zcon cid update = do conv <- getConversationAndCheckMembership zusr cid - m <- getSelfMember zusr (Data.convLocalMembers conv) + m <- getSelfMemberFromLocalsLegacy zusr (Data.convLocalMembers conv) -- Ensure no self role upgrades for_ (mupConvRoleName update) $ ensureConvRoleNotElevated m void $ processUpdateMemberEvent zusr zcon cid [m] m update @@ -574,47 +589,143 @@ updateOtherMember zusr zcon cid victim update = do when (zusr == victim) $ throwM invalidTargetUserOp conv <- getConversationAndCheckMembership zusr cid - let (bots, users) = botsAndUsers (Data.convLocalMembers conv) - ensureActionAllowed ModifyOtherConversationMember =<< getSelfMember zusr users - memTarget <- getOtherMember victim users + let (bots, users) = localBotsAndUsers (Data.convLocalMembers conv) + ensureActionAllowedThrowing ModifyOtherConversationMember =<< getSelfMemberFromLocalsLegacy zusr users + memTarget <- getOtherMemberLegacy victim users e <- processUpdateMemberEvent zusr zcon cid users memTarget (memberUpdate {mupConvRoleName = omuConvRoleName update}) void . forkIO $ void $ External.deliver (bots `zip` repeat e) -removeMemberH :: UserId ::: ConnId ::: ConvId ::: UserId -> Galley Response -removeMemberH (zusr ::: zcon ::: cid ::: victim) = do - handleUpdateResult <$> removeMember zusr (Just zcon) cid victim +-- | A general conversation member removal function used both by the unqualified +-- and the qualified endpoint for member removal. This is also used to leave a +-- conversation. +removeMember :: + Qualified UserId -> + Maybe ConnId -> + Qualified ConvId -> + Qualified UserId -> + Galley RemoveFromConversationResponse +removeMember remover zcon qconvId@(Qualified conv convDomain) victim = do + localDomain <- viewFederationDomain + if localDomain == convDomain + then + runExceptT $ + removeMemberFromLocalConv remover zcon conv victim + else + if remover == victim + then do + let lc = FederatedGalley.LeaveConversationRequest conv (qUnqualified victim) + let rpc = + FederatedGalley.leaveConversation + FederatedGalley.clientRoutes + (qDomain victim) + lc + t <- liftIO getCurrentTime + let successEvent = Event MemberLeave qconvId remover t (EdMembersLeave (QualifiedUserIdList [victim])) + mapRight (const successEvent) . FederatedGalley.leaveResponse <$> runFederated convDomain rpc + else pure . Left $ RemoveFromConversationErrorRemovalNotAllowed + +removeMemberUnqualified :: UserId -> ConnId -> ConvId -> UserId -> Galley RemoveFromConversationResponse +removeMemberUnqualified zusr zcon conv victim = do + localDomain <- viewFederationDomain + let qualify :: v -> Qualified v + qualify a = a `Qualified` localDomain + removeMember (qualify zusr) (Just zcon) (qualify conv) (qualify victim) -removeMember :: UserId -> Maybe ConnId -> ConvId -> UserId -> Galley UpdateResult -removeMember zusr zcon convId victim = do +removeMemberQualified :: + UserId -> + ConnId -> + Qualified ConvId -> + Qualified UserId -> + Galley RemoveFromConversationResponse +removeMemberQualified zusr zcon conv victim = do localDomain <- viewFederationDomain - -- FUTUREWORK(federation, #1274): forward request to conversation's backend. - conv <- Data.conversation convId >>= ifNothing (errorDescriptionToWai convNotFound) - let (bots, users) = botsAndUsers (Data.convLocalMembers conv) - genConvChecks conv users - case Data.convTeam conv of - Nothing -> pure () - Just ti -> teamConvChecks ti - if victim `isMember` users - then do - -- FUTUREWORK: deal with remote members, too, see removeMembers - event <- Data.removeLocalMembers localDomain conv zusr (singleton victim) - -- FUTUREWORK(federation, #1274): users can be on other backend, how to notify it? - for_ (newPushLocal ListComplete zusr (ConvEvent event) (recipient <$> users)) $ \p -> - push1 $ p & pushConn .~ zcon + removeMember (Qualified zusr localDomain) (Just zcon) conv victim - void . forkIO $ void $ External.deliver (bots `zip` repeat event) - pure $ Updated event - else pure Unchanged +-- | Remove a member from a local conversation. +removeMemberFromLocalConv :: + -- | The remover + Qualified UserId -> + -- | Optional connection ID + Maybe ConnId -> + -- | The ID of a conversation local to this domain + ConvId -> + -- | The member to remove + Qualified UserId -> + ExceptT RemoveFromConversationError Galley Public.Event +removeMemberFromLocalConv remover@(Qualified removerUid removerDomain) zcon convId qvictim@(Qualified victim victimDomain) = do + localDomain <- viewFederationDomain + conv <- + lift (Data.conversation convId) + >>= maybe (throwE RemoveFromConversationErrorNotFound) pure + let (bots, locals) = localBotsAndUsers (Data.convLocalMembers conv) + + removerRole <- + withExceptT (const @_ @ConvNotFound RemoveFromConversationErrorNotFound) $ + if localDomain == removerDomain + then memConvRoleName <$> getSelfMemberFromLocals removerUid locals + else rmConvRoleName <$> getSelfMemberFromRemotes (toRemote remover) (Data.convRemoteMembers conv) + + generalConvChecks localDomain removerRole conv + for_ (Data.convTeam conv) teamConvChecks + + unless + ( (victimDomain == localDomain && victim `isMember` locals) + || toRemote qvictim `isRemoteMember` Data.convRemoteMembers conv + ) + $ throwE RemoveFromConversationErrorUnchanged + + event <- + if victimDomain == localDomain + then Data.removeLocalMembersFromLocalConv localDomain conv remover (pure victim) + else Data.removeRemoteMembersFromLocalConv localDomain conv remover (pure . toRemote $ qvictim) + + -- Notify local users + let localRemover = guard (removerDomain == localDomain) $> removerUid + for_ (newPush ListComplete localRemover (ConvEvent event) (recipient <$> locals)) $ \p -> + lift . push1 $ p & pushConn .~ zcon + + -- Notify the bots + lift . void . forkIO . void $ External.deliver (bots `zip` repeat event) + + -- Notify remote backends + let existingRemotes = rmId <$> Data.convRemoteMembers conv + let action = FederatedGalley.ConversationMembersActionRemove $ pure qvictim + lift $ notifyRemoteAboutConvUpdate remover convId (evtTime event) action existingRemotes + + pure event where - genConvChecks conv usrs = do - ensureGroupConv conv - if zusr == victim - then ensureActionAllowed LeaveConversation =<< getSelfMember zusr usrs - else ensureActionAllowed RemoveConversationMember =<< getSelfMember zusr usrs + generalConvChecks :: + Monad m => + Domain -> + RoleName -> + Data.Conversation -> + ExceptT RemoveFromConversationError m () + generalConvChecks localDomain removerRole conv = do + -- remote users can't remove others + when (removerDomain /= localDomain && remover /= qvictim) $ + throwE RemoveFromConversationErrorRemovalNotAllowed + + case ensureGroupConv (Data.convType conv) of + Left GroupConvInvalidOpSelfConv -> throwE RemoveFromConversationErrorSelfConv + Left GroupConvInvalidOpOne2OneConv -> throwE RemoveFromConversationErrorOne2OneConv + Left GroupConvInvalidOpConnectConv -> throwE RemoveFromConversationErrorConnectConv + Right () -> pure () + let action + | remover == qvictim = LeaveConversation + | otherwise = RemoveConversationMember + case ensureActionAllowed action removerRole of + ACOAllowed -> + pure () + ACOActionDenied _ -> + throwE RemoveFromConversationErrorRemovalNotAllowed + ACOCustomRolesNotSupported -> + throwE RemoveFromConversationErrorCustomRolesNotSupported + + teamConvChecks :: TeamId -> ExceptT RemoveFromConversationError Galley () teamConvChecks tid = do tcv <- Data.teamConversation tid convId when (maybe False (view managedConversation) tcv) $ - throwM (invalidOp "Users can not be removed from managed conversations.") + throwE RemoveFromConversationErrorManagedConvNotAllowed -- OTR @@ -638,7 +749,7 @@ postBotMessageH (zbot ::: zcnv ::: val ::: req ::: _) = do handleOtrResult =<< postBotMessage zbot zcnv val' message postBotMessage :: BotId -> ConvId -> Public.OtrFilterMissing -> Public.NewOtrMessage -> Galley OtrResult -postBotMessage zbot zcnv val message = do +postBotMessage zbot zcnv val message = postNewOtrMessage Bot (botUserId zbot) Nothing zcnv val message -- | FUTUREWORK: Send message to remote users, as of now this function fails if @@ -692,8 +803,7 @@ postOtrBroadcastH (zusr ::: zcon ::: val ::: req) = do handleOtrResult =<< postOtrBroadcast zusr zcon val' message postOtrBroadcast :: UserId -> ConnId -> Public.OtrFilterMissing -> Public.NewOtrMessage -> Galley OtrResult -postOtrBroadcast zusr zcon val message = - postNewOtrBroadcast zusr (Just zcon) val message +postOtrBroadcast zusr zcon = postNewOtrBroadcast zusr (Just zcon) -- internal OTR helpers @@ -742,7 +852,7 @@ postRemoteToLocal rm = do -- FUTUREWORK(authorization) review whether filtering members is appropriate -- at this stage (members, allMembers) <- Data.filterRemoteConvMembers (Map.keys rcpts) conv - unless allMembers $ do + unless allMembers $ Log.warn $ Log.field "conversation" (toByteString' (qUnqualified conv)) Log.~~ Log.field "domain" (toByteString' (qDomain conv)) @@ -804,7 +914,7 @@ newMessage qusr con qcnv msg now (m, c, t) ~(toBots, toUsers) = -- use recipient's client's self conversation on broadcast -- (with federation, this might not work for remote members) -- FUTUREWORK: for remote recipients, set the domain correctly here - qconv = fromMaybe ((`Qualified` (qDomain qusr)) . selfConv $ memId m) qcnv + qconv = fromMaybe ((`Qualified` qDomain qusr) . selfConv $ memId m) qcnv e = Event OtrMessageAdd qconv qusr now (EdOtrMessage o) r = recipient m & recipientClients .~ RecipientClientsSome (singleton c) in case newBotMember m of @@ -837,8 +947,8 @@ updateConversationName zusr zcon cnv convRename = do unless alive $ do Data.deleteConversation cnv throwErrorDescription convNotFound - (bots, users) <- botsAndUsers <$> Data.members cnv - ensureActionAllowed ModifyConversationName =<< getSelfMember zusr users + (bots, users) <- localBotsAndUsers <$> Data.members cnv + ensureActionAllowedThrowing ModifyConversationName =<< getSelfMemberFromLocalsLegacy zusr users now <- liftIO getCurrentTime cn <- rangeChecked (cupName convRename) Data.updateConversation cnv cn @@ -903,11 +1013,11 @@ addBot zusr zcon b = do pure e where regularConvChecks c = do - let (bots, users) = botsAndUsers (Data.convLocalMembers c) + let (bots, users) = localBotsAndUsers (Data.convLocalMembers c) unless (zusr `isMember` users) $ throwErrorDescription convNotFound - ensureGroupConv c - ensureActionAllowed AddConversationMember =<< getSelfMember zusr users + ensureGroupConvThrowing c + ensureActionAllowedThrowing AddConversationMember =<< getSelfMemberFromLocalsLegacy zusr users unless (any ((== b ^. addBotId) . botMemId) bots) $ ensureMemberLimit (toList $ Data.convLocalMembers c) [botUserId (b ^. addBotId)] [] return (bots, users) @@ -929,12 +1039,12 @@ rmBot zusr zcon b = do qusr = Qualified zusr localDomain unless (zusr `isMember` Data.convLocalMembers c) $ throwErrorDescription convNotFound - let (bots, users) = botsAndUsers (Data.convLocalMembers c) + let (bots, users) = localBotsAndUsers (Data.convLocalMembers c) if not (any ((== b ^. rmBotId) . botMemId) bots) then pure Unchanged else do t <- liftIO getCurrentTime - let evd = EdMembersLeave (UserIdList [botUserId (b ^. rmBotId)]) + let evd = EdMembersLeave (QualifiedUserIdList [Qualified (botUserId (b ^. rmBotId)) localDomain]) let e = Event MemberLeave qcnv qusr t evd for_ (newPushLocal ListComplete zusr (ConvEvent e) (recipient <$> users)) $ \p -> push1 $ p & pushConn .~ zcon @@ -964,22 +1074,43 @@ addToConversation :: Galley UpdateResult addToConversation _ _ _ _ [] [] _ = pure Unchanged addToConversation (bots, existingLocals) existingRemotes (usr, usrRole) conn newLocals newRemotes c = do - ensureGroupConv c + ensureGroupConvThrowing c mems <- checkedMemberAddSize newLocals newRemotes now <- liftIO getCurrentTime localDomain <- viewFederationDomain (e, lmm, rmm) <- Data.addMembersWithRole localDomain now (Data.convId c) (usr, usrRole) mems - updateRemoteConversationMemberships existingRemotes usr now c lmm rmm + let newMembersWithRoles = + ((flip Qualified localDomain . memId &&& memConvRoleName) <$> lmm) + <> ((unTagged . rmId &&& rmConvRoleName) <$> rmm) + case newMembersWithRoles of + [] -> + pure () + (x : xs) -> do + let action = FederatedGalley.ConversationMembersActionAdd (x :| xs) + qusr = Qualified usr localDomain + notifyRemoteAboutConvUpdate qusr (convId c) now action (rmId <$> existingRemotes <> rmm) let localsToNotify = nubOrd . fmap memId $ existingLocals <> lmm pushConversationEvent (Just conn) e localsToNotify bots pure $ Updated e -ensureGroupConv :: MonadThrow m => Data.Conversation -> m () -ensureGroupConv c = case Data.convType c of - SelfConv -> throwM invalidSelfOp - One2OneConv -> throwM invalidOne2OneOp - ConnectConv -> throwM invalidConnectOp - _ -> return () +data GroupConvInvalidOp + = GroupConvInvalidOpSelfConv + | GroupConvInvalidOpOne2OneConv + | GroupConvInvalidOpConnectConv + +ensureGroupConv :: ConvType -> Either GroupConvInvalidOp () +ensureGroupConv = \case + SelfConv -> Left GroupConvInvalidOpSelfConv + One2OneConv -> Left GroupConvInvalidOpOne2OneConv + ConnectConv -> Left GroupConvInvalidOpConnectConv + _ -> Right () + +ensureGroupConvThrowing :: MonadThrow m => Data.Conversation -> m () +ensureGroupConvThrowing c = case ensureGroupConv (Data.convType c) of + Left GroupConvInvalidOpSelfConv -> throwM invalidSelfOp + Left GroupConvInvalidOpOne2OneConv -> throwM invalidOne2OneOp + Left GroupConvInvalidOpConnectConv -> throwM invalidConnectOp + Right () -> return () ensureMemberLimit :: [LocalMember] -> [UserId] -> [Remote UserId] -> Galley () ensureMemberLimit old newLocals newRemotes = do diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index bc0c8060e18..352c63d455e 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RecordWildCards #-} -- This file is part of the Wire Server implementation. @@ -22,12 +21,12 @@ module Galley.API.Util where import Brig.Types (Relation (..)) import Brig.Types.Intra (ReAuthUser (..)) -import Control.Arrow (Arrow (second), second, (&&&)) -import Control.Error (ExceptT) +import Control.Arrow (Arrow (second), second) +import Control.Error (ExceptT, hoistEither, note) import Control.Lens (set, view, (.~), (^.)) import Control.Monad.Catch import Control.Monad.Except (runExceptT) -import Control.Monad.Extra (allM, anyM) +import Control.Monad.Extra (allM, anyM, eitherM) import Data.ByteString.Conversion import Data.Domain (Domain) import Data.Id as Id @@ -35,7 +34,7 @@ import Data.LegalHold (UserLegalHoldStatus (..), defUserLegalHoldStatus) import Data.List.Extra (chunksOf, nubOrd) import qualified Data.Map as Map import Data.Misc (PlainTextPassword (..)) -import Data.Qualified (Qualified (..), Remote, partitionQualified) +import Data.Qualified (Qualified (..), Remote, partitionQualified, toRemote) import qualified Data.Set as Set import Data.Tagged (Tagged (unTagged)) import qualified Data.Text.Lazy as LT @@ -126,15 +125,30 @@ ensureReAuthorised u secret = do unless reAuthed $ throwM reAuthFailed +-- | Possible outcomes of ensuring an action is allowed. +data ActionCheckingOutcome + = ACOAllowed + | ACOActionDenied Action + | ACOCustomRolesNotSupported + +-- | Given a member in a conversation, check if the given action +-- is permitted. +ensureActionAllowed :: Action -> RoleName -> ActionCheckingOutcome +ensureActionAllowed action role = case isActionAllowed action role of + Just True -> ACOAllowed + Just False -> ACOActionDenied action + Nothing -> ACOCustomRolesNotSupported + -- | Given a member in a conversation, check if the given action -- is permitted. -- If not, throw 'Member'; if the user is found and does not have the given permission, throw -- 'operationDenied'. Otherwise, return the found user. -ensureActionAllowed :: Action -> InternalMember a -> Galley () -ensureActionAllowed action mem = case isActionAllowed action (memConvRoleName mem) of - Just True -> return () - Just False -> throwErrorDescription (actionDenied action) - Nothing -> throwM (badRequest "Custom roles not supported") +ensureActionAllowedThrowing :: Action -> InternalMember a -> Galley () +ensureActionAllowedThrowing action mem = + case ensureActionAllowed action (memConvRoleName mem) of + ACOAllowed -> return () + ACOActionDenied _ -> throwErrorDescription (actionDenied action) + ACOCustomRolesNotSupported -> throwM (badRequest "Custom roles not supported") -- Actually, this will "never" happen due to the -- fact that there can be no custom roles at the moment @@ -235,8 +249,8 @@ isRemoteMember u = isJust . find ((u ==) . rmId) findMember :: Data.Conversation -> UserId -> Maybe LocalMember findMember c u = find ((u ==) . memId) (Data.convLocalMembers c) -botsAndUsers :: Foldable f => f LocalMember -> ([BotMember], [LocalMember]) -botsAndUsers = foldMap botOrUser +localBotsAndUsers :: Foldable f => f LocalMember -> ([BotMember], [LocalMember]) +localBotsAndUsers = foldMap botOrUser where botOrUser m = case memService m of -- we drop invalid bots here, which shouldn't happen @@ -264,22 +278,90 @@ membersToRecipients Nothing = map (userRecipient . view userId) membersToRecipients (Just u) = map userRecipient . filter (/= u) . map (view userId) -- | Note that we use 2 nearly identical functions but slightly different --- semantics; when using `getSelfMember`, if that user is _not_ part of --- the conversation, we don't want to disclose that such a conversation --- with that id exists. -getSelfMember :: Foldable t => UserId -> t LocalMember -> Galley LocalMember -getSelfMember = getMember (errorDescriptionToWai convNotFound) +-- semantics; when using `getSelfMemberFromLocals`, if that user is _not_ part +-- of the conversation, we don't want to disclose that such a conversation with +-- that id exists. +getSelfMemberFromLocals :: + (Foldable t, Monad m) => + UserId -> + t LocalMember -> + ExceptT ConvNotFound m LocalMember +getSelfMemberFromLocals = getLocalMember convNotFound + +-- | A legacy version of 'getSelfMemberFromLocals' that runs in the Galley monad. +getSelfMemberFromLocalsLegacy :: + Foldable t => + UserId -> + t LocalMember -> + Galley LocalMember +getSelfMemberFromLocalsLegacy usr lmems = + eitherM (throwM . errorDescriptionToWai) pure . runExceptT $ getSelfMemberFromLocals usr lmems + +getOtherMember :: (Foldable t, Monad m) => UserId -> t LocalMember -> ExceptT Error m LocalMember +getOtherMember = getLocalMember convMemberNotFound + +getOtherMemberLegacy :: Foldable t => UserId -> t LocalMember -> Galley LocalMember +getOtherMemberLegacy usr lmems = + eitherM throwM pure . runExceptT $ getOtherMember usr lmems -getOtherMember :: Foldable t => UserId -> t LocalMember -> Galley LocalMember -getOtherMember = getMember convMemberNotFound +-- | Note that we use 2 nearly identical functions but slightly different +-- semantics; when using `getSelfMemberQualified`, if that user is _not_ part of +-- the conversation, we don't want to disclose that such a conversation with +-- that id exists. +getSelfMemberQualified :: + (Foldable t, Monad m) => + Domain -> + Qualified UserId -> + t LocalMember -> + t RemoteMember -> + ExceptT ConvNotFound m (Either LocalMember RemoteMember) +getSelfMemberQualified localDomain qusr@(Qualified usr userDomain) lmems rmems = do + if localDomain == userDomain + then Left <$> getSelfMemberFromLocals usr lmems + else Right <$> getSelfMemberFromRemotes (toRemote qusr) rmems + +getSelfMemberFromRemotes :: + (Foldable t, Monad m) => + Remote UserId -> + t RemoteMember -> + ExceptT ConvNotFound m RemoteMember +getSelfMemberFromRemotes = getRemoteMember convNotFound + +getSelfMemberFromRemotesLegacy :: Foldable t => Remote UserId -> t RemoteMember -> Galley RemoteMember +getSelfMemberFromRemotesLegacy usr rmems = + eitherM (throwM . errorDescriptionToWai) pure . runExceptT $ + getSelfMemberFromRemotes usr rmems -- | Since we search by local user ID, we know that the member must be local. -getMember :: Foldable t => Error -> UserId -> t LocalMember -> Galley LocalMember -getMember ex u ms = do - let member = find ((u ==) . memId) ms - case member of - Just m -> return (m {memId = u}) - Nothing -> throwM ex +getLocalMember :: + (Foldable t, Monad m) => + e -> + UserId -> + t LocalMember -> + ExceptT e m LocalMember +getLocalMember = getMember memId + +-- | Since we search by remote user ID, we know that the member must be remote. +getRemoteMember :: + (Foldable t, Monad m) => + e -> + Remote UserId -> + t RemoteMember -> + ExceptT e m RemoteMember +getRemoteMember = getMember rmId + +getMember :: + (Foldable t, Eq userId, Monad m) => + -- | A projection from a member type to its user ID + (mem -> userId) -> + -- | An error to throw in case the user is not in the list + e -> + -- | The member to be found by its user ID + userId -> + -- | A list of members to search + t mem -> + ExceptT e m mem +getMember p ex u = hoistEither . note ex . find ((u ==) . p) getConversationAndCheckMembership :: UserId -> ConvId -> Galley Data.Conversation getConversationAndCheckMembership = @@ -515,50 +597,36 @@ registerRemoteConversationMemberships now localDomain c = do let rpc = FederatedGalley.registerConversation FederatedGalley.clientRoutes rc runFederated domain rpc --- | Notify remote users of being added to an existing conversation -updateRemoteConversationMemberships :: [RemoteMember] -> UserId -> UTCTime -> Data.Conversation -> [LocalMember] -> [RemoteMember] -> Galley () -updateRemoteConversationMemberships existingRemotes usr now c lmm rmm = do +-- | Notify remote backends about changes to the conversation memberships of the +-- conversation their users are part of. +notifyRemoteAboutConvUpdate :: + -- | The originating user that is doing the update + Qualified UserId -> + -- | The conversation being updated, assumed local as we shouldn't be sending + -- updates for non local conversations. + ConvId -> + -- | The current time + UTCTime -> + -- | Action being performed + ConversationMembersAction -> + -- | Remote members that need to be notified + [Remote UserId] -> + Galley () +notifyRemoteAboutConvUpdate origUser convId time action remotesToNotify = do localDomain <- viewFederationDomain - let mm = catMembers localDomain lmm rmm - qcnv = Qualified (Data.convId c) localDomain - qusr = Qualified usr localDomain - -- FUTUREWORK: parallelise federated requests - traverse_ (uncurry (updateRemoteConversations now mm qusr qcnv)) + let qconvId = Qualified convId localDomain + mkUpdate oth = ConversationMemberUpdate time origUser qconvId oth action + traverse_ (uncurry (notificationRPC . mkUpdate) . swap) . Map.assocs . partitionQualified . nubOrd - . map (unTagged . rmId) - $ rmm <> existingRemotes - -updateRemoteConversations :: - UTCTime -> - [(Qualified UserId, RoleName)] -> - Qualified UserId -> - Qualified ConvId -> - Domain -> - [UserId] -> - Galley () -updateRemoteConversations now uids orig cnv domain others = do - let cmu = - ConversationMemberUpdate - { cmuTime = now, - cmuOrigUserId = orig, - cmuConvId = cnv, - cmuAlreadyPresentUsers = others, - cmuUsersAdd = uids, - cmuUsersRemove = [] - } - let rpc = FederatedGalley.updateConversationMemberships FederatedGalley.clientRoutes cmu - runFederated domain rpc - -catMembers :: - Domain -> - [LocalMember] -> - [RemoteMember] -> - [(Qualified UserId, RoleName)] -catMembers localDomain ls rs = - map (((`Qualified` localDomain) . memId) &&& memConvRoleName) ls - <> map ((unTagged . rmId) &&& rmConvRoleName) rs + . map unTagged + $ remotesToNotify + where + notificationRPC :: ConversationMemberUpdate -> Domain -> Galley () + notificationRPC cmu domain = do + let rpc = FederatedGalley.updateConversationMemberships FederatedGalley.clientRoutes cmu + runFederated domain rpc -------------------------------------------------------------------------------- -- Legalhold diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index 2e14434e5d1..32e5797d3f7 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2020 Wire Swiss GmbH @@ -87,8 +85,9 @@ module Galley.Data members, lookupRemoteMembers, removeMember, - removeMembers, - removeLocalMembers, + removeLocalMembersFromLocalConv, + removeRemoteMembersFromLocalConv, + removeLocalMembersFromRemoteConv, updateMember, filterRemoteConvMembers, @@ -126,6 +125,7 @@ import Data.Id as Id import Data.Json.Util (UTCTimeMillis (..)) import Data.LegalHold (UserLegalHoldStatus (..), defUserLegalHoldStatus) import qualified Data.List.Extra as List +import Data.List.NonEmpty (NonEmpty) import Data.List.Split (chunksOf) import Data.List1 (List1, list1, singleton) import qualified Data.Map.Strict as Map @@ -929,29 +929,56 @@ filterRemoteConvMembers users (Qualified conv dom) = let q = query Cql.selectRemoteConvMembership (params Quorum (user, dom, conv)) map runIdentity <$> retry x1 q -removeLocalMembers :: MonadClient m => Domain -> Conversation -> UserId -> List1 UserId -> m Event -removeLocalMembers localDomain conv orig localVictims = removeMembers localDomain conv orig localVictims [] +removeLocalMembersFromLocalConv :: + MonadClient m => + Domain -> + Conversation -> + Qualified UserId -> + NonEmpty UserId -> + m Event +removeLocalMembersFromLocalConv localDomain conv orig localVictims = do + t <- liftIO getCurrentTime + retry x5 . batch $ do + setType BatchLogged + setConsistency Quorum + for_ localVictims $ \localVictim -> do + addPrepQuery Cql.removeMember (convId conv, localVictim) + addPrepQuery Cql.deleteUserConv (localVictim, convId conv) + let qconvId = Qualified (convId conv) localDomain + qualifiedVictims = QualifiedUserIdList . map (`Qualified` localDomain) . toList $ localVictims + return $ Event MemberLeave qconvId orig t (EdMembersLeave qualifiedVictims) -removeMembers :: MonadClient m => Domain -> Conversation -> UserId -> List1 UserId -> [Remote UserId] -> m Event -removeMembers localDomain conv orig localVictims remoteVictims = do +removeRemoteMembersFromLocalConv :: + MonadClient m => + Domain -> + Conversation -> + Qualified UserId -> + NonEmpty (Remote UserId) -> + m Event +removeRemoteMembersFromLocalConv localDomain conv orig remoteVictims = do t <- liftIO getCurrentTime retry x5 . batch $ do setType BatchLogged setConsistency Quorum - for_ remoteVictims $ \u -> do - let rUser = unTagged u + for_ remoteVictims $ \remoteVictim -> do + let rUser = unTagged remoteVictim addPrepQuery Cql.removeRemoteMember (convId conv, qDomain rUser, qUnqualified rUser) - for_ (toList localVictims) $ \u -> do - addPrepQuery Cql.removeMember (convId conv, u) - addPrepQuery Cql.deleteUserConv (u, convId conv) - - -- FUTUREWORK: the user's conversation has to be deleted on their own backend for federation let qconvId = Qualified (convId conv) localDomain - qorig = Qualified orig localDomain - return $ Event MemberLeave qconvId qorig t (EdMembersLeave leavingMembers) - where - -- FUTUREWORK(federation, #1274): We need to tell clients about remote members leaving, too. - leavingMembers = UserIdList . toList $ localVictims + qualifiedVictims = QualifiedUserIdList . map unTagged . toList $ remoteVictims + return $ Event MemberLeave qconvId orig t (EdMembersLeave qualifiedVictims) + +removeLocalMembersFromRemoteConv :: + MonadClient m => + -- | The conversation to remove members from + Qualified ConvId -> + -- | Members to remove local to this backend + List1 UserId -> + m () +removeLocalMembersFromRemoteConv (Qualified conv convDomain) victims = + retry x5 . batch $ do + setType BatchLogged + setConsistency Quorum + for_ victims $ \u -> addPrepQuery Cql.deleteUserRemoteConv (u, convDomain, conv) removeMember :: MonadClient m => UserId -> ConvId -> m () removeMember usr cnv = retry x5 . batch $ do diff --git a/services/galley/src/Galley/Data/Queries.hs b/services/galley/src/Galley/Data/Queries.hs index bd8cdd6277e..cdc2bc3128a 100644 --- a/services/galley/src/Galley/Data/Queries.hs +++ b/services/galley/src/Galley/Data/Queries.hs @@ -310,7 +310,6 @@ selectUserRemoteConvs = "select conv_remote_domain, conv_remote_id from user_rem selectRemoteConvMembership :: PrepQuery R (UserId, Domain, ConvId) (Identity UserId) selectRemoteConvMembership = "select user from user_remote_conv where user = ? and conv_remote_domain = ? and conv_remote_id = ?" --- FUTUREWORK: actually make use of these cql statements. deleteUserRemoteConv :: PrepQuery W (UserId, Domain, ConvId) () deleteUserRemoteConv = "delete from user_remote_conv where user = ? and conv_remote_domain = ? and conv_remote_id = ?" diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 28b6471eb95..05d882be5b7 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -42,6 +42,7 @@ import Control.Monad.Except (MonadError (throwError)) import Data.Aeson hiding (json) import qualified Data.ByteString as BS import Data.ByteString.Conversion +import qualified Data.ByteString.Lazy as LBS import qualified Data.Code as Code import Data.Domain (Domain (Domain), domainText) import Data.Id @@ -157,9 +158,15 @@ tests s = test s "add deleted remote members" testAddDeletedRemoteUser, test s "add remote members on invalid domain" testAddRemoteMemberInvalidDomain, test s "add remote members when federation isn't enabled" testAddRemoteMemberFederationDisabled, - test s "remove members" deleteMembersOk, - test s "fail to remove members from self conv." deleteMembersFailSelf, - test s "fail to remove members from 1:1 conv." deleteMembersFailO2O, + test s "delete conversations/:cnv/members/:usr - success" deleteMembersUnqualifiedOk, + test s "delete conversations/:cnv/members/:usr - fail, self conv" deleteMembersUnqualifiedFailSelf, + test s "delete conversations/:cnv/members/:usr - fail, 1:1 conv" deleteMembersUnqualifiedFailO2O, + test s "delete conversations/:domain/:cnv/members/:domain/:usr - local conv with all locals" deleteMembersConvLocalQualifiedOk, + test s "delete conversations/:domain/:cnv/members/:domain/:usr - local conv with locals and remote, delete local" deleteLocalMemberConvLocalQualifiedOk, + test s "delete conversations/:domain/:cnv/members/:domain/:usr - local conv with locals and remote, delete remote" deleteRemoteMemberConvLocalQualifiedOk, + test s "delete conversations/:domain/:cnv/members/:domain/:usr - remote conv, leave conv" leaveRemoteConvQualifiedOk, + test s "delete conversations/:domain/:cnv/members/:domain/:usr - remote conv, remove local user, fail" removeLocalMemberConvQualifiedFail, + test s "delete conversations/:domain/:cnv/members/:domain/:usr - remote conv, remove remote user, fail" removeRemoteMemberConvQualifiedFail, test s "rename conversation" putConvRenameOk, test s "member update (otr mute)" putMemberOtrMuteOk, test s "member update (otr archive)" putMemberOtrArchiveOk, @@ -211,6 +218,7 @@ emptyFederatedGalley = { FederatedGalley.registerConversation = \_ -> e "registerConversation", FederatedGalley.getConversations = \_ -> e "getConversations", FederatedGalley.updateConversationMemberships = \_ -> e "updateConversationMemberships", + FederatedGalley.leaveConversation = \_ _ -> e "leaveConversation", FederatedGalley.receiveMessage = \_ _ -> e "receiveMessage", FederatedGalley.sendMessage = \_ _ -> e "sendMessage" } @@ -1100,7 +1108,7 @@ postConvertTeamConv = do -- non-team members get kicked out void . liftIO $ WS.assertMatchN (5 # Second) [wsA, wsB, wsE, wsM] $ - wsAssertMemberLeave qconv qalice [eve, mallory] + wsAssertMemberLeave qconv qalice $ (`Qualified` localDomain) <$> [eve, mallory] -- joining (for mallory) is no longer possible postJoinCodeConv mallory j !!! const 403 === statusCode -- team members (dave) can still join @@ -1290,8 +1298,7 @@ paginateConvListIds = do FederatedGalley.cmuOrigUserId = qChad, FederatedGalley.cmuConvId = Qualified conv chadDomain, FederatedGalley.cmuAlreadyPresentUsers = [], - FederatedGalley.cmuUsersAdd = [(qAlice, roleNameWireMember)], - FederatedGalley.cmuUsersRemove = [] + FederatedGalley.cmuAction = FederatedGalley.ConversationMembersActionAdd $ pure (qAlice, roleNameWireMember) } FederatedGalley.updateConversationMemberships fedGalleyClient cmu @@ -1306,8 +1313,7 @@ paginateConvListIds = do FederatedGalley.cmuOrigUserId = qDee, FederatedGalley.cmuConvId = Qualified conv deeDomain, FederatedGalley.cmuAlreadyPresentUsers = [], - FederatedGalley.cmuUsersAdd = [(qAlice, roleNameWireMember)], - FederatedGalley.cmuUsersRemove = [] + FederatedGalley.cmuAction = FederatedGalley.ConversationMembersActionAdd $ pure (qAlice, roleNameWireMember) } FederatedGalley.updateConversationMemberships fedGalleyClient cmu @@ -1350,8 +1356,7 @@ paginateConvListIdsPageEndingAtLocalsAndDomain = do FederatedGalley.cmuOrigUserId = qChad, FederatedGalley.cmuConvId = Qualified conv chadDomain, FederatedGalley.cmuAlreadyPresentUsers = [], - FederatedGalley.cmuUsersAdd = [(qAlice, roleNameWireMember)], - FederatedGalley.cmuUsersRemove = [] + FederatedGalley.cmuAction = FederatedGalley.ConversationMembersActionAdd $ pure (qAlice, roleNameWireMember) } FederatedGalley.updateConversationMemberships fedGalleyClient cmu @@ -1367,8 +1372,7 @@ paginateConvListIdsPageEndingAtLocalsAndDomain = do FederatedGalley.cmuOrigUserId = qDee, FederatedGalley.cmuConvId = Qualified conv deeDomain, FederatedGalley.cmuAlreadyPresentUsers = [], - FederatedGalley.cmuUsersAdd = [(qAlice, roleNameWireMember)], - FederatedGalley.cmuUsersRemove = [] + FederatedGalley.cmuAction = FederatedGalley.ConversationMembersActionAdd $ pure (qAlice, roleNameWireMember) } FederatedGalley.updateConversationMemberships fedGalleyClient cmu @@ -1777,7 +1781,7 @@ leaveConnectConversation = do bob <- randomUser bdy <- postConnectConv alice bob "alice" "ni" Nothing postConv alice [bob, eve] (Just "gossip") [] Nothing Nothing -- Bob leaves - deleteMember bob bob conv !!! const 200 === statusCode + deleteMemberUnqualified bob bob conv !!! const 200 === statusCode -- Fetch bob getSelfMember bob conv !!! const 200 === statusCode -- Alice re-adds Bob to the conversation @@ -2064,35 +2068,221 @@ postTooManyMembersFail = do const 403 === statusCode const (Just "too-many-members") === fmap label . responseJsonUnsafe -deleteMembersOk :: TestM () -deleteMembersOk = do +deleteMembersUnqualifiedOk :: TestM () +deleteMembersUnqualifiedOk = do alice <- randomUser bob <- randomUser eve <- randomUser connectUsers alice (list1 bob [eve]) conv <- decodeConvId <$> postConv alice [bob, eve] (Just "gossip") [] Nothing Nothing - deleteMember bob bob conv !!! const 200 === statusCode - deleteMember bob bob conv !!! const 404 === statusCode + deleteMemberUnqualified bob bob conv !!! const 200 === statusCode + deleteMemberUnqualified bob bob conv !!! const 404 === statusCode -- if conversation still exists, don't respond with 404, but with 403. getConv bob conv !!! const 403 === statusCode - deleteMember alice eve conv !!! const 200 === statusCode - deleteMember alice eve conv !!! const 204 === statusCode - deleteMember alice alice conv !!! const 200 === statusCode - deleteMember alice alice conv !!! const 404 === statusCode + deleteMemberUnqualified alice eve conv !!! const 200 === statusCode + deleteMemberUnqualified alice eve conv !!! const 204 === statusCode + deleteMemberUnqualified alice alice conv !!! const 200 === statusCode + deleteMemberUnqualified alice alice conv !!! const 404 === statusCode -deleteMembersFailSelf :: TestM () -deleteMembersFailSelf = do +-- Creates a conversation with three users from the same domain. Then it uses a +-- qualified endpoint for deleting a conversation member: +-- +-- DELETE /conversations/:domain/:cnv/members/:domain/:usr +deleteMembersConvLocalQualifiedOk :: TestM () +deleteMembersConvLocalQualifiedOk = do + localDomain <- viewFederationDomain + [alice, bob, eve] <- randomUsers 3 + let [qAlice, qBob, qEve] = (`Qualified` localDomain) <$> [alice, bob, eve] + connectUsers alice (list1 bob [eve]) + conv <- decodeConvId <$> postConvQualified alice [qBob, qEve] (Just "federated gossip") [] Nothing Nothing + let qconv = Qualified conv localDomain + deleteMemberQualified bob qBob qconv !!! const 200 === statusCode + deleteMemberQualified bob qBob qconv !!! const 404 === statusCode + -- if the conversation still exists, don't respond with 404, but with 403. + getConv bob conv !!! const 403 === statusCode + deleteMemberQualified alice qEve qconv !!! const 200 === statusCode + deleteMemberQualified alice qEve qconv !!! const 204 === statusCode + deleteMemberQualified alice qAlice qconv !!! const 200 === statusCode + deleteMemberQualified alice qAlice qconv !!! const 404 === statusCode + +-- Creates a conversation with three users. Alice and Bob are on the local +-- domain, while Eve is on a remote domain. It uses a qualified endpoint for +-- removing Bob from the conversation: +-- +-- DELETE /conversations/:domain/:cnv/members/:domain/:usr +deleteLocalMemberConvLocalQualifiedOk :: TestM () +deleteLocalMemberConvLocalQualifiedOk = do + localDomain <- viewFederationDomain + [alice, bob] <- randomUsers 2 + eve <- randomId + let [qAlice, qBob] = (`Qualified` localDomain) <$> [alice, bob] + remoteDomain = Domain "far-away.example.com" + qEve = Qualified eve remoteDomain + + connectUsers alice (singleton bob) + convId <- decodeConvId <$> postConvWithRemoteUser remoteDomain (mkProfile qEve (Name "Eve")) alice [qBob, qEve] + let qconvId = Qualified convId localDomain + + opts <- view tsGConf + let mockReturnEve = onlyMockedFederatedBrigResponse [(qEve, "Eve")] + (respDel, fedRequests) <- + withTempMockFederator opts remoteDomain mockReturnEve $ + deleteMemberQualified alice qBob qconvId + let [galleyFederatedRequest] = fedRequestsForDomain remoteDomain F.Galley fedRequests + assertRemoveUpdate galleyFederatedRequest qconvId qAlice [qUnqualified qEve] qBob + + liftIO $ do + statusCode respDel @?= 200 + case responseJsonEither respDel of + Left err -> assertFailure err + Right e -> assertLeaveEvent qconvId qAlice [qBob] e + + -- Now that Bob is gone, try removing him once again + deleteMemberQualified alice qBob qconvId !!! do + const 204 === statusCode + const Nothing === responseBody + +-- Creates a conversation with five users. Alice and Bob are on the local +-- domain. Chad and Dee are on far-away-1.example.com. Eve is on +-- far-away-2.example.com. It uses a qualified endpoint to remove Chad from the +-- conversation: +-- +-- DELETE /conversations/:domain/:cnv/members/:domain/:usr +deleteRemoteMemberConvLocalQualifiedOk :: TestM () +deleteRemoteMemberConvLocalQualifiedOk = do + localDomain <- viewFederationDomain + [alice, bob] <- randomUsers 2 + let [qAlice, qBob] = (`Qualified` localDomain) <$> [alice, bob] + remoteDomain1 = Domain "far-away-1.example.com" + remoteDomain2 = Domain "far-away-2.example.com" + qChad <- (`Qualified` remoteDomain1) <$> randomId + qDee <- (`Qualified` remoteDomain1) <$> randomId + qEve <- (`Qualified` remoteDomain2) <$> randomId + connectUsers alice (singleton bob) + + opts <- view tsGConf + let mockedResponse fedReq = do + let success :: ToJSON a => a -> IO F.OutwardResponse + success = pure . F.OutwardResponseBody . LBS.toStrict . encode + getUsersPath = Just "/federation/get-users-by-ids" + case (F.domain fedReq, F.path <$> F.request fedReq) of + (d, mp) + | d == domainText remoteDomain1 && mp == getUsersPath -> + success [mkProfile qChad (Name "Chad"), mkProfile qDee (Name "Dee")] + (d, mp) + | d == domainText remoteDomain2 && mp == getUsersPath -> + success [mkProfile qEve (Name "Eve")] + _ -> success () + + (convId, _) <- + withTempMockFederator' opts remoteDomain1 mockedResponse $ + decodeConvId <$> postConvQualified alice [qBob, qChad, qDee, qEve] Nothing [] Nothing Nothing + let qconvId = Qualified convId localDomain + + (respDel, federatedRequests) <- + withTempMockFederator' opts remoteDomain1 mockedResponse $ + deleteMemberQualified alice qChad qconvId + liftIO $ do + statusCode respDel @?= 200 + case responseJsonEither respDel of + Left err -> assertFailure err + Right e -> assertLeaveEvent qconvId qAlice [qChad] e + + let [remote1GalleyFederatedRequest] = fedRequestsForDomain remoteDomain1 F.Galley federatedRequests + [remote2GalleyFederatedRequest] = fedRequestsForDomain remoteDomain2 F.Galley federatedRequests + assertRemoveUpdate remote1GalleyFederatedRequest qconvId qAlice [qUnqualified qChad, qUnqualified qDee] qChad + assertRemoveUpdate remote2GalleyFederatedRequest qconvId qAlice [qUnqualified qEve] qChad + + -- Now that Chad is gone, try removing him once again + deleteMemberQualified alice qChad qconvId !!! do + const 204 === statusCode + const Nothing === responseBody + +-- Alice, a local user, leaves a remote conversation. Bob's domain is the same +-- as that of the conversation. The test uses the following endpoint: +-- +-- DELETE /conversations/:domain/:cnv/members/:domain/:usr +leaveRemoteConvQualifiedOk :: TestM () +leaveRemoteConvQualifiedOk = do + localDomain <- viewFederationDomain + alice <- randomUser + let qAlice = Qualified alice localDomain + conv <- randomId + bob <- randomId + let remoteDomain = Domain "faraway.example.com" + qconv = Qualified conv remoteDomain + qBob = Qualified bob remoteDomain + let mockedFederatedGalleyResponse :: F.FederatedRequest -> Maybe Value + mockedFederatedGalleyResponse req + | fmap F.component (F.request req) == Just F.Galley = + Just . toJSON . FederatedGalley.LeaveConversationResponse . Right $ () + | otherwise = Nothing + mockResponses = + joinMockedFederatedResponses + (mockedFederatedBrigResponse [(qBob, "Bob")]) + mockedFederatedGalleyResponse + opts <- view tsGConf + + (resp, fedRequests) <- + withTempMockFederator opts remoteDomain mockResponses $ + deleteMemberQualified alice qAlice qconv + let leaveRequest = + fromJust . decodeStrict . F.body . fromJust . F.request . Imports.head $ + fedRequests + liftIO $ do + statusCode resp @?= 200 + case responseJsonEither resp of + Left err -> assertFailure err + Right e -> assertLeaveEvent qconv qAlice [qAlice] e + FederatedGalley.lcConvId leaveRequest @?= conv + FederatedGalley.lcLeaver leaveRequest @?= alice + +-- Alice, a user remote to the conversation, tries to remove someone on her own +-- backend other than herself via: +-- +-- DELETE /conversations/:domain/:cnv/members/:domain/:usr +removeLocalMemberConvQualifiedFail :: TestM () +removeLocalMemberConvQualifiedFail = do + alice <- randomUser + conv <- randomId + qBob <- randomQualifiedUser + let remoteDomain = Domain "faraway.example.com" + qconv = Qualified conv remoteDomain + + deleteMemberQualified alice qBob qconv !!! do + const 403 === statusCode + const (Just "action-denied") === fmap label . responseJsonUnsafe + +-- Alice, a user remote to the conversation, tries to remove someone on a remote +-- backend via: +-- +-- DELETE /conversations/:domain/:cnv/members/:domain/:usr +removeRemoteMemberConvQualifiedFail :: TestM () +removeRemoteMemberConvQualifiedFail = do + alice <- randomUser + conv <- randomId + bob <- randomId + let remoteDomain = Domain "faraway.example.com" + qconv = Qualified conv remoteDomain + qBob = Qualified bob remoteDomain + + deleteMemberQualified alice qBob qconv !!! do + const 403 === statusCode + const (Just "action-denied") === fmap label . responseJsonUnsafe + +deleteMembersUnqualifiedFailSelf :: TestM () +deleteMembersUnqualifiedFailSelf = do alice <- randomUser self <- decodeConvId <$> postSelfConv alice - deleteMember alice alice self !!! const 403 === statusCode + deleteMemberUnqualified alice alice self !!! const 403 === statusCode -deleteMembersFailO2O :: TestM () -deleteMembersFailO2O = do +deleteMembersUnqualifiedFailO2O :: TestM () +deleteMembersUnqualifiedFailO2O = do alice <- randomUser bob <- randomUser connectUsers alice (singleton bob) o2o <- decodeConvId <$> postO2OConv alice bob (Just "foo") - deleteMember alice bob o2o !!! const 403 === statusCode + deleteMemberUnqualified alice bob o2o !!! const 403 === statusCode putConvRenameOk :: TestM () putConvRenameOk = do @@ -2289,10 +2479,10 @@ removeUser = do deleteUser bob' void . liftIO $ WS.assertMatchN (5 # Second) [wsA, wsB] $ - matchMemberLeave qconv1 bob + wsAssertMembersLeave qconv1 bob [bob] void . liftIO $ WS.assertMatchN (5 # Second) [wsA, wsB, wsC] $ - matchMemberLeave qconv2 bob + wsAssertMembersLeave qconv2 bob [bob] -- Check memberships mems1 <- fmap cnvMembers . responseJsonUnsafe <$> getConv alice conv1 mems2 <- fmap cnvMembers . responseJsonUnsafe <$> getConv alice conv2 @@ -2304,11 +2494,3 @@ removeUser = do (mems2 >>= other carl) @?= Just (OtherMember carl Nothing roleNameWireAdmin) (mems3 >>= other bob) @?= Nothing (mems3 >>= other carl) @?= Just (OtherMember carl Nothing roleNameWireAdmin) - where - matchMemberLeave conv u n = do - let e = List1.head (WS.unpackPayload n) - ntfTransient n @?= False - evtConv e @?= conv - evtType e @?= MemberLeave - evtFrom e @?= u - evtData e @?= EdMembersLeave (UserIdList [qUnqualified u]) diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 14a5e0fbd1b..a3d31099ded 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -14,13 +14,13 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module API.Federation where import API.Util import Bilge import Bilge.Assert -import qualified Cassandra as Cql import Control.Lens hiding ((#)) import Data.Aeson (ToJSON (..)) import qualified Data.Aeson as A @@ -29,6 +29,7 @@ import qualified Data.ByteString.Lazy as LBS import Data.Domain import Data.Id (ConvId, Id (..), newClientId, randomId) import Data.Json.Util (Base64ByteString (..), toBase64Text) +import Data.List.NonEmpty (NonEmpty (..)) import Data.List1 import qualified Data.List1 as List1 import qualified Data.Map as Map @@ -38,7 +39,6 @@ import qualified Data.Set as Set import Data.Time.Clock import Data.Timeout (TimeoutUnit (..), (#)) import Data.UUID.V4 (nextRandom) -import qualified Galley.Data.Queries as Cql import Galley.Types import Gundeck.Types.Notification import Imports @@ -62,14 +62,11 @@ tests s = "federation" [ test s "POST /federation/get-conversations : All Found" getConversationsAllFound, test s "POST /federation/get-conversations : Conversations user is not a part of are excluded from result" getConversationsNotPartOf, - test - s - "POST /federation/update-conversation-memberships : Add local user to remote conversation" - addLocalUser, - test - s - "POST /federation/update-conversation-memberships : Notify local user about other members joining" - notifyLocalUser, + test s "POST /federation/update-conversation-memberships : Add local user to remote conversation" addLocalUser, + test s "POST /federation/update-conversation-memberships : Remove a local user from a remote conversation" removeLocalUser, + test s "POST /federation/update-conversation-memberships : Remove a remote user from a remote conversation" removeRemoteUser, + test s "POST /federation/update-conversation-memberships : Notify local user about other members joining" notifyLocalUser, + test s "POST /federation/leave-conversation : Success" leaveConversationSuccess, test s "POST /federation/receive-message : Receive a message from another backend" receiveMessage, test s "POST /federation/send-message : Post a message sent from another backend" sendMessage ] @@ -143,11 +140,11 @@ addLocalUser = do c <- view tsCannon alice <- randomUser let qalice = Qualified alice localDomain - let dom = Domain "bobland.example.com" + let remoteDomain = Domain "bobland.example.com" bob <- randomId - let qbob = Qualified bob dom + let qbob = Qualified bob remoteDomain conv <- randomId - let qconv = Qualified conv dom + let qconv = Qualified conv remoteDomain fedGalleyClient <- view tsFedGalleyClient now <- liftIO getCurrentTime let cmu = @@ -156,20 +153,127 @@ addLocalUser = do FedGalley.cmuOrigUserId = qbob, FedGalley.cmuConvId = qconv, FedGalley.cmuAlreadyPresentUsers = [], - FedGalley.cmuUsersAdd = [(qalice, roleNameWireMember)], - FedGalley.cmuUsersRemove = [] + FedGalley.cmuAction = + FedGalley.ConversationMembersActionAdd (pure (qalice, roleNameWireMember)) } WS.bracketR c alice $ \ws -> do FedGalley.updateConversationMemberships fedGalleyClient cmu void . liftIO $ WS.assertMatch (5 # Second) ws $ wsAssertMemberJoinWithRole qconv qbob [qalice] roleNameWireMember - cassState <- view tsCass - convs <- - Cql.runClient cassState - . Cql.query Cql.selectUserRemoteConvs - $ Cql.params Cql.Quorum (Identity alice) - liftIO $ convs @?= [(dom, conv)] + convs <- listRemoteConvs remoteDomain alice + liftIO $ convs @?= [Qualified conv remoteDomain] + +-- | This test invokes the federation endpoint: +-- +-- 'POST /federation/update-conversation-memberships' +-- +-- two times in a row: first adding a remote user to a local conversation, and +-- then removing them. The test asserts the expected list of conversations in +-- between the calls and after everything, and that a local conversation member +-- got notified of the removal. +removeLocalUser :: TestM () +removeLocalUser = do + localDomain <- viewFederationDomain + c <- view tsCannon + alice <- randomUser + bob <- randomId + let qAlice = Qualified alice localDomain + let remoteDomain = Domain "bobland.example.com" + let qBob = bob `Qualified` remoteDomain + conv <- randomId + let qconv = Qualified conv remoteDomain + fedGalleyClient <- view tsFedGalleyClient + now <- liftIO getCurrentTime + let cmuAdd = + FedGalley.ConversationMemberUpdate + { FedGalley.cmuTime = now, + FedGalley.cmuOrigUserId = qBob, + FedGalley.cmuConvId = qconv, + FedGalley.cmuAlreadyPresentUsers = [], + FedGalley.cmuAction = + FedGalley.ConversationMembersActionAdd (pure (qAlice, roleNameWireMember)) + } + cmuRemove = + FedGalley.ConversationMemberUpdate + { FedGalley.cmuTime = addUTCTime (secondsToNominalDiffTime 5) now, + FedGalley.cmuOrigUserId = qBob, + FedGalley.cmuConvId = qconv, + FedGalley.cmuAlreadyPresentUsers = [alice], + FedGalley.cmuAction = + FedGalley.ConversationMembersActionRemove (pure qAlice) + } + + WS.bracketR c alice $ \ws -> do + FedGalley.updateConversationMemberships fedGalleyClient cmuAdd + afterAddition <- listRemoteConvs remoteDomain alice + FedGalley.updateConversationMemberships fedGalleyClient cmuRemove + liftIO $ do + void . WS.assertMatch (3 # Second) ws $ + wsAssertMemberJoinWithRole qconv qBob [qAlice] roleNameWireMember + void . WS.assertMatch (3 # Second) ws $ + wsAssertMembersLeave qconv qBob [qAlice] + afterRemoval <- listRemoteConvs remoteDomain alice + liftIO $ do + afterAddition @?= [qconv] + afterRemoval @?= [] + +-- | This test invokes the federation endpoint: +-- +-- 'POST /federation/update-conversation-memberships' +-- +-- two times in a row: first adding a local and a remote user to a remote +-- conversation, and then removing the remote user. The test asserts the +-- expected list of conversations in between the calls and at the end from the +-- point of view of the local backend and that the local conversation member got +-- notified of the removal. +removeRemoteUser :: TestM () +removeRemoteUser = do + localDomain <- viewFederationDomain + c <- view tsCannon + alice <- randomUser + [bob, eve] <- replicateM 2 randomId + let qAlice = Qualified alice localDomain + remoteDomain = Domain "bobland.example.com" + qBob = Qualified bob remoteDomain + qEve = Qualified eve remoteDomain + conv <- randomId + let qconv = Qualified conv remoteDomain + fedGalleyClient <- view tsFedGalleyClient + now <- liftIO getCurrentTime + let cmuAdd = + FedGalley.ConversationMemberUpdate + { FedGalley.cmuTime = now, + FedGalley.cmuOrigUserId = qBob, + FedGalley.cmuConvId = qconv, + FedGalley.cmuAlreadyPresentUsers = [], + FedGalley.cmuAction = + FedGalley.ConversationMembersActionAdd + ((qAlice, roleNameWireMember) :| [(qEve, roleNameWireMember)]) + } + cmuRemove = + FedGalley.ConversationMemberUpdate + { FedGalley.cmuTime = addUTCTime (secondsToNominalDiffTime 5) now, + FedGalley.cmuOrigUserId = qBob, + FedGalley.cmuConvId = qconv, + FedGalley.cmuAlreadyPresentUsers = [alice], + FedGalley.cmuAction = + FedGalley.ConversationMembersActionRemove (pure qEve) + } + + WS.bracketR c alice $ \ws -> do + FedGalley.updateConversationMemberships fedGalleyClient cmuAdd + afterAddition <- listRemoteConvs remoteDomain alice + void . liftIO . WS.assertMatch (3 # Second) ws $ + wsAssertMemberJoinWithRole qconv qBob [qAlice, qEve] roleNameWireMember + FedGalley.updateConversationMemberships fedGalleyClient cmuRemove + afterRemoval <- listRemoteConvs remoteDomain alice + void . liftIO $ + WS.assertMatch (3 # Second) ws $ + wsAssertMembersLeave qconv qBob [qEve] + liftIO $ do + afterAddition @?= [qconv] + afterRemoval @?= [qconv] notifyLocalUser :: TestM () notifyLocalUser = do @@ -191,8 +295,8 @@ notifyLocalUser = do FedGalley.cmuOrigUserId = qbob, FedGalley.cmuConvId = qconv, FedGalley.cmuAlreadyPresentUsers = [alice], - FedGalley.cmuUsersAdd = [(qcharlie, roleNameWireMember)], - FedGalley.cmuUsersRemove = [] + FedGalley.cmuAction = + FedGalley.ConversationMembersActionAdd (pure (qcharlie, roleNameWireMember)) } WS.bracketR c alice $ \ws -> do FedGalley.updateConversationMemberships fedGalleyClient cmu @@ -200,6 +304,65 @@ notifyLocalUser = do WS.assertMatch (5 # Second) ws $ wsAssertMemberJoinWithRole qconv qbob [qcharlie] roleNameWireMember +leaveConversationSuccess :: TestM () +leaveConversationSuccess = do + localDomain <- viewFederationDomain + c <- view tsCannon + [alice, bob] <- randomUsers 2 + let qBob = Qualified bob localDomain + remoteDomain1 = Domain "far-away-1.example.com" + remoteDomain2 = Domain "far-away-2.example.com" + qChad <- (`Qualified` remoteDomain1) <$> randomId + qDee <- (`Qualified` remoteDomain1) <$> randomId + qEve <- (`Qualified` remoteDomain2) <$> randomId + connectUsers alice (singleton bob) + + opts <- view tsGConf + let mockedResponse fedReq = do + let success :: ToJSON a => a -> IO F.OutwardResponse + success = pure . F.OutwardResponseBody . LBS.toStrict . A.encode + getUsersPath = Just "/federation/get-users-by-ids" + case (F.domain fedReq, F.path <$> F.request fedReq) of + (d, mp) + | d == domainText remoteDomain1 && mp == getUsersPath -> + success [mkProfile qChad (Name "Chad"), mkProfile qDee (Name "Dee")] + (d, mp) + | d == domainText remoteDomain2 && mp == getUsersPath -> + success [mkProfile qEve (Name "Eve")] + _ -> success () + + (convId, _) <- + withTempMockFederator' opts remoteDomain1 mockedResponse $ + decodeConvId <$> postConvQualified alice [qBob, qChad, qDee, qEve] Nothing [] Nothing Nothing + let qconvId = Qualified convId localDomain + + (_, federatedRequests) <- + WS.bracketR2 c alice bob $ \(wsAlice, wsBob) -> do + withTempMockFederator' opts remoteDomain1 mockedResponse $ do + g <- viewGalley + let leaveRequest = FedGalley.LeaveConversationRequest convId (qUnqualified qChad) + respBS <- + post + ( g + . paths ["federation", "leave-conversation"] + . content "application/json" + . header "Wire-Origin-Domain" (toByteString' remoteDomain1) + . json leaveRequest + ) + do - deleteMember admin victim cid !!! assertActionSucceeded + deleteMemberUnqualified admin victim cid !!! assertActionSucceeded postMembersWithRole admin (singleton victim) cid role !!! assertActionSucceeded -- Modify the conversation name void $ putConversationName admin cid "gossip++" !!! assertActionSucceeded @@ -185,7 +185,7 @@ wireAdminChecks cid admin otherAdmin mem = do let memUpdate = memberUpdate {mupOtrMute = Just True} putMember admin memUpdate cid !!! assertActionSucceeded -- You can also leave a conversation - deleteMember admin admin cid !!! assertActionSucceeded + deleteMemberUnqualified admin admin cid !!! assertActionSucceeded -- Readding the user postMembersWithRole otherAdmin (singleton admin) cid role !!! const 200 === statusCode @@ -206,7 +206,7 @@ wireMemberChecks cid mem admin otherMem = do -- Cannot add members, regardless of their role postMembers mem (singleton other) cid !!! assertActionDenied -- Cannot remove members, regardless of who they are - forM_ [admin, otherMem] $ \victim -> deleteMember mem victim cid !!! assertActionDenied + forM_ [admin, otherMem] $ \victim -> deleteMemberUnqualified mem victim cid !!! assertActionDenied -- Cannot modify the conversation name void $ putConversationName mem cid "gossip++" !!! assertActionDenied -- Cannot modify other members roles @@ -233,7 +233,7 @@ wireMemberChecks cid mem admin otherMem = do let memUpdate = memberUpdate {mupOtrMute = Just True} putMember mem memUpdate cid !!! assertActionSucceeded -- Last option is to leave a conversation - deleteMember mem mem cid !!! assertActionSucceeded + deleteMemberUnqualified mem mem cid !!! assertActionSucceeded -- Let's readd the user to make tests easier postMembersWithRole admin (singleton mem) cid role !!! const 200 === statusCode diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index bc4a5c03935..41788e75ef4 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -636,8 +636,8 @@ testRemoveNonBindingTeamMember = do -- Ensure that `mem1` is still a user (tid is not a binding team) Util.ensureDeletedState False owner (mem1 ^. userId) mapConcurrently_ (checkTeamMemberLeave tid (mem1 ^. userId)) [wsOwner, wsMem1, wsMem2] - checkConvMemberLeaveEvent (Qualified cid2 localDomain) (mem1 ^. userId) wsMext1 - checkConvMemberLeaveEvent (Qualified cid3 localDomain) (mem1 ^. userId) wsMext3 + checkConvMemberLeaveEvent (Qualified cid2 localDomain) (Qualified (mem1 ^. userId) localDomain) wsMext1 + checkConvMemberLeaveEvent (Qualified cid3 localDomain) (Qualified (mem1 ^. userId) localDomain) wsMext3 WS.assertNoEvent timeout ws testRemoveBindingTeamMember :: Bool -> TestM () @@ -721,7 +721,7 @@ testRemoveBindingTeamMember ownerHasPassword = do !!! const 202 === statusCode checkTeamMemberLeave tid (mem1 ^. userId) wsOwner - checkConvMemberLeaveEvent (Qualified cid1 localDomain) (mem1 ^. userId) wsMext + checkConvMemberLeaveEvent (Qualified cid1 localDomain) (Qualified (mem1 ^. userId) localDomain) wsMext assertQueue "team member leave" $ tUpdate 2 [ownerWithPassword, owner] WS.assertNoEvent timeout [wsMext] -- Mem1 is now gone from Wire diff --git a/services/galley/test/integration/API/Teams/LegalHold.hs b/services/galley/test/integration/API/Teams/LegalHold.hs index f58a5740d3a..9038df8cba8 100644 --- a/services/galley/test/integration/API/Teams/LegalHold.hs +++ b/services/galley/test/integration/API/Teams/LegalHold.hs @@ -985,18 +985,18 @@ testNoConsentRemoveFromGroupConv whoIsAdmin = do LegalholderIsAdmin -> do assertConvMember legalholder convId assertNotConvMember peer convId - checkConvMemberLeaveEvent (Qualified convId localdomain) peer legalholderWs - checkConvMemberLeaveEvent (Qualified convId localdomain) peer peerWs + checkConvMemberLeaveEvent (Qualified convId localdomain) (Qualified peer localdomain) legalholderWs + checkConvMemberLeaveEvent (Qualified convId localdomain) (Qualified peer localdomain) peerWs PeerIsAdmin -> do assertConvMember peer convId assertNotConvMember legalholder convId - checkConvMemberLeaveEvent (Qualified convId localdomain) legalholder legalholderWs - checkConvMemberLeaveEvent (Qualified convId localdomain) legalholder peerWs + checkConvMemberLeaveEvent (Qualified convId localdomain) (Qualified legalholder localdomain) legalholderWs + checkConvMemberLeaveEvent (Qualified convId localdomain) (Qualified legalholder localdomain) peerWs BothAreAdmins -> do assertConvMember legalholder convId assertNotConvMember peer convId - checkConvMemberLeaveEvent (Qualified convId localdomain) peer legalholderWs - checkConvMemberLeaveEvent (Qualified convId localdomain) peer peerWs + checkConvMemberLeaveEvent (Qualified convId localdomain) (Qualified peer localdomain) legalholderWs + checkConvMemberLeaveEvent (Qualified convId localdomain) (Qualified peer localdomain) peerWs data GroupConvInvCase = InviteOnlyConsenters | InviteAlsoNonConsenters deriving (Show, Eq, Ord, Bounded, Enum) diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index fd7a8cebb88..1daad12b955 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -803,9 +803,9 @@ listConvs u req = do . zType "access" . json req -getConv :: UserId -> ConvId -> TestM ResponseLBS +getConv :: (MonadIO m, MonadHttp m, HasGalley m, HasCallStack) => UserId -> ConvId -> m ResponseLBS getConv u c = do - g <- view tsGalley + g <- viewGalley get $ g . paths ["conversations", toByteString' c] @@ -813,7 +813,7 @@ getConv u c = do . zConn "conn" . zType "access" -getConvQualified :: (MonadIO m, MonadHttp m, HasGalley m) => UserId -> Qualified ConvId -> m ResponseLBS +getConvQualified :: (MonadIO m, MonadHttp m, HasGalley m, HasCallStack) => UserId -> Qualified ConvId -> m ResponseLBS getConvQualified u (Qualified conv domain) = do g <- viewGalley get $ @@ -843,6 +843,13 @@ listConvIds u paginationOpts = do . zUser u . json paginationOpts +-- | Does not page through conversation list +listRemoteConvs :: Domain -> UserId -> TestM [Qualified ConvId] +listRemoteConvs remoteDomain uid = do + let paginationOpts = GetPaginatedConversationIds Nothing (toRange (Proxy @100)) + allConvs <- fmap pageConvIds . responseJsonError =<< listConvIds uid paginationOpts qDomain qcnv == remoteDomain) allConvs + postQualifiedMembers :: UserId -> NonEmpty (Qualified UserId) -> ConvId -> TestM ResponseLBS postQualifiedMembers zusr invitees conv = do g <- view tsGalley @@ -883,8 +890,8 @@ postMembersWithRole u us c r = do . zType "access" . json i -deleteMember :: UserId -> UserId -> ConvId -> TestM ResponseLBS -deleteMember u1 u2 c = do +deleteMemberUnqualified :: HasCallStack => UserId -> UserId -> ConvId -> TestM ResponseLBS +deleteMemberUnqualified u1 u2 c = do g <- view tsGalley delete $ g @@ -893,6 +900,28 @@ deleteMember u1 u2 c = do . zConn "conn" . zType "access" +deleteMemberQualified :: + (HasCallStack, MonadIO m, MonadHttp m, HasGalley m) => + UserId -> + Qualified UserId -> + Qualified ConvId -> + m ResponseLBS +deleteMemberQualified u1 (Qualified u2 u2Domain) (Qualified conv convDomain) = do + g <- viewGalley + delete $ + g + . zUser u1 + . paths + [ "conversations", + toByteString' convDomain, + toByteString' conv, + "members", + toByteString' u2Domain, + toByteString' u2 + ] + . zConn "conn" + . zType "access" + getSelfMember :: UserId -> ConvId -> TestM ResponseLBS getSelfMember u c = do g <- view tsGalley @@ -1197,10 +1226,10 @@ wsAssertOtr' evData conv usr from to txt n = do evtData e @?= EdOtrMessage (OtrMessage from to txt (Just evData)) -- | This assumes the default role name -wsAssertMemberJoin :: Qualified ConvId -> Qualified UserId -> [Qualified UserId] -> Notification -> IO () +wsAssertMemberJoin :: HasCallStack => Qualified ConvId -> Qualified UserId -> [Qualified UserId] -> Notification -> IO () wsAssertMemberJoin conv usr new = wsAssertMemberJoinWithRole conv usr new roleNameWireAdmin -wsAssertMemberJoinWithRole :: Qualified ConvId -> Qualified UserId -> [Qualified UserId] -> RoleName -> Notification -> IO () +wsAssertMemberJoinWithRole :: HasCallStack => Qualified ConvId -> Qualified UserId -> [Qualified UserId] -> RoleName -> Notification -> IO () wsAssertMemberJoinWithRole conv usr new role n = do let e = List1.head (WS.unpackPayload n) ntfTransient n @?= False @@ -1209,6 +1238,35 @@ wsAssertMemberJoinWithRole conv usr new role n = do evtFrom e @?= usr evtData e @?= EdMembersJoin (SimpleMembers (fmap (`SimpleMember` role) new)) +-- FUTUREWORK: See if this one can be implemented in terms of: +-- +-- checkConvMemberLeaveEvent :: HasCallStack => Qualified ConvId -> Qualified UserId -> WS.WebSocket -> TestM () +-- +-- or if they can be combined in general. +wsAssertMembersLeave :: + HasCallStack => + Qualified ConvId -> + Qualified UserId -> + [Qualified UserId] -> + Notification -> + IO () +wsAssertMembersLeave conv usr leaving n = do + let e = List1.head (WS.unpackPayload n) + ntfTransient n @?= False + assertLeaveEvent conv usr leaving e + +assertLeaveEvent :: + Qualified ConvId -> + Qualified UserId -> + [Qualified UserId] -> + Event -> + IO () +assertLeaveEvent conv usr leaving e = do + evtConv e @?= conv + evtType e @?= Conv.MemberLeave + evtFrom e @?= usr + evtData e @?= EdMembersLeave (QualifiedUserIdList leaving) + wsAssertMemberUpdateWithRole :: Qualified ConvId -> Qualified UserId -> UserId -> RoleName -> Notification -> IO () wsAssertMemberUpdateWithRole conv usr target role n = do let e = List1.head (WS.unpackPayload n) @@ -1240,16 +1298,16 @@ wsAssertConvMessageTimerUpdate conv usr new n = do evtFrom e @?= usr evtData e @?= EdConvMessageTimerUpdate new -wsAssertMemberLeave :: Qualified ConvId -> Qualified UserId -> [UserId] -> Notification -> IO () +wsAssertMemberLeave :: Qualified ConvId -> Qualified UserId -> [Qualified UserId] -> Notification -> IO () wsAssertMemberLeave conv usr old n = do let e = List1.head (WS.unpackPayload n) ntfTransient n @?= False evtConv e @?= conv evtType e @?= Conv.MemberLeave evtFrom e @?= usr - sorted (evtData e) @?= sorted (EdMembersLeave (UserIdList old)) + sorted (evtData e) @?= sorted (EdMembersLeave (QualifiedUserIdList old)) where - sorted (EdMembersLeave (UserIdList m)) = EdMembersLeave (UserIdList (sort m)) + sorted (EdMembersLeave (QualifiedUserIdList m)) = EdMembersLeave (QualifiedUserIdList (sort m)) sorted x = x assertNoMsg :: HasCallStack => WS.WebSocket -> (Notification -> Assertion) -> TestM () @@ -1259,6 +1317,15 @@ assertNoMsg ws f = do Left _ -> return () -- expected Right _ -> assertFailure "Unexpected message" +assertRemoveUpdate :: (MonadIO m, HasCallStack) => F.Request -> Qualified ConvId -> Qualified UserId -> [UserId] -> Qualified UserId -> m () +assertRemoveUpdate req qconvId remover alreadyPresentUsers victim = liftIO $ do + F.path req @?= "/federation/update-conversation-memberships" + let Just cmu = decodeStrict (F.body req) + FederatedGalley.cmuOrigUserId cmu @?= remover + FederatedGalley.cmuConvId cmu @?= qconvId + sort (FederatedGalley.cmuAlreadyPresentUsers cmu) @?= sort alreadyPresentUsers + FederatedGalley.cmuAction cmu @?= FederatedGalley.ConversationMembersActionRemove (pure victim) + ------------------------------------------------------------------------------- -- Helpers @@ -1286,7 +1353,7 @@ decodeConvCodeEvent r = case responseJsonUnsafe r of (Event ConvCodeUpdate _ _ _ (EdConvCodeUpdate c)) -> c _ -> error "Failed to parse ConversationCode from Event" -decodeConvId :: Response (Maybe Lazy.ByteString) -> ConvId +decodeConvId :: HasCallStack => Response (Maybe Lazy.ByteString) -> ConvId decodeConvId = qUnqualified . cnvQualifiedId . responseJsonUnsafe decodeConvList :: Response (Maybe Lazy.ByteString) -> [Conversation] @@ -1919,8 +1986,7 @@ withTempMockFederator :: (FederatedRequest -> a) -> SessionT m b -> m (b, Mock.ReceivedRequests) -withTempMockFederator opts targetDomain resp action = - withTempMockFederator' opts targetDomain (pure . oresp) action +withTempMockFederator opts targetDomain resp = withTempMockFederator' opts targetDomain (pure . oresp) where oresp = OutwardResponseBody . Lazy.toStrict . encode . resp @@ -2089,15 +2155,49 @@ checkConvDeleteEvent cid w = WS.assertMatch_ checkTimeout w $ \notif -> do evtConv e @?= cid evtData e @?= Conv.EdConvDelete -checkConvMemberLeaveEvent :: HasCallStack => Qualified ConvId -> UserId -> WS.WebSocket -> TestM () +checkConvMemberLeaveEvent :: HasCallStack => Qualified ConvId -> Qualified UserId -> WS.WebSocket -> TestM () checkConvMemberLeaveEvent cid usr w = WS.assertMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) evtConv e @?= cid evtType e @?= Conv.MemberLeave case evtData e of - Conv.EdMembersLeave mm -> mm @?= Conv.UserIdList [usr] + Conv.EdMembersLeave mm -> mm @?= Conv.QualifiedUserIdList [usr] other -> assertFailure $ "Unexpected event data: " <> show other checkTimeout :: WS.Timeout checkTimeout = 3 # Second + +-- | The function is used in conjuction with 'withTempMockFederator' to mock +-- responses by Brig on the mocked side of federation. +mockedFederatedBrigResponse :: [(Qualified UserId, Text)] -> F.FederatedRequest -> Maybe Value +mockedFederatedBrigResponse users req + | fmap F.component (F.request req) == Just F.Brig = + Just . toJSON $ [mkProfile mem (Name name) | (mem, name) <- users] + | otherwise = Nothing + +-- | Combine two mocked services such that for a given request a JSON response +-- is produced. +joinMockedFederatedResponses :: + (F.FederatedRequest -> Maybe Value) -> + (F.FederatedRequest -> Maybe Value) -> + F.FederatedRequest -> + Value +joinMockedFederatedResponses service1 service2 req = + fromMaybe (toJSON ()) (service1 req <|> service2 req) + +-- | Only Brig is mocked. +onlyMockedFederatedBrigResponse :: [(Qualified UserId, Text)] -> F.FederatedRequest -> Value +onlyMockedFederatedBrigResponse users = + joinMockedFederatedResponses + (mockedFederatedBrigResponse users) + (const Nothing) + +fedRequestsForDomain :: HasCallStack => Domain -> F.Component -> [F.FederatedRequest] -> [F.Request] +fedRequestsForDomain domain component = + map (fromJust . F.request) + . filter + ( \req -> + F.domain req == domainText domain + && fmap F.component (F.request req) == Just component + ) diff --git a/services/integration.yaml b/services/integration.yaml index f28eb23f902..f2e135bc461 100644 --- a/services/integration.yaml +++ b/services/integration.yaml @@ -53,6 +53,11 @@ federatorExternal: host: 127.0.0.1 port: 8098 +# This domain is configured using coredns runing along with the rest of +# docker-ephemeral setup. There is only an SRV record for +# _wire-server-federator._tcp.example.com +originDomain: example.com + # Used by brig-integration (bot providers), galley-integration (legal hold) provider: privateKey: test/resources/key.pem diff --git a/stack.yaml b/stack.yaml index 51be2101581..9c2b6a95c83 100644 --- a/stack.yaml +++ b/stack.yaml @@ -174,6 +174,8 @@ extra-deps: - splitmix-0.0.4 # needed for QuickCheck - servant-mock-0.8.7 - servant-swagger-ui-0.3.4.3.36.1 +- tls-1.5.5 +- cryptonite-0.28 # For changes from #128 and #135, not released to hackage yet - git: https://github.com/haskell-servant/servant-swagger diff --git a/stack.yaml.lock b/stack.yaml.lock index e412ea3e032..7fec0d171fb 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -519,6 +519,20 @@ packages: sha256: 137680a15ee0147cd19634d8296d90c2150ca4fd62ed3d56f7e07ccd8823810c original: hackage: servant-swagger-ui-0.3.4.3.36.1 +- completed: + hackage: tls-1.5.5@sha256:f6681d6624071211edd509a8f56e0c96b4f003bb349b7dc706d4333775a373c5,6996 + pantry-tree: + size: 4897 + sha256: 6400901a8f8ddd0c7d2fb30c95857753a654a60a63fcec38aab4a08b23e0984f + original: + hackage: tls-1.5.5 +- completed: + hackage: cryptonite-0.28@sha256:b6c75e62b4c655d4cb1bcbb80d01430d136aac32bd6962c86c84738935cc8f9d,18195 + pantry-tree: + size: 23132 + sha256: d80d7be9b1d0799a8e401ca5d4f4f424e0d8c42d4a30cc37bf6f82970232bfcf + original: + hackage: cryptonite-0.28 - completed: name: servant-swagger version: 1.1.11