From fbe38174eb0cfa4a07f996c884248d20dd97f267 Mon Sep 17 00:00:00 2001 From: Jun Matsushita Date: Mon, 16 Aug 2021 10:07:24 +0200 Subject: [PATCH 01/72] ldap-scim-bridge chart and openldap test instance SQPIT-625 --- charts/ldap-scim-bridge/.helmignore | 21 ++++++ charts/ldap-scim-bridge/Chart.yaml | 4 ++ .../ldap-scim-bridge/templates/cronjob.yaml | 39 +++++++++++ charts/ldap-scim-bridge/templates/secret.yaml | 13 ++++ charts/ldap-scim-bridge/values.yaml | 35 ++++++++++ charts/openldap/.helmignore | 21 ++++++ charts/openldap/Chart.yaml | 4 ++ charts/openldap/templates/openldap.yaml | 54 +++++++++++++++ .../openldap/templates/secret-newusers.yaml | 69 +++++++++++++++++++ charts/openldap/templates/service.yaml | 12 ++++ 10 files changed, 272 insertions(+) create mode 100644 charts/ldap-scim-bridge/.helmignore create mode 100644 charts/ldap-scim-bridge/Chart.yaml create mode 100644 charts/ldap-scim-bridge/templates/cronjob.yaml create mode 100644 charts/ldap-scim-bridge/templates/secret.yaml create mode 100644 charts/ldap-scim-bridge/values.yaml create mode 100644 charts/openldap/.helmignore create mode 100644 charts/openldap/Chart.yaml create mode 100644 charts/openldap/templates/openldap.yaml create mode 100644 charts/openldap/templates/secret-newusers.yaml create mode 100644 charts/openldap/templates/service.yaml diff --git a/charts/ldap-scim-bridge/.helmignore b/charts/ldap-scim-bridge/.helmignore new file mode 100644 index 00000000000..f0c13194444 --- /dev/null +++ b/charts/ldap-scim-bridge/.helmignore @@ -0,0 +1,21 @@ +# Patterns to ignore when building packages. +# This supports shell glob matching, relative path matching, and +# negation (prefixed with !). Only one pattern per line. +.DS_Store +# Common VCS dirs +.git/ +.gitignore +.bzr/ +.bzrignore +.hg/ +.hgignore +.svn/ +# Common backup files +*.swp +*.bak +*.tmp +*~ +# Various IDEs +.project +.idea/ +*.tmproj diff --git a/charts/ldap-scim-bridge/Chart.yaml b/charts/ldap-scim-bridge/Chart.yaml new file mode 100644 index 00000000000..dffb02fb7d5 --- /dev/null +++ b/charts/ldap-scim-bridge/Chart.yaml @@ -0,0 +1,4 @@ +apiVersion: v1 +description: ldap-scim-bridge - Sync LDAP via Wire Server SCIM API +name: ldap-scim-bridge +version: 0.0.1 diff --git a/charts/ldap-scim-bridge/templates/cronjob.yaml b/charts/ldap-scim-bridge/templates/cronjob.yaml new file mode 100644 index 00000000000..fbd10986a2f --- /dev/null +++ b/charts/ldap-scim-bridge/templates/cronjob.yaml @@ -0,0 +1,39 @@ +apiVersion: batch/v1beta1 +kind: CronJob +metadata: + name: ldap-scim-bridge + labels: + wireService: ldap-scim-bridge + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} +spec: + concurrencyPolicy: Forbid + schedule: {{ .Values.schedule | quote }} + jobTemplate: + metadata: + labels: + wireService: ldap-scim-bridge + release: {{ .Release.Name }} + annotations: + # An annotation of the configmap checksum ensures changes to the configmap cause a redeployment upon `helm upgrade` + checksum/secret: {{ include (print .Template.BasePath "/secret.yaml") . | sha256sum }} + spec: + backoffLimit: 0 + template: + spec: + restartPolicy: Never + volumes: + - name: "ldap-scim-bridge-config" + secret: + secretName: "ldap-scim-bridge" + containers: + - name: ldap-scim-bridge + image: "{{ .Values.image.repository }}:{{ .Values.image.tag }}" + imagePullPolicy: {{ default "" .Values.imagePullPolicy | quote }} + args: ["ldap-scim-bridge", "/etc/ldap-scim-bridge/config.yaml"] + volumeMounts: + - name: "ldap-scim-bridge-config" + mountPath: "/etc/ldap-scim-bridge/" + resources: +{{ toYaml .Values.resources | indent 16 }} diff --git a/charts/ldap-scim-bridge/templates/secret.yaml b/charts/ldap-scim-bridge/templates/secret.yaml new file mode 100644 index 00000000000..01e8bc35682 --- /dev/null +++ b/charts/ldap-scim-bridge/templates/secret.yaml @@ -0,0 +1,13 @@ +apiVersion: v1 +kind: Secret +metadata: + name: ldap-scim-bridge + labels: + wireService: ldap-scim-bridge + chart: "{{ .Chart.Name }}-{{ .Chart.Version }}" + release: "{{ .Release.Name }}" + heritage: "{{ .Release.Service }}" +type: Opaque +stringData: + config.yaml: | +{{ toYaml .Values.config | indent 4 }} \ No newline at end of file diff --git a/charts/ldap-scim-bridge/values.yaml b/charts/ldap-scim-bridge/values.yaml new file mode 100644 index 00000000000..f348153438f --- /dev/null +++ b/charts/ldap-scim-bridge/values.yaml @@ -0,0 +1,35 @@ +image: + repository: quay.io/wire/ldap-scim-bridge + tag: 0.0.3 +resources: + requests: + memory: "256Mi" + cpu: "100m" + limits: + memory: "512Mi" + cpu: "500m" +# https://v1-19.docs.kubernetes.io/docs/tasks/job/automated-tasks-with-cron-jobs/#schedule +# schedule: "@hourly" +schedule: "*/1 * * * *" +# https://github.com/wireapp/ldap-scim-bridge +config: + logLevel: "Debug" + ldapSource: + tls: false + host: "openldap" + port: 389 + dn: "cn=admin,dc=nodomain" + password: "admin" + base: "ou=People,dc=nodomain" + objectClass: "account" + codec: "utf8" + scimTarget: + tls: false + host: "spar" + port: 8080 + path: "/scim/v2" + token: "Bearer test/team=3675658e-f31d-41c1-a41b-fe68a6adf3af/code=7f5cf0b4-cf76-4dc1-b122-28b413a9d2f7" + mapping: + userName: "uidNumber" + externalId: "uid" + email: "email" diff --git a/charts/openldap/.helmignore b/charts/openldap/.helmignore new file mode 100644 index 00000000000..f0c13194444 --- /dev/null +++ b/charts/openldap/.helmignore @@ -0,0 +1,21 @@ +# Patterns to ignore when building packages. +# This supports shell glob matching, relative path matching, and +# negation (prefixed with !). Only one pattern per line. +.DS_Store +# Common VCS dirs +.git/ +.gitignore +.bzr/ +.bzrignore +.hg/ +.hgignore +.svn/ +# Common backup files +*.swp +*.bak +*.tmp +*~ +# Various IDEs +.project +.idea/ +*.tmproj diff --git a/charts/openldap/Chart.yaml b/charts/openldap/Chart.yaml new file mode 100644 index 00000000000..80b07b2ba37 --- /dev/null +++ b/charts/openldap/Chart.yaml @@ -0,0 +1,4 @@ +apiVersion: v1 +description: openldap - Sync LDAP via Wire Server SCIM API +name: openldap +version: 0.0.1 diff --git a/charts/openldap/templates/openldap.yaml b/charts/openldap/templates/openldap.yaml new file mode 100644 index 00000000000..0e2281d27d4 --- /dev/null +++ b/charts/openldap/templates/openldap.yaml @@ -0,0 +1,54 @@ +apiVersion: v1 +kind: Pod +metadata: + name: "openldap" + labels: + wireService: openldap + chart: {{ .Chart.Name }}-{{ .Chart.Version | replace "+" "_" }} + release: {{ .Release.Name }} + heritage: {{ .Release.Service }} +spec: + securityContext: + fsGroup: 911 + volumes: + - name: "openldap-config" + secret: + secretName: "openldap-newusers-ldif" + # - name: workdir + # emptyDir: {} + restartPolicy: Never + # initContainers: + # - name: install + # image: busybox + # command: ["/bin/sh","-c"] + # args: + # - "cp /config/*.* /workdir" + # - "chown 911:911 /workdir/*.*" + # volumeMounts: + # - name: workdir + # mountPath: "/workdir" + # volumeMounts: + # - name: "openldap-config" + # mountPath: "/config" + containers: + - name: openldap + image: osixia/openldap:1.5.0 + volumeMounts: + - name: "openldap-config" + mountPath: "/config" + ports: + - containerPort: 389 + livenessProbe: + tcpSocket: + port: 389 + initialDelaySeconds: 60 + periodSeconds: 20 + env: + - name: LDAP_SEED_INTERNAL_LDIF_PATH + value: /config + - name: LDAP_DOMAIN + value: "nodomain" + - name: LDAP_ORGANISATION + value: "People" + - name: LDAP_ADMIN_PASSWORD + value: "admin" \ No newline at end of file diff --git a/charts/openldap/templates/secret-newusers.yaml b/charts/openldap/templates/secret-newusers.yaml new file mode 100644 index 00000000000..e909f59189f --- /dev/null +++ b/charts/openldap/templates/secret-newusers.yaml @@ -0,0 +1,69 @@ +apiVersion: v1 +kind: Secret +metadata: + name: openldap-newusers-ldif + labels: + wireService: ldap-scim-bridge + chart: "{{ .Chart.Name }}-{{ .Chart.Version }}" + release: "{{ .Release.Name }}" + heritage: "{{ .Release.Service }}" +type: Opaque +stringData: + 00-users.ldif: | + dn: ou=People,dc=nodomain + objectClass: organizationalUnit + ou: People + 10-newusers.ldif: | + dn: cn=john,ou=People,dc=nodomain + objectClass: top + objectClass: account + objectClass: posixAccount + objectClass: shadowAccount + cn: john + uid: john + uidNumber: 10001 + gidNumber: 10001 + homeDirectory: /home/john + userPassword: notgonnatell + loginShell: /bin/bash + + dn: cn=jane,ou=People,dc=nodomain + objectClass: top + objectClass: account + objectClass: posixAccount + objectClass: shadowAccount + cn: jane + uid: jane + uidNumber: 10002 + gidNumber: 10002 + homeDirectory: /home/jane + userPassword: notgonnatelleither + loginShell: /bin/bash + + dn: cn=me,ou=People,dc=nodomain + objectClass: top + objectClass: account + objectClass: posixAccount + objectClass: shadowAccount + cn: me + uid: me + uidNumber: 10003 + gidNumber: 10003 + homeDirectory: /home/me + userPassword: notgonnatelleither + loginShell: /bin/bash + + dn: cn=usesemail,ou=People,dc=nodomain + objectClass: top + objectClass: account + objectClass: posixAccount + objectClass: shadowAccount + objectClass: extensibleObject + cn: usesemail + uid: usesemail + uidNumber: 10004 + gidNumber: 10004 + email: uses@example.com + homeDirectory: /home/me + userPassword: notgonnatelleither + loginShell: /bin/bash diff --git a/charts/openldap/templates/service.yaml b/charts/openldap/templates/service.yaml new file mode 100644 index 00000000000..356597c6056 --- /dev/null +++ b/charts/openldap/templates/service.yaml @@ -0,0 +1,12 @@ +apiVersion: v1 +kind: Service +metadata: + name: openldap +spec: + selector: + wireService: openldap + ports: + - name: openldap + protocol: TCP + port: 389 + targetPort: 389 \ No newline at end of file From 0686447e72405266263cf78a3b1115dd8f3561ce Mon Sep 17 00:00:00 2001 From: Jun Matsushita Date: Mon, 16 Aug 2021 10:11:41 +0200 Subject: [PATCH 02/72] Document ldap-scim-bridge chart change --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 33b9e774942..be03c644583 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -30,7 +30,7 @@ ## API Changes ## Features - +* Helm charts to deploy [ldap-scim-bridge](https://github.com/wireapp/ldap-scim-bridge) #1709 ## Bug fixes and other updates ## Documentation From 622e1e659d5e7908a9c7f5b21aa577f19e0a41d6 Mon Sep 17 00:00:00 2001 From: Jun Matsushita Date: Mon, 16 Aug 2021 14:00:41 +0200 Subject: [PATCH 03/72] Proper syntax for Bearer config --- charts/ldap-scim-bridge/values.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/charts/ldap-scim-bridge/values.yaml b/charts/ldap-scim-bridge/values.yaml index f348153438f..8171ccadacd 100644 --- a/charts/ldap-scim-bridge/values.yaml +++ b/charts/ldap-scim-bridge/values.yaml @@ -28,7 +28,7 @@ config: host: "spar" port: 8080 path: "/scim/v2" - token: "Bearer test/team=3675658e-f31d-41c1-a41b-fe68a6adf3af/code=7f5cf0b4-cf76-4dc1-b122-28b413a9d2f7" + token: "Bearer U6DRfAcwsvCg9eBStJWtiHu/XqTB1iVDcvNcsuftvqk=" mapping: userName: "uidNumber" externalId: "uid" From f574693d5e0d931cf745066cd9d79e9fd1ba309b Mon Sep 17 00:00:00 2001 From: Jun Matsushita Date: Mon, 16 Aug 2021 14:01:00 +0200 Subject: [PATCH 04/72] Fix chart description --- charts/openldap/Chart.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/charts/openldap/Chart.yaml b/charts/openldap/Chart.yaml index 80b07b2ba37..75f3dd538a1 100644 --- a/charts/openldap/Chart.yaml +++ b/charts/openldap/Chart.yaml @@ -1,4 +1,4 @@ apiVersion: v1 -description: openldap - Sync LDAP via Wire Server SCIM API +description: openldap - Test instance for LDAP sync with ldap-scim-bridge name: openldap version: 0.0.1 From 9de0e7bdd0d44eae509e68c6c8c9120e3bb2f537 Mon Sep 17 00:00:00 2001 From: Jun Matsushita Date: Mon, 16 Aug 2021 14:01:28 +0200 Subject: [PATCH 05/72] Make test users uids valid email addresses for testing --- charts/openldap/templates/secret-newusers.yaml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/charts/openldap/templates/secret-newusers.yaml b/charts/openldap/templates/secret-newusers.yaml index e909f59189f..b78ef5a2207 100644 --- a/charts/openldap/templates/secret-newusers.yaml +++ b/charts/openldap/templates/secret-newusers.yaml @@ -20,7 +20,7 @@ stringData: objectClass: posixAccount objectClass: shadowAccount cn: john - uid: john + uid: john@example.com uidNumber: 10001 gidNumber: 10001 homeDirectory: /home/john @@ -33,7 +33,7 @@ stringData: objectClass: posixAccount objectClass: shadowAccount cn: jane - uid: jane + uid: jane@example.com uidNumber: 10002 gidNumber: 10002 homeDirectory: /home/jane @@ -46,7 +46,7 @@ stringData: objectClass: posixAccount objectClass: shadowAccount cn: me - uid: me + uid: me@example.com uidNumber: 10003 gidNumber: 10003 homeDirectory: /home/me @@ -60,7 +60,7 @@ stringData: objectClass: shadowAccount objectClass: extensibleObject cn: usesemail - uid: usesemail + uid: usesemail@example.com uidNumber: 10004 gidNumber: 10004 email: uses@example.com From ac1952c522b259ac1a2e785fd3bb768c038a2d2b Mon Sep 17 00:00:00 2001 From: Jun Matsushita Date: Tue, 17 Aug 2021 11:35:56 +0200 Subject: [PATCH 06/72] Upgrade to ldap-scim-bridge 0.0.4 9e9d8e7 with new config format --- charts/ldap-scim-bridge/values.yaml | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/charts/ldap-scim-bridge/values.yaml b/charts/ldap-scim-bridge/values.yaml index 8171ccadacd..dabc5b07345 100644 --- a/charts/ldap-scim-bridge/values.yaml +++ b/charts/ldap-scim-bridge/values.yaml @@ -1,6 +1,6 @@ image: repository: quay.io/wire/ldap-scim-bridge - tag: 0.0.3 + tag: 0.0.4 resources: requests: memory: "256Mi" @@ -13,20 +13,27 @@ resources: schedule: "*/1 * * * *" # https://github.com/wireapp/ldap-scim-bridge config: - logLevel: "Debug" + logLevel: "Debug" # one of Trace,Debug,Info,Warn,Error,Fatal; `Fatal` is least noisy, `Trace` most. ldapSource: tls: false - host: "openldap" + host: "localhost" port: 389 dn: "cn=admin,dc=nodomain" - password: "admin" - base: "ou=People,dc=nodomain" - objectClass: "account" + password: "geheim hoch drei" + search: + base: "ou=People,dc=nodomain" + objectClass: "account" codec: "utf8" + deleteOnAttribute: # optional, related to `delete-from-directory`. + key: "deleted" + value: "true" + deleteFromDirectory: # optional; ok to use together with `delete-on-attribute` if you use both. + base: "ou=DeletedPeople,dc=nodomain" + objectClass: "account" scimTarget: tls: false - host: "spar" - port: 8080 + host: "localhost" + port: 8088 path: "/scim/v2" token: "Bearer U6DRfAcwsvCg9eBStJWtiHu/XqTB1iVDcvNcsuftvqk=" mapping: From 743acefd95f69204787b331063a18314eede7ae1 Mon Sep 17 00:00:00 2001 From: Jun Matsushita Date: Tue, 17 Aug 2021 11:45:12 +0200 Subject: [PATCH 07/72] Use openldap and wire defaults --- charts/ldap-scim-bridge/values.yaml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/charts/ldap-scim-bridge/values.yaml b/charts/ldap-scim-bridge/values.yaml index dabc5b07345..47eb4b87850 100644 --- a/charts/ldap-scim-bridge/values.yaml +++ b/charts/ldap-scim-bridge/values.yaml @@ -16,10 +16,10 @@ config: logLevel: "Debug" # one of Trace,Debug,Info,Warn,Error,Fatal; `Fatal` is least noisy, `Trace` most. ldapSource: tls: false - host: "localhost" + host: "openldap" port: 389 dn: "cn=admin,dc=nodomain" - password: "geheim hoch drei" + password: "admin" search: base: "ou=People,dc=nodomain" objectClass: "account" @@ -32,7 +32,7 @@ config: objectClass: "account" scimTarget: tls: false - host: "localhost" + host: "spar" port: 8088 path: "/scim/v2" token: "Bearer U6DRfAcwsvCg9eBStJWtiHu/XqTB1iVDcvNcsuftvqk=" From b4fcc6a326d2c3e3de5b4a4dc3ce94b33ed7485d Mon Sep 17 00:00:00 2001 From: Jun Matsushita Date: Tue, 17 Aug 2021 11:45:53 +0200 Subject: [PATCH 08/72] Use wire spar port default --- charts/ldap-scim-bridge/values.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/charts/ldap-scim-bridge/values.yaml b/charts/ldap-scim-bridge/values.yaml index 47eb4b87850..b47a1833e46 100644 --- a/charts/ldap-scim-bridge/values.yaml +++ b/charts/ldap-scim-bridge/values.yaml @@ -33,7 +33,7 @@ config: scimTarget: tls: false host: "spar" - port: 8088 + port: 8080 path: "/scim/v2" token: "Bearer U6DRfAcwsvCg9eBStJWtiHu/XqTB1iVDcvNcsuftvqk=" mapping: From f120141e36cd37dc91ad9ef56ce2a616b26ed644 Mon Sep 17 00:00:00 2001 From: Jun Matsushita Date: Wed, 25 Aug 2021 12:08:53 +0200 Subject: [PATCH 09/72] Add chart deployment docs --- charts/ldap-scim-bridge/README.md | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 charts/ldap-scim-bridge/README.md diff --git a/charts/ldap-scim-bridge/README.md b/charts/ldap-scim-bridge/README.md new file mode 100644 index 00000000000..670ba455f68 --- /dev/null +++ b/charts/ldap-scim-bridge/README.md @@ -0,0 +1,17 @@ +# ldap-scim-bridge + +To do a test deployment on a existing cluster from a machine able to deploy helm charts… +```bash +git clone wire-server +cd wire-server +# deploy test instance of openldap with preloaded users +helm upgrade --install -n wire openldap charts/openldap/ +# deploy ldap-scim-bridge with default chart values +helm upgrade --install -n wire ldap-scim-bridge charts/ldap-scim-bridge -f charts/ldap-scim-bridge/values.yaml +``` + +The kubernetes cronjob resource will spawn a new `ldap-scim-bridge-XXXXXX` pod every minute. Logs for the pod can be gathered with `kubectl log`. +``` +kubectl get pods -n wire +kubectl logs ldap-scim-bridge-XXXXXX -n wire +``` From 6cb529c97fd9d93d4f7680014837a956d669a27f Mon Sep 17 00:00:00 2001 From: Jun Matsushita Date: Wed, 25 Aug 2021 12:09:08 +0200 Subject: [PATCH 10/72] Use 0.0.5 image --- charts/ldap-scim-bridge/values.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/charts/ldap-scim-bridge/values.yaml b/charts/ldap-scim-bridge/values.yaml index b47a1833e46..3529038a382 100644 --- a/charts/ldap-scim-bridge/values.yaml +++ b/charts/ldap-scim-bridge/values.yaml @@ -1,6 +1,6 @@ image: repository: quay.io/wire/ldap-scim-bridge - tag: 0.0.4 + tag: 0.0.5 resources: requests: memory: "256Mi" From 11ad4f8248ce5624ac193d0817e30656637857a3 Mon Sep 17 00:00:00 2001 From: Jun Matsushita Date: Wed, 25 Aug 2021 12:12:38 +0200 Subject: [PATCH 11/72] Use draft --- CHANGELOG-draft.md | 1672 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1672 insertions(+) create mode 100644 CHANGELOG-draft.md diff --git a/CHANGELOG-draft.md b/CHANGELOG-draft.md new file mode 100644 index 00000000000..be03c644583 --- /dev/null +++ b/CHANGELOG-draft.md @@ -0,0 +1,1672 @@ + + + +# [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 + +## Features +* Helm charts to deploy [ldap-scim-bridge](https://github.com/wireapp/ldap-scim-bridge) #1709 +## Bug fixes and other updates + +## Documentation + +## Internal changes + + +# [2021-08-16] + +## Release Notes + +This is a routine release requiring only the routine upgrade steps. + +## API Changes + +* Add `POST /conversations/list-ids` (#1686) +* Deprecate `GET /converstations/ids` (#1686) + +## Features + +* Client functions for the hscim library (#1694, #1699, #1702, https://hackage.haskell.org/package/hscim) + +## Bug fixes and other updates + +* Change http response code for `missing-legalhold-consent`. (#1688) +* Remove old end-point for changing email + +## Federation changes (alpha feature, do not use yet) + +* Add new API to list paginated qualified conversation ids (#1686) + +## Documentation + +* Fix swagger: mark name in UserUpdate as optional (#1691, #1692) + +## Internal changes + +* Replaced uses of `UVerb` and `EmptyResult` with `MultiVerb` (#1693) +* Added a mechanism to derive `AsUnion` instances automatically (#1693) +* Integration test coverage (#1696, #1704) + + +# [2021-08-02] + +## Release Notes + +If you want to set the default for file sharing in all teams to `disabled`, search for "File Sharing" in https://github.com/wireapp/wire-server/tree/develop/docs/reference/config-options.md. + +## Release Notes for Wire.com Cloud operators + +Upgrade nginz (#1658) + +## API Changes + +## Features + +* A new team feature for classified domains is available (#1626): + - a public endpoint is at `GET /teams/:tid/features/classifiedDomains` + - an internal endpoint is at `GET /i/teams/:tid/features/classifiedDomains` +* Extend feature config API (#1658) +* `fileSharing` feature config (#1652, #1654, #1655) +* `conferenceCalling` feature flag (#1683) +* Add user_id to csv export (#1663) + +## Bug fixes and other updates + +* New, hardened end-point for changing email (68b4db08) +* Fix: CSV export is missing SCIM external id when SAML is also used (#1608) +* Fix: sso_id field in user record (brig) was not always filled correctly in cassandra (#1334) +* Change http response code for `missing-legalhold-consent` from 412 to 403 (#1688) + +## Documentation + +* Improved Swagger documentation for endpoints with multiple responses (#1649, #1645) + +## Internal changes + +* Improvements to local integration test setup when using buildah and kind (#1667) +* The servant-swagger dependency now points to the current upstream master (#1656) +* Improved error handling middleware (#1671) +* Refactor function createUser for readability (#1670) +* Removed explicit implementation for user HEAD endpoints (#1679) +* Improved test coverage for error responses (#1680) +* Introduced `MultiVerb` endpoints in Servant API (#1649). + +## Federation changes (alpha feature, do not use yet) + +* Validate server TLS certificate between federators (#1662) +* A clarification is added about listing your own domain as a classified domain (#1678) +* Added a `QualifiedCapture` type to Servant for qualified paths (#1669) +* Renamed `DomainHeader` type to `OriginDomainHeader` (#1689) +* Added golden tests for protobuf serialisation / deserialisation (#1644). + + +# [2021-07-09] + +## Release Notes + +This release requires a manual change in your galley configuration: `settings.conversationCodeURI` in `galley.yaml` was had to be set to `${WEBAPP}/join` before this release, and must be set to `${ACCOUNTS}/conversation-join` from now on, where `${WEBAPP}` is the url to the webapp and `${ACCOUNTS}` is the url to the account pages. + +## API Changes + +* Several public team feature endpoints are removed (their internal and + Stern-based counterparts remain available): + - `PUT /teams/:tid/features/sso` + - `PUT /teams/:tid/features/validateSAMLemails` + - `PUT /teams/:tid/features/digitalSignatures` +* All endpoints that fetch conversation details now also include a new key + `qualified_id` for a qualified conversation ID (#1640) +* New endpoint `POST /list-conversations` similar to `GET /conversations`, but which will also return your own remote conversations (if federation is enabled). (#1591) + +## Features + +* Change `settings.conversationCodeURI` in galley.yaml (#1643). +* [Federation] RPC to propagate messages to other backends (#1596). +* [Federation] Fetch remote user's clients when sending messages (#1635). +* [Federation] Actually propagate messages to other backends (#1638). +* [Federation] Support sending messages to remote conversations (#1609). +* [Federation] Guard against path traversal attacks (#1646). + +## Internal changes + +* Feature endpoints are rewritten in Servant (#1642). +* Internal federation endpoints using the publicly-facing conversation data type + now also include a qualified conversation ID under the `qualified_id` key + (#1640) +* schema-profunctor: add `optField` combinator and corresponding documentation (#1621, #1624). +* [Federation] Let a receiving backend decide conversation attribute specifics of its users + added to a new conversation via `POST /federation/register-conversation` (#1622). +* [Federation] Adjust scripts under ./hack/federation to work with recent changes to the federation API (#1632). +* Refactored Proteus endpoint to work with qualified users (#1634). +* Refactored Federator InternalServer (#1637) + +### Internal Federation API changes + +* Breaking change on InwardResponse and OutwardResponse in router.proto for improved error handling (#1637) + * Note: federation should not be in use anywhere yet, so this should not have any impact + +## Documentation + +* Fix validation errors in Swagger documentation (#1625). + +## Bug fixes and other updates + +* Restore old behaviour for parse errors in request bodies (#1628, #1629). +* Allow to change IdP Issuer name to previous name (#1615). + + +# [2021-06-23] + +## API Changes + +* [Federation] Add qualified endpoint for sending messages at `POST /conversations/:domain/:cnv/proteus/messages` (#1593, #1614, #1616, #1620). +* Replace 'otr' with 'proteus' in new message sending API (#1616) + +## Features + +## Bug fixes and other updates + +* [helm] Allow sending messages upto 40 MB by default (#1614) +* Fix for https://github.com/wireapp/wire-webapp/security/advisories/GHSA-382j-mmc8-m5rw (#1613) +* Update wire-webapp version (#1613) +* Update team-settings version (#1598) +* Allow optional password field in RmClient (#1604, #1607) +* Add endpoint: Get name, id with for CodeAccess conversations (#1592) +* demote logging failed invitations to a warning, rather than an error. Server operators can't act on these errors in any way (#1586) + +## Documentation + +* Add descriptive comments to `ConversationMemberUpdate` (#1578) +* initial few anti-patterns and links about cassandra (#1599) + +## Internal changes + +* Rename a local members field in the Conversation data type (#1580) +* Servantify Protobuf endpoint to send messages (#1583) +* Servantify own client API (#1584, #1603) +* Remove resource requests (#1581) +* Import http2 fix (#1582) +* Remove stale FUTUREWORK comment (#1587) +* Reorganise helper functions for conversation notifications (#1588) +* Extract origin domain header name for use in API (#1597) +* Merge Empty200, Empty404 and EmptyResult (#1589) +* Set content-type header for JSON errors in Servant (#1600) +* Add golden tests for ClientCapability(List) (#1590) +* Add checklist for PRs (#1601, #1610) +* Remove outdated TODO (#1606) +* submodules (#1612) + +## More federation changes (inactive code) + +* Add getUserClients RPC (and thereby allow remote clients lookup) (#1500) +* minor refactor: runFederated (#1575) +* Notify remote backends when users join (#1556) +* end2end test getting remote conversation and complete its implementation (#1585) +* Federation: Notify Remote Users of Being Added to a New Conversation (#1594) +* Add qualified endpoint for sending messages (#1593, #1614) +* Galley/int: Expect remote call when creating conv with remotes (#1611) + + +# [2021-06-08] + +## Release Notes + +This release doesn't require any extra considerations to deploy. + +## Release Notes for Wire.com Cloud operators + +Deploy brig before galley (#1526, #1549) + +## Features +* Update versions of webapp, team-settings, account-pages (#1559) +* Add missing /list-users route (#1572) +* [Legalhold] Block device handshake in case of LH policy conflict (#1526) +* [Legalhold] Fix: Connection type when unblocking after LH (#1549) +* [Legalhold] Allow Legalhold for large teams (>2000) if enabled via whitelist (#1546) +* [Legalhold] Add ClientCapabilities to NewClient. (#1552) +* [Legalhold] Dynamic whitelisted teams & whitelist-teams-and-implicit-consent feature in tests (#1557, #1574) +* [Federation] Add remote members to conversations (#1529) +* [Federation] Federation: new endpoint: GET /conversations/{domain}/{cnv} (#1566) +* [Federation] Parametric mock federator (#1558) +* [Federation] Add more information to federation errors (#1560) +* [Federation] Add remote users when creating a conversation (#1569) +* [Federation] Update conversation membership in a remote backend (#1540) +* [Federation] expose /conversations/{cnv}/members/v2 for federation backends (#1543) + +## Bug fixes and other updates +* Fix MIME-type of asset artifacts +* Add some missing charts (#1533) + +# Internal changes +* Qualify users and conversations in Event (#1547) +* Make botsAndUsers pure (#1562) +* Set swagger type of text schema (#1561) +* More examples in schema-profunctor documentation (#1539) +* Refactoring-friendly FutureWork data type (#1550) +* nginz/Dockerfile: Run 'apk add' verbosely for debugging (#1565) +* Introduce a generalized version of wai-extra Session type constructor (#1563) +* Avoid wrapping error in rethrow middleware (#1567) +* wire-api: Introduce ErrorDescription (#1573) +* [Federation] Use Servant.respond instead of explicit SOP (#1535) +* [Federation] Add end2end test for adding remote users to a conversation (#1538) +* [Federation] Add required fields to Swagger for SchemaP (#1536) +* [Federation] Add Galley component to federator API (#1555) +* [Federation] Generalises the mock federator to work with any MonadIO m monad (#1564) +* [Federation] Introduces the HasGalley class (#1568) +* [Federation] Servantify JSON endpoint to send messages (#1532) +* [Federation] federator: rename Brig -> Service and add galley (#1570) + +## Documentation +* Update Rich Info docs (#1544) + + +# [2021-05-26] + +## Release Notes + +**Legalhold:** This release introduces a notion of "consent" to +legalhold (LH). If you are using LH on your site, follow the +instructions in +https://github.com/wireapp/wire-server/blob/814f3ebc251965ab4492f5df4d9195f3b2e0256f/docs/reference/team/legalhold.md#whitelisting-and-implicit-consent +after the upgrade. **Legalhold will not work as expected until you +change `galley.conf` as described!** + +**SAML/SCIM:** This release introduces changes to the way `NameID` is +processed: all identifiers are stored in lower-case and qualifiers are +ignored. No manual upgrade steps are necessary, but consult +https://docs.wire.com/how-to/single-sign-on/trouble-shooting.html#theoretical-name-clashes-in-saml-nameids +on whether you need to re-calibrate your SAML IdP / SCIM setup. +(Reason / technical details: this change is motivated by two facts: +(1) email casing is complicated, and industry best practice appears to +be to ignore case information even though that is in conflict with the +official standard documents; and (2) SCIM user provisioning does not +allow to provide SAML NameID qualifiers, and guessing them has proven +to be infeasible. See +https://github.com/wireapp/wire-server/pull/1495 for the code +changes.) + +## Features + - [SAML/SCIM] More lenient matching of user ids (#1495) + - [Legalhold] Block and kick users in case of LH no_consent conflict (1:1 convs). (#1507, #1530) + - [Legalhold] Add legalhold status to user profile (#1522) + - [Legalhold] Client-supported capabilities end-point (#1503) + - [Legalhold] Whitelisting Teams for LH with implicit consent (#1502) + - [Federation] Remove OptionallyQualified data type from types-common (#1517) + - [Federation] Add RPC getConversations (#1493) + - [Federation] Prepare remote conversations: Remove Opaque/Mapped Ids, delete remote identifiers from member/user tables. (#1478) + - [Federation] Add schema migration for new tables (#1485) + - [SAML/SCIM] Normalize SAML identifiers and fix issues with duplicate account creation (#1495) + - Internal end-point for ejpd request processing. (#1484) + +## Bug fixes and other updates + - Fix: NewTeamMember vs. UserLegalHoldStatus (increase robustness against rogue clients) (#1496) + +## Documentation + - Fixes a typo in the wire-api documentation (#1513) + - Unify Swagger 2.0 docs for brig, galley and spar (#1508) + +## Internal changes + - Cleanup (no change in behavior) (#1494, #1501) + - wire-api: Add golden test for FromJSON instance of NewOtrMessage (#1531) + - Swagger/JSON cleanup (#1521, #1525) + - Work around a locale issue in Ormolu (#1520) + - Expose mock federator in wire-api-federation (#1524) + - Prettier looking golden tests (#1527) + - Refactorings, bug fixes (in tests only) (#1523) + - Use sed instead of yq to read yaml files (#1518) + - Remove zauth dependency from wire-api (#1516) + - Improve naming conventions federation RPC calls (#1511) + - Event refactoring and schema instances (#1506) + - Fix: regenerate cabal files. (#1510) + - Make DerivingVia a package default. (#1505) + - Port instances to schemas library (#1482) + - wire-api-federator: Make client tests more reliable (#1491) + - Remove duplicated roundtrip test (#1498) + - schema-profunctor: Add combinator for nonEmptyArray (#1497) + - Golden tests for JSON instances (#1486) + - galley: Convert conversation endpoints to servant (#1444, #1499) + - Fix Arbitrary instances and enable corresponding roundtrip tests (#1492) + - wire-api-fed: Mark flaky tests as pending + - RFC: Schemas for documented bidirectional JSON encoding (#1474) + + +# [2021-05-04] + +## Features + - [brig] New option to use a random prekey selection strategy to remove DynamoDB dependency (#1416, #1476) + - [brig] Ensure servant APIs are recorded by the metrics middleware (#1441) + - [brig] Add exact handle matches from all teams in /search/contacts (#1431, #1455) + - [brig] CSV endpoint: Add columns to output (#1452) + - [galley] Make pagination more idiomatic (#1460) + - [federation] Testing improvements (#1411, #1429) + - [federation] error reporting, DNS error logging (#1433, #1463) + - [federation] endpoint refactoring, new brig endpoints, servant client for federated calls, originDomain metadata (#1389, #1446, #1445, #1468, #1447) + - [federation] Add federator to galley (#1465) + - [move-team] Update move-team with upstream schema changes #1423 + +## Bug fixes and other updates + - [security] Update webapp container image tag to address CVE-2021-21400 (#1473) + - [brig] Return correct status phrase and body on error (#1414) … + - [brig] Fix FromJSON instance of ListUsersQuery (#1456) + - [galley] Lower the limit for URL lengths for galley -> brig RPC calls (#1469) + - [chores] Remove unused dependencies (#1424) … + - [compilation] Stop re-compiling nginz when running integration test for unrelated changes + - [tooling] Use jq magic instead of bash (#1432), Add wget (#1443) + - [chores] Refactor Dockerfile apk installation tasks (#1448) + - [tooling] Script to generate token for SCIM endpoints (#1457) + - [tooling] Ormolu script improvements (#1458) + - [tooling] Add script to colourise test failure output (#1459) + - [tooling] Setup for running tests in kind (#1451, #1462) + - [tooling] HLS workaround for optimisation flags (#1449) + +## Documentation + - [docs] Document how to run multi-backend tests for federation (#1436) + - [docs] Fix CHANGELOG: incorrect release dates (#1435) + - [docs] Update release notes with data migration for SCIM (#1442) + - [docs] Fixes a k8s typo in the README (#1475) + - [docs] Document testing strategy and patterns (#1472) + + +# [2021-03-23] + +## Features + +* [federation] Handle errors which could happen while talking to remote federator (#1408) +* [federation] Forward grpc traffic to federator via ingress (or nginz for local integration tests) (#1386) +* [federation] Return UserProfile when getting user by qualified handle (#1397) + +## Bug fixes and other updates + +* [SCIM] Fix: Invalid requests raise 5xxs (#1392) +* [SAML] Fix: permissions for IdP CRUD operations. (#1405) + +## Documentation + +* Tweak docs about team search visibility configuration. (#1407) +* Move docs around. (#1399) +* Describe how to look at swagger locally (#1388) + +## Internal changes + +* Optimize /users/list-clients to only fetch required things from DB (#1398) +* [SCIM] Remove usage of spar.scim_external_ids table (#1418) +* Add-license. (#1394) +* Bump nixpkgs for hls-1.0 (#1412) +* stack-deps.nix: Use nixpkgs from niv (#1406) + + +# [2021-03-21] + +## Release Notes + +If you are using Wire's SCIM functionality you shouldn't skip this release. If you skip it then there's a chance of requests from SCIM clients being missed during the time window of Wire being upgraded. +This might cause sync issues between your SCIM peer and Wire's user DB. +This is due to an internal data migration job (`spar-migrate-data`) that needs to run once. If it hasn't run yet then any upgrade to this and any later release will automatically run it. After it has completed once it is safe again to upgrade Wire while receiving requests from SCIM clients. + +## Internal changes + +* Migrate spar external id table (#1400, #1413, #1415, #1417) + +# [2021-03-02] + +## Bug fixes and other updates + +* Return PubClient instead of Client from /users/list-clients (#1391) + +## Internal changes + +* Federation: Add qualified endpoints for prekey management (#1372) + + +# [2021-02-25] + +## Bug fixes and other updates + +* Pin kubectl image in sftd chart (#1383) +* Remove imagePullPolicy: Always for reaper chart (#1387) + + +## Internal changes + +* Use mu-haskell to implement one initial federation request across backends (#1319) +* Add migrate-external-ids tool (#1384) + + +# [2021-02-16] + +## Release Notes + +This release might require manual migration steps, see [ElasticSearch migration instructions for release 2021-02-16 ](https://github.com/wireapp/wire-server/blob/c81a189d0dc8916b72ef20d9607888618cb22598/docs/reference/elasticsearch-migration-2021-02-16.md). + +## Features + +* Team search: Add search by email (#1344) (#1286) +* Add endpoint to get client metadata for many users (#1345) +* Public end-point for getting the team size. (#1295) +* sftd: add support for multiple SFT servers (#1325) (#1377) +* SAML allow enveloped signatures (#1375) + +## Bug fixes and other updates + +* Wire.API.UserMap & Brig.API.Public: Fix Swagger docs (#1350) +* Fix nix build on OSX (#1340) + +## Internal changes + +* [federation] Federation end2end test scripts and Makefile targets (#1341) +* [federation] Brig integration tests (#1342) +* Add stack 2.3.1 to shell.nix (#1347) +* buildah: Use correct dist directory while building docker-images (#1352) +* Add spar.scim_external table and follow changes (#1359) +* buildah: Allow building only a given exec and fix brig templates (#1353) +* Galley: Add /teams/:tid/members csv download (#1351) (#1351) +* Faster local docker image building using buildah (#1349) +* Replace federation guard with env var (#1346) +* Update cassandra schema after latest changes (#1337) +* Add fast-intermediate Dockerfile for faster PR CI (#1328) +* dns-util: Allow running lookup with a given resolver (#1338) +* Add missing internal qa routes (#1336) +* Extract and rename PolyLog to a library for reusability (#1329) +* Fix: Spar integration tests misconfigured on CI (#1343) +* Bump ormolu version (#1366, #1368) +* Update ES upgrade path (#1339) (#1376) +* Bump saml2-web-sso version to latest upstream (#1369) +* Add docs for deriving-swagger2 (#1373) + + +# [2021-01-15] + +## Release Notes + +This release contains bugfixes and internal changes. + +## Features + +* [federation] Add helm chart for the federator (#1317) + +## Bug fixes and other updates + +* [SCIM] Accept any query string for externalId (#1330) +* [SCIM] Allow at most one identity provider (#1332) + +## Internal changes + +* [SCIM] Change log level to Warning & format filter logs (#1331) +* Improve flaky integration tests (#1333) +* Upgrade nixpkgs and niv (#1326) + + +# [2021-01-12] + +## Release Notes + +This release contains bugfixes and internal changes. + +## Bug fixes and other updates + +* [SCIM] Fix bug: Deleting a user retains their externalId (#1323) +* [SCIM] Fix bug: Provisioned users can update update to email, handle, name (#1320) + +## Internal changes + +* [SCIM] Add logging to SCIM ops, invitation ops, createUser (#1322) (#1318) +* Upgrade nixpkgs and add HLS to shell.nix (#1314) +* create_test_team_scim.sh script: fix arg parsing and invite (#1321) + + +# [2021-01-06] + +## Release Notes + +This release contains bugfixes and internal changes. + +## Bug fixes and other updates + +* [SCIM] Bug fix: handle is lost after registration (#1303) +* [SCIM] Better error message (#1306) + +## Documentation + +* [SCIM] Document `validateSAMLemails` feature in docs/reference/spar-braindump.md (#1299) + +## Internal changes + +* [federation] Servantify get users by unqualified ids or handles (#1291) +* [federation] Add endpoint to get users by qualified ids or handles (#1291) +* Allow overriding NAMESPACE for kube-integration target (#1305) +* Add script create_test_team_scim.sh for development (#1302) +* Update brig helm chart: Add `setExpiredUserCleanupTimeout` (#1304) +* Nit-picks (#1300) +* nginz_disco: docker building consistency (#1311) +* Add tools/db/repair-handles (#1310) +* small speedup for 'make upload-charts' by inlining loop (#1308) +* Cleanup stack.yaml. (#1312) (#1316) + + +# [2020-12-21] + +## Release Notes + +* upgrade spar before brig +* upgrade nginz + +## Features + +* Increase the max allowed search results from 100 to 500. (#1282) + +## Bug fixes and other updates + +* SCIM: Allow strings for boolean values (#1296) +* Extend SAML IdP/SCIM permissions to admins (not just owners) (#1274, #1280) +* Clean up SCIM-invited users with expired invitation (#1264) +* move-team: CLI to export/import team data (proof of concept, needs testing) (#1288) +* Change some error labels for status 403 responses under `/identity-providers` (used by team-settings only) (#1274) +* [federation] Data.Qualified: Better field names (#1290) +* [federation] Add endpoint to get User Id by qualified handle (#1281, #1297) +* [federation] Remove DB tables for ID mapping (#1287) +* [federation] servantify /self endpoint, add `qualified_id` field (#1283) + +## Documentation + +* Integrate servant-swagger-ui to brig (#1270) + +## Internal changes + +* import all charts from wire-server-deploy/develop as of 2012-12-17 (#1293) +* Migrate code for easier CI (#1294) +* unit test and fix for null values in rendered JSON in UserProfile (#1292) +* hscim: Bump upper bound for servant packages (#1285) +* drive-by fix: allow federator to locally start up by specifying config (#1283) + + +# 2020-12-15 + +## Release Notes + +As a preparation for federation, this release introduces a mandatory 'federationDomain' configuration setting for brig and galley (#1261) + +## Features + +* brig: Allow setting a static SFT Server (#1277) + +## Bug fixes and other updates + +## Documentation + +## Internal changes + +* Add federation aware endpoint for getting user (#1254) +* refactor brig Servant API for consistency (#1276) +* Feature flags cleanup (#1256) + + +# 2020-11-24 + +## Release Notes + +* Allow an empty SAML contact list, which is configured at `saml.contacts` in spar's config. + The contact list is exposed at the `/sso/metadata` endpoint. + +## Features + +* Make Content-MD5 header optional for asset upload (#1252) +* Add applock team feature (#1242, #1253) +* /teams/[tid]/features endpoint + +## Bug fixes + +* Fix content-type headers in saml responses (#1241) + +## Internal changes + +* parse exposed 'tracestate' header in nginz logs if present (#1244) +* Store SCIM tokens in hashed form (#1240) +* better error handling (#1251) + + +# 2020-10-28 + +## Features + +* Onboard password-auth'ed users via SCIM, via existing invitation flow (#1213) + +## Bug fixes and other updates + +* cargohold: add compatibility mode for Scality RING S3 implementation (#1217, reverted in 4ce798e8d9db, then #1234) +* update email translations to latest (#1231) + +## Documentation + +* [brig:docs] Add a note on feature flag: setEmailVisibility (#1235) + +## Internal changes + +* Upgrade bonanza to geoip2 (#1236) +* Migrate rex to this repository (#1218) +* Fix stack warning about bloodhound. (#1237) +* Distinguish different places that throw the same error. (#1229) +* make fetch.py compatible with python 3 (#1230) +* add missing license headers (#1221) +* More debug logging for native push notifications. (#1220, #1226) +* add libtinfo/ncurses to docs and nix deps (#1215) +* Double memory available to cassandra in demo mode (#1216) + + +# 2020-10-05 + +## Release Notes + +With this release, the `setCookieDomain` configuration (under `brig`/`config`.`optSettings`) no longer has any effect, and can be removed. + +## Security improvements + +* Authentication cookies are set to the specific DNS name of the backend server (like nginz-https.example.com), instead of a wildcard domain (like *.example.com). This is achieved by leaving the domain empty in the Set-Cookie header, but changing the code to allow clients with old cookies to continue using them until they get renewed. (#1102) + +## Bug Fixes + +* Match users on email in SCIM search: Manage invited user by SCIM when SSO is enabled (#1207) + +## New Features + +* Amount of SFT servers returned on /calls/config/v2 can be limited (default 5, configurable) (#1206) +* Allow SCIM without SAML (#1200) + +## Internal changes + +* Cargohold: Log more about AWS errors, ease compatibility testing (#1205, #1210) +* GHC upgrade to 8.8.4 (#1204) +* Preparation for APNS notification on iOS 13 devices: Use mutable content for non-voip notifications and update limits (#1212) +* Cleanup: remove unused scim_user table (#1211) + + +# 2020-09-04 + +## Release Notes + +## Bug Fixes + +* Fixed logic related to ephemeral users (#1197) + +## New Features + +* SFT servers now exposed over /calls/config/v2 (#1177) +* First federation endpoint (#1188) + +## Internal changes + +* ormolu upgrade to 0.1.2.0 and formatting (#1145, #1185, #1186) +* handy cqlsh make target to manually poke at the database (#1170) +* spar cleanup +* brig user name during scim user parsing (#1195) +* invitation refactor (#1196) +* SCIM users are never ephemeral (#1198) + + +# 2020-07-29 + +## Release Notes + +* This release makes a couple of changes to the elasticsearch mapping and requires a data migration. The correct order of upgrade is: + 1. [Update mapping](./docs/reference/elastic-search.md#update-mapping) + 1. Upgrade brig as usual + 1. [Run data migration](./docs/reference/elastic-search.md#migrate-data) + Search should continue to work normally during this upgrade. +* Now with cargohold using V4 signatures, the region is part of the Authorization header, so please make sure it is configured correctly. This can be provided the same way as the AWS credentials, e.g. using the AWS_REGION environment variable. + +## Bug Fixes + +* Fix member count of suspended teams in journal events (#1171) +* Disallow team creation when setRestrictUserCreation is true (#1174) + +## New Features + +* Pending invitations by email lookup (#1168) +* Support s3 v4 signatures (and use package amazonka instead of aws in cargohold) (#1157) +* Federation: Implement ID mapping (brig) (#1162) + +## Internal changes + +* SCIM cleanup; drop table `spar.scim_user` (#1169, #1172) +* ormolu script: use ++FAILURES as it will not evaluate to 0 (#1178) +* Refactor: Simplify SRV lookup logic in federation-util (#1175) +* handy cqlsh make target to manually poke at the database (#1170) +* hscim: add license headers (#1165) +* Upgrade stack to 2.3.1 (#1166) +* gundeck: drop deprecated tables (#1163) + + +# 2020-07-13 + +## Release Notes + +* If you are self-hosting wire on the public internet, consider [changing your brig server config](https://github.com/wireapp/wire-server/blob/49f414add470f4c5e969814a37bc851e26f6d9a7/docs/reference/user/registration.md#blocking-creation-of-personal-users-new-teams-refrestrictregistration). +* Deploy all services except nginz. +* No migrations, no restrictions on deployment order. + +## New Features + +* Restrict user creation in on-prem installations (#1161) +* Implement active flag in SCIM for user suspension (#1158) + +## Bug Fixes + +* Fix setting team feature status in Stern/backoffice (#1146) +* Add missing Swagger models (#1153) +* docs/reference/elastic-search.md: fix typos (#1154) + +## Internal changes + +* Federation: Implement ID mapping (galley) (#1134) +* Tweak cassandra container settings to get it to work on nixos. (#1155) +* Merge wireapp/subtree-hscim repository under `/libs`, preserving history (#1152) +* Add link to twilio message ID format (#1150) +* Run backoffice locally (#1148) +* Fix services-demo (#1149, #1156) +* Add missing license headers (#1143) +* Test sign up with invalid email (#1141) +* Fix ormolu script (source code pretty-printing) (#1142) + + +# 2020-06-19 + +## Release Notes + +- run galley schema migrations +- no need to upgrade nginz + +## New Features + +* Add team level flag for digital signtaures (#1132) + +## Bug fixes + +* Bump http-client (#1138) + +## Internal changes + +* Script for finding undead users in elasticsearch (#1137) +* DB changes for federation (#1070) +* Refactor team feature tests (#1136) + + +# 2020-06-10 + +## Release Notes + +- schema migration for cassandra_galley +- promote stern *after* galley +- promote spar *after* brig +- no need to upgrade nginz + +## New Features + +* Validate saml emails (#1113, #1122, #1129) + +## Documentation + +* Add a note about unused registration flow in docs (#1119) +* Update cassandra-schema.cql (#1127) + +## Internal changes + +* Fix incomplete pattern in code checking email domain (custom extensions) (#1130) +* Enable additional GHC warnings (#1131) +* Cleanup export list; swagger names. (#1126) + + +# 2020-06-03 + +## Release Notes + +* This release fixes a bug with searching. To get this fix, a new elasticsearch index must be used. + The steps for doing this migration can be found in [./docs/reference/elastic-search.md](./docs/reference/elastic-search.md#migrate-to-a-new-index) + Alternatively the same index can be recreated instead, this will cause downtime. + The steps for the recreation can be found in [./docs/reference/elastic-search.md](./docs/reference/elastic-search.md#recreate-an-index-requires-downtime) + +## New Features + +* Customer Extensions (not documented, disabled by default, use at your own risk, [details](https://github.com/wireapp/wire-server/blob/3a21a82a1781f0d128f503df6a705b0b5f733d7b/services/brig/src/Brig/Options.hs#L465-L504)) (#1108) +* Upgrade emails to the latest version: small change in the footer (#1106) +* Add new "team event queue" and send MemberJoin events on it (#1097, #1115) +* Change maxTeamSize to Word32 to allow for larger teams (#1105) + +## Bug fixes + +* Implement better prefix search for name/handle (#1052, #1124) +* Base64 encode error details in HTML presented by Spar. (#1120) +* Bump schemaVersion for Brig and Galley (#1118) + +## Internal Changes + +* Copy swagger-ui bundle to nginz conf for integration tests (#1121) +* Use wire-api types in public endpoints (galley, brig, gundeck, cargohold) (#1114, #1116, #1117) +* wire-api: extend generic Arbitrary instances with implementation for 'shrink' (#1111) +* api-client: depend on wire-api only (#1110) +* Move and add wire-api JSON roundtrip tests (#1098) +* Spar tests cleanup (#1100) + + +# 2020-05-15 + +## New Features + +* Add tool to migrate data for galley (#1096) + This can be used in a more automated way than the backfill-billing-team-member. + It should be done as a step after deployment. + +## Internal Changes + +* More tests for OTR messages using protobuf (#1095) +* Set brig's logLevel to Warn while running integration-tests (#1099) +* Refactor: Create wire-api package for types used in the public API (#1090) + + +# 2020-05-07 + +## Upgrade steps (IMPORTANT) + +* Deploy new version of all services as usual, make sure `enableIndexedBillingTeamMember` setting in galley is `false`. +* Run backfill using + ```bash + CASSANDRA_HOST_GALLEY= + CASSANDRA_PORT_GALLEY= + CASSANDRA_KEYSPACE_GALLEY= + docker run quay.io/wire/backfill-billing-team-members:2.81.18 \ + --cassandra-host-galley="$CASSANDRA_HOST_GALLEY" \ + --cassandra-port-galley="$CASSANDRA_PORT_GALLEY" \ + --cassandra-keyspace-galley="$CASSANDRA_KEYSPACE_GALLEY" + ``` + You can also run the above using [`kubectl run`](https://kubernetes.io/docs/reference/generated/kubectl/kubectl-commands#run). +* Set `enableIndexedBillingTeamMember` setting in galley to `true` and re-deploy the same version. + +## New Features + +* Custom search visibility - limit name search (#1086) +* Add tool to backfill billing_team_member (#1089) +* Index billing team members (#1081, #1091) +* Allow team deletion on stern (#1080) +* Do not fanout very large teams (#1060, #1075) + +## Bug fixes + +* Fix licenses of db tools (#1088) + +## Internal Changes +* Add docs for updating ID Provider (#1074) +* Add comments/docs about hie.yaml (#1037) +* Don't poll from SQS as often (#1082) +* Refactor: Split API modules into public/internal (#1083) +* Manage license headers with headroom instead of licensure (#1084) +* Monitor access to DynamoDB (#1077) +* Make make docker-intermediate command work again (#1079) +* Upgrade Ormolu to 0.0.5.0 (#1078) +* Add (very few) unit tests to galley (#1071) +* Pull brig-index before running the docker ephemeral setup (#1066) + + +# 2020-04-21 + +## New Features + +* Allow for `report_missing` in `NewOtrMessage`. (#1056, #1062) +* List team members by UserId (#1048) +* Support idp update. (#1065 for issuer, #1026 for everything else) +* Support synchronous purge-deletion of idps (via query param). (#1068) + +## Bug fixes + +* Test that custom backend domains are case-insensitive (#1051) +* Swagger improvements. (#1059, #1054) + +## Internal Changes + +* Count team members using es (#1046) +* Make delete or downgrade team owners scale (#1029) +* services-demo/demo.sh: mkdir zauth (if not exists) (#1055) +* Use fork of bloodhound to support ES 5.2 (#1050) + + +# 2020-04-15 + +## Upgrade steps (IMPORTANT) + +1. Update mapping in ElasticSearch (see [./docs/reference/elastic-search.md](./docs/reference/elastic-search.md)) +2. Upgrade brig and the other services as usual +3. Migrate data in ElasticSearch (see [./docs/reference/elastic-search.md](./docs/reference/elastic-search.md)) + +## New features + +* Allow `brig-index create` to set ES index settings (#1023) +* Extended team invitations to have name and phone number (#1032) +* Allow team members to be searched by teammates. (#964) +* Better defaults for maxKeyLen and maxValueLen (#1034) + +## Bug Fixes + +* Fix swagger (#1012, #1031) +* Custom backend lookup by domain is now case-insensitive (#1013) + +## Internal Changes + +* Federation: resolve opaque IDs at the edges of galley (#1008) +* Qualify all API imports in Galley (#1006) +* types-common: write unit tests for Data.Qualified (#1011) +* Remove subv4 (#1003) +* Add federation feature flag to brig and galley (#1014) +* Add hie.yaml (#1024) +* Improve reproducibility of builds (#1027) +* Update types of some brig endpoints to be federation-aware (#1013) +* Bump to lts-14.27 (#1030) +* Add comments about which endpoints send which events to clients (#1025) +* Minimize dependencies of all brig binaries (#1035) +* Federation: Use status 403 for 'not implemented' (#1036) +* Add endpoint to count team members using ES (#1022) +* Rename brig's userName to userDisplayName to avoid confusion (#1039) +* Upgrade to restund 0.4.14 (#1043) +* Add license headers to all files (#980, #1045) +* Federation: Link related issue IDs (#1041) + + +# 2020-03-10 + +## New features + +- Remove autoconnect functionality; deprecate end-point. (#1005) +- Email visible to all users in same team (#999) + +## Bug fixes + +- fix nginx permissions in docker image (#985) + +## Significant internal changes + +- Update nginx to latest stable (#725) + +## Internal Changes + +- ormolu.sh: make queries for options more robust (#1009) +- Run hscim azure tests (#941) +- move FUTUREWORK(federation) comment to right place +- stack snapshot 3.0. (#1004, works around 8697b57609b523905641f943d68bbbe18de110e8) +- Fix .gitignore shenanigans in Nix (#1002) +- Update types of some galley endpoints to be federation-aware (#1001) +- Cleanup (#1000) +- Compile nginx with libzauth using nix (#988) +- Move and create federation-related types (#997) +- Tweak ormolu script. (#998) +- Give handlers in gundeck, cannon stronger types (#990) +- Rename cassandra-schema.txt to cassandra-schema.cql (#992) +- Ignore dist-newstyle (#991) +- Refactor: separate HTTP handlers from app logic (galley) (#989) +- Mock federator (#986) +- Eliminate more CPP (#987) +- Cleanup compiler warnings (#984) +- Make ormolu available in builder (#983) + + +# 2020-02-27 + +## Hotfix + +- Fix encoding bug in SAML SSO (#995) + + +# 2020-02-06 + +## New features + +* Configure max nr of devices (#969) +* libs/federation-util: SRV resolution (#962) + +## Significant internal changes + +* Better docs on brig integration yaml (#973) + +## Internal changes + +- Remove unnecessary LANGUAGE CPP pragmas (#978) +- Introduce code formatting with ormolu (#974, #979) +- Soften a rarely occurring timing issue by slowing things down. (#975) +- debug spar prod (#977) +- Upgrade amazonka (abandon fork) (#976) +- remove unused imports +- Symlink local dist folders in tools to the global one (#971, similar to #904) +- Upgrade to GHC 8.6.5 (LTS 14.12) (#958) +- Refactor: separate http parsing / generation from app logic. (#967) +- spar/integration: no auth required for /sso/settings (#963) + + +# 2020-02-06 + +## New features + +- SCIM top level extra attrs / rich info (#931) + - Added to all endpoints under "/scim/v2" +- Create endpoint for default SSO code (#954) + - New public endpoint: + - GET "/sso/settings" + - New private endpoint: + - PUT "/i/sso/settings" + +## Relevant for client developers + +- add docs for default sso code (#960) +- Add missing options to services-demo config files (#961) + +## Security fixes + +- Remove verifcation code from email subject line. (#950) + +## Internal changes + +- Whitespace (#957) + + +# 2020-01-30 + +## API changes (relevant client developers) + +- Allow up to 256 characters as handle, dots and dashes too (#953) + - All handles related endpoints, namely: + - POST "/users/handles" + - HEAD "/users/handles/:handle" + - GET "/users/handles/:handle" + - now accept this new format of handles +- Refuse to delete non-empty IdPs (412 precondition failed) (#875) + - DELETE "identity-providers/:idp" will now return 412 if there are users provisioned with that IDP +- Linear onboarding feature: Provide information about custom backends (#946) + - New public endpoint: + - GET "/custom-backend/by-domain/:domain" + - New interal endpoints: + - PUT "/i/custom-backend/by-domain/:domain" + - DELETE "/i/custom-backend/by-domain/:domain" + +## Bug fixes + +- Make sure that someone is SSO user before setting ManagedBy (#947) +- Misc SCIM bugfixes (#948) + +## Internal changes + +- Fix complexity issue in cassandra query. (#942) +- Remove collectd metrics (finally!) (#940) +- Update `cargoSha256` for cryptobox-c in stack-deps.nix (#949) + + +# 2020-01-08 + +## Relevant for self-hosters + +- Handle search within team (#921) +- Fixed logic with connection checks (#930) + +## Relevant for client developers + +- SCIM Fixes Phase 1 + 2 (#926) + +## Bug fixes + +- Stack nix fixes (#937) + + +# 2019-12-20 + +## Relevant for self-hosters + +- Access tokens are now sanitized on nginz logs (#920) + +## Relevant for client developers + +- Conversation roles (#911) + - Users joining by link are always members (#924) and (#927) + +## Bug fixes + +- Limit batch size when adding users to conversations (#923) +- Fixed user property integration test (#922) + + + +# 2019-11-28 + +## Relevant for client developers + +- Remove unnecessary fanout team events (#915) + + +## Bug fixes + +- SCIM fixes Phase 0: User creation in correct order (#905) + +## Internal changes + +- Gundeck: Use polledMapConcurrently (#914) + + +# 2019-11-06 #901 + +## Relevant for self-hosters + +- New configuration options available (none mandatory). See #895 #900 #869 + +## Relevant for client developers + +- Support HEAD requests for `/sso/initiate-bind` (#878) + +## Bug fixes + +- Do not send conversation delete events to team members upon team deletion (#897) +- Support SNI for bot registrations (by bumping http-client version) (#899) + +## Internal changes + +- Make gundeck handle AWS outages better. (#869, #890, #892) +- Improve performance by avoiding unbounded intra-service traffic spikes on team deletions (#900) +- Add optional native push connection throttling (#895) +- New backoffice/stern endpoint (#896) +- SAML: Store raw idp metadata with typed details in c* (#872) +- documentation/script updates + + +# 2019-09-30 #868 + +## Relevant for self-hosters +- More information is logged about user actions (#856) + +## Relevant for client developers +- Make team member property size configurable (#867) + +## Bug fixes +- Fix bugs related to metrics (#853, #866) +- Sneak up on flaky test. (#863) + +## Internal Changes +- Derive Generic everywhere (#864) +- Add issue templates (#862) +- Cleanup stern (#845) +- Log warnings only when users are suspended (#854) +- Documentation update for restund and smoketester (#855) + + +# 2019-09-16 #858 + +## Relevant for self-hosters + +- Documentation changes for Twilio configurations and TURN setup. (#775) + +## Relevant for client developers + +- Better events for deletion of team conversations (also send `conversation.delete` to team members) (#849) +- Add a new type of authorization tokens for legalhold (for details on legalhold, see https://github.com/wireapp/wire-server/blob/develop/docs/reference/team/legalhold.md) (#761) + +## Bug fixes + +- Fix swagger docs. (#852) +- Fix intra call in stern (aka customer support, aka backoffice) (#844) + +## Internal Changes + +- Change feature flags from boolean to custom enum types. (#850) +- Fix flaky integration test. (#848) +- Cleanup: incoherent functions for response body parsing. (#847) +- add route for consistency (#851) + + +# 2019-09-03 #843 + +## Relevant for self-hosters + +- Option for limiting login retries (#830) +- Option for suspending inactive users (#831) +- Add json logging (#828) (#836) +- Feature Flags in galley options. (#825) + +## Relevant for client developers + +- Specialize the error cases on conversation lookup. (#841) + +## Bug fixes + +- Fix is-team-owner logic (don't require email in all cases) (#833) +- Typos in swagger (#826) + +## Internal changes + +- Fix flaky integration test. (#834) +- Remove `exposed-modules` sections from all package.yaml files. (#832) +- Remove Debug.Trace from Imports. (#838) +- Cleanup integration tests (#839) + + +# 2019-08-08 #822 + +## Features + +- legalhold (#802), but block feature activation (#823) +- a few shell scripts for self-hosters (#805, #801) +- Release nginz_disco (#759) + +## Public API changes + +- SSO is disabled by default now; but enabled for all teams that already have an IdP. +- feature flags (starting with legalhold, sso) (#813, #818) + - new public end-points (#813, #818): + - get "/teams/:tid/features/legalhold" + - get "/teams/:tid/features/sso" + - new internal end-points: + - get "/i/teams/:tid/features/legalhold" + - get "/i/teams/:tid/features/sso" + - put "/i/teams/:tid/features/legalhold" + - put "/i/teams/:tid/features/sso" + - new backoffice end-points: + - get "/teams/:tid/features/legalhold" + - get "/teams/:tid/features/sso" + - put "/teams/:tid/features/legalhold" + - put "/teams/:tid/features/sso" +- Always throw json errors, never plaintext (#722, #814) +- Register IdP: allow json bodies with xml strings (#722) + +## Backend-internal changes + +- [stern aka backoffice] allow galeb returning a 404 (#820) +- Cleanup logging (#816, #819) +- Canonicalize http request path capture names (#808, #809) +- Galley depends on libsodium too now (#807) +- Add generics instances to common, brig, galley types. (#804) +- Upgrade CQL protocol version to V4 (#763) +- Log last prekey used only at debug level (#785) +- Cleanup (#799) + + +# 2019-07-08 #798 + +## Internal Changes + +* restund: add EXTRA_CFLAGS to work on ubuntu 16 (#788) +* Fix flaky unit test. (#770) +* Add upstream references in stack.yaml deps (wai-middleware-prometheus). (#760) +* Cannon analytics (2) (#750) +* fix this file. + + +# 2019-05-13 #756 + +## Documentation changes + +* Group provisioning (#748) +* Instructions for running load tests (#738) +* Twilio configuration (#733) + +## Bug fixes + +Cannon no longer reports 500s in the prometheus metrics when establishing websocket connections. (#751, #754) + +## Features + +Per-installation flag: Allow displaying emails of users in a team (code from #724, see description in #719) + +## Internal Changes + +Docker image building improvements (#755) + +## Changes (potentially) requiring action for self-hosters + +Config value `setEmailVisibility` must be set in brig's config file (if you're not sure, `visible_to_self` is the preferred default) + + +# 2019-05-02 #746 + +## Documentation changes + +* Improved Cassandra documentation in `docs/README.md` +* Improved documentation on SCIM storage in `docs/README.md` +* Improved documentation on SCIM Tokens in `docs/reference/provisioning/scim-token.md` + +## Bug fixes + +* Sanitize metric names to be valid prometheus names in metrics-core +* Add missing a `.git` suffix on gitlab dependencies in stack.yaml +* Time bounds checks now allow 60s of tolerance; this is helpful in cases of drifting clocks (#730) + +## Features + +* Services now provide Prometheus metrics on `/i/metrics` +* Garbage Collection and memory statistics are available alongside other prometheus metrics + +## Internal Changes + +* Alpine Builder is no longer built with `--profile` +* SCIM users now have an additional wire-specific schema attached. + +## Changes (potentially) requiring action +* `/i/monitoring` is *DEPRECATED*. Please use prometheus metrics provided by `/i/metrics` instead. +* On password reset the new password must be different than the old one +* Stern is now available as a new tool for performing adminstrative tasks via API (#720) +* SCIM handler errors are now reported according to SCIM error schema (#575) + + +# 2019-04-09 #710 + +## API changes + +- Do not allow provisioning saml users if SCIM is configured (#706) + +## Documentation changes + +- Docs for user deletion via SCIM. (#691) +- Docs for jump-to-definition with Emacs (#693) +- Add missing config options in demo (#694) +- Move the connections doc, add haddocks (#695) + +## Bug fixes + +- Fix templating in outgoing SMSs. (#696) +- Saml implicit user creation no longer chokes on odd but legal names. (#702) +- Fix: user deletion via scim (#698) + +## Internal changes + +- Remove redundant cassandra write in renewCookie (#676) +- Add Prometheus middleware for wire-services (#672) +- Improve logging of spar errors (#654) +- Upgrade cql-io-1.1.0 (#697) +- Switch metrics-core to be backed by Prometheus (#704) +- Refactorings: + - #665, #687, #685, #686 + +## Changes (potentially) requiring action for self-hosters + +- Switch proxy to use YAML-only config (#684) + + +# 2019-03-25 #674 + +## API changes + + * SCIM delete user endpoint (#660) + * Require reauthentication when creating a SCIM token (#639) + * Disallow duplicate external ids via SCIM update user (#657) + +## Documentation changes + + * Make an index for the docs/ (#662) + * Docs: using scim with curl. (#659) + * Add spar to the arch diagram. (#650) + +## Bug fixes + + * ADFS-workaround for SAML2 authn response signature validation. (#670) + * Fix: empty objects `{}` are valid TeamMemberDeleteData. (#652) + * Better logo rendering in emails (#649) + +## Internal changes + + * Remove some unused instances (#671) + * Reusable wai middleware for prometheus (for Galley only for now) (#669) + * Bump cql-io dep from merge request to latest release. (#661) + * docker image building for all of the docker images our integration tests require. (#622, #668) + * Checking for 404 is flaky; depends on deletion succeeding (#667) + * Refactor Galley Tests to use Reader Pattern (#666) + * Switch Cargohold to YAML-only config (#653) + * Filter newlines in log output. (#642) + + +# 2019-02-28 #648 + +## API changes + + * Support for SCIM based rich profiles (#645) + * `PUT /scim/v2/Users/:id` supports rich profile + * `GET /users/:id/rich-info` to get the rich profile id + +## Internal changes + + * Gundeck now uses YAML based config + * Brig templates can now be easily customized and have been updated too + * Misc improvements to our docs and build processes + + +# 2019-02-18 #646 + +## API changes + + * n/a + +## Bug fixes + + * SAML input sanitization (#636) + +## Internal changes + + * helper script for starting services only without integration tests (#641) + * Scim error handling (#640) + * Gundeck: cleanup, improve logging (#628) + + +# 2019-02-18 #634 + +## API changes + + * Support for SCIM (#559, #608, #602, #613, #617, #614, #620, #621, #627) + - several new end-points under `/scim` (see hscim package or the standards for the details; no swagger docs). + - new end-point `put "/i/users/:uid/managed-by"` for marking scim-managed users (no swagger docs) + * Add support for excluding certain phone number prefixes (#593) + - several new end-points under `/i/users/phone-prefixes/` (no swagger docs) + * Fix SAML2.0 compatibility issues in Spar (#607, #623) + +## Bug fixes + + * Update swagger docs (#598) + +## Internal changes + + * Architecture independence, better use of make features, more docs. (#594) + * Fix nginz docker image building (#605) + * Enable journaling locally and fix integration tests (#606) + * Use network-2.7 for more informative "connection failed" errors (#586) + * Use custom snapshots (#597) + * Add module documentation for all Spar modules (#611) + * Change the bot port in integration tests to something less common (#618) + * Spar metrics (#604, #633) + * Extend the list of default language extensions (#619) + * Fix: do not have newlines in log messages. (#625) + + +# 2019-01-27 #596 + +## API changes + + * Track inviters of team members (#566) + * New partner role. (#569, #572, #573, #576, #579, #584, #577, #592) + * App-level websocket pongs. (#561) + +## Bug fixes + + * Spar re-login deleted sso users; fix handling of brig errors. (#588) + * Gundeck: lost push notifications with push-all enabled. (#554) + * Gundeck: do not push natively to devices if they are not on the whitelist. (#554) + * Gundeck: link gundeck unit tests with -threaded. (#554) + +## Internal changes + + * Get rid of async-pool (unliftio now provides the same functionality) (#568) + * Fix: log multi-line error messages on one line. (#595) + * Whitelist all wire.com email addresses (#578) + * SCIM -> Scim (#581) + * Changes to make the demo runnable from Docker (#571) + * Feature/docker image consistency (#570) + * add a readme, for how to build libzauth. (#591) + * better support debian style machines of different architecturs (#582, #587, #583, #585, #590, #580) + + +# 2019-01-10 #567 + +## API changes + + * `sigkeys` attribute on POST|PUT to `/clients` is now deprecated and ignored (clients can stop sending it) + * `cancel_callback` parameter on GET `/notifications` is now deprecated and ignored (clients can stop sending it) + * The deprecated `POST /push/fallback//cancel` is now removed. + * The deprecated `tokenFallback` field returned on `GET /push/tokens` is now removed. + +## Bug fixes + + * Size-restrict SSO subject identities (#557) + * Propagate team deletions to spar (#519) + * Allow using `$arg_name` in nginz (#538) + +## Internal changes + + * Version upgrades to GHC 8.4 (LTS-12), nginx 14.2, alpine 3.8 (#527, #540) + * Code refactoring, consitency with Imports.hs (#543, #553, #552) + * Improved test coverage on spar (#539) + * Use yaml configuration in cannon (#555) + +## Others + + * Docs and local dev/demo improvements + + +# 2018-12-07 #542 + +## API changes + + * New API endpoint (`/properties-values`) to get all properties keys and values + +## Bug fixes + + * Proper JSON object encapsulation for `conversation.receipt-mode-update` events (#535) + * Misc Makefile related changes to improve dev workflow + +## Internal changes + + * Gundeck now pushes events asynchronously after writing to Cassandra (#530) + +# Others + + * Improved docs (yes!) with (#528) + + +# 2018-11-28 #527 + +## Bug fixes + + * Spar now handles base64 input more leniently (#526) + + * More lenient IdP metadata parsing (#522) + +## Internal changes + + * Refactor Haskell module imports (#524, #521, #520) + + * Switch Galley, Brig to YAML-only config (#517, #510) + + * Better SAML error types (#522) + + * Fix: gundeck bulkpush option. (#511) + + +# 2018-11-16 #515 + +## Bug Fixes + + * Fix: spar session cookie (#512) + + * SSO: fix cookie handling around binding users (#505) + +## Internal Changes + + * partial implementation of SCIM (without exposure to the spar routing table) + + * Always build benchmarks (#486) + + * Fix: gundeck compilation (#506) + + * Fix: use available env var for docker tag in dev make rule. (#509) + + * Use Imports.hs in Brig, Spar, Galley (#507) + + * update dependencies docs (#514) + + +# 2018-10-25 #500 + +## New Features + + * SSO: team member deletion, team deletion do not require + the user to have chosen a password. (Needed for + SAML-authenticated team co-admins.) #497 + + * SSO: `sso-initiate-bind` end-point for inviting ("binding") + existing users to SAML auth. #496 + + * SSO: shell script for registering IdPs in wire-teams. + (`/deploy/services-demo/register_idp.sh`) #489 + + * Allow setting a different endpoint for generating download links. + #480 + + * Allow setting specific ports for SMTP and use different image for + SMTP. #481 + + * Route calls/config in the demo to brig. #487 + +## Internal Changes + + * Metrics for spar (service for SSO). #498 + + * Upgrade to stackage lts-11. #478 + + * Upgrade cql-io library. #495 + + * Allow easily running tests against AWS. #482 + + +# 2018-10-04 #477 + +## Highlights + + * We now store the `otr_muted_status` field per conversation, + suitable for supporting more notifications options than just "muted/not + muted". The exact meaning of this field is client-dependent. #469 + + * Our schema migration tools (which you are probably using if + you're doing self-hosting) are more resilient now. They have longer + timeouts and they wait for schema consistency across peers before + reporting success. #467 + +## Other changes + + * Building from scratch on macOS is now a tiny bit easier. #474 + + * Various Spar fixes, breaking changes, refactorings, and what-not. Please + refer to the commit log, in particular commits c173f42b and + 80d06c9a. + + * Spar now only accepts a [subset][TLS ciphersuite] of available TLS + ciphers. See af8299d4. + +[TLS ciphersuite]: https://hackage.haskell.org/package/tls-1.4.1/docs/src/Network-TLS-Extra-Cipher.html#ciphersuite_default From 080e9c379b85dad0ccb55ea43721e6b653f31fd8 Mon Sep 17 00:00:00 2001 From: Jun Matsushita Date: Wed, 25 Aug 2021 12:14:41 +0200 Subject: [PATCH 12/72] Restore CHANGELOG from develop branch --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index be03c644583..33b9e774942 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -30,7 +30,7 @@ ## API Changes ## Features -* Helm charts to deploy [ldap-scim-bridge](https://github.com/wireapp/ldap-scim-bridge) #1709 + ## Bug fixes and other updates ## Documentation From 2fefd29d25cbe2980422cc6a675926b4b63c60c2 Mon Sep 17 00:00:00 2001 From: Jun Matsushita Date: Wed, 25 Aug 2021 12:18:06 +0200 Subject: [PATCH 13/72] Start from develop draft --- CHANGELOG-draft.md | 1643 +------------------------------------------- 1 file changed, 12 insertions(+), 1631 deletions(-) diff --git a/CHANGELOG-draft.md b/CHANGELOG-draft.md index be03c644583..4d6c7148b39 100644 --- a/CHANGELOG-draft.md +++ b/CHANGELOG-draft.md @@ -1,3 +1,5 @@ +THIS FILE ACCUMULATES THE RELEASE NOTES FOR THE UPCOMING RELEASE. + + +# Federation API Conventions + +- All endpoints must start with `/federation/` +- All endpoints must have exactly one path segment after federation, so + `/federation/foo` is valid `/fedeartion/foo/bar` is not. The path segments + must be in kebab-case. The name of the field in this record must be the + same name in camelCase. +- All endpoints must be `POST`. +- No query query params, all information that needs to go must go in body. +- All responses must be `200 OK`, domain specific failures (e.g. the + conversation doesn't exist) must be indicated as a Sum type. Unhandled + failures can be 5xx, an endpoint not being implemented will of course + return 404. But we shouldn't pile onto these. This keeps the federator simple. +- Accept only json, respond with only json. Maybe we can think of changing + this in future. But as of now, the federator hardcodes application/json as + the content type of the body. +- Name of the last path segment must be either `-` or + `on--`, e.g. `get-conversations` or + `on-conversation-created`. + + How to decide which one to use: + - If the request is supposed to ask for information/change from another + backend which has authority over that information, like send a message or + leave a conversation, then use the first format like `send-message` or + `leave-conversation`. + - If the request is supposed to notify a backend about something the caller of + this request has authority on, like a conversation got created, or a message + is sent, then use the second format like `on-conversation-created` or + `on-message-sent` 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 3606a4d05f5..5605e940ee2 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 @@ -45,6 +45,8 @@ instance ToJSON SearchRequest instance FromJSON SearchRequest +-- | For conventions see /docs/developer/federation-api-conventions.md +-- -- Maybe this module should be called Brig data Api routes = Api { getUserByHandle :: 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 d30922421ec..a8d2c2b859f 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 @@ -45,14 +45,15 @@ import Wire.API.Util.Aeson (CustomEncoded (..)) -- https://wearezeta.atlassian.net/wiki/spaces/CORE/pages/356090113/Federation+Galley+Conversation+API -- for the current list we need. +-- | For conventions see /docs/developer/federation-api-conventions.md data Api routes = Api { -- | Register a new conversation - registerConversation :: + onConversationCreated :: routes :- "federation" :> Summary "Register users to be in a new remote conversation" - :> "register-conversation" - :> ReqBody '[JSON] RegisterConversation + :> "on-conversation-created" + :> ReqBody '[JSON] NewRemoteConversation :> Post '[JSON] (), getConversations :: routes @@ -62,10 +63,10 @@ data Api routes = Api :> Post '[JSON] GetConversationsResponse, -- used by backend that owns the conversation to inform the backend about -- add/removal of its users to the conversation - updateConversationMemberships :: + onConversationMembershipsChanged :: routes :- "federation" - :> "update-conversation-memberships" + :> "on-conversation-memberships-changed" :> OriginDomainHeader :> ReqBody '[JSON] ConversationMemberUpdate :> Post '[JSON] (), @@ -78,10 +79,10 @@ data Api routes = Api :> Post '[JSON] LeaveConversationResponse, -- used to notify this backend that a new message has been posted to a -- remote conversation - receiveMessage :: + onMessageSent :: routes :- "federation" - :> "receive-message" + :> "on-message-sent" :> OriginDomainHeader :> ReqBody '[JSON] (RemoteMessage ConvId) :> Post '[JSON] (), @@ -116,7 +117,7 @@ newtype GetConversationsResponse = GetConversationsResponse -- -- FUTUREWORK: Think about extracting common conversation metadata into a -- separarate data type that can be reused in several data types in this module. -data RegisterConversation = MkRegisterConversation +data NewRemoteConversation = NewRemoteConversation { -- | The time when the conversation was created rcTime :: UTCTime, -- | The user that created the conversation @@ -136,7 +137,7 @@ data RegisterConversation = MkRegisterConversation rcReceiptMode :: Maybe ReceiptMode } deriving stock (Eq, Show, Generic) - deriving (ToJSON, FromJSON) via (CustomEncoded RegisterConversation) + deriving (ToJSON, FromJSON) via (CustomEncoded NewRemoteConversation) -- | A conversation membership update, as given by ' ConversationMemberUpdate', -- can be either a member addition or removal. diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index a6bbbd27a1b..b6cf8ac9bbc 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -35,7 +35,7 @@ import Galley.API.Error (invalidPayload) import qualified Galley.API.Mapping as Mapping import Galley.API.Message (MessageMetadata (..), UserType (..), postQualifiedOtrMessage, sendLocalMessages) import qualified Galley.API.Update as API -import Galley.API.Util (fromRegisterConversation, pushConversationEvent, viewFederationDomain) +import Galley.API.Util (fromNewRemoteConversation, pushConversationEvent, viewFederationDomain) import Galley.App (Galley) import qualified Galley.Data as Data import Galley.Types.Conversations.Members (InternalMember (..), LocalMember) @@ -56,7 +56,7 @@ import Wire.API.Federation.API.Galley LeaveConversationResponse (..), MessageSendRequest (..), MessageSendResponse (..), - RegisterConversation (..), + NewRemoteConversation (..), RemoteMessage (..), ) import qualified Wire.API.Federation.API.Galley as FederationAPIGalley @@ -67,16 +67,16 @@ federationSitemap :: ServerT (ToServantApi FederationAPIGalley.Api) Galley federationSitemap = genericServerT $ FederationAPIGalley.Api - { FederationAPIGalley.registerConversation = registerConversation, + { FederationAPIGalley.onConversationCreated = onConversationCreated, FederationAPIGalley.getConversations = getConversations, - FederationAPIGalley.updateConversationMemberships = updateConversationMemberships, + FederationAPIGalley.onConversationMembershipsChanged = onConversationMembershipsChanged, FederationAPIGalley.leaveConversation = leaveConversation, - FederationAPIGalley.receiveMessage = receiveMessage, + FederationAPIGalley.onMessageSent = onMessageSent, FederationAPIGalley.sendMessage = sendMessage } -registerConversation :: RegisterConversation -> Galley () -registerConversation rc = do +onConversationCreated :: NewRemoteConversation -> Galley () +onConversationCreated rc = do localDomain <- viewFederationDomain let localUsers = foldMap (\om -> guard (qDomain (omQualifiedId om) == localDomain) $> omQualifiedId om) @@ -85,7 +85,7 @@ registerConversation rc = do localUserIds = fmap qUnqualified localUsers unless (null localUsers) $ do Data.addLocalMembersToRemoteConv localUserIds (rcCnvId rc) - forM_ (fromRegisterConversation localDomain rc) $ \(mem, c) -> do + forM_ (fromNewRemoteConversation localDomain rc) $ \(mem, c) -> do let event = Event ConvCreate @@ -104,8 +104,8 @@ getConversations (GetConversationsRequest qUid gcrConvIds) = do -- | Update the local database with information on conversation members joining -- or leaving. Finally, push out notifications to local users. -updateConversationMemberships :: Domain -> ConversationMemberUpdate -> Galley () -updateConversationMemberships requestingDomain cmu = do +onConversationMembershipsChanged :: Domain -> ConversationMemberUpdate -> Galley () +onConversationMembershipsChanged requestingDomain cmu = do localDomain <- viewFederationDomain let users = case cmuAction cmu of FederationAPIGalley.ConversationMembersActionAdd toAdd -> fst <$> toAdd @@ -155,8 +155,8 @@ leaveConversation requestingDomain lc = do -- FUTUREWORK: report errors to the originating backend -- FUTUREWORK: error handling for missing / mismatched clients -receiveMessage :: Domain -> RemoteMessage ConvId -> Galley () -receiveMessage domain rmUnqualified = do +onMessageSent :: Domain -> RemoteMessage ConvId -> Galley () +onMessageSent domain rmUnqualified = do let rm = fmap (Tagged . (`Qualified` domain)) rmUnqualified let convId = unTagged $ rmConversation rm msgMetadata = diff --git a/services/galley/src/Galley/API/Message.hs b/services/galley/src/Galley/API/Message.hs index 23ac50dafca..8b2683ecaa3 100644 --- a/services/galley/src/Galley/API/Message.hs +++ b/services/galley/src/Galley/API/Message.hs @@ -379,7 +379,7 @@ sendRemoteMessages domain now sender senderClient conv metadata messages = handl -- Semantically, the origin domain should be the converation domain. Here one -- backend has only one domain so we just pick it from the environment. originDomain <- viewFederationDomain - let rpc = FederatedGalley.receiveMessage FederatedGalley.clientRoutes originDomain rm + let rpc = FederatedGalley.onMessageSent FederatedGalley.clientRoutes originDomain rm executeFederated domain rpc where handle :: Either FederationError a -> Galley (Set (UserId, ClientId)) diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 9ae92e72b38..658b73f82cb 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -464,13 +464,13 @@ runFederated remoteDomain rpc = do >>= either (throwM . federationErrorToWai) pure -- | Convert an internal conversation representation 'Data.Conversation' to --- 'RegisterConversation' to be sent over the wire to a remote backend that will +-- 'NewRemoteConversation' to be sent over the wire to a remote backend that will -- reconstruct this into multiple public-facing -- 'Wire.API.Conversation.Convevrsation' values, one per user from that remote -- backend. -- -- FUTUREWORK: Include the team ID as well once it becomes qualified. -toRegisterConversation :: +toNewRemoteConversation :: -- | The time stamp the conversation was created at UTCTime -> -- | The domain of the user that created the conversation @@ -478,9 +478,9 @@ toRegisterConversation :: -- | The conversation to convert for sending to a remote Galley Data.Conversation -> -- | The resulting information to be sent to a remote Galley - RegisterConversation -toRegisterConversation now localDomain Data.Conversation {..} = - MkRegisterConversation + NewRemoteConversation +toNewRemoteConversation now localDomain Data.Conversation {..} = + NewRemoteConversation { rcTime = now, rcOrigUserId = Qualified convCreator localDomain, rcCnvId = Qualified convId localDomain, @@ -514,16 +514,16 @@ toRegisterConversation now localDomain Data.Conversation {..} = omConvRoleName = rmConvRoleName } --- | The function converts a 'RegisterConversation' value to a +-- | The function converts a 'NewRemoteConversation' value to a -- 'Wire.API.Conversation.Conversation' value for each user that is on the given -- domain/backend. The obtained value can be used in e.g. creating an 'Event' to -- be sent out to users informing them that they were added to a new -- conversation. -fromRegisterConversation :: +fromNewRemoteConversation :: Domain -> - RegisterConversation -> + NewRemoteConversation -> [(Public.Member, Public.Conversation)] -fromRegisterConversation d MkRegisterConversation {..} = +fromNewRemoteConversation d NewRemoteConversation {..} = let membersView = fmap (second Set.toList) . setHoles $ rcMembers in foldMap ( \(me, others) -> @@ -578,7 +578,7 @@ registerRemoteConversationMemberships :: Data.Conversation -> Galley () registerRemoteConversationMemberships now localDomain c = do - let rc = toRegisterConversation now localDomain c + let rc = toNewRemoteConversation now localDomain c -- FUTUREWORK: parallelise federated requests traverse_ (registerRemoteConversations rc) . Map.keys @@ -589,11 +589,11 @@ registerRemoteConversationMemberships now localDomain c = do $ c where registerRemoteConversations :: - RegisterConversation -> + NewRemoteConversation -> Domain -> Galley () registerRemoteConversations rc domain = do - let rpc = FederatedGalley.registerConversation FederatedGalley.clientRoutes rc + let rpc = FederatedGalley.onConversationCreated FederatedGalley.clientRoutes rc runFederated domain rpc -- | Notify remote backends about changes to the conversation memberships of the @@ -624,7 +624,7 @@ notifyRemoteAboutConvUpdate origUser convId time action remotesToNotify = do notificationRPC :: Domain -> ConversationMemberUpdate -> Domain -> Galley () notificationRPC sendingDomain cmu receivingDomain = do let rpc = - FederatedGalley.updateConversationMemberships + FederatedGalley.onConversationMembershipsChanged FederatedGalley.clientRoutes sendingDomain cmu diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 577a2d6bbe7..037d64f4d80 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -224,11 +224,11 @@ emptyFederatedGalley = let e :: Text -> Handler a e s = throwError err501 {errBody = cs ("mock not implemented: " <> s)} in FederatedGalley.Api - { FederatedGalley.registerConversation = \_ -> e "registerConversation", + { FederatedGalley.onConversationCreated = \_ -> e "onConversationCreated", FederatedGalley.getConversations = \_ -> e "getConversations", - FederatedGalley.updateConversationMemberships = \_ _ -> e "updateConversationMemberships", + FederatedGalley.onConversationMembershipsChanged = \_ _ -> e "onConversationMembershipsChanged", FederatedGalley.leaveConversation = \_ _ -> e "leaveConversation", - FederatedGalley.receiveMessage = \_ _ -> e "receiveMessage", + FederatedGalley.onMessageSent = \_ _ -> e "onMessageSent", FederatedGalley.sendMessage = \_ _ -> e "sendMessage" } @@ -538,7 +538,7 @@ postMessageQualifiedLocalOwningBackendSuccess = do } galleyApi = emptyFederatedGalley - { FederatedGalley.receiveMessage = \_ _ -> pure () + { FederatedGalley.onMessageSent = \_ _ -> pure () } (resp2, requests) <- postProteusMessageQualifiedWithMockFederator aliceUnqualified aliceClient convId message "data" Message.MismatchReportAll brigApi galleyApi @@ -549,7 +549,7 @@ postMessageQualifiedLocalOwningBackendSuccess = do liftIO $ do let expectedRequests = [ (F.Brig, "get-user-clients"), - (F.Galley, "receive-message") + (F.Galley, "on-message-sent") ] forM_ (zip requests expectedRequests) $ \(req, (component, rpcPath)) -> do F.domain req @?= domainText (qDomain deeRemote) @@ -679,7 +679,7 @@ postMessageQualifiedLocalOwningBackendRedundantAndDeletedClients = do } galleyApi = emptyFederatedGalley - { FederatedGalley.receiveMessage = \_ _ -> pure () + { FederatedGalley.onMessageSent = \_ _ -> pure () } (resp2, _requests) <- postProteusMessageQualifiedWithMockFederator aliceUnqualified aliceClient convId message "data" Message.MismatchReportAll brigApi galleyApi @@ -880,7 +880,7 @@ postMessageQualifiedLocalOwningBackendFailedToSendClients = do } galleyApi = emptyFederatedGalley - { FederatedGalley.receiveMessage = \_ _ -> throwError err503 {errBody = "Down for maintanance."} + { FederatedGalley.onMessageSent = \_ _ -> throwError err503 {errBody = "Down for maintanance."} } (resp2, _requests) <- postProteusMessageQualifiedWithMockFederator aliceUnqualified aliceClient convId message "data" Message.MismatchReportAll brigApi galleyApi @@ -1309,7 +1309,7 @@ paginateConvListIds = do FederatedGalley.cmuAlreadyPresentUsers = [], FederatedGalley.cmuAction = FederatedGalley.ConversationMembersActionAdd $ pure (qAlice, roleNameWireMember) } - FederatedGalley.updateConversationMemberships fedGalleyClient chadDomain cmu + FederatedGalley.onConversationMembershipsChanged fedGalleyClient chadDomain cmu remoteDee <- randomId let deeDomain = Domain "dee.example.com" @@ -1324,7 +1324,7 @@ paginateConvListIds = do FederatedGalley.cmuAlreadyPresentUsers = [], FederatedGalley.cmuAction = FederatedGalley.ConversationMembersActionAdd $ pure (qAlice, roleNameWireMember) } - FederatedGalley.updateConversationMemberships fedGalleyClient deeDomain cmu + FederatedGalley.onConversationMembershipsChanged fedGalleyClient deeDomain cmu -- 1 self conv + 2 convs with bob and eve + 197 local convs + 25 convs on -- chad.example.com + 31 on dee.example = 256 convs. Getting them 16 at a time @@ -1367,7 +1367,7 @@ paginateConvListIdsPageEndingAtLocalsAndDomain = do FederatedGalley.cmuAlreadyPresentUsers = [], FederatedGalley.cmuAction = FederatedGalley.ConversationMembersActionAdd $ pure (qAlice, roleNameWireMember) } - FederatedGalley.updateConversationMemberships fedGalleyClient chadDomain cmu + FederatedGalley.onConversationMembershipsChanged fedGalleyClient chadDomain cmu remoteDee <- randomId let deeDomain = Domain "dee.example.com" @@ -1383,7 +1383,7 @@ paginateConvListIdsPageEndingAtLocalsAndDomain = do FederatedGalley.cmuAlreadyPresentUsers = [], FederatedGalley.cmuAction = FederatedGalley.ConversationMembersActionAdd $ pure (qAlice, roleNameWireMember) } - FederatedGalley.updateConversationMemberships fedGalleyClient deeDomain cmu + FederatedGalley.onConversationMembershipsChanged fedGalleyClient deeDomain cmu foldM_ (getChunkedConvs 16 0 alice) Nothing [4, 3, 2, 1, 0 :: Int] @@ -1816,7 +1816,7 @@ testAddRemoteMember = do map F.domain reqs @?= replicate 2 (domainText remoteDomain) map (fmap F.path . F.request) reqs @?= [ Just "/federation/get-users-by-ids", - Just "/federation/update-conversation-memberships" + Just "/federation/on-conversation-memberships-changed" ] e <- responseJsonUnsafe <$> (pure resp do - FedGalley.updateConversationMemberships fedGalleyClient remoteDomain cmu + FedGalley.onConversationMembershipsChanged fedGalleyClient remoteDomain cmu void . liftIO $ WS.assertMatch (5 # Second) ws $ wsAssertMemberJoinWithRole qconv qbob [qalice] roleNameWireMember @@ -166,7 +166,7 @@ addLocalUser = do -- | This test invokes the federation endpoint: -- --- 'POST /federation/update-conversation-memberships' +-- 'POST /federation/on-conversation-memberships-changed' -- -- 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 @@ -205,9 +205,9 @@ removeLocalUser = do } WS.bracketR c alice $ \ws -> do - FedGalley.updateConversationMemberships fedGalleyClient remoteDomain cmuAdd + FedGalley.onConversationMembershipsChanged fedGalleyClient remoteDomain cmuAdd afterAddition <- listRemoteConvs remoteDomain alice - FedGalley.updateConversationMemberships fedGalleyClient remoteDomain cmuRemove + FedGalley.onConversationMembershipsChanged fedGalleyClient remoteDomain cmuRemove liftIO $ do void . WS.assertMatch (3 # Second) ws $ wsAssertMemberJoinWithRole qconv qBob [qAlice] roleNameWireMember @@ -220,7 +220,7 @@ removeLocalUser = do -- | This test invokes the federation endpoint: -- --- 'POST /federation/update-conversation-memberships' +-- 'POST /federation/on-conversation-memberships-changed' -- -- 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 @@ -262,11 +262,11 @@ removeRemoteUser = do } WS.bracketR c alice $ \ws -> do - FedGalley.updateConversationMemberships fedGalleyClient remoteDomain cmuAdd + FedGalley.onConversationMembershipsChanged fedGalleyClient remoteDomain cmuAdd afterAddition <- listRemoteConvs remoteDomain alice void . liftIO . WS.assertMatch (3 # Second) ws $ wsAssertMemberJoinWithRole qconv qBob [qAlice, qEve] roleNameWireMember - FedGalley.updateConversationMemberships fedGalleyClient remoteDomain cmuRemove + FedGalley.onConversationMembershipsChanged fedGalleyClient remoteDomain cmuRemove afterRemoval <- listRemoteConvs remoteDomain alice void . liftIO $ WS.assertMatch (3 # Second) ws $ @@ -299,7 +299,7 @@ notifyLocalUser = do FedGalley.ConversationMembersActionAdd (pure (qcharlie, roleNameWireMember)) } WS.bracketR c alice $ \ws -> do - FedGalley.updateConversationMemberships fedGalleyClient bdom cmu + FedGalley.onConversationMembershipsChanged fedGalleyClient bdom cmu void . liftIO $ WS.assertMatch (5 # Second) ws $ wsAssertMemberJoinWithRole qconv qbob [qcharlie] roleNameWireMember @@ -363,8 +363,8 @@ leaveConversationSuccess = do assertRemoveUpdate remote1GalleyFederatedRequest qconvId qChad [qUnqualified qChad, qUnqualified qDee] qChad assertRemoveUpdate remote2GalleyFederatedRequest qconvId qChad [qUnqualified qEve] qChad -receiveMessage :: TestM () -receiveMessage = do +onMessageSent :: TestM () +onMessageSent = do localDomain <- viewFederationDomain c <- view tsCannon alice <- randomUser @@ -392,7 +392,7 @@ receiveMessage = do FedGalley.cmuAction = FedGalley.ConversationMembersActionAdd (pure (qalice, roleNameWireMember)) } - FedGalley.updateConversationMemberships fedGalleyClient bdom cmu + FedGalley.onConversationMembershipsChanged fedGalleyClient bdom cmu let txt = "Hello from another backend" msg client = Map.fromList [(client, txt)] @@ -414,7 +414,7 @@ receiveMessage = do -- send message to alice and check reception WS.bracketAsClientRN c [(alice, aliceC1), (alice, aliceC2), (eve, eveC)] $ \[wsA1, wsA2, wsE] -> do - FedGalley.receiveMessage fedGalleyClient bdom rm + FedGalley.onMessageSent fedGalleyClient bdom rm liftIO $ do -- alice should receive the message on her first client WS.assertMatch_ (5 # Second) wsA1 $ \n -> do @@ -445,7 +445,7 @@ receiveMessage = do -- alice local, bob and chad remote in a local conversation -- bob sends a message (using the RPC), we test that alice receives it and that --- a call is made to the receiveMessage RPC to inform chad +-- a call is made to the onMessageSent RPC to inform chad sendMessage :: HasCallStack => TestM () sendMessage = do cannon <- view tsCannon @@ -483,7 +483,7 @@ sendMessage = do fmap F.component (F.request brigReq) @?= Just F.Brig fmap F.path (F.request brigReq) @?= Just "/federation/get-users-by-ids" fmap F.component (F.request galleyReq) @?= Just F.Galley - fmap F.path (F.request galleyReq) @?= Just "/federation/register-conversation" + fmap F.path (F.request galleyReq) @?= Just "/federation/on-conversation-created" let conv = Qualified convId localDomain -- we use bilge instead of the federation client to make a federated request @@ -543,7 +543,7 @@ sendMessage = do xs@[_, _] -> pure xs _ -> assertFailure "unexpected number of requests" fmap F.component (F.request receiveReq) @?= Just F.Galley - fmap F.path (F.request receiveReq) @?= Just "/federation/receive-message" + fmap F.path (F.request receiveReq) @?= Just "/federation/on-message-sent" rm <- case A.decode . LBS.fromStrict . F.body =<< F.request receiveReq of Nothing -> assertFailure "invalid federated request body" Just x -> pure (x :: FedGalley.RemoteMessage ConvId) diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index ae5afebc38b..8cbb3079641 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -1163,9 +1163,9 @@ registerRemoteConv :: Qualified ConvId -> Qualified UserId -> Maybe Text -> Set registerRemoteConv convId originUser name othMembers = do fedGalleyClient <- view tsFedGalleyClient now <- liftIO getCurrentTime - FederatedGalley.registerConversation + FederatedGalley.onConversationCreated fedGalleyClient - ( FederatedGalley.MkRegisterConversation + ( FederatedGalley.NewRemoteConversation { rcTime = now, rcOrigUserId = originUser, rcCnvId = convId, @@ -1369,7 +1369,7 @@ assertNoMsg ws f = do 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" + F.path req @?= "/federation/on-conversation-memberships-changed" F.originDomain req @?= (domainText . qDomain) qconvId let Just cmu = decodeStrict (F.body req) FederatedGalley.cmuOrigUserId cmu @?= remover From b289dfea61503b733aa3e21e1ee8c97152e0e135 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 14 Sep 2021 16:08:17 +0200 Subject: [PATCH 20/72] Remove ES specific details from the federation search endpoint (#1768) --- changelog.d/6-federation/search-endpoint | 1 + .../src/Wire/API/Federation/API/Brig.hs | 2 +- services/brig/src/Brig/API/Federation.hs | 13 ++----------- services/brig/src/Brig/Federation/Client.hs | 2 +- services/brig/src/Brig/User/API/Search.hs | 10 +++++++++- services/brig/test/integration/API/Federation.hs | 10 +++------- services/brig/test/integration/API/Search.hs | 11 +++++++++-- 7 files changed, 26 insertions(+), 23 deletions(-) create mode 100644 changelog.d/6-federation/search-endpoint diff --git a/changelog.d/6-federation/search-endpoint b/changelog.d/6-federation/search-endpoint new file mode 100644 index 00000000000..aa406f372be --- /dev/null +++ b/changelog.d/6-federation/search-endpoint @@ -0,0 +1 @@ +Remove elasticsearch specific details from the search endpoint \ No newline at end of file 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 5605e940ee2..1e714c58c03 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 @@ -86,7 +86,7 @@ data Api routes = Api -- FUTUREWORK(federation): do we want to perform some type-level validation like length checks? -- (handles can be up to 256 chars currently) :> ReqBody '[JSON] SearchRequest - :> Post '[JSON] (SearchResult Contact), + :> Post '[JSON] [Contact], getUserClients :: routes :- "federation" diff --git a/services/brig/src/Brig/API/Federation.hs b/services/brig/src/Brig/API/Federation.hs index 455a606903e..9ef12ad8a1e 100644 --- a/services/brig/src/Brig/API/Federation.hs +++ b/services/brig/src/Brig/API/Federation.hs @@ -81,22 +81,13 @@ claimMultiPrekeyBundle uc = API.claimLocalMultiPrekeyBundles LegalholdPlusFedera -- | Searching for federated users on a remote backend should -- only search by exact handle search, not in elasticsearch. -- (This decision may change in the future) -searchUsers :: SearchRequest -> Handler (SearchResult Contact) +searchUsers :: SearchRequest -> Handler [Contact] searchUsers (SearchRequest searchTerm) = do let maybeHandle = parseHandle searchTerm maybeOwnerId <- maybe (pure Nothing) (lift . API.lookupHandle) maybeHandle - exactLookupProfile <- case maybeOwnerId of + case maybeOwnerId of Nothing -> pure [] Just foundUser -> lift $ contactFromProfile <$$> API.lookupLocalProfiles Nothing [foundUser] - let exactHandleMatchCount = length exactLookupProfile - pure $ - SearchResult - { searchResults = exactLookupProfile, - searchFound = exactHandleMatchCount, - searchReturned = exactHandleMatchCount, - searchTook = 0 - } - getUserClients :: GetUserClients -> Handler (UserMap (Set PubClient)) getUserClients (GetUserClients uids) = API.lookupLocalPubClientsBulk uids !>> clientError diff --git a/services/brig/src/Brig/Federation/Client.hs b/services/brig/src/Brig/Federation/Client.hs index 9ae8b86c226..e0b732d3158 100644 --- a/services/brig/src/Brig/Federation/Client.hs +++ b/services/brig/src/Brig/Federation/Client.hs @@ -75,7 +75,7 @@ claimMultiPrekeyBundle domain uc = do Log.info $ Log.msg @Text "Brig-federation: claiming remote multi-user prekey bundle" executeFederated domain $ FederatedBrig.claimMultiPrekeyBundle clientRoutes uc -searchUsers :: Domain -> SearchRequest -> FederationAppIO (Public.SearchResult Public.Contact) +searchUsers :: Domain -> SearchRequest -> FederationAppIO [Public.Contact] searchUsers domain searchTerm = do Log.warn $ Log.msg $ T.pack "Brig-federation: search call on remote backend" executeFederated domain $ FederatedBrig.searchUsers clientRoutes searchTerm diff --git a/services/brig/src/Brig/User/API/Search.hs b/services/brig/src/Brig/User/API/Search.hs index d79eb3c3dc0..ecaccf457b5 100644 --- a/services/brig/src/Brig/User/API/Search.hs +++ b/services/brig/src/Brig/User/API/Search.hs @@ -135,7 +135,15 @@ searchRemotely domain searchTerm = do msg (val "searchRemotely") ~~ field "domain" (show domain) ~~ field "searchTerm" searchTerm - Federation.searchUsers domain (FedBrig.SearchRequest searchTerm) !>> fedError + contacts <- Federation.searchUsers domain (FedBrig.SearchRequest searchTerm) !>> fedError + let count = length contacts + pure + SearchResult + { searchResults = contacts, + searchFound = count, + searchReturned = count, + searchTook = 0 + } searchLocally :: UserId -> Text -> Maybe (Range 1 500 Int32) -> Handler (Public.SearchResult Public.Contact) searchLocally searcherId searchTerm maybeMaxResults = do diff --git a/services/brig/test/integration/API/Federation.hs b/services/brig/test/integration/API/Federation.hs index 017ce73d019..15e6a508405 100644 --- a/services/brig/test/integration/API/Federation.hs +++ b/services/brig/test/integration/API/Federation.hs @@ -80,22 +80,18 @@ testSearchSuccess brig fedBrigClient = do searchResult <- FedBrig.searchUsers fedBrigClient (SearchRequest (fromHandle handle)) liftIO $ do - let contacts = contactQualifiedId <$> searchResults searchResult + let contacts = contactQualifiedId <$> searchResult assertEqual "should return only the first user id but not the identityThief" [quid] contacts testSearchNotFound :: FedBrigClient -> Http () testSearchNotFound fedBrigClient = do searchResult <- FedBrig.searchUsers fedBrigClient $ SearchRequest "this-handle-should-not-exist" - liftIO $ do - let contacts = searchResults searchResult - assertEqual "should return empty array of users" [] contacts + liftIO $ assertEqual "should return empty array of users" [] searchResult testSearchNotFoundEmpty :: FedBrigClient -> Http () testSearchNotFoundEmpty fedBrigClient = do searchResult <- FedBrig.searchUsers fedBrigClient $ SearchRequest "" - liftIO $ do - let contacts = searchResults searchResult - assertEqual "should return empty array of users" [] contacts + liftIO $ assertEqual "should return empty array of users" [] searchResult testGetUserByHandleSuccess :: Brig -> FedBrigClient -> Http () testGetUserByHandleSuccess brig fedBrigClient = do diff --git a/services/brig/test/integration/API/Search.hs b/services/brig/test/integration/API/Search.hs index 4a41f3185e0..084edb76bc7 100644 --- a/services/brig/test/integration/API/Search.hs +++ b/services/brig/test/integration/API/Search.hs @@ -444,12 +444,19 @@ testSearchOtherDomain opts brig = do user <- randomUser brig -- We cannot assert on a real federated request here, so we make a request to -- a mocked federator started and stopped during this test - otherSearchResult :: SearchResult Contact <- liftIO $ generate arbitrary + otherSearchResult :: [Contact] <- liftIO $ generate arbitrary let mockResponse = OutwardResponseBody (cs $ Aeson.encode otherSearchResult) (results, _) <- liftIO . withTempMockFederator opts (Domain "non-existent.example.com") mockResponse $ do executeSearchWithDomain brig (userId user) "someSearchText" (Domain "non-existent.example.com") + let expectedResult = + SearchResult + { searchResults = otherSearchResult, + searchFound = length otherSearchResult, + searchReturned = length otherSearchResult, + searchTook = 0 + } liftIO $ do - assertEqual "The search request should get its result from federator" otherSearchResult results + assertEqual "The search request should get its result from federator" expectedResult results -- | Migration sequence: -- 1. A migration is planned, in this time brig writes to two indices From 250d72b2363875773895794a9c3e8ad4e9939cc1 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 15 Sep 2021 08:37:47 +0200 Subject: [PATCH 21/72] Make conversation ID in on-conversation-created RPC unqualified (#1766) * Make conv ID in register-conversation unqualified The conversation being created has to be in the backend which originated the RPC, therefore we can simply make its ID unqualified instead of checking if the two domains match. --- .../6-federation/new-remote-conversation-unqualify | 1 + .../src/Wire/API/Federation/API/Galley.hs | 14 +++++++------- services/galley/src/Galley/API/Federation.hs | 11 ++++++----- services/galley/src/Galley/API/Util.hs | 10 +++++----- services/galley/test/integration/API.hs | 2 +- services/galley/test/integration/API/Util.hs | 3 ++- 6 files changed, 22 insertions(+), 19 deletions(-) create mode 100644 changelog.d/6-federation/new-remote-conversation-unqualify diff --git a/changelog.d/6-federation/new-remote-conversation-unqualify b/changelog.d/6-federation/new-remote-conversation-unqualify new file mode 100644 index 00000000000..fc556751d05 --- /dev/null +++ b/changelog.d/6-federation/new-remote-conversation-unqualify @@ -0,0 +1 @@ +Make conversation ID of the on-conversation-created RPC unqualified 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 a8d2c2b859f..02a46ed39ee 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 @@ -53,7 +53,8 @@ data Api routes = Api :- "federation" :> Summary "Register users to be in a new remote conversation" :> "on-conversation-created" - :> ReqBody '[JSON] NewRemoteConversation + :> OriginDomainHeader + :> ReqBody '[JSON] (NewRemoteConversation ConvId) :> Post '[JSON] (), getConversations :: routes @@ -117,14 +118,13 @@ newtype GetConversationsResponse = GetConversationsResponse -- -- FUTUREWORK: Think about extracting common conversation metadata into a -- separarate data type that can be reused in several data types in this module. -data NewRemoteConversation = NewRemoteConversation +data NewRemoteConversation conv = NewRemoteConversation { -- | The time when the conversation was created rcTime :: UTCTime, -- | The user that created the conversation rcOrigUserId :: Qualified UserId, - -- | The qualified conversation ID - -- FUTUREWORK: Make this unqualified, assume the conversation is being hosted by OriginDomain - rcCnvId :: Qualified ConvId, + -- | The conversation ID, local to the backend invoking the RPC + rcCnvId :: conv, -- | The conversation type rcCnvType :: ConvType, rcCnvAccess :: [Access], @@ -136,8 +136,8 @@ data NewRemoteConversation = NewRemoteConversation rcMessageTimer :: Maybe Milliseconds, rcReceiptMode :: Maybe ReceiptMode } - deriving stock (Eq, Show, Generic) - deriving (ToJSON, FromJSON) via (CustomEncoded NewRemoteConversation) + deriving stock (Eq, Show, Generic, Functor) + deriving (ToJSON, FromJSON) via (CustomEncoded (NewRemoteConversation conv)) -- | A conversation membership update, as given by ' ConversationMemberUpdate', -- can be either a member addition or removal. diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index b6cf8ac9bbc..f8e42b75486 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -75,8 +75,9 @@ federationSitemap = FederationAPIGalley.sendMessage = sendMessage } -onConversationCreated :: NewRemoteConversation -> Galley () -onConversationCreated rc = do +onConversationCreated :: Domain -> NewRemoteConversation ConvId -> Galley () +onConversationCreated domain rc = do + let qrc = fmap (`Qualified` domain) rc localDomain <- viewFederationDomain let localUsers = foldMap (\om -> guard (qDomain (omQualifiedId om) == localDomain) $> omQualifiedId om) @@ -84,12 +85,12 @@ onConversationCreated rc = do $ rc localUserIds = fmap qUnqualified localUsers unless (null localUsers) $ do - Data.addLocalMembersToRemoteConv localUserIds (rcCnvId rc) - forM_ (fromNewRemoteConversation localDomain rc) $ \(mem, c) -> do + Data.addLocalMembersToRemoteConv localUserIds (rcCnvId qrc) + forM_ (fromNewRemoteConversation localDomain qrc) $ \(mem, c) -> do let event = Event ConvCreate - (rcCnvId rc) + (rcCnvId qrc) (rcOrigUserId rc) (rcTime rc) (EdConversation c) diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 658b73f82cb..98020dcfc98 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -478,12 +478,12 @@ toNewRemoteConversation :: -- | The conversation to convert for sending to a remote Galley Data.Conversation -> -- | The resulting information to be sent to a remote Galley - NewRemoteConversation + NewRemoteConversation ConvId toNewRemoteConversation now localDomain Data.Conversation {..} = NewRemoteConversation { rcTime = now, rcOrigUserId = Qualified convCreator localDomain, - rcCnvId = Qualified convId localDomain, + rcCnvId = convId, rcCnvType = convType, rcCnvAccess = convAccess, rcCnvAccessRole = convAccessRole, @@ -521,7 +521,7 @@ toNewRemoteConversation now localDomain Data.Conversation {..} = -- conversation. fromNewRemoteConversation :: Domain -> - NewRemoteConversation -> + NewRemoteConversation (Qualified ConvId) -> [(Public.Member, Public.Conversation)] fromNewRemoteConversation d NewRemoteConversation {..} = let membersView = fmap (second Set.toList) . setHoles $ rcMembers @@ -589,11 +589,11 @@ registerRemoteConversationMemberships now localDomain c = do $ c where registerRemoteConversations :: - NewRemoteConversation -> + NewRemoteConversation ConvId -> Domain -> Galley () registerRemoteConversations rc domain = do - let rpc = FederatedGalley.onConversationCreated FederatedGalley.clientRoutes rc + let rpc = FederatedGalley.onConversationCreated FederatedGalley.clientRoutes localDomain rc runFederated domain rpc -- | Notify remote backends about changes to the conversation memberships of the diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 037d64f4d80..aede4721e2c 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -224,7 +224,7 @@ emptyFederatedGalley = let e :: Text -> Handler a e s = throwError err501 {errBody = cs ("mock not implemented: " <> s)} in FederatedGalley.Api - { FederatedGalley.onConversationCreated = \_ -> e "onConversationCreated", + { FederatedGalley.onConversationCreated = \_ _ -> e "onConversationCreated", FederatedGalley.getConversations = \_ -> e "getConversations", FederatedGalley.onConversationMembershipsChanged = \_ _ -> e "onConversationMembershipsChanged", FederatedGalley.leaveConversation = \_ _ -> e "leaveConversation", diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 8cbb3079641..aaea6c8a7ba 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -1165,10 +1165,11 @@ registerRemoteConv convId originUser name othMembers = do now <- liftIO getCurrentTime FederatedGalley.onConversationCreated fedGalleyClient + (qDomain convId) ( FederatedGalley.NewRemoteConversation { rcTime = now, rcOrigUserId = originUser, - rcCnvId = convId, + rcCnvId = qUnqualified convId, rcCnvType = RegularConv, rcCnvAccess = [], rcCnvAccessRole = ActivatedAccessRole, From c90f3b74175373430eafbda44d453385c1975721 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Wed, 15 Sep 2021 13:00:53 +0200 Subject: [PATCH 22/72] Clean up JSON Golden Tests, Part 6 (#1769) * Clean up JSON golden tests for `User`, `SelfProfile`, `InvitationCode`, `BindingNewTeamUser` and `UserUpdate` --- .../5-internal/reduce-json-golden-tests | 1 + ...testObject_BindingNewTeamUser_user_10.json | 6 - ...testObject_BindingNewTeamUser_user_11.json | 6 - ...testObject_BindingNewTeamUser_user_12.json | 5 - ...testObject_BindingNewTeamUser_user_13.json | 6 - ...testObject_BindingNewTeamUser_user_14.json | 5 - ...testObject_BindingNewTeamUser_user_15.json | 6 - ...testObject_BindingNewTeamUser_user_16.json | 6 - ...testObject_BindingNewTeamUser_user_17.json | 6 - ...testObject_BindingNewTeamUser_user_18.json | 4 - ...testObject_BindingNewTeamUser_user_19.json | 6 - ...testObject_BindingNewTeamUser_user_20.json | 5 - .../testObject_BindingNewTeamUser_user_3.json | 6 - .../testObject_BindingNewTeamUser_user_4.json | 5 - .../testObject_BindingNewTeamUser_user_5.json | 6 - .../testObject_BindingNewTeamUser_user_6.json | 4 - .../testObject_BindingNewTeamUser_user_7.json | 5 - .../testObject_BindingNewTeamUser_user_8.json | 6 - .../testObject_BindingNewTeamUser_user_9.json | 6 - .../testObject_InvitationCode_user_10.json | 1 - .../testObject_InvitationCode_user_11.json | 1 - .../testObject_InvitationCode_user_12.json | 1 - .../testObject_InvitationCode_user_13.json | 1 - .../testObject_InvitationCode_user_14.json | 1 - .../testObject_InvitationCode_user_15.json | 1 - .../testObject_InvitationCode_user_16.json | 1 - .../testObject_InvitationCode_user_17.json | 1 - .../testObject_InvitationCode_user_18.json | 1 - .../testObject_InvitationCode_user_19.json | 1 - .../testObject_InvitationCode_user_2.json | 2 +- .../testObject_InvitationCode_user_20.json | 1 - .../testObject_InvitationCode_user_3.json | 2 +- .../testObject_InvitationCode_user_4.json | 2 +- .../testObject_InvitationCode_user_5.json | 2 +- .../testObject_InvitationCode_user_6.json | 1 - .../testObject_InvitationCode_user_7.json | 1 - .../testObject_InvitationCode_user_8.json | 1 - .../testObject_InvitationCode_user_9.json | 1 - .../testObject_SelfProfile_user_10.json | 21 - .../testObject_SelfProfile_user_11.json | 31 - .../testObject_SelfProfile_user_12.json | 16 - .../testObject_SelfProfile_user_13.json | 26 - .../testObject_SelfProfile_user_14.json | 21 - .../testObject_SelfProfile_user_15.json | 36 - .../testObject_SelfProfile_user_16.json | 35 - .../testObject_SelfProfile_user_17.json | 21 - .../testObject_SelfProfile_user_18.json | 30 - .../testObject_SelfProfile_user_19.json | 32 - .../golden/testObject_SelfProfile_user_2.json | 38 - .../testObject_SelfProfile_user_20.json | 25 - .../golden/testObject_SelfProfile_user_3.json | 23 - .../golden/testObject_SelfProfile_user_4.json | 22 - .../golden/testObject_SelfProfile_user_5.json | 28 - .../golden/testObject_SelfProfile_user_6.json | 33 - .../golden/testObject_SelfProfile_user_7.json | 21 - .../golden/testObject_SelfProfile_user_8.json | 31 - .../golden/testObject_SelfProfile_user_9.json | 23 - .../golden/testObject_UserUpdate_user_1.json | 15 +- .../golden/testObject_UserUpdate_user_10.json | 35 - .../golden/testObject_UserUpdate_user_11.json | 19 - .../golden/testObject_UserUpdate_user_12.json | 5 - .../golden/testObject_UserUpdate_user_13.json | 34 - .../golden/testObject_UserUpdate_user_14.json | 11 - .../golden/testObject_UserUpdate_user_15.json | 22 - .../golden/testObject_UserUpdate_user_16.json | 5 - .../golden/testObject_UserUpdate_user_17.json | 24 - .../golden/testObject_UserUpdate_user_18.json | 24 - .../golden/testObject_UserUpdate_user_19.json | 4 - .../golden/testObject_UserUpdate_user_20.json | 4 - .../golden/testObject_UserUpdate_user_3.json | 37 - .../golden/testObject_UserUpdate_user_4.json | 26 - .../golden/testObject_UserUpdate_user_5.json | 11 - .../golden/testObject_UserUpdate_user_6.json | 6 - .../golden/testObject_UserUpdate_user_7.json | 12 - .../golden/testObject_UserUpdate_user_8.json | 15 - .../golden/testObject_UserUpdate_user_9.json | 21 - .../test/golden/testObject_User_user_1.json | 22 +- .../test/golden/testObject_User_user_10.json | 26 - .../test/golden/testObject_User_user_11.json | 21 - .../test/golden/testObject_User_user_12.json | 25 - .../test/golden/testObject_User_user_13.json | 27 - .../test/golden/testObject_User_user_14.json | 22 - .../test/golden/testObject_User_user_15.json | 47 -- .../test/golden/testObject_User_user_16.json | 30 - .../test/golden/testObject_User_user_17.json | 29 - .../test/golden/testObject_User_user_18.json | 42 - .../test/golden/testObject_User_user_19.json | 23 - .../test/golden/testObject_User_user_2.json | 14 - .../test/golden/testObject_User_user_20.json | 21 - .../test/golden/testObject_User_user_3.json | 6 +- .../test/golden/testObject_User_user_4.json | 2 +- .../test/golden/testObject_User_user_5.json | 34 +- .../test/golden/testObject_User_user_6.json | 30 - .../test/golden/testObject_User_user_7.json | 28 - .../test/golden/testObject_User_user_8.json | 20 - .../test/golden/testObject_User_user_9.json | 22 - .../unit/Test/Wire/API/Golden/Generated.hs | 60 +- .../Generated/BindingNewTeamUser_user.hs | 466 +---------- .../Golden/Generated/InvitationCode_user.hs | 70 +- .../API/Golden/Generated/SelfProfile_user.hs | 762 +----------------- .../API/Golden/Generated/UserUpdate_user.hs | 304 +------ .../Wire/API/Golden/Generated/User_user.hs | 575 +------------ 102 files changed, 133 insertions(+), 3561 deletions(-) create mode 100644 changelog.d/5-internal/reduce-json-golden-tests delete mode 100644 libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_10.json delete mode 100644 libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_11.json delete mode 100644 libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_12.json delete mode 100644 libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_13.json delete mode 100644 libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_14.json delete mode 100644 libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_15.json delete mode 100644 libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_16.json delete mode 100644 libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_17.json delete mode 100644 libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_18.json delete mode 100644 libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_19.json delete mode 100644 libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_20.json delete mode 100644 libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_3.json delete mode 100644 libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_4.json delete mode 100644 libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_5.json delete mode 100644 libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_6.json delete mode 100644 libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_7.json delete mode 100644 libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_8.json delete mode 100644 libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_9.json delete mode 100644 libs/wire-api/test/golden/testObject_InvitationCode_user_10.json delete mode 100644 libs/wire-api/test/golden/testObject_InvitationCode_user_11.json delete mode 100644 libs/wire-api/test/golden/testObject_InvitationCode_user_12.json delete mode 100644 libs/wire-api/test/golden/testObject_InvitationCode_user_13.json delete mode 100644 libs/wire-api/test/golden/testObject_InvitationCode_user_14.json delete mode 100644 libs/wire-api/test/golden/testObject_InvitationCode_user_15.json delete mode 100644 libs/wire-api/test/golden/testObject_InvitationCode_user_16.json delete mode 100644 libs/wire-api/test/golden/testObject_InvitationCode_user_17.json delete mode 100644 libs/wire-api/test/golden/testObject_InvitationCode_user_18.json delete mode 100644 libs/wire-api/test/golden/testObject_InvitationCode_user_19.json delete mode 100644 libs/wire-api/test/golden/testObject_InvitationCode_user_20.json delete mode 100644 libs/wire-api/test/golden/testObject_InvitationCode_user_6.json delete mode 100644 libs/wire-api/test/golden/testObject_InvitationCode_user_7.json delete mode 100644 libs/wire-api/test/golden/testObject_InvitationCode_user_8.json delete mode 100644 libs/wire-api/test/golden/testObject_InvitationCode_user_9.json delete mode 100644 libs/wire-api/test/golden/testObject_SelfProfile_user_10.json delete mode 100644 libs/wire-api/test/golden/testObject_SelfProfile_user_11.json delete mode 100644 libs/wire-api/test/golden/testObject_SelfProfile_user_12.json delete mode 100644 libs/wire-api/test/golden/testObject_SelfProfile_user_13.json delete mode 100644 libs/wire-api/test/golden/testObject_SelfProfile_user_14.json delete mode 100644 libs/wire-api/test/golden/testObject_SelfProfile_user_15.json delete mode 100644 libs/wire-api/test/golden/testObject_SelfProfile_user_16.json delete mode 100644 libs/wire-api/test/golden/testObject_SelfProfile_user_17.json delete mode 100644 libs/wire-api/test/golden/testObject_SelfProfile_user_18.json delete mode 100644 libs/wire-api/test/golden/testObject_SelfProfile_user_19.json delete mode 100644 libs/wire-api/test/golden/testObject_SelfProfile_user_2.json delete mode 100644 libs/wire-api/test/golden/testObject_SelfProfile_user_20.json delete mode 100644 libs/wire-api/test/golden/testObject_SelfProfile_user_3.json delete mode 100644 libs/wire-api/test/golden/testObject_SelfProfile_user_4.json delete mode 100644 libs/wire-api/test/golden/testObject_SelfProfile_user_5.json delete mode 100644 libs/wire-api/test/golden/testObject_SelfProfile_user_6.json delete mode 100644 libs/wire-api/test/golden/testObject_SelfProfile_user_7.json delete mode 100644 libs/wire-api/test/golden/testObject_SelfProfile_user_8.json delete mode 100644 libs/wire-api/test/golden/testObject_SelfProfile_user_9.json delete mode 100644 libs/wire-api/test/golden/testObject_UserUpdate_user_10.json delete mode 100644 libs/wire-api/test/golden/testObject_UserUpdate_user_11.json delete mode 100644 libs/wire-api/test/golden/testObject_UserUpdate_user_12.json delete mode 100644 libs/wire-api/test/golden/testObject_UserUpdate_user_13.json delete mode 100644 libs/wire-api/test/golden/testObject_UserUpdate_user_14.json delete mode 100644 libs/wire-api/test/golden/testObject_UserUpdate_user_15.json delete mode 100644 libs/wire-api/test/golden/testObject_UserUpdate_user_16.json delete mode 100644 libs/wire-api/test/golden/testObject_UserUpdate_user_17.json delete mode 100644 libs/wire-api/test/golden/testObject_UserUpdate_user_18.json delete mode 100644 libs/wire-api/test/golden/testObject_UserUpdate_user_19.json delete mode 100644 libs/wire-api/test/golden/testObject_UserUpdate_user_20.json delete mode 100644 libs/wire-api/test/golden/testObject_UserUpdate_user_3.json delete mode 100644 libs/wire-api/test/golden/testObject_UserUpdate_user_4.json delete mode 100644 libs/wire-api/test/golden/testObject_UserUpdate_user_5.json delete mode 100644 libs/wire-api/test/golden/testObject_UserUpdate_user_6.json delete mode 100644 libs/wire-api/test/golden/testObject_UserUpdate_user_7.json delete mode 100644 libs/wire-api/test/golden/testObject_UserUpdate_user_8.json delete mode 100644 libs/wire-api/test/golden/testObject_UserUpdate_user_9.json delete mode 100644 libs/wire-api/test/golden/testObject_User_user_10.json delete mode 100644 libs/wire-api/test/golden/testObject_User_user_11.json delete mode 100644 libs/wire-api/test/golden/testObject_User_user_12.json delete mode 100644 libs/wire-api/test/golden/testObject_User_user_13.json delete mode 100644 libs/wire-api/test/golden/testObject_User_user_14.json delete mode 100644 libs/wire-api/test/golden/testObject_User_user_15.json delete mode 100644 libs/wire-api/test/golden/testObject_User_user_16.json delete mode 100644 libs/wire-api/test/golden/testObject_User_user_17.json delete mode 100644 libs/wire-api/test/golden/testObject_User_user_18.json delete mode 100644 libs/wire-api/test/golden/testObject_User_user_19.json delete mode 100644 libs/wire-api/test/golden/testObject_User_user_20.json delete mode 100644 libs/wire-api/test/golden/testObject_User_user_6.json delete mode 100644 libs/wire-api/test/golden/testObject_User_user_7.json delete mode 100644 libs/wire-api/test/golden/testObject_User_user_8.json delete mode 100644 libs/wire-api/test/golden/testObject_User_user_9.json diff --git a/changelog.d/5-internal/reduce-json-golden-tests b/changelog.d/5-internal/reduce-json-golden-tests new file mode 100644 index 00000000000..1470dd69b9e --- /dev/null +++ b/changelog.d/5-internal/reduce-json-golden-tests @@ -0,0 +1 @@ +Clean up JSON Golden Tests (Part 6) diff --git a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_10.json b/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_10.json deleted file mode 100644 index 75e65570892..00000000000 --- a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_10.json +++ /dev/null @@ -1,6 +0,0 @@ -{ - "currency": "QAR", - "icon": "+Y\u0001\n𩺢_{摇婮hFn􌿱-里o\u0003K6􀝇b4#~f\u0019🨻㰰\u001c\u0004\u000b𢬢9-[n󵲱󶔏z*􏂱\u000b\u0017X\u0006󾗣\u0017z\u001a􊅵𓃔s1 [󵍋\u0014|𘅣MoY6\u0014d𢨂E\u0005\u0001𑚶Oh#􈳎u!𩁓[𪒦(뽗$}Y𨪜<\u001b*P1A𮂌*𧩉G4dx𣾵󶘿@;x􁫒d\u0012\u000cp\u0001氶4WY\u0005\u0000􏺺D^栀-I􅊚kC_新S\u0017>􆤧8\u0014Wb}$+􍦏y\u0000m\nR􀪮!(󶄘􃞎\t𬏆KF1[\\(N𥞋(U\u0002Nݨ3󷐒z{$幼Nv3NY\u0014f\u0011nDfh贾S\u0000󰣄\u0010%e󺷎o󽧞\u0018qq[w􊰠\u000c9:ऽZ|+3o\n/󱒻SM|J[,􂣯2󴊈z\u0014\u001f79}\u0004𩮭%V󺩉l_󲙮)󲜥I", - "icon_key": "\u001dnlrE􅁦H\u001d\u0015~\u001f\u001b|-𦰡Zo\\$\u0017󹺝\u001dC󷨪\u0016\u0003Fj{<7􅱝m'\u001b\u0018Bn_N{䉊4\\g\u000b𧫇\u000bsg󻼾\\𦑶8\u0012F@t\u0001\u0015Xy+\u001c\u000f󶡌$󿱑𥇲󸩫)\u000cC󻤖_r\u001a󿲑\u001b&4Pm\u0007-wS󶝋n竹]\u0016󶮺:\r\nO󻆌\u000f+9q\u0004]RyY\u001e𩏱#6'mk𠪦북/\u0017ZZ󿜣|L𠾤o􍗧m_`;,􍞁D構4󽆍\u0000톚\u001d8뢭d𗗿𤊓󰂗3#􏗫𗨼O𨴮0(F\u0004", - "name": "􀇱𩉯󱃗\u00158u;\u0017􃯹\u0015\rA$#,𦻗\u0019\u001c󱳊Y\u0003𑑊\u0000(7󴃚1􈏉\t𠚩\u0001:?$s]1U𝍶\\:3𣖵n?K~" -} diff --git a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_11.json b/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_11.json deleted file mode 100644 index 3b0db770beb..00000000000 --- a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_11.json +++ /dev/null @@ -1,6 +0,0 @@ -{ - "currency": "NPR", - "icon": "!5Ȁ􀝭䓜I􍺝q__i𝍅V𫆁󼩬\u000c%T'Μᾔ'%5y\u000fj󷖞qK\u0003VJ􋷦Q􈫧x8\u0014\t苞r\u0000\r⊬⣲􋍠􊖕,;\u000c󷯒^󸌰m\u001c~L:󰵔\u0003󸧇i𤔻\u0015&\u0005BFR\u0015􄢄󶊼v󿽗j䬷b'd2D🝒9o𓃤\u0019㌕!`{󿯨/]\u001c)\u001aq潢F\u001dS󳉵𝅆\u0011<\u0001\u001d01`夐\"Qzt􋨭\u001b|𤸒w\u001c􍚤󱳇+ =Xhl P􋣒󻽒𤓒oPb8$􁻘\u0012􀒓5\u0013j􎌠sU\"#@u{Yﱠw\r\u0019\u0010AUae𐘆;\"uP{\u000b\nm󹽈}\u0005L\u000f7𦜡𨟖:\u001e= Yt5Nj㫕cYf\u001b󶟐,\u0008ZCPn󸽪\u0015U𬊜|\u00072뜬z杺\u0000畊RaO[\u0011WW󺟸\u001a錩2\u0007豹Fjs\u0014(󼦬𩊎𝀩󰾺Hỹl𡔷󱃛ꎾg8\u0011\u0004𦑳rC\u0001x", - "icon_key": "5;\u0018'BNﱔ:j\u0004r\u0011泻磒鱕\u0000\t🢠𫍐~Tq&k\u000eX6cP\u0000𮅪󵞳7􈻌\u0016\u001ez䇂䷍󲅒)%}$O'.ᜯ#g", - "name": "\u000f𗓢\u000c5h𥃉1G𪖚\u0017a􌅀V\u001de+SH|\u000ce􄂞𩘸%8𬫻jWZ:􀼂O)󵳙\u0008\u0019􎮶U􇟰j0V3U䌓󸉗i\u0007󲑘󼗶󲗉<n\u0008唄]Mo󷓁y\u0005BS7Qh#\u001bI`=󽹆󳵴5\"*i⁌􌭡𗿛􍆆v󳢑&𨈚)~\u001c󲀅,\n僝𫆻󴽃􀱡\u0015\u001c􁙅~VWB(jD&i󽓜􋐆{\u001c|\u000e8󷺃ﾔ󴒰󶈻L󺁔2,|E筫􉥤g󻅤\u0006(8?\u0019\u0007L@" -} diff --git a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_12.json b/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_12.json deleted file mode 100644 index 9cb9b055e9b..00000000000 --- a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_12.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "currency": "GNF", - "icon": "l\u0014]\u0007`N\u0012􉇝飯􏫸󺙟䔝\u0002\u0015Xw󹓸)\u00054𗦨󿙗\u0018uV𣳒𦰅T𣯵痴P9\u0008P?J󺝯m|=pk\u001d\u0007-9@J\tP􄻇󻡢􆬮󾉥𥺍,\u0018🠯\u001e􏀣g#󵍰E9󻔜ky8\u0017𖡛e(v\u0018챌0󱚷ॢc!\u0004QGtp", - "name": "Y\u0007Uh=:􀨐?󶆉V~\u000cX?)\u0013R􉶦\n1󾐹^#􈊱WepJ\u001c\u000f\u0017[ =-\u0017pu􈉄`\u0016o!폒󰢣\u0018k󳼭󵖳\u000c󶢓8NY\u001a_G&􄸖\u0000Y\u0004쵨\u00042􌼨\\\u001da5\u0011g\u0007􀝔󹁮No㍍८\u0011(𝤪\u0018\u0006􎫭_𬪷\u000c{! X \u0015\u0001䰋\u001d𗭫 H𮘹4*\u000c/𤙿X󹝏\n|.㝹rd䐘`.j:\u0018&􄸻宲󺠝\\F>*\u001d􆗺.Y\u0011\u0007\"\u0002𥻵/󲠨7𥁉a󿣲ᑞ#?LQwzpeF\t􇕈󼰚\u001bOj\\P袊踫vP2mh$(󴆛eaUw\u001a\u0008] 60\u0017􊅗S𦻏`󾜀2" -} diff --git a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_13.json b/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_13.json deleted file mode 100644 index e0c356a660f..00000000000 --- a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_13.json +++ /dev/null @@ -1,6 +0,0 @@ -{ - "currency": "AUD", - "icon": "\u00112>ꏞG)+\"L𧝁dZQ󱓓XGMY\r~c7U􌾠i𩛒\u001f?M# \u0016\u000cEweI`ᷠ𦉖\u0012󰳌\nCO\u001c􁦬I\u0015󹅢w8􁹵\\󺝖t2🃑u\u0019\r[\\fk\u001f:Yp*?Pຟul\u0016􉺙󸮫󳌻\u0002+􂻈\u0015=닡󻘺󻝢2b,N\r􅍢\u000f`\u0017ZD𞹲:騀𥒣𖬫󵿋!呓6\u0017=DA􃓝\u0004コ6\u0016𫚎􇍖􈴑%\u001aZ\u0000KNmJqr𫄎\u001fF𪥸0i5𣺮X\u001dKD>b􆮥E3T", - "icon_key": "\u0011IS\u001e=xd%\u0004}T_7 􀍃qdLtTL\ruiu\u001ad􂶠𘥛\u000b\u0010Mn@+R]􀄓G\u0018瓂/H\u001b􆬄􌥁up$b2q􎬬!륋\t󲮻D川.#៤m𦵂􆪔\u0005=m󾔟\u001c\u0014𪢦6hD\u001c\u0001\u0010AsL\u000b(􁋵?u𭽲󸦇3%ปY1p󵕉\u0014Lhj%􆕨]b\u0003psL\u0007􋏠G𝂱\u0018w_", - "name": "V\u00018(4\"zꢊAM󶺱/\"\u001b\u0001\u0001󺄠V𮒧􅚢𧔛P𢪋^\u001fH⊃I*\u0013,⻭:\ns`%}H3%\u001ee𓈸ꐯ𘉝A\rY)':!B\u0006󻽱\t\u0003rc\u00012h=I6A7g󰾴YT󱒟𪙵􀢨l󷼤D\u0005V`\u000fE\u001cE{cnx􀁔ej'{v#u8𨬷𤦚\r\u0000ﺻ^T\u0000*𤙛󽥼U渾q==\u001f𩃪6叫2F\n" -} diff --git a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_14.json b/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_14.json deleted file mode 100644 index 88bbfd42606..00000000000 --- a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_14.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "icon": "󲻁v=xḁ\u0010B?{󿎸𥺑𢋝y𬤭Z\u000cP􌘡eC𧇭\u0019\r!(x\u0007\u001c|azC$𝑁8აMv\rV^4Z01\u0007k𖨶\u0015 \u0007|\u0004Ocxwa𡄧x \u0010[󲺒􆤮K\u0000󻕃=50tg\u0011􊧓\u0004O􀏽`𓁤\u000bﲛ\u0018oPQ􂭅v𩓯\u0001t;\u001e7󻰬􎷃v%\u0000]U@\\:\u00043𡯝%]P􏏖\u000f}𠁺\u001aW𪻠\u0016i\u0006\u0011\n=xtyY\u0005!\t4~t\u0001\u0011~\u0018󹶗􁗖􅰔\u001d2ュ󠁈+X\u0006E7.\r)`f L)\u0000󶊑󲏏q\u0019󷒴⼩𠁯79\u000bh𖣛𘗛(\u0019𪙂e󻍣^\"\u0017􏽚e􏯔fHZj󹒂2O􍂹`<┛󼎣]\u0001l􂽲qx", - "icon_key": "r󻤭1M>=,:􀾚Of#䡷%?p𔒸c􃱬~\t􁴺E\u000c󼔣\u00040H%ಣ󼤹\u000f熴)\u001cs󴂘\u0007cBw􀨵\u0019d\u0001󺸎4\u0013G𨡷8𨆹\u0000i󹜙P~\u0005\u000b\u0000Vr@vR𗪃󹐄􇒋B2+\u0015BDMo(󸞻;몰t󶬆U<-\u0000\u0014Mo􉚣U𫽳'\u0010>)\u0017𮋍@qO\u0010\u000e\u0017𘌜놵+)M\rD󹺛緂\u0002-$􅑚T\u00184M𨅒3V\u0007[y9\\' {E𨇧􉲗z+⽻\u001f\t;*zUvU!\u00017钩􎅏xF=sqy", - "name": "HUZo!3i𦻇\u00110XJ𥜘_m\u0005cc?Y>\u0001\u0008bd\u00030p&f􍨌Ct䣙􃃟Z𠪗R⦮\u0007\u0002\u0015a\tC*eet󻎓\\OHkGN\"CD7Ch\u0015𝟏󺟡tcS\u0017\"\u0003\u0019󳾏\u0010=_㌳~􅮃Lve^\t􎍺H5s􎢉<󵼏鋄i>Yd$\u001b11𦰸Ea軭!O\u0000Q\u0006\"mlc\u0013𩧴𗥪y\u0018\"(Wu4伨rY_\r􄣈]-\u0014r𤯱}7t#*)𨴸m\u000b󾨀[𡇈\u001f룉+\u0016􈙉󼧫a険\td\u001aQ\u0014_󵫽mI􄊝S\u0004RK\u0000p5uf \u000cz󹹉c󽪁\u0015U\u0002Yu𗔂$蜱\u0015\u0012%jB\u001bNHxd`J9z\nyg𪂉ZⅪ5A\u0002𬌪󺢯􊿄\u000bn\u001f𪙾'SNtE[\u001b\r_De􏎅'G𨖞\u0005[I.󱂨3󴺓\u0008v=R􏆘𣸑\u0015G\u0017R祓)􇷒\u0019𬣒\u0017T\u0002dGW\u0012YBV0_%𮅒ꦢw\u00159\rL%􂌛k<\u0007,?𭇶U2C𪍼", - "name": ")\u000eI\u000f\n3\u00182􋂫𦌿翘􈏾\u000b𤂚1,|.=􋆢􊤫\u000cH0d󺷔\u0008\u001b\u0010\u0007b󼧋\u0018\u001d𗘖󿄳9|􆚄𗖞𨹎􋘯C\u000f\u000cT`\u0001󹉒w􏤾Fn[9󵂥\u0014􄼱N試\u000b儌-rC4\"{^@\u0007𛃏RG\r!]#]'Z􃅴n󽤰-􁒇𥳩𬍤nv#FwizՀW\u0011i뭙.\u000b贈𡯁􈅖\t=\u001e\u0018,j/E踌󻎩\u0017yt󴂐.9Mk\\\"i5M{T􏃐󱤭RyrD%3_󸓄*o󰏽d\u001b𝧑h\u000ce󵅱󷙧𧙱,=r㈬𧙕哏o讻𔐟Yt􈫖\n*if\u0013􌱵T󿅃I\u0003o)𬀤\u001d\u0003\u001c)\u000cw\u0014\u0006Ek𨶵[\u0001;􂖺p\u0019􄕻T\u001d\u0013Hx" -} diff --git a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_16.json b/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_16.json deleted file mode 100644 index 0312ed8a488..00000000000 --- a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_16.json +++ /dev/null @@ -1,6 +0,0 @@ -{ - "currency": "XUA", - "icon": "i[􈀢9\u001ezKKVf,KD\"󲻕7헑??诪\tt}E!􏪑𘔒􉦸𠴒A\u0017􇝯C\u000e􄆰u\u0003e\u0015ꈴ;u󻾈60T󾫱􌗖\u000f\u001bⲥ\u001cY\u0016􂀰x䀐h\u0004\u00089󿗤]\\\u001a𡢕e􍆆温Y>\u0007T\u0011\t/k鬝s\u000b)h\u0018󼤲UH\u0005𩉒~\u000f𤡽\u0010.q𨚦챡^6&2sUN\u000b􂵱󱫽\"=\u000ebh\"\u0013檻{1𠱳\u0018K]⛎a􊥹m薪z\u0002󺯓I\u0003􋄒􁬚􏫞𗜃􀣸x?􅤅󻝟􌂮캟1\u000c􎸥h􇃄\u0007\u0006/mX5$C?!", - "icon_key": "\u000c􃌗`HS&􄲸8Il\u0019􏲫\tQJ\u001a\u00019\u001a\u0007􄚧𝓋Lㇷꆚ𠮫&\u0002􁝅w􉤧4󾍸\u001f𡸍\u0003\u0012~􏂾\u0004B[Ya\u0006\u0002닉n𓄾󱓈k󿴣V(􋙯𗵿􂟓@ǚN=/.󱀕`m\u0017d6𑴤'od2J7[􅹓Z:셞\u0004𤉈l\t􇂞𧘍\u0005M􉡯y􍽸櫓Y铖鏠5\u0000\u0003Rl\u0014 \u0014|:\u0013􀃘&𑚞\u0016X8󰂚`nmFZw𥛹[Dg\u001b\u001a\u0008 7kN󾚁N筛PlꢞX\u0014𗥏?B1\\jM\"b\\x_\u0003􂜢:\u0014쑶6󺑊𫈏G𮘷􀝐{\u0016\u000eo\u0018%EB𣴁\r@􁂵뻖Em󿗓􌩌𫓧𧇜v.", - "name": "8^\u0010􋗿A\u001b(󶗭P|C{\u0003𑶡s󻛃󶐲F(\u0007e2\u0000)\u0005N\u001e" -} diff --git a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_18.json b/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_18.json deleted file mode 100644 index e9f60c11bad..00000000000 --- a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_18.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "icon": "Y𝞐􎞭?iT𗿖􍦆`3𗄯\u0002\r􁟈t󽧫{@`@f𭝮(~󸪵\u001fE0\u0002D-\"􂊮A=_a\u0019𡙛Nn/x", - "name": "r!ef\u0012~[2v&j\u000b𩙸-m㢠\u0006󺨨X\u001alDSOHrN􏔣J.𢹱𪴽j􂹞喑>𮥼^𨎐yz\u0006𑇣6G\\􋝍m\u0016Ei\u0011co!^/\u001a?\u000e\u0013\u0006a󻦏\u001e󴘝\u001a􎷟躹C\rt\u000c&zN任+\u0001\u000fF􅡾\u000e𝅹\u0011󷪻tJ_,\u001cq󵵆G\u0017𧊵𦪎a(P㤒<@F􎜫󿇟, 󷩍xt\u0003𫐭𓌔6e𐬃NS+1#\u0005𗆀\"j샺􈐬0G\u0012\u0014\u000c󹐐󻭄𗀓F𩩢o/j:I󻠄VD뮳?Kz\"]f#㍲M􋬌󳏀Ed\t􍮛s󰰯\n{MKM砟0\rᝲDi)ﳮ`\u0000:i겙𞤋r-𪓚\u0000(x\u001d\u0001㉦\u0017xB?\rK\u000e\u000cfm𨳆𡜪􅎎5V\u001a𐛛𩶦\\󷁥b\tj􍷈𡠇􎦽9t1撐b+[N\u0018ꮛx" -} diff --git a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_19.json b/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_19.json deleted file mode 100644 index 37848f52fca..00000000000 --- a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_19.json +++ /dev/null @@ -1,6 +0,0 @@ -{ - "currency": "UAH", - "icon": "󺃼\u0010y󸗚{􄍺\\嚶:)*Mb\u0000w.󾔥o󻰙􉷋yd%䉌􊷪\nu􈙸\u000cj\"v`2-\u0008䌉P6\u0007뙡w\u00079a+󹥳Q\u0000Am㛼(8K%>CU\u001dQ󼖞䖓􂁺𮕚跟>", - "icon_key": "~6u|𝥐\u0005}𬲸a\u0010\u0006󷢯?v$󻅽F󿐭#w@P󴙢p\u0019\u0006􅓟Ok󴎟\u0007󱵾󸴟𝛛\u001a󿐑7`𬸼꼾BL\u001f󱺋䀢\u000b\u0003瀠\u0011{\u0006sv4\u0011I8'\u0010Iz\u0008\u00043=+io𝃤j􇤅\n&<\u0019𗎌b\n]]7\u0004w𐿯q􎛮e)A\u0013-O,㇇󼴣1'\r󽞶\u0013􂛏䖗1\u001a6\u0006RuY𦏸}3\u001d`j\u000cq\u001e􇡓)y\u001awq\u000cR0\u0002(JJ\u0011|\n\u001e󹢗66d\u0015z\u000ew\"[~􎒁u󲇜\u0004󹶺\u0016󹹉\u0001󱄻㠩\u0006D\u0011g0\u001b']q𢷧󱦴ᣡZ\u0013lp\u0001\u0014\u001fi\u0019L)[?\rfহN-4󿻥(\u0002\u0017<,!􂸕\u0014f𘢄P󼶶s𗸟r3\u0008{jzp(\u001dN&\\1𡩸c󳶱\u001e{hh$=i󹾮-0~􂚲𪗣𠐵󷗻lq5󳻦\rclO\u0013)px􆊒9\u000bI􎑼\u0010\u000b}𞋲+,l󳰨o(󶴳󠇡⨲c]\u0010𪭲[]󴈻\u0000", - "name": "\u001al|>41*𮣧\u0015TLx~}󾫆\u001dNI𠦾o閤T󴏥DrQ\u0004q\u001cD\u0011\u001d=|<𐧜]Y'{u8%𒉓\u0003𝢥\u000bc\u001ej)咶%𗜋DE󿨫&+!l󻩾D_\"\u000er󾝥󽃪󻛍􀦛󱄤\n_5*F/𬌔$,󽎼\u0006􂥉Pd~󿊈!􇂲\u000ea󷪂_󺁷g\u0001l^jz\u001e􄀻󿰐𧣞𩶆내󱔲Fꊴ2a8'\"n0bH\u00140v\u0013E~\u000c\u001as)5b􁥺𘝰?GzN=𡸄3c<,\u000c&+𐛎𣺽&af𡡀FqV󲑊󱒂\u0012k9\u0001\u001cOZ󶜛躘􁠝H<Iei=󺅯􃀨\u000eg\u0018\u0012\u00190UO\u001b 'I\u0012)𩪻'𠹷\u0008\u0004\u001d\u0013\u0004y]c\n𭘛\u0012l4\u0012)\u00176󰘓?~\t\u000f" -} diff --git a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_3.json b/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_3.json deleted file mode 100644 index c971d7aff65..00000000000 --- a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_3.json +++ /dev/null @@ -1,6 +0,0 @@ -{ - "currency": "UZS", - "icon": "\u0017$𨄺뵫;𩢞E𐫌𠀧鬇\u0001c\u0017od^.\u0002$V7Q?\u0006\u0014L\\\n㇋(?𬬱\u001dc󿽝aZH󻖖03􂐃LA@\u0006\nX\u0005Jz􏺺1󶑿\u0016\u0002l\u0013\u0006h􍖦!]#𢏲\u001f󸙚V뒏𬣢\u0002\u0000\u0000꽢]D6mR[󹥡kV\n\n𐨀,\\󱢢,aY\u000e󰸟[<[􊱈K\u000f!o䰉#wC\u001d2^\u0010$􃄉𓌙^|4\u0002陴f(,Q쳵\")󽘱\"𢛦\u0000]𠿶9(r􎊲f/𣸫􁘡%0ihW󿖬&]󷶞mi2g􎅳I\u001f", - "icon_key": "Bw󵢟G𣳻\n>\u000ef𭦿,FU-𖧺\u0006+𩵧\u000cz}􏋌\u0011}\u0006t\u000c#􏬤\u000cЏ\u000f\u0000\u001bꇻi$\u001d色1A󴆭(\r", - "name": "Y\\73󴉔R`h\u0002p舰\u0008:'󺺓Uq$N􈓧󴛭G*@Ss\u0001\u001d꠹\u000fโc𑱕厑\t>a\u0001󴶪L􌍣R^缙:K{>鏄Y1\u00004h娡Q@\"𨄒DR𠛎몢v\u0019𡅚x\u0014\u0017\u0013\u0006A\u0015v𝨡𡐅\t[aVgL\u0018@kL-uP\u00013$~4醽K.c\u0008\u000b0B󲕓+\r20}\u001a^g⌽N\u001a􆃱󾐥2󴽙\u001bHP\u001f\u0012p􏍥(􌰖{\t%Gry\u001c'^Y1􍁭bM&(A􇓂􊪺\u0017\u000c몦3󿇮􎑬o􏵺5𖬛oly騮SE]嚽􈙬𮢹\u00082\u0018>h'G󸗺(0󼣔ᩃ8⾠\u0006𝇢􏽕C8\u000b~#\u000bev𩟔D60𨉙$\u0013x➁𑿪𥺆\u0003A\tD`w\"Qp", - "icon_key": "\u00130'J󹳂9鳗ᘣk􌔧JW.\u0004u^0ro1y-𣗼𨩺\u0002%!Q뵼", - "name": "𬣵M}袛vE󾁯Q\u0005{t\\􄡱I􁰭\u0006󷳸\\𗔴]􇭠%A\u000c꽹u.`^#󿽘⚪瑕􅬆􎁍\u0016\u0008􀖒?K\u000b\\􉴮\u001f􄞼􋞅^}󹺃󵀼\u0015􋧆-_89z:.9z\u000e*W@𐜓𪿌wb􀅀𨪲\u001fW󷀭d𡷁:WGs-%(ᒷ􎦔C\u0003$0RPh𤊳%C9\u000c4O􃸀Hv3\u0015𧐘h$\u001c/󳖬\u001c𪯻󻢗󿷫𡺹P&\u0000􍪋du0@􀜻\u001aG\u000flSw\u001c얤􂏉\u0003.N Pp\u0004", - "name": "U;\u0007􎡷I􉿎8tx.J^o]7P6#Lr0`\u0004\u0014􁉃\u0017􀀯\u00080􂽅d |UYᇂ漅7J􈳖𗉛\rQX𠢂𭔷vW֡'鄓 \u001d\u000f\u001aoVj=\nVDq'4塯B\\;6^\u0006-\u0015󾙋𘖱`.r'5n~g X󲃈\u0016#󸛟S0'󷤊1-pY󿽉㼴\\1P𝩪𑇯ꓟ󲠌!6Jw𬪨\u0003/_\u001ay􈼺2Rv󸞎v\u0000󳖹{󲶷.l\u001eq/𦹺󶁟.𖠸~ri5\u0019㍎>c\u0001󸓆\u0004f􇐖𣷐TR\u001d[r𨴳,2\u001eM,􍱬󹩊𫲧JivP𓎁In?ec#s󿞲\u001cg\u0014+eeAa\rA^X.𗺐J\u0003\u0011" -} diff --git a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_6.json b/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_6.json deleted file mode 100644 index 433bda498b9..00000000000 --- a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_6.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "icon": "$^𤙾𧏞*\u001cT1t\u0006t𢔵w\u0017'󾛵5z𭞢􉎟mmEaf\u001c䷽g+⭼<\u0013𭄢𠻕-󸒆\u0015􍤌\u0016py󶿛2a냲zPS|_􊕵a\u0002\u001fmo䩻T&-$&󳶉쥯xX$\u0005o.A󽝭;kz\u0015^$cGD<\u0004_\u0014릟󽀠􎾕󺝦􈻰0{\u001e𩜪1􃁛O萧WY.𗠗ⱯM8u5\u0012\u001d'4D\u0008󶅂󷒳ZQݯZ\n촣/􁭮^51􈕏\u000e􅲅\u001e6ㇺT𘉅X[􈰢Ng#|2VjG\u0016U<儁3􀈐Ⴃ􉴹N󿄺M\r3\\gp󿔵Vx\r$7N4W\u0010\u0017𧁵ヾ\n󹌩qZ\u00181F\u0005M;u\u0000󼇱V\u000cj遪<]/U\u001b􍄘~)j𭐬\u0000\"掊\"Nsd\u0002m!j/:I\u0019􄼑Z\u0007jac\u0005:e\u0005\u000e<\"\n􂁲d{􀤇\u0012𠳺s\u0013O󶵄g\u001e\n2-\u00152,\u0006뱘\n\u0005xU8Dlu爮ꨮ컗\u000b󲹰1&9器􍘎󾇋\u00176\u0011󷜜!C1W=j\u001c;󼥣<#w5Sl\u001a􀅟\u0011\u0018O韔7\u000f𧨽]dX\r𩳠\u0006D\u00058s\u0013𮐢@\"*h~ꛞQ𦁒q􃮖\u001a \u001eE\u000e^􍌢Fa@\u0008\r%+W\u0002󻊻󹍺{HR\u0014 \u0013\u0014dg\u0016\u0000𣊶\n􉿘~𝖪j􃝱K3uK󶻯8" -} diff --git a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_9.json b/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_9.json deleted file mode 100644 index 1a50f80a50f..00000000000 --- a/libs/wire-api/test/golden/testObject_BindingNewTeamUser_user_9.json +++ /dev/null @@ -1,6 +0,0 @@ -{ - "currency": "MZN", - "icon": ">a&7󹚪0\u0005􁜅hﮖ\u000e𓃐n\u0013 k^\u000b󿰞2OOz𢄴X2󵆔􀰹bu􅤯C􊶛\u001dｷ2;)𬆦퀖\u0007BY󻴷\u001en4\u0015\u0003v", - "icon_key": "􀃙f稓􎈢", - "name": "\u001b\u000f諼b+\u0006GR𫘥5*\u0008=x\u0008\r]pP릍􃑇⢞F=Tm襓\u0018󽢠\u000f7\u0000𭕔;􆆄l )m𠢔􁈊俲䶴\u0004첒ak%JP􊈽P𝖨M\u00133sT󾬢煪ml􇓩ᅫun|Obt 󹭶􅌥/:5􏙮j" -} diff --git a/libs/wire-api/test/golden/testObject_InvitationCode_user_10.json b/libs/wire-api/test/golden/testObject_InvitationCode_user_10.json deleted file mode 100644 index 7faac4c5ae3..00000000000 --- a/libs/wire-api/test/golden/testObject_InvitationCode_user_10.json +++ /dev/null @@ -1 +0,0 @@ -"Ts_qqqR28DY45TFogbSj_r6zucCScCei" diff --git a/libs/wire-api/test/golden/testObject_InvitationCode_user_11.json b/libs/wire-api/test/golden/testObject_InvitationCode_user_11.json deleted file mode 100644 index 45749f24f42..00000000000 --- a/libs/wire-api/test/golden/testObject_InvitationCode_user_11.json +++ /dev/null @@ -1 +0,0 @@ -"OBrWOSrGo9kzEiYcLa3APM6WwDEC" diff --git a/libs/wire-api/test/golden/testObject_InvitationCode_user_12.json b/libs/wire-api/test/golden/testObject_InvitationCode_user_12.json deleted file mode 100644 index c39d31cb94e..00000000000 --- a/libs/wire-api/test/golden/testObject_InvitationCode_user_12.json +++ /dev/null @@ -1 +0,0 @@ -"K1SuIMYMcZvuRSCazOsbQyv6-AD1GqQ=" diff --git a/libs/wire-api/test/golden/testObject_InvitationCode_user_13.json b/libs/wire-api/test/golden/testObject_InvitationCode_user_13.json deleted file mode 100644 index ed9c56fc0d3..00000000000 --- a/libs/wire-api/test/golden/testObject_InvitationCode_user_13.json +++ /dev/null @@ -1 +0,0 @@ -"fDBjTyGqA80aVYoxz6beTfpxVn7KPFA=" diff --git a/libs/wire-api/test/golden/testObject_InvitationCode_user_14.json b/libs/wire-api/test/golden/testObject_InvitationCode_user_14.json deleted file mode 100644 index 98064d1d9d2..00000000000 --- a/libs/wire-api/test/golden/testObject_InvitationCode_user_14.json +++ /dev/null @@ -1 +0,0 @@ -"f-s=" diff --git a/libs/wire-api/test/golden/testObject_InvitationCode_user_15.json b/libs/wire-api/test/golden/testObject_InvitationCode_user_15.json deleted file mode 100644 index e16c76dff88..00000000000 --- a/libs/wire-api/test/golden/testObject_InvitationCode_user_15.json +++ /dev/null @@ -1 +0,0 @@ -"" diff --git a/libs/wire-api/test/golden/testObject_InvitationCode_user_16.json b/libs/wire-api/test/golden/testObject_InvitationCode_user_16.json deleted file mode 100644 index e3b5fc780e4..00000000000 --- a/libs/wire-api/test/golden/testObject_InvitationCode_user_16.json +++ /dev/null @@ -1 +0,0 @@ -"JYFRObZQLGag5fvn-w==" diff --git a/libs/wire-api/test/golden/testObject_InvitationCode_user_17.json b/libs/wire-api/test/golden/testObject_InvitationCode_user_17.json deleted file mode 100644 index aedd5f6a0fb..00000000000 --- a/libs/wire-api/test/golden/testObject_InvitationCode_user_17.json +++ /dev/null @@ -1 +0,0 @@ -"bH0uavRmmjBrnJoygpAPeQ==" diff --git a/libs/wire-api/test/golden/testObject_InvitationCode_user_18.json b/libs/wire-api/test/golden/testObject_InvitationCode_user_18.json deleted file mode 100644 index 914a30b4ff9..00000000000 --- a/libs/wire-api/test/golden/testObject_InvitationCode_user_18.json +++ /dev/null @@ -1 +0,0 @@ -"YwE=" diff --git a/libs/wire-api/test/golden/testObject_InvitationCode_user_19.json b/libs/wire-api/test/golden/testObject_InvitationCode_user_19.json deleted file mode 100644 index f27a72f0112..00000000000 --- a/libs/wire-api/test/golden/testObject_InvitationCode_user_19.json +++ /dev/null @@ -1 +0,0 @@ -"_ZpeIeHxSAVQ_4g904i-jpm9ygqKeg==" diff --git a/libs/wire-api/test/golden/testObject_InvitationCode_user_2.json b/libs/wire-api/test/golden/testObject_InvitationCode_user_2.json index 95e668f8e5e..049a26cea9e 100644 --- a/libs/wire-api/test/golden/testObject_InvitationCode_user_2.json +++ b/libs/wire-api/test/golden/testObject_InvitationCode_user_2.json @@ -1 +1 @@ -"4Zxb50Taj6g2Cdhdpo6TE18L" +"j-G82ks0MYiz_gOEUvVpWa3V6bpuP5UcUhc7" diff --git a/libs/wire-api/test/golden/testObject_InvitationCode_user_20.json b/libs/wire-api/test/golden/testObject_InvitationCode_user_20.json deleted file mode 100644 index 2fbc5c02726..00000000000 --- a/libs/wire-api/test/golden/testObject_InvitationCode_user_20.json +++ /dev/null @@ -1 +0,0 @@ -"wBibAg==" diff --git a/libs/wire-api/test/golden/testObject_InvitationCode_user_3.json b/libs/wire-api/test/golden/testObject_InvitationCode_user_3.json index 049a26cea9e..e16c76dff88 100644 --- a/libs/wire-api/test/golden/testObject_InvitationCode_user_3.json +++ b/libs/wire-api/test/golden/testObject_InvitationCode_user_3.json @@ -1 +1 @@ -"j-G82ks0MYiz_gOEUvVpWa3V6bpuP5UcUhc7" +"" diff --git a/libs/wire-api/test/golden/testObject_InvitationCode_user_4.json b/libs/wire-api/test/golden/testObject_InvitationCode_user_4.json index 403d6a20298..96cb0a93caf 100644 --- a/libs/wire-api/test/golden/testObject_InvitationCode_user_4.json +++ b/libs/wire-api/test/golden/testObject_InvitationCode_user_4.json @@ -1 +1 @@ -"sLBqu6Bs8L_augCOf-UQ" +"0y-7KQ==" diff --git a/libs/wire-api/test/golden/testObject_InvitationCode_user_5.json b/libs/wire-api/test/golden/testObject_InvitationCode_user_5.json index e16c76dff88..b75948c31a1 100644 --- a/libs/wire-api/test/golden/testObject_InvitationCode_user_5.json +++ b/libs/wire-api/test/golden/testObject_InvitationCode_user_5.json @@ -1 +1 @@ -"" +"-Oj_2VAtOI_kSg==" diff --git a/libs/wire-api/test/golden/testObject_InvitationCode_user_6.json b/libs/wire-api/test/golden/testObject_InvitationCode_user_6.json deleted file mode 100644 index 96cb0a93caf..00000000000 --- a/libs/wire-api/test/golden/testObject_InvitationCode_user_6.json +++ /dev/null @@ -1 +0,0 @@ -"0y-7KQ==" diff --git a/libs/wire-api/test/golden/testObject_InvitationCode_user_7.json b/libs/wire-api/test/golden/testObject_InvitationCode_user_7.json deleted file mode 100644 index 6c7173b355e..00000000000 --- a/libs/wire-api/test/golden/testObject_InvitationCode_user_7.json +++ /dev/null @@ -1 +0,0 @@ -"C8hR7dkwQ8V9Rryx-EeAnHA=" diff --git a/libs/wire-api/test/golden/testObject_InvitationCode_user_8.json b/libs/wire-api/test/golden/testObject_InvitationCode_user_8.json deleted file mode 100644 index b75948c31a1..00000000000 --- a/libs/wire-api/test/golden/testObject_InvitationCode_user_8.json +++ /dev/null @@ -1 +0,0 @@ -"-Oj_2VAtOI_kSg==" diff --git a/libs/wire-api/test/golden/testObject_InvitationCode_user_9.json b/libs/wire-api/test/golden/testObject_InvitationCode_user_9.json deleted file mode 100644 index 7a03c2419b6..00000000000 --- a/libs/wire-api/test/golden/testObject_InvitationCode_user_9.json +++ /dev/null @@ -1 +0,0 @@ -"KguCogw-Yw==" diff --git a/libs/wire-api/test/golden/testObject_SelfProfile_user_10.json b/libs/wire-api/test/golden/testObject_SelfProfile_user_10.json deleted file mode 100644 index e72220941b4..00000000000 --- a/libs/wire-api/test/golden/testObject_SelfProfile_user_10.json +++ /dev/null @@ -1,21 +0,0 @@ -{ - "accent_id": -2, - "assets": [], - "deleted": true, - "expires_at": "1864-05-11T13:37:46.490Z", - "handle": "tq-xm3ywkgplimqfqyd76v696af.zcb2e-svk45z3uw2ba8gxok1gyjy1st01f3ocq6", - "id": "00000001-0000-0000-0000-000000000000", - "locale": "tr-GG", - "managed_by": "wire", - "name": "\u000fdW󳲝T\u001d\rpx\u001bc\"􍟰䄯@𢵲\u0007􉘊x;\u0000􌅖*沷拣(𗏇𩷓B$6G(\\st\u001aiQ蹆$", - "picture": [], - "qualified_id": { - "domain": "0.orr", - "id": "00000000-0000-0002-0000-000000000001" - }, - "service": { - "id": "00000001-0000-0000-0000-000000000001", - "provider": "00000000-0000-0001-0000-000100000001" - }, - "team": "00000000-0000-0000-0000-000100000002" -} diff --git a/libs/wire-api/test/golden/testObject_SelfProfile_user_11.json b/libs/wire-api/test/golden/testObject_SelfProfile_user_11.json deleted file mode 100644 index 7582453b4e6..00000000000 --- a/libs/wire-api/test/golden/testObject_SelfProfile_user_11.json +++ /dev/null @@ -1,31 +0,0 @@ -{ - "accent_id": -2, - "assets": [ - { - "key": "", - "size": "complete", - "type": "image" - } - ], - "deleted": true, - "email": "@", - "expires_at": "1864-05-08T20:12:10.459Z", - "handle": "qk", - "id": "00000001-0000-0002-0000-000000000002", - "locale": "rm-TH", - "managed_by": "wire", - "name": "tWWWXt\u001eﰍi\u001b\u0014\u0017\u000fSɬD\u00143\u0019Q󠆈}G4r󹠠-\u0013eyf2竭􁶿f,\u0004~\u0019𭮩q𑜽𨌊𒆽8W􃾼B󽥯Mhj\n􌼺\u0005)o\"O\u0002\u0016;􋣞\u0014􏰒􇂷c9s\u001c,\u001a-w솵Y!<\u0005|\u0003訙", - "picture": [], - "qualified_id": { - "domain": "j.8-1.of", - "id": "00000000-0000-0000-0000-000200000000" - }, - "service": { - "id": "00000000-0000-0001-0000-000000000001", - "provider": "00000001-0000-0000-0000-000000000000" - }, - "sso_id": { - "scim_external_id": "" - }, - "team": "00000000-0000-0001-0000-000200000001" -} diff --git a/libs/wire-api/test/golden/testObject_SelfProfile_user_12.json b/libs/wire-api/test/golden/testObject_SelfProfile_user_12.json deleted file mode 100644 index c9be8b555d2..00000000000 --- a/libs/wire-api/test/golden/testObject_SelfProfile_user_12.json +++ /dev/null @@ -1,16 +0,0 @@ -{ - "accent_id": -2, - "assets": [], - "email": "렱@U", - "handle": "iz.9z-r0txd10beaq3awhdi00as2ttk4w_-sb73-qa0e-bj9q-do_d.1wivilwgag_da6hy_nx._d_ranqfh94mv4-tisuwevxjcw94-h60ae6-x1tptoboa-x2a1s08q4wywul3rusm37hl.vjn8en__837eodq8134tecr8qzpm2c2hle7ao_wa85hk", - "id": "00000002-0000-0001-0000-000100000001", - "locale": "ca-OM", - "managed_by": "wire", - "name": "\u0019桑f+\u000b=]􉽞u9\u0016v􄢇\u0000aT\u001eKK𑊖o87g2TꋲaOU\r;_jUZ`/\u001dR\u0004s\u001fo@:\u0007󸸬we4g􉟹􂳖 \u0000j", - "picture": [], - "qualified_id": { - "domain": "i-w8.nea5", - "id": "00000000-0000-0000-0000-000000000000" - }, - "team": "00000002-0000-0002-0000-000000000000" -} diff --git a/libs/wire-api/test/golden/testObject_SelfProfile_user_13.json b/libs/wire-api/test/golden/testObject_SelfProfile_user_13.json deleted file mode 100644 index baa4959c187..00000000000 --- a/libs/wire-api/test/golden/testObject_SelfProfile_user_13.json +++ /dev/null @@ -1,26 +0,0 @@ -{ - "accent_id": 2, - "assets": [ - { - "key": "", - "type": "image" - } - ], - "deleted": true, - "email": "@", - "expires_at": "1864-05-07T20:25:30.218Z", - "id": "00000001-0000-0002-0000-000100000000", - "locale": "id", - "managed_by": "wire", - "name": "􈧣yc襘y􏹯&\u0019\u0002󾪲{N>\u001c䊈O=]픝i<`\u00081mBS𑨋𨔕t账)x𩲬[􈎼􉵐m퀌5𧹟􂂟\u0012p\u001c􁎛\u0019 ,T*\u0003s.\u001dT:\u0010󸌎z/#8-e*W𪤢W\r󻁩\u000f\u0005*}𮟻%􊤷𪣩{厯\u0012'N\u001f/윬Z*E𣰦\u0017", - "picture": [], - "qualified_id": { - "domain": "7.kr1-96m-s--x1g3", - "id": "00000000-0000-0000-0000-000000000002" - }, - "sso_id": { - "subject": "", - "tenant": "" - }, - "team": "00000000-0000-0000-0000-000200000001" -} diff --git a/libs/wire-api/test/golden/testObject_SelfProfile_user_14.json b/libs/wire-api/test/golden/testObject_SelfProfile_user_14.json deleted file mode 100644 index 47f0cad00d1..00000000000 --- a/libs/wire-api/test/golden/testObject_SelfProfile_user_14.json +++ /dev/null @@ -1,21 +0,0 @@ -{ - "accent_id": 1, - "assets": [], - "email": "􌪽@", - "handle": "9_hc2_-en1a8jck-tkni14wqqw6mx16tzlmo87gw3xu811i9424ku8fbmpl_hf06nus61lza7_kslu", - "id": "00000000-0000-0002-0000-000000000002", - "locale": "ss-SN", - "managed_by": "scim", - "name": "󸀭dp\u001eW@\u0013$i$)𥛪R󸖱\u0014d\u0013\u0014B.\u0003㥿\u0001\u0011x󾵸g𠛚􄞫\u0019)\u0014K)e=\u000f#s먁d𨷱Q􄗚ㄍ𥵅󾏲:mZ􌶵V󴴎􀶻􁐈^y\u001f𫧾􌴢N𝘯;%\u0004󴮤(eW&C@yh\u0014%᥉i\u0017", - "phone": "+3606473750", - "picture": [], - "qualified_id": { - "domain": "o33xllsl.br.w1a-cl", - "id": "00000001-0000-0000-0000-000200000002" - }, - "service": { - "id": "00000000-0000-0001-0000-000100000000", - "provider": "00000001-0000-0001-0000-000100000001" - }, - "team": "00000002-0000-0000-0000-000100000000" -} diff --git a/libs/wire-api/test/golden/testObject_SelfProfile_user_15.json b/libs/wire-api/test/golden/testObject_SelfProfile_user_15.json deleted file mode 100644 index 42d14c2d30e..00000000000 --- a/libs/wire-api/test/golden/testObject_SelfProfile_user_15.json +++ /dev/null @@ -1,36 +0,0 @@ -{ - "accent_id": 1, - "assets": [ - { - "key": "", - "size": "preview", - "type": "image" - }, - { - "key": "", - "type": "image" - }, - { - "key": "", - "size": "complete", - "type": "image" - } - ], - "deleted": true, - "email": "󶉌@(", - "handle": "ncyk2udev3vg1bl_ujr0ff4fwymv_j_5lcse8b.c99i--lwnquz4mpbqzmrc_2ok_ytgqeov4bkkn_l", - "id": "00000000-0000-0002-0000-000000000000", - "locale": "co-FM", - "managed_by": "scim", - "name": "2\u0008󼕮\"\u000c\u000f{?b\"\n>q\u000fe8D󲣡􊞚􅁩{{eX|-q\u00083*59v󼳒s죠\u001b􃩧󠁼wG!uAO\rBZ\u001dF[4ᾗ\u000b|\"\u00154b\u0018tE\u0012YB\u0006\u0015l5D>%P`𧶐\u0008Z", - "picture": [], - "qualified_id": { - "domain": "w-csl2vx.rpb.fq2", - "id": "00000000-0000-0002-0000-000000000000" - }, - "service": { - "id": "00000000-0000-0001-0000-000000000000", - "provider": "00000001-0000-0000-0000-000100000000" - }, - "team": "00000002-0000-0002-0000-000200000002" -} diff --git a/libs/wire-api/test/golden/testObject_SelfProfile_user_16.json b/libs/wire-api/test/golden/testObject_SelfProfile_user_16.json deleted file mode 100644 index 7e802c25408..00000000000 --- a/libs/wire-api/test/golden/testObject_SelfProfile_user_16.json +++ /dev/null @@ -1,35 +0,0 @@ -{ - "accent_id": 2, - "assets": [ - { - "key": "", - "type": "image" - }, - { - "key": "", - "size": "complete", - "type": "image" - } - ], - "expires_at": "1864-05-11T06:04:44.922Z", - "handle": "v36sek51j__9i-w67.0foj6fpsrb_8-54_4c7yqld4cxu4emk0s67-f0oqyippzwxh9hmbrc-i0vpl0m-ww53-pku0kjb_6uprh4n6wg.xn7n9xp0t_5t.r_itjjmxjgkxud0ih083c6vscdlb-wex8no_4vlo.2llhidhq0awu3xr0craik", - "id": "00000002-0000-0002-0000-000200000000", - "locale": "zh-NF", - "managed_by": "scim", - "name": "\u001a􀸖\u0018p\u001d􁻨𣱚k󹖝󶛋纃􅸵𤑺󼲰󸕓mzSJ", - "phone": "+673892193308", - "picture": [], - "qualified_id": { - "domain": "76y01l79xajp.u5p8-qo--om", - "id": "00000000-0000-0000-0000-000000000000" - }, - "service": { - "id": "00000000-0000-0001-0000-000000000000", - "provider": "00000000-0000-0001-0000-000000000001" - }, - "sso_id": { - "subject": "", - "tenant": "" - }, - "team": "00000000-0000-0001-0000-000000000000" -} diff --git a/libs/wire-api/test/golden/testObject_SelfProfile_user_17.json b/libs/wire-api/test/golden/testObject_SelfProfile_user_17.json deleted file mode 100644 index 8d29e0c81a1..00000000000 --- a/libs/wire-api/test/golden/testObject_SelfProfile_user_17.json +++ /dev/null @@ -1,21 +0,0 @@ -{ - "accent_id": -2, - "assets": [], - "email": "@", - "expires_at": "1864-05-09T08:41:37.172Z", - "handle": "6huo", - "id": "00000001-0000-0001-0000-000200000002", - "locale": "ts-FI", - "managed_by": "scim", - "name": "T󻁎\u000eK\u0015Iwh%𖤝C\u000f!􆉧(*Iq󼅽'W𤰎c=\u0002MAK@먃\u001f\t)^x\u0018\u0018\\^'s9\u0011Qﾀ.3\u00075􅐬\u001b\u0019퐄\u001a􍂻󼆞\u0004g+W(;W[\u0012!ꁂ>𑀡:5󶇺\u0019Y-,\u0013\u0016i扡\u0010\t𢀴!a\u000e=􉠼󻧒𭬬\u0018=0\u00026,\u001czr(", - "phone": "+023372401614100", - "picture": [], - "qualified_id": { - "domain": "2.dh4", - "id": "00000001-0000-0001-0000-000000000002" - }, - "sso_id": { - "scim_external_id": "" - }, - "team": "00000001-0000-0001-0000-000200000002" -} diff --git a/libs/wire-api/test/golden/testObject_SelfProfile_user_18.json b/libs/wire-api/test/golden/testObject_SelfProfile_user_18.json deleted file mode 100644 index fcd48c5d44b..00000000000 --- a/libs/wire-api/test/golden/testObject_SelfProfile_user_18.json +++ /dev/null @@ -1,30 +0,0 @@ -{ - "accent_id": 0, - "assets": [ - { - "key": "", - "size": "complete", - "type": "image" - }, - { - "key": "", - "size": "complete", - "type": "image" - } - ], - "expires_at": "1864-05-11T16:10:28.222Z", - "id": "00000002-0000-0002-0000-000200000002", - "locale": "bs-SB", - "managed_by": "wire", - "name": "}Mr$铨Fi~O\u0019b\\䬇k􉁜󽭜\r^n􏧷8𭪵󶨩\u0018\u0012xj\u001e󻟎\u0007h\u0019𭾱)WJ>Y􅐺[\u0018󱣒ed􏺬,端=\u001eHmMV%x-^;_\u000fun", - "picture": [], - "qualified_id": { - "domain": "1.t3yc3", - "id": "00000002-0000-0000-0000-000200000002" - }, - "service": { - "id": "00000001-0000-0001-0000-000000000000", - "provider": "00000001-0000-0000-0000-000000000001" - }, - "team": "00000002-0000-0000-0000-000100000002" -} diff --git a/libs/wire-api/test/golden/testObject_SelfProfile_user_19.json b/libs/wire-api/test/golden/testObject_SelfProfile_user_19.json deleted file mode 100644 index 901f5e59d69..00000000000 --- a/libs/wire-api/test/golden/testObject_SelfProfile_user_19.json +++ /dev/null @@ -1,32 +0,0 @@ -{ - "accent_id": -2, - "assets": [ - { - "key": "", - "size": "complete", - "type": "image" - }, - { - "key": "", - "size": "preview", - "type": "image" - } - ], - "deleted": true, - "email": "?@S", - "handle": "-bc4hz9hn8ep81cxp.9_jy4wl-w2h8o34wb1we4.77yp9oai6le1fm_lshwh4_j5dhzzpkidmg23t75bzjvms7x-7v.ru1l7cqkkci9uynit6kbwinsy4fug55j5p6pek_9d5g90sx7jgixu3teh_dvo.a-l79pgpxs4iov569j4bnpv-4lck0qj5vjv.5sb9p47w_.5lfyuqcwrpeq.fqfl9miil.epxsert-dh1", - "id": "00000001-0000-0000-0000-000200000000", - "locale": "hr-BG", - "managed_by": "wire", - "name": "󳖔2􎣀𖦂\u0013B\u00155􄕿", - "picture": [], - "qualified_id": { - "domain": "8y.o9", - "id": "00000002-0000-0002-0000-000200000000" - }, - "service": { - "id": "00000000-0000-0000-0000-000000000001", - "provider": "00000001-0000-0000-0000-000000000000" - }, - "team": "00000000-0000-0000-0000-000200000002" -} diff --git a/libs/wire-api/test/golden/testObject_SelfProfile_user_2.json b/libs/wire-api/test/golden/testObject_SelfProfile_user_2.json deleted file mode 100644 index c1226df8762..00000000000 --- a/libs/wire-api/test/golden/testObject_SelfProfile_user_2.json +++ /dev/null @@ -1,38 +0,0 @@ -{ - "accent_id": -2, - "assets": [ - { - "key": "", - "type": "image" - }, - { - "key": "", - "type": "image" - }, - { - "key": "", - "type": "image" - }, - { - "key": "", - "size": "preview", - "type": "image" - } - ], - "expires_at": "1864-05-08T07:51:14.715Z", - "id": "00000002-0000-0001-0000-000200000002", - "locale": "az", - "managed_by": "scim", - "name": "􍚜৪SYMﶒ\nem\u0013\u000e\u0002𫙣THme郾꼴_Bo>%Gudt􁆶Ⳅ𮐞M󷶉𪢇W+uU[5*\u0000󴵻\u0001􋥶\"\u000b=aV3P\u0002􋵚\u0006𫔖@\tjUS\"􋈛Sng:3m^\\𪘎5䎈抠6l􃴬\u0018⽗􍚠4[\u0016bL!", - "phone": "+3387841470", - "picture": [], - "qualified_id": { - "domain": "60.3pc.a7t75j.9-3sx0.au-rt.y", - "id": "00000002-0000-0000-0000-000000000000" - }, - "service": { - "id": "00000000-0000-0000-0000-000100000001", - "provider": "00000001-0000-0001-0000-000100000000" - }, - "team": "00000000-0000-0001-0000-000200000001" -} diff --git a/libs/wire-api/test/golden/testObject_SelfProfile_user_4.json b/libs/wire-api/test/golden/testObject_SelfProfile_user_4.json deleted file mode 100644 index f43d3266ab2..00000000000 --- a/libs/wire-api/test/golden/testObject_SelfProfile_user_4.json +++ /dev/null @@ -1,22 +0,0 @@ -{ - "accent_id": 2, - "assets": [], - "email": "@", - "expires_at": "1864-05-10T10:07:20.481Z", - "handle": "sncnzzz_ffzdy-8.70xb9gni-jtexm4lbr4h9an", - "id": "00000002-0000-0001-0000-000200000001", - "locale": "af-MV", - "managed_by": "scim", - "name": "/RCd𧶤𭉜:\u001ba%[⣐𭓍𛃶F\u000c@#{U\rn𫆕", - "phone": "+30745803086", - "picture": [], - "qualified_id": { - "domain": "fa3gz465.g-2", - "id": "00000002-0000-0000-0000-000200000000" - }, - "service": { - "id": "00000000-0000-0001-0000-000000000000", - "provider": "00000001-0000-0001-0000-000100000000" - }, - "team": "00000000-0000-0000-0000-000100000002" -} diff --git a/libs/wire-api/test/golden/testObject_SelfProfile_user_5.json b/libs/wire-api/test/golden/testObject_SelfProfile_user_5.json deleted file mode 100644 index 4fd48c024ad..00000000000 --- a/libs/wire-api/test/golden/testObject_SelfProfile_user_5.json +++ /dev/null @@ -1,28 +0,0 @@ -{ - "accent_id": 2, - "assets": [ - { - "key": "𐒒", - "size": "preview", - "type": "image" - } - ], - "deleted": true, - "expires_at": "1864-05-10T10:30:21.640Z", - "handle": "29", - "id": "00000001-0000-0000-0000-000100000001", - "locale": "tr-CZ", - "managed_by": "scim", - "name": "\u0004𭸣dE0K𪑬:􌚀^v𢼐􏕨G0𮖀_7𡕳a\u0006󵃸&p\u001a`\r6\ro\\􁠥[\u0016>9lx叻V諛p\u001c󷞮<>j{", - "phone": "+11141922", - "picture": [], - "qualified_id": { - "domain": "90i1.84arbm9252qg.b", - "id": "00000002-0000-0001-0000-000100000000" - }, - "service": { - "id": "00000000-0000-0001-0000-000100000001", - "provider": "00000000-0000-0000-0000-000100000001" - }, - "team": "00000001-0000-0002-0000-000200000002" -} diff --git a/libs/wire-api/test/golden/testObject_SelfProfile_user_6.json b/libs/wire-api/test/golden/testObject_SelfProfile_user_6.json deleted file mode 100644 index 79fce062540..00000000000 --- a/libs/wire-api/test/golden/testObject_SelfProfile_user_6.json +++ /dev/null @@ -1,33 +0,0 @@ -{ - "accent_id": 2, - "assets": [ - { - "key": "", - "type": "image" - }, - { - "key": "", - "type": "image" - }, - { - "key": "", - "size": "complete", - "type": "image" - } - ], - "id": "00000000-0000-0002-0000-000100000000", - "locale": "mi-VE", - "managed_by": "scim", - "name": "􃫍\"3@n􂃩𬾹z6w3lCo+🐩]6\u0005􄷦2􂬒EVQ\u0000􁺗1\u0002\u001c^勯}C", - "phone": "+73308549330", - "picture": [], - "qualified_id": { - "domain": "u54.h8--m0--752", - "id": "00000002-0000-0002-0000-000000000001" - }, - "service": { - "id": "00000000-0000-0001-0000-000100000000", - "provider": "00000000-0000-0001-0000-000000000000" - }, - "team": "00000001-0000-0001-0000-000200000001" -} diff --git a/libs/wire-api/test/golden/testObject_SelfProfile_user_7.json b/libs/wire-api/test/golden/testObject_SelfProfile_user_7.json deleted file mode 100644 index dd73f46992f..00000000000 --- a/libs/wire-api/test/golden/testObject_SelfProfile_user_7.json +++ /dev/null @@ -1,21 +0,0 @@ -{ - "accent_id": 0, - "assets": [], - "email": ":@\u0007", - "expires_at": "1864-05-09T09:08:35.327Z", - "handle": "_5dpks7l", - "id": "00000001-0000-0001-0000-000000000000", - "locale": "zh-AX", - "managed_by": "scim", - "name": "\u001cz󴓣􊍿(Y噫Z5FGu'􆱂HB+e&%\r\u001f256𭝇HHa\"or!uV\u0015T飯<\u0019pH", - "picture": [] -} diff --git a/libs/wire-api/test/golden/testObject_UserUpdate_user_12.json b/libs/wire-api/test/golden/testObject_UserUpdate_user_12.json deleted file mode 100644 index fdb1684bf7d..00000000000 --- a/libs/wire-api/test/golden/testObject_UserUpdate_user_12.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "accent_id": 6, - "name": "\r󽱺Z\u0018&zv󷦇\u0006vz􌬚𦪟󱋶ex=3\u0002􊮖\n;@tᗇt,!Dx󺭸~\"iks\u0008!R𫚭MT𠺟\u001c%\u0018g內\u0008x\u001d􍻁𮃈4V\u0001􊏿\u001e\u0010旁.㪄a󲗃\u0004_+M\u00008GY%\n􋎣\u0000}!tIB", - "picture": [] -} diff --git a/libs/wire-api/test/golden/testObject_UserUpdate_user_13.json b/libs/wire-api/test/golden/testObject_UserUpdate_user_13.json deleted file mode 100644 index 749452cadb8..00000000000 --- a/libs/wire-api/test/golden/testObject_UserUpdate_user_13.json +++ /dev/null @@ -1,34 +0,0 @@ -{ - "accent_id": 2, - "assets": [ - { - "key": "?w", - "size": "complete", - "type": "image" - }, - { - "key": "", - "size": "complete", - "type": "image" - }, - { - "key": "􇉀1", - "size": "preview", - "type": "image" - }, - { - "key": "i\u0006", - "type": "image" - }, - { - "key": "􉡄\u0013𮭁", - "type": "image" - }, - { - "key": "U􍜕,", - "size": "complete", - "type": "image" - } - ], - "name": "󿂿9k\u0008E\u0000\"9d\u0015􎻻8Z㭢.(+: _7As~𞤪\u0001𢘫󼅄D􈾭yC$󳒞Q\u0011\u0014󷣼6[󼤖𪹝?፼P蝔1!N\n􄼟4V\u001ck\u0000\u0001_-郸󹙛\n;&m\u0005\t𨢈D1V25^𡢈#s􄓛2l𪼃\u000f􃆴𭳒\u001d􃨏[ L𫩇V􌂍\u0012\u001f䭩\u0008𘢆󽈅K󷥤:UMM1H\tk" -} diff --git a/libs/wire-api/test/golden/testObject_UserUpdate_user_14.json b/libs/wire-api/test/golden/testObject_UserUpdate_user_14.json deleted file mode 100644 index 96bd98b307a..00000000000 --- a/libs/wire-api/test/golden/testObject_UserUpdate_user_14.json +++ /dev/null @@ -1,11 +0,0 @@ -{ - "assets": [ - { - "key": "﴿𝤂", - "size": "complete", - "type": "image" - } - ], - "name": "/H\u0011Toc\u0014\u0011퍣`{0𥦑[\u0001<𤫙􅷲\u0015m\u0003|Wd|󶈡\u0013\u001d󽸃\u0001n􌰱𢔬wuN􁙉tvB/En|2^n𩳸_K󶂡4\u0018\u0017󷠃􉤡D𨜛R'q6\u0014?\u0012\u0002AEO((W󵓺r'C󸯯\u001a\u0002+M\u000eE\u0013hi\u0018솎8𭪌\u0000#\u0018⚹Ex𢥉𠰨Av&=&%𠂌H}p嶹grJ𝘰d", - "picture": [] -} diff --git a/libs/wire-api/test/golden/testObject_UserUpdate_user_15.json b/libs/wire-api/test/golden/testObject_UserUpdate_user_15.json deleted file mode 100644 index 7a06aa6521b..00000000000 --- a/libs/wire-api/test/golden/testObject_UserUpdate_user_15.json +++ /dev/null @@ -1,22 +0,0 @@ -{ - "accent_id": -2, - "assets": [ - { - "key": "𨱔", - "size": "preview", - "type": "image" - }, - { - "key": "", - "size": "preview", - "type": "image" - }, - { - "key": "%", - "size": "preview", - "type": "image" - } - ], - "name": "䆮e𥿌:󲙸\u0000z\u0012\u001amx𬁿󽍻\u000bꔜu􆊦J핡#ᅫ]|􏬜%𛊕~zM6*-𖭥~\u0018Xm𬊞R!v􅍱Nano􉐑uf7􅮽TP\u0017𥌴🃳𮪄!O\u0015ꔩ\u0006\u001b\u0014𐆓\u0004H|镐K\u001d1,RzU`(\u0000𦓁𫖦:4\\%𫮈dc〫w\u000bd\n󺩧𥒒􌑯\u000e󴞟d\u0004􉴭G\u00040􂓐\u001f\u0015tH\u0018N𤆟봃E\u001e󵶧", - "picture": [] -} diff --git a/libs/wire-api/test/golden/testObject_UserUpdate_user_16.json b/libs/wire-api/test/golden/testObject_UserUpdate_user_16.json deleted file mode 100644 index 44c15822a80..00000000000 --- a/libs/wire-api/test/golden/testObject_UserUpdate_user_16.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "assets": [], - "name": "\ncV~sD!􂐁螧sU\u0010\t>*\u0000,h<􋹌.l^X\u001f𭭩oc9;􇂍􁴳\u0015nofI~𡆍\u0012L􋈓􋥛\u001b\u0004󻷾;\\%󵠽$𨽊6e􊖩?0\u000fAk", - "picture": [] -} diff --git a/libs/wire-api/test/golden/testObject_UserUpdate_user_17.json b/libs/wire-api/test/golden/testObject_UserUpdate_user_17.json deleted file mode 100644 index ff47a4bcff8..00000000000 --- a/libs/wire-api/test/golden/testObject_UserUpdate_user_17.json +++ /dev/null @@ -1,24 +0,0 @@ -{ - "accent_id": 6, - "assets": [ - { - "key": ")E𘥋", - "type": "image" - }, - { - "key": "c\u0012/", - "size": "preview", - "type": "image" - }, - { - "key": "6OT", - "type": "image" - }, - { - "key": "B", - "size": "complete", - "type": "image" - } - ], - "picture": [] -} diff --git a/libs/wire-api/test/golden/testObject_UserUpdate_user_18.json b/libs/wire-api/test/golden/testObject_UserUpdate_user_18.json deleted file mode 100644 index eff43e55553..00000000000 --- a/libs/wire-api/test/golden/testObject_UserUpdate_user_18.json +++ /dev/null @@ -1,24 +0,0 @@ -{ - "accent_id": 7, - "assets": [ - { - "key": "r󶾐s", - "type": "image" - }, - { - "key": "", - "type": "image" - }, - { - "key": "H", - "size": "complete", - "type": "image" - }, - { - "key": "", - "type": "image" - } - ], - "name": "\u0014}𮬚$.3Z\u0016X󹕵:\u000223𠤂􆽩v􉘠\u0018\u0013\u0017r2%sf\u0007\\󿜝\u0006畁{$,𝗆\u0019x\u000e-t눘󰳌y\u001e𬃇R\u0001G𧏺\"\u0018.𥽑𧩅`UJe\"\r\u0007=.2\u0015\u001d\u0003W\u000e􈤹n*2􅯒@VK\u0016@Q,@E_~\u0005i\u001b~􂇁;!II,k07􊛮2\u0003\u001b", - "picture": [] -} diff --git a/libs/wire-api/test/golden/testObject_UserUpdate_user_19.json b/libs/wire-api/test/golden/testObject_UserUpdate_user_19.json deleted file mode 100644 index 2f222c3924b..00000000000 --- a/libs/wire-api/test/golden/testObject_UserUpdate_user_19.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "accent_id": 0, - "picture": [] -} diff --git a/libs/wire-api/test/golden/testObject_UserUpdate_user_20.json b/libs/wire-api/test/golden/testObject_UserUpdate_user_20.json deleted file mode 100644 index cf120e43d8f..00000000000 --- a/libs/wire-api/test/golden/testObject_UserUpdate_user_20.json +++ /dev/null @@ -1,4 +0,0 @@ -{ - "accent_id": -1, - "name": "D]980󰑉)e󲉋:?s$QP籜_\u0014qyj𥱤𡰮\u0014x\u001aq6uwz𬑬趕􀒆\u0014􄸥\u000e\u0001\u001az󿣬D\r\u0003􇡣6NK󸼓f/OK𗯜\u0005r\u0004y*\u0015\u001fA{\u0017}\u0015rr(X^`\t_W}L􁊀\u000cUy\u001a\r𡰧sMᆾ\u001d7\u000c󻫧:􃰂B\u001d􃴗\u0002)󴘫k\u001bj\u0011\u0015󳠩;f*" -} diff --git a/libs/wire-api/test/golden/testObject_UserUpdate_user_3.json b/libs/wire-api/test/golden/testObject_UserUpdate_user_3.json deleted file mode 100644 index 10aaddd80f6..00000000000 --- a/libs/wire-api/test/golden/testObject_UserUpdate_user_3.json +++ /dev/null @@ -1,37 +0,0 @@ -{ - "accent_id": -5, - "assets": [ - { - "key": "`蓒", - "type": "image" - }, - { - "key": "", - "size": "complete", - "type": "image" - }, - { - "key": "4\u0006E", - "size": "preview", - "type": "image" - }, - { - "key": "", - "type": "image" - }, - { - "key": "", - "type": "image" - }, - { - "key": "", - "type": "image" - }, - { - "key": "\u0002f", - "size": "preview", - "type": "image" - } - ], - "picture": [] -} diff --git a/libs/wire-api/test/golden/testObject_UserUpdate_user_4.json b/libs/wire-api/test/golden/testObject_UserUpdate_user_4.json deleted file mode 100644 index edc4adc188a..00000000000 --- a/libs/wire-api/test/golden/testObject_UserUpdate_user_4.json +++ /dev/null @@ -1,26 +0,0 @@ -{ - "accent_id": 2, - "assets": [ - { - "key": "W%", - "size": "preview", - "type": "image" - }, - { - "key": "", - "type": "image" - }, - { - "key": "", - "size": "preview", - "type": "image" - }, - { - "key": "e\u0016󷜨", - "size": "preview", - "type": "image" - } - ], - "name": "䚢\\5-`\u000c𥾪T\u001a|\rD𣿲GV􇍟떿nt@,5󶃑Ux0M􊹍\u0018rf돤+󴼷\u0018𥢽4L纍]+u\u0000󹰫\t6𨉊z\u000co匧\u0000𤸨d\u0000\u001a𗤍\u0007\u001d", - "picture": [] -} diff --git a/libs/wire-api/test/golden/testObject_UserUpdate_user_5.json b/libs/wire-api/test/golden/testObject_UserUpdate_user_5.json deleted file mode 100644 index bae4da54f78..00000000000 --- a/libs/wire-api/test/golden/testObject_UserUpdate_user_5.json +++ /dev/null @@ -1,11 +0,0 @@ -{ - "accent_id": -8, - "assets": [ - { - "key": "R󴕥", - "size": "complete", - "type": "image" - } - ], - "name": "}C)BJ\u001aM1\u001c􁀀\u0010𭜉\u000cT\u001f}lG}B4D\u001c/Y􁲒\u0014g󼛅I󲌈\n%𪁺p" -} diff --git a/libs/wire-api/test/golden/testObject_UserUpdate_user_6.json b/libs/wire-api/test/golden/testObject_UserUpdate_user_6.json deleted file mode 100644 index 0e152a804b2..00000000000 --- a/libs/wire-api/test/golden/testObject_UserUpdate_user_6.json +++ /dev/null @@ -1,6 +0,0 @@ -{ - "accent_id": -2, - "assets": [], - "name": "𫳳ᯩ6U5!E󺤔nyH􂳮𗉴B$\u0010\u0013-\u0011󳷥󾆊󻅻rO\u001b\u0007\u001c󺽡􍅖`i`𦲾m/YzFX:ZRzꀌ\u001c󲮨𧝰75", - "picture": [] -} diff --git a/libs/wire-api/test/golden/testObject_UserUpdate_user_7.json b/libs/wire-api/test/golden/testObject_UserUpdate_user_7.json deleted file mode 100644 index 3aed506fac1..00000000000 --- a/libs/wire-api/test/golden/testObject_UserUpdate_user_7.json +++ /dev/null @@ -1,12 +0,0 @@ -{ - "accent_id": 6, - "assets": [ - { - "key": "nC", - "size": "preview", - "type": "image" - } - ], - "name": "\u000c/\r􅳽𧊏\u0000􆰡}A[D 𪏷\u0019]Q\u0006#:!q+$&\u0017𫹿#\u000f\u0008^2\u000b땃\u000csPB󷆺o:𩵡;󴫥+稦'm􄢾􉰓3X!ELsR\u001d%瓝\u0003摺\u0012d#Q\u0011(H􂈰Al+E[\u0001󾶺\u0014)𤢢𪠛󾃺\u0000󼻛\u001b\u001d\u001d\u0011q\u0007_󾺰.Cq;O􃍮\t\u001e\u001a肟仝𦚎", - "phone": "+9360086324", - "picture": [], - "qualified_id": { - "domain": "94.eg8.s1.u", - "id": "00000002-0000-0001-0000-000000000000" - }, - "service": { - "id": "00000000-0000-0000-0000-000000000000", - "provider": "00000000-0000-0000-0000-000100000001" - }, - "team": "00000001-0000-0000-0000-000200000000" -} diff --git a/libs/wire-api/test/golden/testObject_User_user_12.json b/libs/wire-api/test/golden/testObject_User_user_12.json deleted file mode 100644 index 8947f401b37..00000000000 --- a/libs/wire-api/test/golden/testObject_User_user_12.json +++ /dev/null @@ -1,25 +0,0 @@ -{ - "accent_id": -2, - "assets": [ - { - "key": "", - "size": "complete", - "type": "image" - } - ], - "deleted": true, - "handle": "jor0tv5x7jcptbelj4lb8asjp6-1knhjb0y44uxc5m7apnyzwqg-v.cnnbpxmbr_7tcmygsn5wvnjtb8uzvprai6ayk4kp9gcwtkpsadfs7bqz9qk6.nyeone71vfmmfnvw0f6._4apxbqrpju3v-z-l0osvpfdaajsyyr2bvdq_sffgw12.9gr3zl_d43rrc5.zz0xhxqqvv12l85t2u31_c-gdbr", - "id": "00000000-0000-0000-0000-000200000001", - "locale": "de-CY", - "managed_by": "scim", - "name": "aM䄩\t_%\"z>3𣍧\u0013!yrxp䋃\u0007]0RQp5}v𬥊bn6󱔔󲼬g\u001cDC󽹘\rNl\u0016\\􋠰𘣀􀤪_𣭹$,_kk\t.C brXI􇹅\"+p􋒳H4'$\u0013\u001fv?rf0d5w􅰠0", - "picture": [], - "qualified_id": { - "domain": "36c48v3.j22", - "id": "00000002-0000-0000-0000-000200000002" - }, - "service": { - "id": "00000000-0000-0001-0000-000100000000", - "provider": "00000000-0000-0001-0000-000100000000" - } -} diff --git a/libs/wire-api/test/golden/testObject_User_user_13.json b/libs/wire-api/test/golden/testObject_User_user_13.json deleted file mode 100644 index 354b1323bad..00000000000 --- a/libs/wire-api/test/golden/testObject_User_user_13.json +++ /dev/null @@ -1,27 +0,0 @@ -{ - "accent_id": 1, - "assets": [ - { - "key": "H", - "size": "preview", - "type": "image" - } - ], - "expires_at": "1864-05-10T06:01:03.394Z", - "handle": "jq-b_m8hdt36tw9a4owiboeuv8rzxih0g", - "id": "00000000-0000-0001-0000-000000000000", - "locale": "ba-DM", - "managed_by": "wire", - "name": "/씬e9s\u001f\u0006󼒍*􆄦!;$$rF4?㆖\u0008~{]\u0005~􃉝Ic&&𝐠S騊􃬮{𗧟oW𤺳𠲂?󾒊&&,\r\u0007>9V5&e+O\u0004?m󿷕M𫊷V􅛗󾀌\u000b󼑐𣡯#jm@󼔩x􌚶\u0008Ḣ1gZ", - "phone": "+8377346869260", - "picture": [], - "qualified_id": { - "domain": "m.gs-h8m3", - "id": "00000002-0000-0002-0000-000100000002" - }, - "team": "00000001-0000-0002-0000-000100000000" -} diff --git a/libs/wire-api/test/golden/testObject_User_user_2.json b/libs/wire-api/test/golden/testObject_User_user_2.json index 93a131ce181..a1d8041884c 100644 --- a/libs/wire-api/test/golden/testObject_User_user_2.json +++ b/libs/wire-api/test/golden/testObject_User_user_2.json @@ -14,20 +14,6 @@ "key": "", "size": "complete", "type": "image" - }, - { - "key": "", - "size": "preview", - "type": "image" - }, - { - "key": "", - "type": "image" - }, - { - "key": "", - "size": "preview", - "type": "image" } ], "deleted": true, diff --git a/libs/wire-api/test/golden/testObject_User_user_20.json b/libs/wire-api/test/golden/testObject_User_user_20.json deleted file mode 100644 index dfe6441bbdd..00000000000 --- a/libs/wire-api/test/golden/testObject_User_user_20.json +++ /dev/null @@ -1,21 +0,0 @@ -{ - "accent_id": 1, - "assets": [], - "expires_at": "1864-05-10T13:00:07.275Z", - "handle": "apdh51n9mpxew4sose_n_mu", - "id": "00000001-0000-0000-0000-000100000001", - "locale": "cu", - "managed_by": "wire", - "name": "bW\\&𨢆𢡒\\k𥥗搑􆢭0\u0015i龍GRh\u0015h\u0018O\u0017J󶷜s_󱬘jV\u000f\u0011\u0002􎄣~N(\u0003rj1r^􈆸Zaw𤪸􉕟j𠍜󻆽𭕼𠶒N\u0001瞱ex8*飵A\u0012nkzr筧{j\u0001-g󷍆=d<\\Pc+K(vZ\u001c", - "phone": "+43245195312227", - "picture": [], - "qualified_id": { - "domain": "6mlxl.2v5.gd7", - "id": "00000000-0000-0000-0000-000200000000" - }, - "service": { - "id": "00000000-0000-0001-0000-000100000001", - "provider": "00000001-0000-0001-0000-000000000000" - }, - "team": "00000000-0000-0000-0000-000200000000" -} diff --git a/libs/wire-api/test/golden/testObject_User_user_3.json b/libs/wire-api/test/golden/testObject_User_user_3.json index ccb088167c2..56a5d1c0d39 100644 --- a/libs/wire-api/test/golden/testObject_User_user_3.json +++ b/libs/wire-api/test/golden/testObject_User_user_3.json @@ -2,13 +2,13 @@ "accent_id": -2, "assets": [], "deleted": true, + "email": "f@𔒫", "expires_at": "1864-05-09T20:12:05.821Z", "handle": "1c", "id": "00000002-0000-0000-0000-000100000000", "locale": "tg-UA", "managed_by": "wire", "name": ",r\u0019XEg0$𗾋\u001e\u000f'uS\u0003/󶙆`äV.J{\u000cgE(\rK!\u000ep8s9gXO唲Xj\u0002\u001e\u0012", - "phone": "+025643547231991", "picture": [], "qualified_id": { "domain": "dt.n", @@ -18,9 +18,5 @@ "id": "00000001-0000-0001-0000-000100000000", "provider": "00000001-0000-0000-0000-000100000000" }, - "sso_id": { - "subject": "", - "tenant": "" - }, "team": "00000002-0000-0001-0000-000200000000" } diff --git a/libs/wire-api/test/golden/testObject_User_user_4.json b/libs/wire-api/test/golden/testObject_User_user_4.json index 76d106c0a5c..ddcb4711156 100644 --- a/libs/wire-api/test/golden/testObject_User_user_4.json +++ b/libs/wire-api/test/golden/testObject_User_user_4.json @@ -3,7 +3,7 @@ "assets": [], "email": "@", "expires_at": "1864-05-09T14:25:26.089Z", - "handle": "mzebw5l9p858om29lqwj5d08otrwzzickuh_s8dpookvkl_ryzbsvw-ogxrwyiw2-.udd2l7us58siy2rp024r9-ezsotchneqgalz1y1ltna7yg3dfg.wzn4vx3hjhch8.-pi3azd9u3l-5t6uyjqk93twvx_3gdh32e82fsrdpf8qfsi2ls-a2pce8p1xjh7387nztzu.q", + "handle": "iw2-.udd2l7-7yg3dfg.wzn4vx3hjhch8.--5t6uyjqk93twv-a2pce8p1xjh7387nztzu.q", "id": "00000002-0000-0001-0000-000100000002", "locale": "bi-MQ", "managed_by": "scim", diff --git a/libs/wire-api/test/golden/testObject_User_user_5.json b/libs/wire-api/test/golden/testObject_User_user_5.json index cc5bda97636..01e0284bf5f 100644 --- a/libs/wire-api/test/golden/testObject_User_user_5.json +++ b/libs/wire-api/test/golden/testObject_User_user_5.json @@ -1,28 +1,22 @@ { - "accent_id": -2, - "assets": [ - { - "key": "", - "size": "preview", - "type": "image" - } - ], - "deleted": true, - "email": "f@𔒫", - "expires_at": "1864-05-11T20:43:46.798Z", - "handle": "hb", - "id": "00000002-0000-0002-0000-000100000002", - "locale": "et-NF", + "accent_id": 0, + "assets": [], + "email": "@", + "expires_at": "1864-05-09T14:25:26.089Z", + "handle": "iw2-.udd2l7-7yg3dfg.wzn4vx3hjhch8.--5t6uyjqk93twv-a2pce8p1xjh7387nztzu.q", + "id": "00000002-0000-0001-0000-000100000002", + "locale": "bi-MQ", "managed_by": "scim", - "name": "[|u\u0007FH􈨳\u0013𨍦𫯯k#􄧗fN4\u001a#G󵅱\u000ekK\u001d󿲷yP􄄪|H🧊\u000bi\rAcUp\u000e\u001f", + "name": "^󺝨F􈝼=&o>f<7\u000eq|6\u0011\u0019󳟧􁗄\u001bf󷯶𩣇\u0013bnVAj`^L\u000c󿮁\u001fLI\u0005!􃈈\u0017`󾒁\u0003e曉\u001aK|", + "phone": "+837934954", "picture": [], "qualified_id": { - "domain": "k.ma656.845z--u9.34.4ot8v.p6-2o", - "id": "00000002-0000-0000-0000-000200000002" + "domain": "28b.cqb", + "id": "00000000-0000-0002-0000-000200000002" }, "service": { - "id": "00000000-0000-0000-0000-000000000000", - "provider": "00000000-0000-0000-0000-000100000000" + "id": "00000000-0000-0001-0000-000100000000", + "provider": "00000000-0000-0000-0000-000000000000" }, - "team": "00000000-0000-0001-0000-000200000000" + "team": "00000000-0000-0000-0000-000100000002" } diff --git a/libs/wire-api/test/golden/testObject_User_user_6.json b/libs/wire-api/test/golden/testObject_User_user_6.json deleted file mode 100644 index 17d4a0112a9..00000000000 --- a/libs/wire-api/test/golden/testObject_User_user_6.json +++ /dev/null @@ -1,30 +0,0 @@ -{ - "accent_id": -1, - "assets": [ - { - "key": "􌡐", - "size": "complete", - "type": "image" - } - ], - "deleted": true, - "handle": "hp95jkglpreb88pm0w.35i6za1241dt2el.8s1msvq2u4aov_muws4n4xdvv-ocd95oqqbb7.eqdi1hmudsh_9h0nt0o0gtkpnm7xu494-nl6ljfoxsxlm.66l8ny3yejd2fqb5y.zpi2rgo-f8yhkwl0k7.a91kdxflxx4.am_ka62kebtexj97f07bko4t2.6tr1rx1cbabnk0w_dz714nmenx8bscvdw8_ay1o", - "id": "00000002-0000-0000-0000-000100000002", - "locale": "tw-BD", - "managed_by": "wire", - "name": "󲔐RiM2\u0013􍱅#5T-~=#\u000f􂰀rf󲯵}\u0001𪅎\\K𤓻\u0012I\n\u000ez'貎\u001a\u0016>p􎠘\u001c\\(𨵄󻿐󾦲j􀥳M|𨸴\u0014c𬒿`/\tpU]#\u000f􁷟(9\u0015V𤌛23i𢦏\u0019gs[\u001f:\\􅸋", - "phone": "+90270460", - "picture": [], - "qualified_id": { - "domain": "u8-9--eppc-k-02.l5-ci5zk", - "id": "00000000-0000-0000-0000-000000000001" - }, - "service": { - "id": "00000000-0000-0000-0000-000000000001", - "provider": "00000001-0000-0001-0000-000100000001" - }, - "sso_id": { - "subject": "", - "tenant": "" - } -} diff --git a/libs/wire-api/test/golden/testObject_User_user_7.json b/libs/wire-api/test/golden/testObject_User_user_7.json deleted file mode 100644 index b3a95f938e4..00000000000 --- a/libs/wire-api/test/golden/testObject_User_user_7.json +++ /dev/null @@ -1,28 +0,0 @@ -{ - "accent_id": -1, - "assets": [ - { - "key": ";", - "size": "preview", - "type": "image" - } - ], - "deleted": true, - "email": "@o", - "expires_at": "1864-05-09T16:08:44.186Z", - "handle": "t.w_8.", - "id": "00000002-0000-0001-0000-000200000002", - "locale": "ve-BS", - "managed_by": "scim", - "name": "$]\u0004e<&\u0007KfM", - "picture": [], - "qualified_id": { - "domain": "7sb.43o7z--k8.k-7", - "id": "00000002-0000-0001-0000-000200000001" - }, - "service": { - "id": "00000001-0000-0001-0000-000100000001", - "provider": "00000000-0000-0001-0000-000100000000" - }, - "team": "00000000-0000-0002-0000-000200000001" -} diff --git a/libs/wire-api/test/golden/testObject_User_user_8.json b/libs/wire-api/test/golden/testObject_User_user_8.json deleted file mode 100644 index 5f3ddcbdd9c..00000000000 --- a/libs/wire-api/test/golden/testObject_User_user_8.json +++ /dev/null @@ -1,20 +0,0 @@ -{ - "accent_id": -2, - "assets": [ - { - "key": "", - "size": "complete", - "type": "image" - } - ], - "email": "@", - "id": "00000002-0000-0000-0000-000100000000", - "locale": "ka-AQ", - "managed_by": "wire", - "name": "?𢴠𘪊w\nLi\u0008\u0011{[8\nd}甤.Wh^z𒌦రV}\u000bAPy\u0012sgvk󹃶 5􀓷(5\u000b\u001f_y곕dcfc즎ℛ)fK\u0012A󳑬􃊪zu􄨦GEk\u000bQ􂾔𣏈\u0000󳟁5雛\u000b", - "picture": [], - "qualified_id": { - "domain": "2v.k55u", - "id": "00000002-0000-0000-0000-000100000002" - } -} diff --git a/libs/wire-api/test/golden/testObject_User_user_9.json b/libs/wire-api/test/golden/testObject_User_user_9.json deleted file mode 100644 index d908944e11e..00000000000 --- a/libs/wire-api/test/golden/testObject_User_user_9.json +++ /dev/null @@ -1,22 +0,0 @@ -{ - "accent_id": -2, - "assets": [], - "email": "@\u001b", - "expires_at": "1864-05-11T13:40:26.091Z", - "handle": "qptpyy3", - "id": "00000002-0000-0002-0000-000100000001", - "locale": "tl-MO", - "managed_by": "scim", - "name": "P􂫝o1qr1(k󱆙-\u001fW\u0016𖢮TX9F@\u001d\u0019\u0018`傫\u00054\u0004@", - "phone": "+783368053", - "picture": [], - "qualified_id": { - "domain": "9.fs7-3.x-0", - "id": "00000000-0000-0000-0000-000200000000" - }, - "service": { - "id": "00000000-0000-0001-0000-000100000001", - "provider": "00000001-0000-0000-0000-000000000000" - }, - "team": "00000000-0000-0002-0000-000100000001" -} 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 22a1aa00539..c08a1e30054 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 @@ -909,15 +909,65 @@ tests = ) ], testGroup "Golden: User_user" $ - testObjects [(Test.Wire.API.Golden.Generated.User_user.testObject_User_user_1, "testObject_User_user_1.json"), (Test.Wire.API.Golden.Generated.User_user.testObject_User_user_2, "testObject_User_user_2.json"), (Test.Wire.API.Golden.Generated.User_user.testObject_User_user_3, "testObject_User_user_3.json"), (Test.Wire.API.Golden.Generated.User_user.testObject_User_user_4, "testObject_User_user_4.json"), (Test.Wire.API.Golden.Generated.User_user.testObject_User_user_5, "testObject_User_user_5.json"), (Test.Wire.API.Golden.Generated.User_user.testObject_User_user_6, "testObject_User_user_6.json"), (Test.Wire.API.Golden.Generated.User_user.testObject_User_user_7, "testObject_User_user_7.json"), (Test.Wire.API.Golden.Generated.User_user.testObject_User_user_8, "testObject_User_user_8.json"), (Test.Wire.API.Golden.Generated.User_user.testObject_User_user_9, "testObject_User_user_9.json"), (Test.Wire.API.Golden.Generated.User_user.testObject_User_user_10, "testObject_User_user_10.json"), (Test.Wire.API.Golden.Generated.User_user.testObject_User_user_11, "testObject_User_user_11.json"), (Test.Wire.API.Golden.Generated.User_user.testObject_User_user_12, "testObject_User_user_12.json"), (Test.Wire.API.Golden.Generated.User_user.testObject_User_user_13, "testObject_User_user_13.json"), (Test.Wire.API.Golden.Generated.User_user.testObject_User_user_14, "testObject_User_user_14.json"), (Test.Wire.API.Golden.Generated.User_user.testObject_User_user_15, "testObject_User_user_15.json"), (Test.Wire.API.Golden.Generated.User_user.testObject_User_user_16, "testObject_User_user_16.json"), (Test.Wire.API.Golden.Generated.User_user.testObject_User_user_17, "testObject_User_user_17.json"), (Test.Wire.API.Golden.Generated.User_user.testObject_User_user_18, "testObject_User_user_18.json"), (Test.Wire.API.Golden.Generated.User_user.testObject_User_user_19, "testObject_User_user_19.json"), (Test.Wire.API.Golden.Generated.User_user.testObject_User_user_20, "testObject_User_user_20.json")], + testObjects + [ ( Test.Wire.API.Golden.Generated.User_user.testObject_User_user_1, + "testObject_User_user_1.json" + ), + ( Test.Wire.API.Golden.Generated.User_user.testObject_User_user_2, + "testObject_User_user_2.json" + ), + ( Test.Wire.API.Golden.Generated.User_user.testObject_User_user_3, + "testObject_User_user_3.json" + ), + ( Test.Wire.API.Golden.Generated.User_user.testObject_User_user_4, + "testObject_User_user_4.json" + ), + ( Test.Wire.API.Golden.Generated.User_user.testObject_User_user_5, + "testObject_User_user_5.json" + ) + ], testGroup "Golden: SelfProfile_user" $ - testObjects [(Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_1, "testObject_SelfProfile_user_1.json"), (Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_2, "testObject_SelfProfile_user_2.json"), (Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_3, "testObject_SelfProfile_user_3.json"), (Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_4, "testObject_SelfProfile_user_4.json"), (Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_5, "testObject_SelfProfile_user_5.json"), (Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_6, "testObject_SelfProfile_user_6.json"), (Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_7, "testObject_SelfProfile_user_7.json"), (Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_8, "testObject_SelfProfile_user_8.json"), (Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_9, "testObject_SelfProfile_user_9.json"), (Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_10, "testObject_SelfProfile_user_10.json"), (Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_11, "testObject_SelfProfile_user_11.json"), (Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_12, "testObject_SelfProfile_user_12.json"), (Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_13, "testObject_SelfProfile_user_13.json"), (Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_14, "testObject_SelfProfile_user_14.json"), (Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_15, "testObject_SelfProfile_user_15.json"), (Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_16, "testObject_SelfProfile_user_16.json"), (Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_17, "testObject_SelfProfile_user_17.json"), (Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_18, "testObject_SelfProfile_user_18.json"), (Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_19, "testObject_SelfProfile_user_19.json"), (Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_20, "testObject_SelfProfile_user_20.json")], + testObjects + [ ( Test.Wire.API.Golden.Generated.SelfProfile_user.testObject_SelfProfile_user_1, + "testObject_SelfProfile_user_1.json" + ) + ], testGroup "Golden: InvitationCode_user" $ - testObjects [(Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_1, "testObject_InvitationCode_user_1.json"), (Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_2, "testObject_InvitationCode_user_2.json"), (Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_3, "testObject_InvitationCode_user_3.json"), (Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_4, "testObject_InvitationCode_user_4.json"), (Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_5, "testObject_InvitationCode_user_5.json"), (Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_6, "testObject_InvitationCode_user_6.json"), (Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_7, "testObject_InvitationCode_user_7.json"), (Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_8, "testObject_InvitationCode_user_8.json"), (Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_9, "testObject_InvitationCode_user_9.json"), (Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_10, "testObject_InvitationCode_user_10.json"), (Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_11, "testObject_InvitationCode_user_11.json"), (Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_12, "testObject_InvitationCode_user_12.json"), (Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_13, "testObject_InvitationCode_user_13.json"), (Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_14, "testObject_InvitationCode_user_14.json"), (Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_15, "testObject_InvitationCode_user_15.json"), (Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_16, "testObject_InvitationCode_user_16.json"), (Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_17, "testObject_InvitationCode_user_17.json"), (Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_18, "testObject_InvitationCode_user_18.json"), (Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_19, "testObject_InvitationCode_user_19.json"), (Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_20, "testObject_InvitationCode_user_20.json")], + testObjects + [ ( Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_1, + "testObject_InvitationCode_user_1.json" + ), + ( Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_2, + "testObject_InvitationCode_user_2.json" + ), + ( Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_3, + "testObject_InvitationCode_user_3.json" + ), + ( Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_4, + "testObject_InvitationCode_user_4.json" + ), + ( Test.Wire.API.Golden.Generated.InvitationCode_user.testObject_InvitationCode_user_5, + "testObject_InvitationCode_user_5.json" + ) + ], testGroup "Golden: BindingNewTeamUser_user" $ - testObjects [(Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_1, "testObject_BindingNewTeamUser_user_1.json"), (Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_2, "testObject_BindingNewTeamUser_user_2.json"), (Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_3, "testObject_BindingNewTeamUser_user_3.json"), (Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_4, "testObject_BindingNewTeamUser_user_4.json"), (Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_5, "testObject_BindingNewTeamUser_user_5.json"), (Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_6, "testObject_BindingNewTeamUser_user_6.json"), (Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_7, "testObject_BindingNewTeamUser_user_7.json"), (Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_8, "testObject_BindingNewTeamUser_user_8.json"), (Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_9, "testObject_BindingNewTeamUser_user_9.json"), (Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_10, "testObject_BindingNewTeamUser_user_10.json"), (Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_11, "testObject_BindingNewTeamUser_user_11.json"), (Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_12, "testObject_BindingNewTeamUser_user_12.json"), (Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_13, "testObject_BindingNewTeamUser_user_13.json"), (Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_14, "testObject_BindingNewTeamUser_user_14.json"), (Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_15, "testObject_BindingNewTeamUser_user_15.json"), (Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_16, "testObject_BindingNewTeamUser_user_16.json"), (Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_17, "testObject_BindingNewTeamUser_user_17.json"), (Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_18, "testObject_BindingNewTeamUser_user_18.json"), (Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_19, "testObject_BindingNewTeamUser_user_19.json"), (Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_20, "testObject_BindingNewTeamUser_user_20.json")], + testObjects + [ ( Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_1, + "testObject_BindingNewTeamUser_user_1.json" + ), + ( Test.Wire.API.Golden.Generated.BindingNewTeamUser_user.testObject_BindingNewTeamUser_user_2, + "testObject_BindingNewTeamUser_user_2.json" + ) + ], testGroup "Golden: UserUpdate_user" $ - testObjects [(Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_1, "testObject_UserUpdate_user_1.json"), (Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_2, "testObject_UserUpdate_user_2.json"), (Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_3, "testObject_UserUpdate_user_3.json"), (Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_4, "testObject_UserUpdate_user_4.json"), (Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_5, "testObject_UserUpdate_user_5.json"), (Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_6, "testObject_UserUpdate_user_6.json"), (Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_7, "testObject_UserUpdate_user_7.json"), (Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_8, "testObject_UserUpdate_user_8.json"), (Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_9, "testObject_UserUpdate_user_9.json"), (Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_10, "testObject_UserUpdate_user_10.json"), (Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_11, "testObject_UserUpdate_user_11.json"), (Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_12, "testObject_UserUpdate_user_12.json"), (Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_13, "testObject_UserUpdate_user_13.json"), (Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_14, "testObject_UserUpdate_user_14.json"), (Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_15, "testObject_UserUpdate_user_15.json"), (Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_16, "testObject_UserUpdate_user_16.json"), (Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_17, "testObject_UserUpdate_user_17.json"), (Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_18, "testObject_UserUpdate_user_18.json"), (Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_19, "testObject_UserUpdate_user_19.json"), (Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_20, "testObject_UserUpdate_user_20.json")], + testObjects + [ ( Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_1, + "testObject_UserUpdate_user_1.json" + ), + ( Test.Wire.API.Golden.Generated.UserUpdate_user.testObject_UserUpdate_user_2, + "testObject_UserUpdate_user_2.json" + ) + ], testGroup "Golden: PasswordChange_user" $ testObjects [(Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_1, "testObject_PasswordChange_user_1.json"), (Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_2, "testObject_PasswordChange_user_2.json"), (Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_3, "testObject_PasswordChange_user_3.json"), (Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_4, "testObject_PasswordChange_user_4.json"), (Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_5, "testObject_PasswordChange_user_5.json"), (Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_6, "testObject_PasswordChange_user_6.json"), (Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_7, "testObject_PasswordChange_user_7.json"), (Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_8, "testObject_PasswordChange_user_8.json"), (Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_9, "testObject_PasswordChange_user_9.json"), (Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_10, "testObject_PasswordChange_user_10.json"), (Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_11, "testObject_PasswordChange_user_11.json"), (Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_12, "testObject_PasswordChange_user_12.json"), (Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_13, "testObject_PasswordChange_user_13.json"), (Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_14, "testObject_PasswordChange_user_14.json"), (Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_15, "testObject_PasswordChange_user_15.json"), (Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_16, "testObject_PasswordChange_user_16.json"), (Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_17, "testObject_PasswordChange_user_17.json"), (Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_18, "testObject_PasswordChange_user_18.json"), (Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_19, "testObject_PasswordChange_user_19.json"), (Test.Wire.API.Golden.Generated.PasswordChange_user.testObject_PasswordChange_user_20, "testObject_PasswordChange_user_20.json")], testGroup "Golden: LocaleUpdate_user" $ diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/BindingNewTeamUser_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/BindingNewTeamUser_user.hs index c2fd06322f4..a0f5251163c 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/BindingNewTeamUser_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/BindingNewTeamUser_user.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedLists #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2021 Wire Swiss GmbH @@ -18,23 +16,7 @@ -- with this program. If not, see . module Test.Wire.API.Golden.Generated.BindingNewTeamUser_user where -import Data.Currency - ( Alpha - ( AOA, - AUD, - BZD, - GNF, - GYD, - KRW, - MXV, - MZN, - NPR, - QAR, - UAH, - UZS, - XUA - ), - ) +import Data.Currency (Alpha (XUA)) import Data.Range (unsafeRange) import Imports (Maybe (Just, Nothing)) import Wire.API.Team @@ -56,17 +38,15 @@ testObject_BindingNewTeamUser_user_1 = BindingNewTeam ( NewTeam { _newTeamName = - ( unsafeRange - ("\fe\ENQ\1011760zm\166331\&6+)g;5\989956Z\8196\&41\DC1\n\STX\ETX%|\NULM\996272S=`I\59956UK1\1003466]X\r\SUBa\EM!\74407+\ETXepRw\ACK\ENQ#\127835\1061771\1036174\1018930UX\66821]>i&r\137805\1055913Z\1070413\&6\DC4\DC4\1024114\1058863\1044802\ESC\SYNa4\NUL\1059602\1015948\123628\tLZ\ACKw$=\SYNu\ETXE1\63200C'\ENQ\151764\47003\134542$\100516\1112326\&9;#\1044763\1015439&\ESC\1026916k/\tu\\pk\NUL\STX\1083510)\FS/Lni]Q\NUL\SIZ|=\DC1V]]\FS5\156475U6>(\17233'\CAN\179678%'I1-D\"\1098303\n\78699\npkHY#\NUL\1014868u]\1078674\147414\STX\USj'\993967'\CAN\1042144&\35396E\37802=\135058Da\STX\v\1100351=\1083565V#\993183\RS\FSN#`uny\1003178\1094898\&53#\DEL/|,+\243pW\44721i4j") - ), + unsafeRange + "\fe\ENQ\1011760zm\166331\&6+)g;5\989956Z\8196\&41\DC1\n\STX\ETX%|\NULM\996272S=`I\59956UK1\1003466]X\r\SUBa\EM!\74407+\ETXepRw\ACK\ENQ#\127835\1061771\1036174\1018930UX\66821]>i&r\137805\1055913Z\1070413\&6\DC4\DC4\1024114\1058863\1044802\ESC\SYNa4\NUL\1059602\1015948\123628\tLZ\ACKw$=\SYNu\ETXE1\63200C'\ENQ\151764\47003\134542$\100516\1112326\&9;#\1044763\1015439&\ESC\1026916k/\tu\\pk\NUL\STX\1083510)\FS/Lni]Q\NUL\SIZ|=\DC1V]]\FS5\156475U6>(\17233'\CAN\179678%'I1-D\"\1098303\n\78699\npkHY#\NUL\1014868u]\1078674\147414\STX\USj'\993967'\CAN\1042144&\35396E\37802=\135058Da\STX\v\1100351=\1083565V#\993183\RS\FSN#`uny\1003178\1094898\&53#\DEL/|,+\243pW\44721i4j", _newTeamIcon = - ( unsafeRange - ("Coq\52427\v\182208\&7\SYN\\N\134130\8419h3 \30278;X\STX\a\a$|D\NUL\SOHh'\62853\&3-m7\1078900\SOp\22214`\1093812\&6QF\CAN\SOH9\1062958\ETB\15747FP;lm\1075533\173111\134845\22570n:\rf\1044997\\:\35041\GS\GS\26754\EM\22764i\991235\ETXjj}\1010340~\989348{; \119085\1006542\SUBL&%2\170880;@\\2`gA\984195\&0\162341\&2\163058h\FSuF\DC4\17376\ESC\GS\SO\vYnKy?v\129546H\fcLdBy\170730\&4I\1108995i\1017125\ETBc6f\v\SOH\DC3\1018708ce\1083597\SOs3L&") - ), + unsafeRange + "Coq\52427\v\182208\&7\SYN\\N\134130\8419h3 \30278;X\STX\a\a$|D\NUL\SOHh'\62853\&3-m7\1078900\SOp\22214`\1093812\&6QF\CAN\SOH9\1062958\ETB\15747FP;lm\1075533\173111\134845\22570n:\rf\1044997\\:\35041\GS\GS\26754\EM\22764i\991235\ETXjj}\1010340~\989348{; \119085\1006542\SUBL&%2\170880;@\\2`gA\984195\&0\162341\&2\163058h\FSuF\DC4\17376\ESC\GS\SO\vYnKy?v\129546H\fcLdBy\170730\&4I\1108995i\1017125\ETBc6f\v\SOH\DC3\1018708ce\1083597\SOs3L&", _newTeamIconKey = Just ( unsafeRange - ("\ACKc\151665L ,\STX\NAK[\SUB\DC1\63043\GSxe\1000559c\US\DC4<`|\29113\147003Q\1028347\987929<{\NUL^\FST\141040J\1071963U\EOT\SYN\65033\DC3G\1003198+\EM\181213xr\v\32449\ESCyTD@>Ou\70496j\43574E\STX6e\983711\SO\ESC\135327\&34\1063210\41000\1018151\&8\1057958\163400uxW\41951\1080957Y\ACK\141633(\CAN\FS$D\1055410\148196\36291\SI3\1082544#\SYN?\ETX\ACK0*W3\ACK\1085759i\35231h\NAK-\42529\1034909\ACKH?\\Tv\1098776\54330Q\46933\DLE-@k%{=4\SUB!w&\1042435D\DC2cuT^\DC4\GSH\b\137953^]\985924jXA\1010085\133569@fV,OA\185077\38677F\154006Az^g7\177712),C\1020911}.\72736\996321~V\1077077\1024186(9^z\1014725\67354\&3}Gj\1078379\fd>\57781\1088153Y\177269p#^\1054503L`S~\1101440\DC23\EOT\145319\24591\92747\13418as:F\ETX") + "\ACKc\151665L ,\STX\NAK[\SUB\DC1\63043\GSxe\1000559c\US\DC4<`|\29113\147003Q\1028347\987929<{\NUL^\FST\141040J\1071963U\EOT\SYN\65033\DC3G\1003198+\EM\181213xr\v\32449\ESCyTD@>Ou\70496j\43574E\STX6e\983711\SO\ESC\135327\&34\1063210\41000\1018151\&8\1057958\163400uxW\41951\1080957Y\ACK\141633(\CAN\FS$D\1055410\148196\36291\SI3\1082544#\SYN?\ETX\ACK0*W3\ACK\1085759i\35231h\NAK-\42529\1034909\ACKH?\\Tv\1098776\54330Q\46933\DLE-@k%{=4\SUB!w&\1042435D\DC2cuT^\DC4\GSH\b\137953^]\985924jXA\1010085\133569@fV,OA\185077\38677F\154006Az^g7\177712),C\1020911}.\72736\996321~V\1077077\1024186(9^z\1014725\67354\&3}Gj\1078379\fd>\57781\1088153Y\177269p#^\1054503L`S~\1101440\DC23\EOT\145319\24591\92747\13418as:F\ETX" ), _newTeamMembers = Nothing } @@ -81,439 +61,13 @@ testObject_BindingNewTeamUser_user_2 = BindingNewTeam ( NewTeam { _newTeamName = - ( unsafeRange - ("G\EOT\DC47\1030077bCy\83226&5\"\96437B$\STX\DC2QJb_\15727\1104659Y \156055\1044397Y\1004994g\v\991186xkJUi\1028168.=-\1054839\&2\1113630U\ESC]\SUB\1091929\DLE}R\157290\DC1\1111740\1096562+R/\1083774\170894p(M\ENQ5Fw<\144133E\1005699R\DLE44\1060383\SO%@FPG\986135JJ\vE\GSz\RS_\tb]0t_Ax}\rt\1057458h\DC3O\ACK\991050`\1038022vm-?$!)~\152722bh\RS\1011653\1007510\&0x \1092001\1078327+)A&mRfL\1109449\ENQ\1049319>K@\US\1006511\ab\vPDWG,\1062888/J~)%7?aRr\989765\&4*^\1035118K*\996771\EM\"\SO\987994\186383l\n\tE\136474\1037228\NAK\a\n\78251c?\\\ENQj\"\ESCpe\98450\NUL=\EM>J") - ), - _newTeamIcon = (unsafeRange ("\SUB4\NAKF")), - _newTeamIconKey = - Just - ( unsafeRange - ("-\ACK\59597v^\SOH_>p\13939\ETX\SYN\EOT\ENQ\2922\1080262]\45888\917616\SI;v}q\47502\190968\a\SI\1113366&~\51980<\GS\1024632`,\1033586sn\2651H\160130\1100746\176758:qNi]\1051932'\1000100#\a#T\171243}\990743\DC2\1008291M_\FS\DC4\988716\1091854\EM,\SO\CAN^]\77867\&9\1112574-\a\SOHID. FAp\EOT\1033411\1004852(S\1052010\68416\129120\DLEsI\ETXe|Mv-\"q\49103zM\14348$H\SOH\139130\1004399D]\SUB\1056469\ESC\151220qW2\ENQ\1104272\RSy\1018323gg\1018839 /\1079527\98975\18928~&y\b\ACK\1084334\1047493\36198\SO\FS\SYN\RSt\\a.V\SO\&Hy8k\US$O\699Xu/=") - ), - _newTeamMembers = Nothing - } - ), - bnuCurrency = Nothing - } - -testObject_BindingNewTeamUser_user_3 :: BindingNewTeamUser -testObject_BindingNewTeamUser_user_3 = - BindingNewTeamUser - { bnuTeam = - BindingNewTeam - ( NewTeam - { _newTeamName = - ( unsafeRange - ("Y\\73\1000020R`h\STXp\33328\b:'\1027731Uq$N\1082599\1001197G*\62847\SOf\186815,FU-\92666\ACK+\171367\fz}\1110732\DC1}\ACKt\f#\1112868\f\1039\SI\NUL\ESC\41467i$\GS\33394\&1A\999853(\r") - ), - _newTeamMembers = Nothing - } - ), - bnuCurrency = Just UZS - } - -testObject_BindingNewTeamUser_user_4 :: BindingNewTeamUser -testObject_BindingNewTeamUser_user_4 = - BindingNewTeamUser - { bnuTeam = - BindingNewTeam - ( NewTeam - { _newTeamName = - ( unsafeRange - ("\182517M}\34971vE\1040495Q\ENQ{t\\\1067121I\1055789\ACK\1015032\\\95540]\1080160%A\f\44921u.`^#\1048408\9898\29781\1071878\1105997\SYN\b\1050002?K\v\\\1088814\US\1066940\1095557^}\1023619\1003580\NAK\1096134-_89z:.9z\SO*W@\67347\176076wb\1048896\166578\USW\1011757d\138689:WGs-%(\5303\1108372C\ETX$0RPh\148147%\DELC9\f4O\1064448Hv3\NAK\160792h$\FS/\996780\FS\175099\1030295\1048043\138937P&\NUL\1104523du0@\1050427\SUBG\SIlSw@Ss\SOH\GS\43065\SI\3650c\72789\21393\t>a\SOH\1002922L\1098595R^\32537:K{>\37828Y1\NUL4h\23073Q@\"\164114DR\132814\47778v\EM\135514x\DC4\ETB\DC3\ACKA\NAKv\121377\136197\t[aVgL\CAN@kL-uP\SOH3$~4\37309K.c\b\v0B\992595+\r20}\SUB^g\9021N\SUB\1073393\1041445\&2\1003353\ESCHP\US\DC2p\1110885(\1100822{\t%Gry\FS'^Y1\1101933bM&(A\1078466\1092282\ETB\f\47782\&3\1044974\1107052o\1113466\&5\92955oly\39470SE\DEL]\22205\1082988\190649\b2\CAN>h'G\1017338(0\1034452\6723\&8\12192\ACK\119266\1113941C8\v~#\vev\169940D60\164441$\DC3x\10113\73706\155270\ETXA\tD`w\"Qp") - ), - _newTeamIconKey = - Just (unsafeRange ("\DC30'J\1023170\&9\40151\5667k\1099047JW.\EOTu^0ro1y-\144892\166522\STX%!Q\48508")), - _newTeamMembers = Nothing - } - ), - bnuCurrency = Nothing - } - -testObject_BindingNewTeamUser_user_5 :: BindingNewTeamUser -testObject_BindingNewTeamUser_user_5 = - BindingNewTeamUser - { bnuTeam = - BindingNewTeam - ( NewTeam - { _newTeamName = - ( unsafeRange - ("U;\a\1108087I\1089486\&8tx.J^o]7\DELP6#Lr0`\EOT\DC4\1053251\ETB\1048623\b0\1060677d |UY\4546\28421\&7J\1084630\94811\rQX\133250\185655vW\59837\1441'\37139 \GS\SI\SUBoVj=\nVDq'4\22639B\\;6^\ACK-\NAK\1041995\99761`.r'5n~g X\991432\SYN#\1017567S0'\1014026\&1-pY\1048393\16180\\1P\121450\70127\42207\993292!6\63549Jw\182952\ETX/_\SUBy\1085242\&2Rv\1017742v\NUL\996793{\994743.l\RS\DELq/\159354\1007711.\92216~ri5\DEL\EM\13134>c\SOH\1017030\EOTf\1078294\146896TR\GS[r\167219,2\RSM,\1105004\1022538\179367JivP\78721In?ec#s\1046450\FSg\DC4+\60535eeAa\rA^X.\97936J\ETX\DC1") - ), - _newTeamIcon = - ( unsafeRange - ("\DC2\RSd\44888\82946\1015273Kg\168358\60534\bJ.BoJ%\DC38z~!#|@\17904uQj}\RS\133043\1108513\1082985\175914\n\1064502F\9690oN{_:67\1037008\rO7d\1093250\178638-`\9253aRB\ACK\151421sx\64878P@\1064552:\SOHb\190489\NULNuL\RS\NAK\137507!\fb\SOH-\1071296a8BM?kX\EOTc;WIeG\NAK\1097814\EMr\1089652\CANtNv\DEL\996402\996965\EMYU\bsT\62496-\32143\986088\1034207\aXG$5\STXHi\1002699\46837=\1020133") - ), - _newTeamIconKey = - Just - ( unsafeRange - ("v\1053051\&3\SO\1075972N\1040747\4197h_\ETB[AS\98479\NUL{\DC3\f\1058390\"V\fS\1109927\DC2\r* \NULi\NUL\1061172}\38778ck\157296n\EM\52953iRGA!\\\CANWKI1\1050639\SOg\45944`6Q\68177\EOTsY\1088598T\3174\29369\1053819\68000VF8xA\37760,\ESCt\98082\ETX#\1073850\15498\1011311A\1082386\34173\167070\SO\&Hl]d\1030151\DC2\1091436\1031340(\NUL<\62433D;gb\b\ETX\58840'\1074090\US\1077526|\1050393\1015265>\FS\50596\1057737\ETX.N Pp\EOT") - ), - _newTeamMembers = Nothing - } - ), - bnuCurrency = Just GYD - } - -testObject_BindingNewTeamUser_user_6 :: BindingNewTeamUser -testObject_BindingNewTeamUser_user_6 = - BindingNewTeamUser - { bnuTeam = - BindingNewTeam - ( NewTeam - { _newTeamName = - ( unsafeRange - ("M\FS\148019\96606\FS\1100702Bzq\CANb\ETB\FS\51538\1102552 \158766\&0\RS\72787\\F\SI\NAK\ETXPs\DC1\DELPg$)r\1008935\171681\DEL\NUL@n(\25789yf\DC4\\I-\nOok\DEL\1006510@wb^uM\NUL\RS\DEL5\1108464m~K\1000820lQ\SYN\176049\1004567\DC4f\141993\SO\STX\CANaJ?\\yg%AH6R\1068361Ax\986978\&1\DEL[6]mV(\1037512U;\1059091\GS,Y\DEL^\18067DXP\165016b\1070465\1001647=b\\\41060\1052544k\\oM.v^L\1058306/cF\ETX/Dk\DEL\DLE\1013320\996138b)\1095767\985263L\ETX\1084505}b$s\ah\58600-.\15149Nh\31648Je\1025856\51222;\1022921\174521\DC1#\STX/U\GS\5598T|\t\15463\99045\991928") - ), - _newTeamIcon = - ( unsafeRange - ("$^\149118\160734*\FST1t\ACKt\140597w\ETB'\1042165\DEL5z\186274\1086367mmEaf\FS\19965g+\11132<\DC3\184610\DEL\134869-\1016966\NAK\1104140\SYNpy\1011675\&2a\45298zPS|_\DEL\1090933a\STX\USmo\19067T&-$&\998793\51567xX$\ENQo.A\1038189;kz\NAK^$cGD<\EOT_\DC4\47519\1036320\1109909\1025894\1085168\&0{\RS\169770\&1\1060955O\33831WY.\96279\11375M8u5\DC2\GS'4D\b\1007938\1012915ZQ\1903Z\n\52515/\1055598^51\1082703\SO\1072261\RS6\12794T\98885X[\1084450Ng#|2VjG\SYNU<\20737\&3\1049104\4259\1088825N\1044794M\r3\\gp\1045813Vx\r$7N4W\DLE\ETB\159861\12542\n\1020713qZ\CAN1F\ENQM;u\NUL\1032689V\fj\36970<]/U\ESC\1102104~)j\185388\NUL\"\25482\"\DELNsd\STXm!j/:I\EM\1068817Z\ajac\ENQ:exU8Dlu\29230\43566\52951\v\994928\&1&9\64056\1103374\1040843\ETB6\DC1\1013532!C1W=j\FS;\1034595<#w5Sl\SUB\1048927\DC1\CANO\38868\&7\SI\162365]dX\r\171232\ACKD\ENQ8s\DC3\189474@\"*h~\42718Q\155730q\1063830\SUB \RSE\SO^\1102626Fa@\b\r%+W\STX\1028795\1020794{HR\DC4 \DC3\DC4dg\SYN\NUL\144054\n\1089496~\120234j\1062769K3uK\1011439\&8") - ), - _newTeamIcon = - ( unsafeRange - ("{\6407\1045496\162593 }\ENQ\SO<\"\61180\n\1056882d{\1050887\DC2\134394s\DC3O\1011012g\RS\n2-\NAK2,\ACK\48216\n\ENQa&7\1021610\&0\ENQ\1054469h\64406\SO\78032n\DC3 k^\v\1047582\&2OOz\139572X2\1003924\1051705bu\1071407C\1093019\GS\65399\58155\&2;)\180646\53270\aBY\1031479\RSn4\NAK\ETXv") - ), - _newTeamIconKey = Just (unsafeRange ("\1048793f\31251\1106466")), - _newTeamMembers = Nothing - } - ), - bnuCurrency = Just MZN - } - -testObject_BindingNewTeamUser_user_10 :: BindingNewTeamUser -testObject_BindingNewTeamUser_user_10 = - BindingNewTeamUser - { bnuTeam = - BindingNewTeam - ( NewTeam - { _newTeamName = - ( unsafeRange - ("\1049073\168559\987351\NAK8u;\ETB\1063929\NAK\rA$#,\159447\EM\FS\990410Y\ETX\70730\NUL(7\999642\&1\1082313\t\132777\SOH:?$s]1U\119670\\:3\144821n?K~") - ), - _newTeamIcon = - ( unsafeRange - ("+Y\SOH\n\171682_{\25671\23150hFn\1101809-\37324o\ETXK6\1050439b4#~f\EM\129595\15408\FS\EOT\v\142114\&9-[n\1006769\1008911z*\1110193\v\ETBX\ACK\1041891\ETBz\SUB\1089909\78036s1 [\1004363\DC4|\98659MoY6\DC4d\141826E\ENQ\SOH\71350Oh#\1084622u!\168019[\173222(\48983$}Y\166556<\ESC*P1A\188556*\162377G4dx\147381\1009215@;x\1055442d\DC2\fp\SOH\27702\&4WY\ENQ\NUL\1113786D^\26624-I\1069722kC_\26032S\ETB>\1075495\&8\DC4Wb}$+\1104271y\NULm\nR\1051310!(\1007896\1062798\t\181190KF1[\\(N\153483(U\STXN\1896\&3\1012754z{$\24188Nv3NY\DC4\61735f\DC1nDfh\36158S\NUL\985284\DLE%e\1027534o\1038814\CANqq[w\1092640\f9:\2365Z|+3o\n/\988347SM|J[,\1059055\&2\1000072z\DC4\US79}\EOT\170925%V\1026633l_\992878)\993061I") - ), - _newTeamIconKey = - Just - ( unsafeRange - ("\GSnlrE\1069158H\GS\NAK~\US\ESC|-\DEL\158753Zo\\$\ETB\1023645\GSC\1014314\SYN\ETXFj{<7\1072221m'\ESC\CAN\59710Bn_N{\16970\&4\\g\v\162503\vsg\1031998\\\156790\&8\DC2F@t\SOH\NAKXy+\FS\SI\1009740$\1047633\152050\1018475)\fC\1030422_r\SUB\DEL\1047697\ESC&4Pm\a-wS\1009483n\31481]\SYN\1010618:\r\nO\1028492\SI+9q\EOT]RyY\RS\168945#6'mk\133798\48513/\ETBZZ\1046307|L\135076o\1103335m_`;,\1103745D\27083\&4\1036685\NUL\53658\GS8\47277d\95743\148115\983191\&3#\1111531\96828O\167214\&0(F\EOT") - ), - _newTeamMembers = Nothing - } - ), - bnuCurrency = Just QAR - } - -testObject_BindingNewTeamUser_user_11 :: BindingNewTeamUser -testObject_BindingNewTeamUser_user_11 = - BindingNewTeamUser - { bnuTeam = - BindingNewTeam - ( NewTeam - { _newTeamName = - ( unsafeRange - ("\SI\95458\f5h\151753\&1G\173466\ETBa\1098048V\GSe+SH|\fe\1065118\169528%8\183035jWZ:\1052418O)\1006809\b\EM\1108918U\1079280j0V3U\17171\1016407i\a\992344\1033718\992713<\58600n\b\21764]Mo\1012929y\ENQBS7Qh#\ESCI`=\1039942\998772\&5\"*i\8268\1100641\98267\1102214v\997521&\164378)~\FS\991237,\n\20701\176571\1003331\1051745\NAK\FS\1054277~VWB(jD&i\1037532\1094662{\FS|\DEL\SO8\1015427\65428\1000624\1008187L\1024084\&2,|E\31595\1087844g\1028452\ACK(8?\EM\aL@") - ), - _newTeamIcon = - ( unsafeRange - ("!5\512\1050477\17628I\1105565q__i\119621V\176513\1034860\f%T'\924\8084'%5y\SIj\1013150qK\ETXVJ\1097190Q\1084135x8\DC4\t\33502r\NUL\r\8876\10482\1094496\1090965,;\f\1014738^\1016624m\FS~L:\986452\DEL\ETX\1018311i\148795\NAK&\ENQBFR\NAK\1067140\1008316v\1048407j\19255b'd2D\128850\&9o\78052\EM\13077!`{\1047528/]\FS)\SUBq\28514F\GSS\995957\119110\DC1<\SOH\GS01`\22800\"Qzt\1096237\ESC|\151058w\FS\1103524\990407+ =Xhl P\1095890\1032018\148690oPb8$\1056472\DC2\1049747\&5\DC3j\DEL\1106720sU\"#@u{Y\64608w\r\EM\DLEAUae\67078;\"uP{\v\nm\1023816}\ENQL\SI7\157473\165846:\RS= Yt5Nj\15061cYf\ESC\1009616,\bZCPn\1019754\NAKU\180892|\a2\46892z\26490\NUL\30026RaO[\DC1WW\1026040\SUB\37673\&2\a\35961Fjs\DC4(\1034668\168590\118825\987066H\7929l\136503\987355\41918g8\DC1\EOT\156787rC\SOHx") - ), - _newTeamIconKey = - Just - ( unsafeRange - ("5;\CAN'BN\64596:j\EOTr\DC1\27899\30930\40021\NUL\t\129184\176976~Tq&k\SOX6cP\NUL\188778\1005491\&7\1085132\SYN\RSz\16834\19917\991570)%}$O'.\5935#g") - ), - _newTeamMembers = Nothing - } - ), - bnuCurrency = Just NPR - } - -testObject_BindingNewTeamUser_user_12 :: BindingNewTeamUser -testObject_BindingNewTeamUser_user_12 = - BindingNewTeamUser - { bnuTeam = - BindingNewTeam - ( NewTeam - { _newTeamName = - ( unsafeRange - ("Y\aUh=:\1051152?\1008009V~\fX?)\DC3R\1088934\n1\1041465^#\1082033WepJ\FS\SI\ETB[ =-\ETBpu\1081924`\SYNo!\54226\985251\CANk\999213\1004979\f\1009811\&8NY\SUB_G&\1068566\NULY\EOT\52584\EOT2\1101608\\\GSa5\DC1g\a\1050452\1020014No\13133\2414\DC1(\121130\CAN\ACK\1108717_\182967\f{! X \NAK\SOH\19467\GS\97131 H\190009\&4*\f/\149119X\1021775\n|.\14201rd\17432`.j:\CAN&\1068603\23474\1026077\\F>*\GS\1074682.Y\DC1\a\"\STX\155381/\993320\&7\151625a\1046770\5214#?LQwzpeF\t\1078600\1035290\ESCOj\\P\34954\36395vP2mh$(\999835eaUw\SUB\b] 60\ETB\1089879S\159439`\1042176\&2") - ), - _newTeamIcon = - ( unsafeRange - ("l\DC4]\a`N\DC2\1085917\64042\1112824\1025631\17693\STX\NAKXw\1021176)\ENQ4\96680\1046103\CANuV\146642\158725T\146421\30196P9\bP?J\1025903m|=pk\GS\a-9@J\tP\1068743\1030242\1076014\1040997\155277,\CAN\129071\RS\1110051g#\1004400E9\1029404ky8\ETB\92251e(v\CAN\52300\&0\988855\2402c!\EOTQGtp") - ), - _newTeamIconKey = Nothing, - _newTeamMembers = Nothing - } - ), - bnuCurrency = Just GNF - } - -testObject_BindingNewTeamUser_user_13 :: BindingNewTeamUser -testObject_BindingNewTeamUser_user_13 = - BindingNewTeamUser - { bnuTeam = - BindingNewTeam - ( NewTeam - { _newTeamName = - ( unsafeRange - ("V\SOH8(4\"z\43146AM\1011377/\"\ESC\SOH\SOH\1024288V\189607\1070754\161051P\58886\141963^\USH\8835I*\DC3,\12013:\ns`%}H3%\DEL\RSe\78392\42031\98909A\rY)':!B\ACK\1032049\t\ETXrc\SOH2h=I6A7g\987060YT\988319\173685\1050792l\1015588D\ENQV`\SIE\FSE{cnx\1048660ej'{\DELv#u8\166711\149914\r\NUL\65211^T\NUL*\149083\1038716U\28222q==\US\168170\&6\21483\&2F\n") - ), - _newTeamIcon = - ( unsafeRange - ("\DC1\61392\&2>\41950G)+\"L\161601dZQ\988371XGMY\r~c7U\1101728i\169682\US?M# \SYN\fEweI`\7648\156246\DC2\986316\nCO\FS\1055148I\NAK\1020258w8\61013\1056373\\\1025878t2\127185u\EM\r\60003[\\fk\US:Yp*?P\3743ul\SYN\1089177\1018795\996155\STX+\1060552\NAK=\45793\1029690\1029986\&2b,N\r\1069922\SI`\ETBZD\126578:\39424\152739\92971\1007563!\21587\&6\ETB=DA\1062109\EOT\12467\&6\SYN\177806\1078102\1084689%\SUBZ\NULKNmJqr\176398\USF\174456\&0i5\147118X\GSKD>b\1076133E3T") - ), - _newTeamIconKey = - Just - ( unsafeRange - ("\DC1IS\RS=xd%\EOT}T_7 \1049411qdLtTL\ruiu\SUBd\1060256\100699\v\DLEMn@+R]\1048851G\CAN\29890/H\ESC\1075972\1100097up$b2q\1108780!\47435\t\994235D\24029.#\6116m\159042\1075860\ENQ=m\1041695\FS\DC4\174246\&6hD\FS\SOH\DLEAsL\v(\1053429?u\188274\1018247\&3%\3611Y1p\1004873\DEL\DC4Lhj%\1074536]b\ETXpsL\a\1094624G\118961\CANw_") - ), - _newTeamMembers = Nothing - } - ), - bnuCurrency = Just AUD - } - -testObject_BindingNewTeamUser_user_14 :: BindingNewTeamUser -testObject_BindingNewTeamUser_user_14 = - BindingNewTeamUser - { bnuTeam = - BindingNewTeam - ( NewTeam - { _newTeamName = - ( unsafeRange - ("HUZo!3i\159431\DC10XJ\153368_m\ENQcc?Y>\SOH\bbd\ETX0p&f\1104396Ct\18649\1061087Z\133783R\10670\a\STX\NAKa\tC*eet\1029011\\OHkGN\"CD7Ch\NAK\120783\1026017tcS\ETB\"\58037\ETX\EM\999311\DLE=_\13107~\1072003Lve^\t\1106810H5s\1108105<\1007375\37572i=,:\1052570\57604Of#\18551%?p\83128c\1064044~\t\1056058E\f\1033507\EOT0H%\3235\1034553\SI\29108)\FSs\999576\acBw\1051189\EMd\SOH\1027598\&4\DC3G\166007\&8\164281\NULi\1021721P~\ENQ\v\60662\NULVr@vR\96899\1020932\1078411B2+\NAKBDMo(\1017787;\47792t\1010438U<-\NUL\DC4Mo\1087139U\180083'\DLE>)\ETB\189133@qO\DLE\SO\ETB\99100\45493+)M\rD\1023643\32194\STX-$\1070170T\CAN4M\164178\&3V\a[y9\\' {E\164327\1088663z+\12155\US\t;*zUvU!\SOH7\38057\1106255xF=sqy") - ), - _newTeamMembers = Nothing - } - ), - bnuCurrency = Nothing - } - -testObject_BindingNewTeamUser_user_15 :: BindingNewTeamUser -testObject_BindingNewTeamUser_user_15 = - BindingNewTeamUser - { bnuTeam = - BindingNewTeam - ( NewTeam - { _newTeamName = - ( unsafeRange - (")\SOI\SI\n3\CAN2\1093803\156479\32728\1082366\v\147610\&1,|.=\1094050\1091883\fH0d\1027540\b\ESC\DLE\ab\1034699\CAN\GS\95766\1044787\&9|\1074820\95646\167502\1095215C\SI\fT`\SOH\1020498w\1112382Fn[9\1003685\DC4\1068849N\35430\v\20748-rC4\"{^@\a\110799RG\r!]#]'Z\1061236n\1038640-\1053831\154857\181092n\DELv#Fwiz\1344W\DC1i\47961.\v\64101\138177\1081686\t=\RS\CAN,j/E\36364\1029033\ETByt\999568.9Mk\\\"i5M{T\1110224\989485RyrD%3_\1017028*o\984061d\ESC\121297h\fe\1003889\1013351\161393,=r\12844\161365\21711o\35771\82975Yt\1084118\n*if\DC3\1100917T\1044803I\ETXo)\180260\GS\ETX\FS)\fw\DC4\ACKEk\167349[\SOH;\1058234p\EM\1066363T\GS\DC3Hx") - ), - _newTeamIcon = - ( unsafeRange - (",3\DC2BJD^A*eH\DC3i3\EM2J@\a\1073979\DC3W\129616Ecd')}\162724+S~\14075=\186797ANFU\1080161\&5kg&\\\1038406\1022727\t\ETXJ\4769\ao\1109192\CAN*$\988647hM\148122\DLEl\ENQ!&=BN\ETB3\991458)8\EOT\15362;-k\6712\ETBF*\127889V#7\98929);\v\160873\SYN_\DC1c.X\ACKyL\SIQH\SYN|3\GS:JX\195009fD|,\SYN|MC\176485&\60957J\143856g~\ESC\DEL)K\1113676\1106497W\1069036\GS\a)\98434J\ETB.!D\STX\156884[%\FS&H\ESC62X\141111\&7r\180262HoMs\1026205\\\72333\nqmR\984002D\RS.{ S\SUB\SOH^\171040RC\RS}\DLErzN\vN\DEL\1019401\CANI\DLE\SYN\66010\18966`!Q\1111295Wm9cbFWz\RS\78132\24816eD\46135D\126978UI^eOM\1065465\EM\177862\36329\49916Q'7\40709K") - ), - _newTeamIconKey = - Just - ( unsafeRange - ("+#s:\83505\128803\1026731o\1010649\EM\ENQ\41143\153592\&8E\1009150\&16-gJ-\ACKAG\983421Vv,>>Yd$\ESC11\158776Ea\36589!O\NULQ\ACK\"mlc\DC3\170484\96618y\CAN\"(Wu4\20264rY_\r\1067208]-\DC4r\150513}7t#*)\167224m\v\1042944[\135624\US\47305+\SYN\1082953\1034731a\38522\td\SUBQ\DC4_\1006333mI\1065629S\EOTRK\NULp5uf \fz\1023561c\1038977\NAKU\STXYu\95490$\34609\NAK\DC2%jB\ESCNHxd`J9z\nyg\172169Z\8554\&5A\STX\181034\1026223\1093572\vn\US\173694'SNtE[\ESC\r_De\1110917'G\165278\ENQ[I.\987304\&3\1003155\bv=R\1110424\146961\NAKG\ETBR\31059)\1080786\EM\182482\ETBT\STXdGW\DC2YBV0_%\188754\43426w\NAK9\rL%\1057563k<\a,?\184822U2C\172924") - ), - _newTeamMembers = Nothing - } - ), - bnuCurrency = Just KRW - } - -testObject_BindingNewTeamUser_user_16 :: BindingNewTeamUser -testObject_BindingNewTeamUser_user_16 = - BindingNewTeamUser - { bnuTeam = - BindingNewTeam - ( NewTeam - { _newTeamName = - ( unsafeRange - ("\DC1\1038979` \CAN\"\122902\1063633\EMa*@*U\173927=p|=:y\101049\DLED.9\nt~\39377\161110@,B\ESC]$\30129\&1\1057585\fdcU[JM4\ETX9_\53434\1097597w~\ESCkI\72134Am\992355\aT\DC1\t/k\39709s\v)h\CAN\1034546UH\ENQ\168530~\SI\149629\DLE.\DELq\165542\52321^6&2sUN\v\1060209\989949\"=\SObh\"\DC3\27323{1\134259\CANK]\9934a\1091961m\34218z\STX\1027027I\ETX\1093906\1055514\1112798\96003\1050872x?\1071365\1029983\1097902\52895\&1\f\1109541h\1077444\a\ACK/mX5$C?!") - ), - _newTeamIconKey = - Just - ( unsafeRange - ("\f\1061655`HS&\1068216\&8Il\EM\1113259\tQJ\SUB\SOH9\SUB\a\1066663\120011L\12791\41370\134059&\STX\DEL\1054533w\1087783\&4\1041272\US\138765\ETX\DC2~\1110206\EOTB[Ya\ACK\STX\45769n\78142\988360k\1047843V(\1095279\97663\1058771@\474N=/.\987157`m\ETBd6\72996'od2J7[\1072723Z:\49502\EOT\148040l\t\1077406\161293\ENQM\1087599y\1105784\63793Y\38102\37856\&5\NUL\ETXRl\DC4 \DC4|:\DC3\1048792&\71326\SYNX8\983194`nmFZw\153337[Dg\ESC\SUB\b 7kN\1042049N\31579Pl\43166X\DC4\96591?B1\\jM\"b\\x_\DEL\ETX\1058594:\DC4\50294\&6\1025098\176655G\190007\1050448{\SYN\SOo\CAN%EB\146689\r@\1052853\48854Em\1045971\1100364\177383\160220v.") - ), - _newTeamMembers = Nothing - } - ), - bnuCurrency = Just AOA - } - -testObject_BindingNewTeamUser_user_18 :: BindingNewTeamUser -testObject_BindingNewTeamUser_user_18 = - BindingNewTeamUser - { bnuTeam = - BindingNewTeam - ( NewTeam - { _newTeamName = - ( unsafeRange - ("r!ef\DC2~[2v&j\v\169592-m\14496\ACK\1026600X\SUBlDSOHrN\1111331J.\142961\175421j\1060446\21905>\190844^\164752yz\ACK\70115\&6G\\\1095501m\SYNEi\DC1co!^/\SUB?\SO\DC3\ACKa\1030543\RS\1000989\SUB\1109471\36537C\rt\f&zN\20219+\SOH\SIF\1071230\SO\119161\DC1\1014459tJ_,\FSq\1006918G\ETB\160437\158350a(P\14610\63560<@F\1107755\1044959, \1014349xt\ETX\177197\78612\&6e\68355\63114NS+1#\ENQ\94592\"j\49402\1082412\&0G\DC2\DC4\f\1020944\1030980\94227F\170594o/j:I\1030148VD\48051?Kz\"]f#\13170M\1096460\996288Ed\t\1104795s\986159\n{MKM\30751\&0\r\6002Di)\64750`\NUL:i\44185\125195r-\173274\NUL(x\GS\SOH\12902\ETBxB?\rK\SO\ffm\61899\167110\137002\1069966\&5V\SUB\67291\171430\\\1011813b\tj\1105352\137223\1108413\&9t1\25744b+[N\CAN\43931x") - ), - _newTeamIcon = - ( unsafeRange - ("Y\120720\1107885?iT\98262\1104262`3\94511\STX\r\1054664t\1038827{@`@f\186222(~\1018549\USE0\STXD-\"\1057454A=_a\EM\136795Nn/x") - ), - _newTeamIconKey = Nothing, - _newTeamMembers = Nothing - } - ), - bnuCurrency = Nothing - } - -testObject_BindingNewTeamUser_user_19 :: BindingNewTeamUser -testObject_BindingNewTeamUser_user_19 = - BindingNewTeamUser - { bnuTeam = - BindingNewTeam - ( NewTeam - { _newTeamName = - ( unsafeRange - ("\1110951C\26749\&4\DC2f-\1017780;+b2rMM!ck\DC1\60720\1073435M\SOi$K\1088397\147462\CAN\18721ur\1030183D\147829v>\DLEIz\b\EOT3=+io\119012j\1079557\n&<\EM\95116b\62430\n]]7\EOTw\69615q\1107694e)A\DC3-O,\12743\1035555\&1'\r\1038262\DC3\1058511\17815\&1\SUB6\ACKRuY\156664CU\GSQ\1033630\17811\1056890\189786\36319>") - ), - _newTeamIconKey = - Just - ( unsafeRange - ("~6u|\121168\ENQ}\183480a\DLE\ACK\1013935?v$\1028477F\1045549#\59393w@P\1001058p\EM\ACK\1070303Ok\1000351\a\990590\1019167\120539\SUB\1045521\&7`\183868\44862BL\US\990859\16418\v\ETX\28704\DC1{\ACKsv4\DC1I8'41*\190695\NAKTLx~}\1043142\GSNI\133566o\38308T\1000421DrQ\EOTq\FSD\DC1\GS=|<\68060]Y'{u8%\74323\ETX\120997\vc\RSj)\21686%\96011DE\1047083&+!l\1030782D_\"\SOr\1042277\1036522\1029837\1051035\987428\n_5*F/\181012$,\1037244\ACK\1059145Pd~\1045128!\1077426\SOa\1014402_\1024119g\SOHl^jz\RS\1065019\1047568\162014\171398\45236\988466F\41652\&2a8'\"n0bH\DC40v\DC3E\61478~\f\SUBs)5b\1055098\100208?GzN=\138756\&3c<,\f&+\67278\147133&af\137280FqV\992330\988290\DC2k9\SOH\FSOZ\1009435\36504\1054749H<\63734Iei=\1024367\1060904\SOg\CAN\DC2\EM0UO\ESC 'I\DC2)\170683'\134775\b\EOT\GS\DC3\EOTy]c\n\185883\DC2l4\DC2)\ETB6\984595?~\t\SI") - ), - _newTeamIcon = - ( unsafeRange - ("C\146291\178505\&9=$Z4\1089687`J#^e:\1059521\1028975|\1011817$6\DC3te[EP3)\986627\169769&\96698\1043\DELHk`\1055905\vo-\ACK\140378\&1\SO\19105AtI\42662\94688&\NAK\GS\1080086\120323I%GLA\1093605I -\1090047\468\1079066pt6)<.\"\1085035") - ), + unsafeRange + "G\EOT\DC47\1030077bCy\83226&5\"\96437B$\STX\DC2QJb_\15727\1104659Y \156055\1044397Y\1004994g\v\991186xkJUi\1028168.=-\1054839\&2\1113630U\ESC]\SUB\1091929\DLE}R\157290\DC1\1111740\1096562+R/\1083774\170894p(M\ENQ5Fw<\144133E\1005699R\DLE44\1060383\SO%@FPG\986135JJ\vE\GSz\RS_\tb]0t_Ax}\rt\1057458h\DC3O\ACK\991050`\1038022vm-?$!)~\152722bh\RS\1011653\1007510\&0x \1092001\1078327+)A&mRfL\1109449\ENQ\1049319>K@\US\1006511\ab\vPDWG,\1062888/J~)%7?aRr\989765\&4*^\1035118K*\996771\EM\"\SO\987994\186383l\n\tE\136474\1037228\NAK\a\n\78251c?\\\ENQj\"\ESCpe\98450\NUL=\EM>J", + _newTeamIcon = unsafeRange "\SUB4\NAKF", _newTeamIconKey = Just ( unsafeRange - ("y\154212X/y\135232E\STX5}THt\b\SI6h\1080596\1070995F\988357\&8t\12802\995577\1027242\1006410(t\1082625\1088232DRn\993619~ifa\n\30271\DC4L\65281w\\g\DLERQwPRiyB>}3\GS`j\fq\RS\1079379)y\SUBwq\fR0\STX(JJ\DC1|\n\RS\1022103\&66d\NAKz\SOw\"\DEL[~\1107073u\991708\EOT\1023418\SYN\1023561\SOH\987451\14377\ACKD\DC1g0\ESC']q\142823\989620\6369Z\DC3lp\SOH\DC4\USi\EML)[?\rf\2489N-4\1048293(\STX\ETB<,!\1060373\DC4f\100484P\1035702s\97823r3\b{jzp(\GSN&\\1\137848c\998833\RS{hh$=i\1023918-0~\1058482\173539\132149\1013243lq5\999142\rclO\DC3)px\1073810\&9\vI\1107068\DLE\v}\123634+,l\998440o(\1010995\917985\10802c]\DLE\174962[]\999995\NUL") + "-\ACK\59597v^\SOH_>p\13939\ETX\SYN\EOT\ENQ\2922\1080262]\45888\917616\SI;v}q\47502\190968\a\SI\1113366&~\51980<\GS\1024632`,\1033586sn\2651H\160130\1100746\176758:qNi]\1051932'\1000100#\a#T\171243}\990743\DC2\1008291M_\FS\DC4\988716\1091854\EM,\SO\CAN^]\77867\&9\1112574-\a\SOHID. FAp\EOT\1033411\1004852(S\1052010\68416\129120\DLEsI\ETXe|Mv-\"q\49103zM\14348$H\SOH\139130\1004399D]\SUB\1056469\ESC\151220qW2\ENQ\1104272\RSy\1018323gg\1018839 /\1079527\98975\18928~&y\b\ACK\1084334\1047493\36198\SO\FS\SYN\RSt\\a.V\SO\&Hy8k\US$O\699Xu/=" ), _newTeamMembers = Nothing } diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/InvitationCode_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/InvitationCode_user.hs index 51173ae8329..4729210634c 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/InvitationCode_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/InvitationCode_user.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedLists #-} - -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2021 Wire Swiss GmbH @@ -24,74 +22,18 @@ import Wire.API.User (InvitationCode (..)) testObject_InvitationCode_user_1 :: InvitationCode testObject_InvitationCode_user_1 = - InvitationCode {fromInvitationCode = (fromRight undefined (validate ("RUne0vse27qsm5jxGmL0xQaeuEOqcqr65rU=")))} + InvitationCode {fromInvitationCode = fromRight undefined (validate "RUne0vse27qsm5jxGmL0xQaeuEOqcqr65rU=")} testObject_InvitationCode_user_2 :: InvitationCode testObject_InvitationCode_user_2 = - InvitationCode {fromInvitationCode = (fromRight undefined (validate ("4Zxb50Taj6g2Cdhdpo6TE18L")))} + InvitationCode {fromInvitationCode = fromRight undefined (validate "j-G82ks0MYiz_gOEUvVpWa3V6bpuP5UcUhc7")} testObject_InvitationCode_user_3 :: InvitationCode -testObject_InvitationCode_user_3 = - InvitationCode {fromInvitationCode = (fromRight undefined (validate ("j-G82ks0MYiz_gOEUvVpWa3V6bpuP5UcUhc7")))} +testObject_InvitationCode_user_3 = InvitationCode {fromInvitationCode = fromRight undefined (validate "")} testObject_InvitationCode_user_4 :: InvitationCode -testObject_InvitationCode_user_4 = - InvitationCode {fromInvitationCode = (fromRight undefined (validate ("sLBqu6Bs8L_augCOf-UQ")))} +testObject_InvitationCode_user_4 = InvitationCode {fromInvitationCode = fromRight undefined (validate "0y-7KQ==")} testObject_InvitationCode_user_5 :: InvitationCode -testObject_InvitationCode_user_5 = InvitationCode {fromInvitationCode = (fromRight undefined (validate ("")))} - -testObject_InvitationCode_user_6 :: InvitationCode -testObject_InvitationCode_user_6 = InvitationCode {fromInvitationCode = (fromRight undefined (validate ("0y-7KQ==")))} - -testObject_InvitationCode_user_7 :: InvitationCode -testObject_InvitationCode_user_7 = - InvitationCode {fromInvitationCode = (fromRight undefined (validate ("C8hR7dkwQ8V9Rryx-EeAnHA=")))} - -testObject_InvitationCode_user_8 :: InvitationCode -testObject_InvitationCode_user_8 = - InvitationCode {fromInvitationCode = (fromRight undefined (validate ("-Oj_2VAtOI_kSg==")))} - -testObject_InvitationCode_user_9 :: InvitationCode -testObject_InvitationCode_user_9 = - InvitationCode {fromInvitationCode = (fromRight undefined (validate ("KguCogw-Yw==")))} - -testObject_InvitationCode_user_10 :: InvitationCode -testObject_InvitationCode_user_10 = - InvitationCode {fromInvitationCode = (fromRight undefined (validate ("Ts_qqqR28DY45TFogbSj_r6zucCScCei")))} - -testObject_InvitationCode_user_11 :: InvitationCode -testObject_InvitationCode_user_11 = - InvitationCode {fromInvitationCode = (fromRight undefined (validate ("OBrWOSrGo9kzEiYcLa3APM6WwDEC")))} - -testObject_InvitationCode_user_12 :: InvitationCode -testObject_InvitationCode_user_12 = - InvitationCode {fromInvitationCode = (fromRight undefined (validate ("K1SuIMYMcZvuRSCazOsbQyv6-AD1GqQ=")))} - -testObject_InvitationCode_user_13 :: InvitationCode -testObject_InvitationCode_user_13 = - InvitationCode {fromInvitationCode = (fromRight undefined (validate ("fDBjTyGqA80aVYoxz6beTfpxVn7KPFA=")))} - -testObject_InvitationCode_user_14 :: InvitationCode -testObject_InvitationCode_user_14 = InvitationCode {fromInvitationCode = (fromRight undefined (validate ("f-s=")))} - -testObject_InvitationCode_user_15 :: InvitationCode -testObject_InvitationCode_user_15 = InvitationCode {fromInvitationCode = (fromRight undefined (validate ("")))} - -testObject_InvitationCode_user_16 :: InvitationCode -testObject_InvitationCode_user_16 = - InvitationCode {fromInvitationCode = (fromRight undefined (validate ("JYFRObZQLGag5fvn-w==")))} - -testObject_InvitationCode_user_17 :: InvitationCode -testObject_InvitationCode_user_17 = - InvitationCode {fromInvitationCode = (fromRight undefined (validate ("bH0uavRmmjBrnJoygpAPeQ==")))} - -testObject_InvitationCode_user_18 :: InvitationCode -testObject_InvitationCode_user_18 = InvitationCode {fromInvitationCode = (fromRight undefined (validate ("YwE=")))} - -testObject_InvitationCode_user_19 :: InvitationCode -testObject_InvitationCode_user_19 = - InvitationCode {fromInvitationCode = (fromRight undefined (validate ("_ZpeIeHxSAVQ_4g904i-jpm9ygqKeg==")))} - -testObject_InvitationCode_user_20 :: InvitationCode -testObject_InvitationCode_user_20 = InvitationCode {fromInvitationCode = (fromRight undefined (validate ("wBibAg==")))} +testObject_InvitationCode_user_5 = + InvitationCode {fromInvitationCode = fromRight undefined (validate "-Oj_2VAtOI_kSg==")} diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/SelfProfile_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/SelfProfile_user.hs index e9979ac094a..8e5f7b6d4d5 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/SelfProfile_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/SelfProfile_user.hs @@ -20,61 +20,21 @@ module Test.Wire.API.Golden.Generated.SelfProfile_user where import Data.Domain (Domain (Domain, _domainText)) import Data.Handle (Handle (Handle, fromHandle)) -import Data.ISO3166_CountryCodes - ( CountryCode - ( AX, - BG, - CZ, - FI, - FM, - GG, - MV, - NF, - OM, - PA, - SB, - SN, - SY, - TH, - VE - ), - ) +import Data.ISO3166_CountryCodes (CountryCode (PA)) import Data.Id (Id (Id)) import Data.Json.Util (readUTCTimeMillis) -import qualified Data.LanguageCodes - ( ISO639_1 - ( AF, - AZ, - BS, - CA, - CO, - GL, - HR, - ID, - MI, - OJ, - RM, - SS, - TR, - TS, - UK, - UZ, - ZH - ), - ) +import qualified Data.LanguageCodes (ISO639_1 (GL)) import Data.Qualified (Qualified (Qualified, qDomain, qUnqualified)) import qualified Data.UUID as UUID (fromString) -import Imports (Bool (False, True), Maybe (Just, Nothing), fromJust) +import Imports (Bool (False), Maybe (Just), fromJust) import Wire.API.Provider.Service (ServiceRef (ServiceRef, _serviceRefId, _serviceRefProvider)) import Wire.API.User - ( Asset (ImageAsset), - AssetSize (AssetComplete, AssetPreview), - ColourId (ColourId, fromColourId), + ( ColourId (ColourId, fromColourId), Country (Country, fromCountry), Email (Email, emailDomain, emailLocal), Language (Language), Locale (Locale, lCountry, lLanguage), - ManagedBy (ManagedByScim, ManagedByWire), + ManagedBy (ManagedByScim), Name (Name, fromName), Phone (Phone, fromPhone), Pict (Pict, fromPict), @@ -97,12 +57,8 @@ import Wire.API.User userTeam ), UserIdentity - ( EmailIdentity, - FullIdentity, - PhoneIdentity, - SSOIdentity + ( FullIdentity ), - UserSSOId (UserSSOId, UserScimExternalId), ) testObject_SelfProfile_user_1 :: SelfProfile @@ -110,10 +66,10 @@ testObject_SelfProfile_user_1 = SelfProfile { selfUser = User - { userId = (Id (fromJust (UUID.fromString "00000002-0000-0002-0000-000200000002"))), + { userId = Id (fromJust (UUID.fromString "00000002-0000-0002-0000-000200000002")), userQualifiedId = Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000002"))), + { qUnqualified = Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000002")), qDomain = Domain {_domainText = "n0-994.m-226.f91.vg9p-mj-j2"} }, userIdentity = @@ -128,8 +84,8 @@ testObject_SelfProfile_user_1 = userService = Just ( ServiceRef - { _serviceRefId = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000000"))), - _serviceRefProvider = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000001"))) + { _serviceRefId = Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000000")), + _serviceRefProvider = Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000001")) } ), userHandle = Just (Handle {fromHandle = "do9-5"}), @@ -138,701 +94,3 @@ testObject_SelfProfile_user_1 = userManagedBy = ManagedByScim } } - -testObject_SelfProfile_user_2 :: SelfProfile -testObject_SelfProfile_user_2 = - SelfProfile - { selfUser = - User - { userId = (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000200000002"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000000"))), - qDomain = Domain {_domainText = "h2rphp.47t1.pw0"} - }, - userIdentity = Just (PhoneIdentity (Phone {fromPhone = "+28532238745460"})), - userDisplayName = - Name - { fromName = - "\1103516\2538SYM\64914\nem\DC3\SO\STX\177763THme\37118\44852_Bo>%Gudt\1053110\11460\189470M\1015177\174215W+uU[5*\NUL\1002875\SOH\1096054\"\v=a\62902V3P\STX\1097050\ACK\177430@\tjUS\"\1094171Sng:3m^\\\173582\&5\17288\25248\&6l\1064236\CAN\12119\1103520\&4[\SYNbL!" - }, - userPict = Pict {fromPict = []}, - userAssets = [], - userAccentId = ColourId {fromColourId = 1}, - userDeleted = True, - userLocale = Locale {lLanguage = Language Data.LanguageCodes.UK, lCountry = Nothing}, - userService = - Just - ( ServiceRef - { _serviceRefId = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000001"))), - _serviceRefProvider = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000000"))) - } - ), - userHandle = Just (Handle {fromHandle = "6o7n9"}), - userExpire = Just (fromJust (readUTCTimeMillis "1864-05-09T19:59:51.146Z")), - userTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000200000001"))), - userManagedBy = ManagedByScim - } - } - -testObject_SelfProfile_user_4 :: SelfProfile -testObject_SelfProfile_user_4 = - SelfProfile - { selfUser = - User - { userId = (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000200000001"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000002-0000-0000-0000-000200000000"))), - qDomain = Domain {_domainText = "fa3gz465.g-2"} - }, - userIdentity = - Just (FullIdentity (Email {emailLocal = "", emailDomain = ""}) (Phone {fromPhone = "+30745803086"})), - userDisplayName = Name {fromName = "/RCd\163236\184924:\ESCa%[\10448\185549\110838F\f@#{U\rn\176533"}, - userPict = Pict {fromPict = []}, - userAssets = [], - userAccentId = ColourId {fromColourId = 2}, - userDeleted = False, - userLocale = - Locale {lLanguage = Language Data.LanguageCodes.AF, lCountry = Just (Country {fromCountry = MV})}, - userService = - Just - ( ServiceRef - { _serviceRefId = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000000"))), - _serviceRefProvider = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000000"))) - } - ), - userHandle = Just (Handle {fromHandle = "sncnzzz_ffzdy-8.70xb9gni-jtexm4lbr4h9an"}), - userExpire = Just (fromJust (readUTCTimeMillis "1864-05-10T10:07:20.481Z")), - userTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000002"))), - userManagedBy = ManagedByScim - } - } - -testObject_SelfProfile_user_5 :: SelfProfile -testObject_SelfProfile_user_5 = - SelfProfile - { selfUser = - User - { userId = (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000100000001"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000100000000"))), - qDomain = Domain {_domainText = "90i1.84arbm9252qg.b"} - }, - userIdentity = Just (PhoneIdentity (Phone {fromPhone = "+11141922"})), - userDisplayName = - Name - { fromName = - "\EOT\187939dE0K\173164:\1099392^v\143120\1111400G0\189824_7\136563a\ACK\1003768&p\SUB`\r6\ro\\\1054757[\SYN>9lx\21499V\35547p\FS\1013678<>j{" - }, - userPict = Pict {fromPict = []}, - userAssets = [(ImageAsset "\66706" (Just AssetPreview))], - userAccentId = ColourId {fromColourId = 2}, - userDeleted = True, - userLocale = - Locale {lLanguage = Language Data.LanguageCodes.TR, lCountry = Just (Country {fromCountry = CZ})}, - userService = - Just - ( ServiceRef - { _serviceRefId = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000100000001"))), - _serviceRefProvider = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000001"))) - } - ), - userHandle = Just (Handle {fromHandle = "29"}), - userExpire = Just (fromJust (readUTCTimeMillis "1864-05-10T10:30:21.640Z")), - userTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0002-0000-000200000002"))), - userManagedBy = ManagedByScim - } - } - -testObject_SelfProfile_user_6 :: SelfProfile -testObject_SelfProfile_user_6 = - SelfProfile - { selfUser = - User - { userId = (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000100000000"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000002-0000-0002-0000-000000000001"))), - qDomain = Domain {_domainText = "u54.h8--m0--752"} - }, - userIdentity = Just (PhoneIdentity (Phone {fromPhone = "+73308549330"})), - userDisplayName = - Name - { fromName = - "\1063629\"3@n\1057001\184249z6w3lCo+\128041]6\ENQ\1068518\&2\1059602EVQ\NUL\1056407\&1\STX\FS^\21231}C" - }, - userPict = Pict {fromPict = []}, - userAssets = [(ImageAsset "" (Nothing)), (ImageAsset "" (Nothing)), (ImageAsset "" (Just AssetComplete))], - userAccentId = ColourId {fromColourId = 2}, - userDeleted = False, - userLocale = - Locale {lLanguage = Language Data.LanguageCodes.MI, lCountry = Just (Country {fromCountry = VE})}, - userService = - Just - ( ServiceRef - { _serviceRefId = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000100000000"))), - _serviceRefProvider = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000000"))) - } - ), - userHandle = Nothing, - userExpire = Nothing, - userTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200000001"))), - userManagedBy = ManagedByScim - } - } - -testObject_SelfProfile_user_7 :: SelfProfile -testObject_SelfProfile_user_7 = - SelfProfile - { selfUser = - User - { userId = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000000000000"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000000000002"))), - qDomain = Domain {_domainText = "8.071.c"} - }, - userIdentity = Just (EmailIdentity (Email {emailLocal = ":", emailDomain = "\a"})), - userDisplayName = - Name - { fromName = - "\FSz\1000675\1090431(Y\22123Z5FGu'\FS\17032O=]\54557i<`\b1mBS\72203\165141t\36134)x\171180[\1082300\1088848m\53260\&5\163423\1056927\DC2\DELp\FS\1053595\EM ,T*\ETXs.\GST:\DLE\1016590z/#8-e*W\174370W\r\1028201\SI\ENQ*}\190459%\1091895\174313{\21423\DC2'N\US/\50988Z*E\146470\ETB" - }, - userPict = Pict {fromPict = []}, - userAssets = [(ImageAsset "" (Nothing))], - userAccentId = ColourId {fromColourId = 2}, - userDeleted = True, - userLocale = Locale {lLanguage = Language Data.LanguageCodes.ID, lCountry = Nothing}, - userService = Nothing, - userHandle = Nothing, - userExpire = Just (fromJust (readUTCTimeMillis "1864-05-07T20:25:30.218Z")), - userTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001"))), - userManagedBy = ManagedByWire - } - } - -testObject_SelfProfile_user_14 :: SelfProfile -testObject_SelfProfile_user_14 = - SelfProfile - { selfUser = - User - { userId = (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000000000002"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000200000002"))), - qDomain = Domain {_domainText = "o33xllsl.br.w1a-cl"} - }, - userIdentity = - Just - (FullIdentity (Email {emailLocal = "\1100477", emailDomain = ""}) (Phone {fromPhone = "+3606473750"})), - userDisplayName = - Name - { fromName = - "\1015853dp\RSW@\DC3$i$)\153322R\1017265\DC4d\DC3\DC4B.\ETX\14719\SOH\DC1x\1043832g\132826\1066923\EM)\DC4K)e=\SI#s\47617d\167409Q\1066458\12557\154949\1041394:mZ\1101237V\1002766\1052091\1053704^y\US\178686\1101090N\120367;%\EOT\1002404(eW&C@yh\DC4\DEL%\6473i\ETB" - }, - userPict = Pict {fromPict = []}, - userAssets = [], - userAccentId = ColourId {fromColourId = 1}, - userDeleted = False, - userLocale = - Locale {lLanguage = Language Data.LanguageCodes.SS, lCountry = Just (Country {fromCountry = SN})}, - userService = - Just - ( ServiceRef - { _serviceRefId = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000100000000"))), - _serviceRefProvider = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000001"))) - } - ), - userHandle = - Just - (Handle {fromHandle = "9_hc2_-en1a8jck-tkni14wqqw6mx16tzlmo87gw3xu811i9424ku8fbmpl_hf06nus61lza7_kslu"}), - userExpire = Nothing, - userTeam = Just (Id (fromJust (UUID.fromString "00000002-0000-0000-0000-000100000000"))), - userManagedBy = ManagedByScim - } - } - -testObject_SelfProfile_user_15 :: SelfProfile -testObject_SelfProfile_user_15 = - SelfProfile - { selfUser = - User - { userId = (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000000000000"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000000000000"))), - qDomain = Domain {_domainText = "w-csl2vx.rpb.fq2"} - }, - userIdentity = Just (EmailIdentity (Email {emailLocal = "\1008204", emailDomain = "("})), - userDisplayName = - Name - { fromName = - "2\b\1033582\"\f\SI{?b\"\n>q\SIe8D\993505\1091482\1069161{{eX|-q\b3*59v\1035474s\51424\ESC\1063527\917628wG!uAO\rBZ\GSF[4\8087\v|\"\NAK4b\CANtE\DC2YB\ACK\NAKl5D>%P`\163216\bZ" - }, - userPict = Pict {fromPict = []}, - userAssets = - [(ImageAsset "" (Just AssetPreview)), (ImageAsset "" (Nothing)), (ImageAsset "" (Just AssetComplete))], - userAccentId = ColourId {fromColourId = 1}, - userDeleted = True, - userLocale = - Locale {lLanguage = Language Data.LanguageCodes.CO, lCountry = Just (Country {fromCountry = FM})}, - userService = - Just - ( ServiceRef - { _serviceRefId = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000000"))), - _serviceRefProvider = (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000100000000"))) - } - ), - userHandle = - Just - (Handle {fromHandle = "ncyk2udev3vg1bl_ujr0ff4fwymv_j_5lcse8b.c99i--lwnquz4mpbqzmrc_2ok_ytgqeov4bkkn_l"}), - userExpire = Nothing, - userTeam = Just (Id (fromJust (UUID.fromString "00000002-0000-0002-0000-000200000002"))), - userManagedBy = ManagedByScim - } - } - -testObject_SelfProfile_user_16 :: SelfProfile -testObject_SelfProfile_user_16 = - SelfProfile - { selfUser = - User - { userId = (Id (fromJust (UUID.fromString "00000002-0000-0002-0000-000200000000"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000000"))), - qDomain = Domain {_domainText = "76y01l79xajp.u5p8-qo--om"} - }, - userIdentity = Just (SSOIdentity (UserSSOId "" "") Nothing (Just (Phone {fromPhone = "+673892193308"}))), - userDisplayName = - Name - { fromName = - "\SUB\1052182\CANp\GS\1056488\146522k\1021341\1009355\32387\1072693\148602\1035440\1017171mzSJ" - }, - userPict = Pict {fromPict = []}, - userAssets = [(ImageAsset "" (Nothing)), (ImageAsset "" (Just AssetComplete))], - userAccentId = ColourId {fromColourId = 2}, - userDeleted = False, - userLocale = - Locale {lLanguage = Language Data.LanguageCodes.ZH, lCountry = Just (Country {fromCountry = NF})}, - userService = - Just - ( ServiceRef - { _serviceRefId = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000000"))), - _serviceRefProvider = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000001"))) - } - ), - userHandle = - Just - ( Handle - { fromHandle = - "v36sek51j__9i-w67.0foj6fpsrb_8-54_4c7yqld4cxu4emk0s67-f0oqyippzwxh9hmbrc-i0vpl0m-ww53-pku0kjb_6uprh4n6wg.xn7n9xp0t_5t.r_itjjmxjgkxud0ih083c6vscdlb-wex8no_4vlo.2llhidhq0awu3xr0craik" - } - ), - userExpire = Just (fromJust (readUTCTimeMillis "1864-05-11T06:04:44.922Z")), - userTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000000"))), - userManagedBy = ManagedByScim - } - } - -testObject_SelfProfile_user_17 :: SelfProfile -testObject_SelfProfile_user_17 = - SelfProfile - { selfUser = - User - { userId = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200000002"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000000000002"))), - qDomain = Domain {_domainText = "2.dh4"} - }, - userIdentity = - Just - ( SSOIdentity - (UserScimExternalId "") - (Just (Email {emailLocal = "", emailDomain = ""})) - (Just (Phone {fromPhone = "+023372401614100"})) - ), - userDisplayName = - Name - { fromName = - "T\1028174\SOK\NAKIwh%\92445C\SI!\1073767(*Iq\1032573\DEL'W\150542c=\STXMAK@\47619\US\t)^x\CAN\CAN\\^'s9\57735\DC1Q\65408.3\a5\1070124\ESC\EM\54276\SUB\1102011\1032606\EOTg+W(;W[\DC2!\41026>\69665:5\1008122\EMY-,\DC3\SYNi\25185\DLE\t\139316!a\SO=\1087548\1030610\187180\CAN=0\STX6,\FSzr(" - }, - userPict = Pict {fromPict = []}, - userAssets = [], - userAccentId = ColourId {fromColourId = -2}, - userDeleted = False, - userLocale = - Locale {lLanguage = Language Data.LanguageCodes.TS, lCountry = Just (Country {fromCountry = FI})}, - userService = Nothing, - userHandle = Just (Handle {fromHandle = "6huo"}), - userExpire = Just (fromJust (readUTCTimeMillis "1864-05-09T08:41:37.172Z")), - userTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200000002"))), - userManagedBy = ManagedByScim - } - } - -testObject_SelfProfile_user_18 :: SelfProfile -testObject_SelfProfile_user_18 = - SelfProfile - { selfUser = - User - { userId = (Id (fromJust (UUID.fromString "00000002-0000-0002-0000-000200000002"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000002-0000-0000-0000-000200000002"))), - qDomain = Domain {_domainText = "1.t3yc3"} - }, - userIdentity = Nothing, - userDisplayName = - Name - { fromName = - "}Mr$\38120Fi~O\EMb\\\19207k\1085532\1039196\r^n\1112567\&8\187061\1010217\CAN\DC2xj\RS\1030094\ah\EM\DEL\188337)WJ>Y\1070138[\CAN\989394ed\1113772,\31471=\RSHmMV%x-^;_\SIun" - }, - userPict = Pict {fromPict = []}, - userAssets = [(ImageAsset "" (Just AssetComplete)), (ImageAsset "" (Just AssetComplete))], - userAccentId = ColourId {fromColourId = 0}, - userDeleted = False, - userLocale = - Locale {lLanguage = Language Data.LanguageCodes.BS, lCountry = Just (Country {fromCountry = SB})}, - userService = - Just - ( ServiceRef - { _serviceRefId = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000000000000"))), - _serviceRefProvider = (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000001"))) - } - ), - userHandle = Nothing, - userExpire = Just (fromJust (readUTCTimeMillis "1864-05-11T16:10:28.222Z")), - userTeam = Just (Id (fromJust (UUID.fromString "00000002-0000-0000-0000-000100000002"))), - userManagedBy = ManagedByWire - } - } - -testObject_SelfProfile_user_19 :: SelfProfile -testObject_SelfProfile_user_19 = - SelfProfile - { selfUser = - User - { userId = (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000200000000"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000002-0000-0002-0000-000200000000"))), - qDomain = Domain {_domainText = "8y.o9"} - }, - userIdentity = Just (EmailIdentity (Email {emailLocal = "?", emailDomain = "S"})), - userDisplayName = Name {fromName = "\996756\&2\1108160\92546\DC3B\NAK5\1066367"}, - userPict = Pict {fromPict = []}, - userAssets = [(ImageAsset "" (Just AssetComplete)), (ImageAsset "" (Just AssetPreview))], - userAccentId = ColourId {fromColourId = -2}, - userDeleted = True, - userLocale = - Locale {lLanguage = Language Data.LanguageCodes.HR, lCountry = Just (Country {fromCountry = BG})}, - userService = - Just - ( ServiceRef - { _serviceRefId = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000001"))), - _serviceRefProvider = (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000"))) - } - ), - userHandle = - Just - ( Handle - { fromHandle = - "-bc4hz9hn8ep81cxp.9_jy4wl-w2h8o34wb1we4.77yp9oai6le1fm_lshwh4_j5dhzzpkidmg23t75bzjvms7x-7v.ru1l7cqkkci9uynit6kbwinsy4fug55j5p6pek_9d5g90sx7jgixu3teh_dvo.a-l79pgpxs4iov569j4bnpv-4lck0qj5vjv.5sb9p47w_.5lfyuqcwrpeq.fqfl9miil.epxsert-dh1" - } - ), - userExpire = Nothing, - userTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000002"))), - userManagedBy = ManagedByWire - } - } - -testObject_SelfProfile_user_20 :: SelfProfile -testObject_SelfProfile_user_20 = - SelfProfile - { selfUser = - User - { userId = (Id (fromJust (UUID.fromString "00000001-0000-0002-0000-000200000000"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000001-0000-0002-0000-000000000002"))), - qDomain = Domain {_domainText = "l2.y"} - }, - userIdentity = Just (PhoneIdentity (Phone {fromPhone = "+23457350508"})), - userDisplayName = - Name - { fromName = - "\1093767\172141o\1005690\129309.b\134607\f5UDRv8T(\SOT\997389N*GQ\ENQ\ESCjtl\SIDK_;\"v\1099332\SUBr\ACKI\133837Y\50543z%5$[\DC3\rQji.\NUL\1048415j\n\ESC\f\165699\"I\ETB" - }, - userPict = Pict {fromPict = []}, - userAssets = [(ImageAsset "" (Nothing)), (ImageAsset "" (Nothing))], - userAccentId = ColourId {fromColourId = 0}, - userDeleted = False, - userLocale = Locale {lLanguage = Language Data.LanguageCodes.OJ, lCountry = Nothing}, - userService = Nothing, - userHandle = - Just - ( Handle - { fromHandle = - "v89lg6khwz.ruz1ngo032582p5z2qvmk92m58_5x688fqurqg..j2p9wa.pipqhunk.q-cdtnvntvv16whxmbay63licg.v9nm_bnn1xdlovj7_wa..hwx-horp6oj8yzqne_49qpsdh.shj8q9rjh7384.mhk1244pay9tiale9433tmz7q9upc0lh5wurqo5wpnyidivhrtgk-jm.6wc-02ptct33e" - } - ), - userExpire = Nothing, - userTeam = Just (Id (fromJust (UUID.fromString "00000002-0000-0000-0000-000000000001"))), - userManagedBy = ManagedByScim - } - } diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/UserUpdate_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/UserUpdate_user.hs index e9acea44643..224e125bbf1 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/UserUpdate_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/UserUpdate_user.hs @@ -21,7 +21,7 @@ module Test.Wire.API.Golden.Generated.UserUpdate_user where import Imports (Maybe (Just, Nothing)) import Wire.API.User ( Asset (ImageAsset), - AssetSize (AssetComplete, AssetPreview), + AssetSize (AssetComplete), ColourId (ColourId, fromColourId), Name (Name, fromName), Pict (Pict, fromPict), @@ -32,9 +32,9 @@ testObject_UserUpdate_user_1 :: UserUpdate testObject_UserUpdate_user_1 = UserUpdate { uupName = Nothing, - uupPict = Just (Pict {fromPict = []}), - uupAssets = Just [(ImageAsset "" (Nothing)), (ImageAsset "" (Nothing))], - uupAccentId = Just (ColourId {fromColourId = 2}) + uupPict = Nothing, + uupAssets = Nothing, + uupAccentId = Nothing } testObject_UserUpdate_user_2 :: UserUpdate @@ -42,300 +42,6 @@ testObject_UserUpdate_user_2 = UserUpdate { uupName = Just (Name {fromName = "~\RSK\1033973w\EMd\156648\59199g"}), uupPict = Just (Pict {fromPict = []}), - uupAssets = Just [(ImageAsset "" (Just AssetComplete))], + uupAssets = Just [ImageAsset "" (Just AssetComplete)], uupAccentId = Just (ColourId {fromColourId = 3}) } - -testObject_UserUpdate_user_3 :: UserUpdate -testObject_UserUpdate_user_3 = - UserUpdate - { uupName = Nothing, - uupPict = Just (Pict {fromPict = []}), - uupAssets = - Just - [ (ImageAsset "`\34002" (Nothing)), - (ImageAsset "" (Just AssetComplete)), - (ImageAsset "4\ACKE" (Just AssetPreview)), - (ImageAsset "" (Nothing)), - (ImageAsset "" (Nothing)), - (ImageAsset "" (Nothing)), - (ImageAsset "\61750\STXf" (Just AssetPreview)) - ], - uupAccentId = Just (ColourId {fromColourId = -5}) - } - -testObject_UserUpdate_user_4 :: UserUpdate -testObject_UserUpdate_user_4 = - UserUpdate - { uupName = - Just - ( Name - { fromName = - "\18082\\5-`\f\155562T\SUB|\rD\147442GV\1078111\46527nt@,5\1007825Ux0M\1093197\CANrf\46052+\1003319\CAN\153789\&4L\32397]+\DELu\NUL\1023019\t6\164426z\fo\21287\NUL\151080d\NUL\SUB\96525\a\GS" - } - ), - uupPict = Just (Pict {fromPict = []}), - uupAssets = - Just - [ (ImageAsset "W%" (Just AssetPreview)), - (ImageAsset "" (Nothing)), - (ImageAsset "" (Just AssetPreview)), - (ImageAsset "e\SYN\1013544" (Just AssetPreview)) - ], - uupAccentId = Just (ColourId {fromColourId = 2}) - } - -testObject_UserUpdate_user_5 :: UserUpdate -testObject_UserUpdate_user_5 = - UserUpdate - { uupName = - Just - ( Name - { fromName = - "}C)BJ\SUB\60353M1\FS\1052672\DLE\186121\fT\US}lG}B4D\FS/Y\1055890\DC4g\1033925I\992008\n%\172154p" - } - ), - uupPict = Nothing, - uupAssets = Just [(ImageAsset "R\1000805" (Just AssetComplete))], - uupAccentId = Just (ColourId {fromColourId = -8}) - } - -testObject_UserUpdate_user_6 :: UserUpdate -testObject_UserUpdate_user_6 = - UserUpdate - { uupName = - Just - ( Name - { fromName = - "\179443\7145\&6U5!E\1026324nyH\1060078\94836B$\DLE\DEL\DC3-\DC1\998885\1040778\1028475rO\ESC\a\FS\1027937\1102166`i`\158910m/YzFX:ZRz\40972\FS\994216\161648\&75" - } - ), - uupPict = Just (Pict {fromPict = []}), - uupAssets = Just [], - uupAccentId = Just (ColourId {fromColourId = -2}) - } - -testObject_UserUpdate_user_7 :: UserUpdate -testObject_UserUpdate_user_7 = - UserUpdate - { uupName = - Just - ( Name - { fromName = - "\f/\r\1072381\160399\NUL\1076257}A[D \173047\EM]Q\ACK#:!q\59840+$&\ETB\179839#\SI\b^2\v\46403\fsPB\1012154\1076290HB+e&%\r\US256\186183HHa\"or!uV\NAKT\64042<\EMpH" - } - ), - uupPict = Just (Pict {fromPict = []}), - uupAssets = - Just [(ImageAsset "v" (Nothing)), (ImageAsset "" (Nothing)), (ImageAsset "\CAN\GS" (Just AssetPreview))], - uupAccentId = Nothing - } - -testObject_UserUpdate_user_12 :: UserUpdate -testObject_UserUpdate_user_12 = - UserUpdate - { uupName = - Just - ( Name - { fromName = - "\r\1039482Z\CAN&zv\1014151\ACKvz\1100570\158367\987894ex=3\STX\1092502\n;@t\5575t,!Dx\1026936~\"iks\b!R\177837MT\134815\FS%\CANg\20839\bx\GS\1105601\188616\&4V\SOH\1090559\RS\DLE\26049.\14980a\992707\EOT_+M\NUL8GY%\n\1094563\NUL\58828}!tIB" - } - ), - uupPict = Just (Pict {fromPict = []}), - uupAssets = Nothing, - uupAccentId = Just (ColourId {fromColourId = 6}) - } - -testObject_UserUpdate_user_13 :: UserUpdate -testObject_UserUpdate_user_13 = - UserUpdate - { uupName = - Just - ( Name - { fromName = - "\1044671\&9k\bE\NUL\"9d\NAK\1109755\&8Z\15202.(+: _7As~\125226\SOH\140843\1032516D\1085357yC$\996510Q\DC1\DC4\1014012\&6[\1034518\175709?\4988P\34644\&1!N\n\1068831\&4V\FSk\NUL\SOH_-\37112\1021531\n;&m\ENQ\t\166024D1V25\61064^\137352#s\1066203\&2l\175875\SI\1061300\187602\GS\1063439[ L\178759V\1097869\DC2\US\19305\b\100486\1036805K\1014116:UMM1H\tk" - } - ), - uupPict = Nothing, - uupAssets = - Just - [ (ImageAsset "?w" (Just AssetComplete)), - (ImageAsset "" (Just AssetComplete)), - (ImageAsset "\1077824\&1" (Just AssetPreview)), - (ImageAsset "i\ACK\63652" (Nothing)), - (ImageAsset "\1087556\DC3\191297" (Nothing)), - (ImageAsset "U\1103637," (Just AssetComplete)) - ], - uupAccentId = Just (ColourId {fromColourId = 2}) - } - -testObject_UserUpdate_user_14 :: UserUpdate -testObject_UserUpdate_user_14 = - UserUpdate - { uupName = - Just - ( Name - { fromName = - "/H\DC1Toc\DC4\DC1\54115`{0\154001[\SOH<\150233\1072626\NAKm\ETX|Wd|\1008161\DC3\GS\1039875\SOHn\1100849\140588wuN\1054281tvB/En|2^n\171256_\58506K\1007777\&4\CAN\ETB\1013763\1087777D\165659R'q6\DC4?\DC2\STXAEO((W\1004794r'C\1018863\SUB\STX+M\SOE\DC3hi\CAN\49550\&8\187020\NUL#\CAN\9913Ex\141641\134184Av&=&%\131212H}p\23993grJ\120368d" - } - ), - uupPict = Just (Pict {fromPict = []}), - uupAssets = Just [(ImageAsset "\64831\121090" (Just AssetComplete))], - uupAccentId = Nothing - } - -testObject_UserUpdate_user_15 :: UserUpdate -testObject_UserUpdate_user_15 = - UserUpdate - { uupName = - Just - ( Name - { fromName = - "\16814e\155596:\992888\NULz\DC2\SUBmx\180351\1037179\v\42268u\1073830J\54625#\4459]|\1112860%\111253~zM6*-\93029~\CANXm\180894R!v\1069937Nano\1086481uf7\1072061TP\ETB\152372\127219\191108!O\NAK\42281\ACK\ESC\DC4\65939\EOTH|\38224K\GS1,RzU`(\NUL\156865\177574:4\\%\179080dc\12331w\vd\n\1026663\152722\1098863\SO\1001375d\EOT\1088813G\EOT0\1058000\US\NAKtH\CANN\147871\48387E\RS\1007015" - } - ), - uupPict = Just (Pict {fromPict = []}), - uupAssets = - Just - [ (ImageAsset "\166996" (Just AssetPreview)), - (ImageAsset "" (Just AssetPreview)), - (ImageAsset "%" (Just AssetPreview)) - ], - uupAccentId = Just (ColourId {fromColourId = -2}) - } - -testObject_UserUpdate_user_16 :: UserUpdate -testObject_UserUpdate_user_16 = - UserUpdate - { uupName = - Just - ( Name - { fromName = - "\ncV~sD!\1057793\34727sU\DLE\t>*\NUL,h<\1097292\DEL.l^X\US\187241oc9;\1077389\1056051\NAKnofI~\135565\DC2L\1094163\1096027\ESC\EOT\1031678;\\%\1005629$\167754\&6e\1090985?0\SIAk" - } - ), - uupPict = Just (Pict {fromPict = []}), - uupAssets = Just [], - uupAccentId = Nothing - } - -testObject_UserUpdate_user_17 :: UserUpdate -testObject_UserUpdate_user_17 = - UserUpdate - { uupName = Nothing, - uupPict = Just (Pict {fromPict = []}), - uupAssets = - Just - [ (ImageAsset ")E\100683" (Nothing)), - (ImageAsset "c\DC2/" (Just AssetPreview)), - (ImageAsset "6OT" (Nothing)), - (ImageAsset "B" (Just AssetComplete)) - ], - uupAccentId = Just (ColourId {fromColourId = 6}) - } - -testObject_UserUpdate_user_18 :: UserUpdate -testObject_UserUpdate_user_18 = - UserUpdate - { uupName = - Just - ( Name - { fromName = - "\DC4}\191258$.3Z\SYNX\1021301:\STX23\133378\1077097v\1087008\CAN\DC3\ETBr2%sf\a\\\1046301\ACK\30017{$,\120262\EMx\SO-t\45592\986316y\RS\180423R\SOHG\160762\"\CAN.\155473\162373`UJe\"\r\a=.2\NAK\GS\ETXW\SO\1083705n*2\1072082@V\DELK\SYN@Q,@E_~\ENQi\ESC~\1057217;!II,k07\1091310\&2\62319\ETX\ESC" - } - ), - uupPict = Just (Pict {fromPict = []}), - uupAssets = - Just - [ (ImageAsset "r\1011600s" (Nothing)), - (ImageAsset "\DEL" (Nothing)), - (ImageAsset "H" (Just AssetComplete)), - (ImageAsset "" (Nothing)) - ], - uupAccentId = Just (ColourId {fromColourId = 7}) - } - -testObject_UserUpdate_user_19 :: UserUpdate -testObject_UserUpdate_user_19 = - UserUpdate - { uupName = Nothing, - uupPict = Just (Pict {fromPict = []}), - uupAssets = Nothing, - uupAccentId = Just (ColourId {fromColourId = 0}) - } - -testObject_UserUpdate_user_20 :: UserUpdate -testObject_UserUpdate_user_20 = - UserUpdate - { uupName = - Just - ( Name - { fromName = - "D]980\984137)e\991819:?s$QP\31836_\DC4qyj\154724\138286\DC4x\SUBq6uwz\181356\36245\1049734\DC4\1068581\SO\SOH\SUBz\1046764D\r\ETX\1079395\&6NK\1019667f/OK\97244\ENQr\EOTy*\NAK\USA{\ETB}\NAKrr(X^`\t_W}L\1053312\fUy\SUB\r\138279sM\4542\GS7\f\1030887:\1063938B\GS\1064215\STX)\1001003k\ESCj\DC1\NAK\997417;f*\DEL" - } - ), - uupPict = Nothing, - uupAssets = Nothing, - uupAccentId = Just (ColourId {fromColourId = -1}) - } diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/User_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/User_user.hs index e77912e00b3..a6cf67b39c5 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/User_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/User_user.hs @@ -22,21 +22,8 @@ import Data.Domain (Domain (Domain, _domainText)) import Data.Handle (Handle (Handle, fromHandle)) import Data.ISO3166_CountryCodes ( CountryCode - ( AQ, - BD, - BJ, - BS, - CN, - CY, - DM, - ES, - HK, - MO, - MQ, - NF, - PL, + ( MQ, SB, - TG, TN, UA ), @@ -45,26 +32,10 @@ import Data.Id (Id (Id)) import Data.Json.Util (readUTCTimeMillis) import qualified Data.LanguageCodes ( ISO639_1 - ( BA, - BI, - CU, - CY, + ( BI, DA, - DE, - EE, - ET, - KA, - LA, - LI, - MI, - MR, - NE, - PL, TG, - TL, - TN, - TW, - VE + TN ), ) import Data.Qualified (Qualified (Qualified, qDomain, qUnqualified)) @@ -73,7 +44,7 @@ import Imports (Bool (False, True), Maybe (Just, Nothing), fromJust) import Wire.API.Provider.Service (ServiceRef (ServiceRef, _serviceRefId, _serviceRefProvider)) import Wire.API.User ( Asset (ImageAsset), - AssetSize (AssetComplete, AssetPreview), + AssetSize (AssetComplete), ColourId (ColourId, fromColourId), Country (Country, fromCountry), Email (Email, emailDomain, emailLocal), @@ -90,7 +61,7 @@ import Wire.API.User PhoneIdentity, SSOIdentity ), - UserSSOId (UserSSOId, UserScimExternalId), + UserSSOId (UserScimExternalId), ) testObject_User_user_1 :: User @@ -102,23 +73,17 @@ testObject_User_user_1 = { qUnqualified = (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000200000002"))), qDomain = Domain {_domainText = "s-f4.s"} }, - userIdentity = Just (PhoneIdentity (Phone {fromPhone = "+340639706578"})), + userIdentity = Nothing, userDisplayName = Name {fromName = "\NULuv\996028su\28209lRi"}, userPict = Pict {fromPict = []}, - userAssets = [(ImageAsset "" (Just AssetPreview)), (ImageAsset "" (Just AssetPreview))], + userAssets = [], userAccentId = ColourId {fromColourId = 1}, userDeleted = True, userLocale = Locale {lLanguage = Language Data.LanguageCodes.TN, lCountry = Just (Country {fromCountry = SB})}, - userService = - Just - ( ServiceRef - { _serviceRefId = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000001"))), - _serviceRefProvider = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000001"))) - } - ), + userService = Nothing, userHandle = Nothing, - userExpire = Just (fromJust (readUTCTimeMillis "1864-05-08T06:39:23.932Z")), - userTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000000"))), + userExpire = Nothing, + userTeam = Nothing, userManagedBy = ManagedByWire } @@ -141,10 +106,7 @@ testObject_User_user_2 = userAssets = [ (ImageAsset "" (Nothing)), (ImageAsset "" (Just AssetComplete)), - (ImageAsset "" (Just AssetComplete)), - (ImageAsset "" (Just AssetPreview)), - (ImageAsset "" (Nothing)), - (ImageAsset "" (Just AssetPreview)) + (ImageAsset "" (Just AssetComplete)) ], userAccentId = ColourId {fromColourId = -2}, userDeleted = True, @@ -171,7 +133,7 @@ testObject_User_user_3 = { qUnqualified = (Id (fromJust (UUID.fromString "00000002-0000-0000-0000-000100000002"))), qDomain = Domain {_domainText = "dt.n"} }, - userIdentity = Just (SSOIdentity (UserSSOId "" "") Nothing (Just (Phone {fromPhone = "+025643547231991"}))), + userIdentity = Just (EmailIdentity (Email {emailLocal = "f", emailDomain = "\83115"})), userDisplayName = Name {fromName = ",r\EMXEg0$\98187\RS\SI'uS\ETX/\1009222`\228V.J{\fgE(\rK!\SOp8s9gXO\21810Xj\STX\RS\DC2"}, userPict = Pict {fromPict = []}, @@ -224,7 +186,7 @@ testObject_User_user_4 = Just ( Handle { fromHandle = - "mzebw5l9p858om29lqwj5d08otrwzzickuh_s8dpookvkl_ryzbsvw-ogxrwyiw2-.udd2l7us58siy2rp024r9-ezsotchneqgalz1y1ltna7yg3dfg.wzn4vx3hjhch8.-pi3azd9u3l-5t6uyjqk93twvx_3gdh32e82fsrdpf8qfsi2ls-a2pce8p1xjh7387nztzu.q" + "iw2-.udd2l7-7yg3dfg.wzn4vx3hjhch8.--5t6uyjqk93twv-a2pce8p1xjh7387nztzu.q" } ), userExpire = Just (fromJust (readUTCTimeMillis "1864-05-09T14:25:26.089Z")), @@ -235,530 +197,39 @@ testObject_User_user_4 = testObject_User_user_5 :: User testObject_User_user_5 = User - { userId = (Id (fromJust (UUID.fromString "00000002-0000-0002-0000-000100000002"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000002-0000-0000-0000-000200000002"))), - qDomain = Domain {_domainText = "k.ma656.845z--u9.34.4ot8v.p6-2o"} - }, - userIdentity = Just (EmailIdentity (Email {emailLocal = "f", emailDomain = "\83115"})), - userDisplayName = - Name - { fromName = - "[|u\aFH\1083955\DC3\164710\179183k#\1067479fN4\SUB#G\1003889\SOkK\GS\1047735yP\1065258|H\129482\vi\rAcUp\SO\US" - }, - userPict = Pict {fromPict = []}, - userAssets = [(ImageAsset "" (Just AssetPreview))], - userAccentId = ColourId {fromColourId = -2}, - userDeleted = True, - userLocale = Locale {lLanguage = Language Data.LanguageCodes.ET, lCountry = Just (Country {fromCountry = NF})}, - userService = - Just - ( ServiceRef - { _serviceRefId = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000000"))), - _serviceRefProvider = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000000"))) - } - ), - userHandle = Just (Handle {fromHandle = "hb"}), - userExpire = Just (fromJust (readUTCTimeMillis "1864-05-11T20:43:46.798Z")), - userTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000200000000"))), - userManagedBy = ManagedByScim - } - -testObject_User_user_6 :: User -testObject_User_user_6 = - User - { userId = (Id (fromJust (UUID.fromString "00000002-0000-0000-0000-000100000002"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000001"))), - qDomain = Domain {_domainText = "u8-9--eppc-k-02.l5-ci5zk"} - }, - userIdentity = Just (SSOIdentity (UserSSOId "" "") Nothing (Just (Phone {fromPhone = "+90270460"}))), - userDisplayName = - Name - { fromName = - "\992528RiM2\DC3\1104965#5T-~=#\SI\1059840rf\994293}\SOH\172366\\K\148731\DC2I\n\SOz'\35982\SUB\SYN>p\1107992\FS\\(\167236\1032144\1042866\DELj\1050995M|\167476\DC4c\181439`/\tpU]#\SI\1056223(9\NAKV\148251\&23i\141711\EMgs[\US:\\\1072651" - }, - userPict = Pict {fromPict = []}, - userAssets = [(ImageAsset "\1099856" (Just AssetComplete))], - userAccentId = ColourId {fromColourId = -1}, - userDeleted = True, - userLocale = Locale {lLanguage = Language Data.LanguageCodes.TW, lCountry = Just (Country {fromCountry = BD})}, - userService = - Just - ( ServiceRef - { _serviceRefId = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000001"))), - _serviceRefProvider = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000001"))) - } - ), - userHandle = - Just - ( Handle - { fromHandle = - "hp95jkglpreb88pm0w.35i6za1241dt2el.8s1msvq2u4aov_muws4n4xdvv-ocd95oqqbb7.eqdi1hmudsh_9h0nt0o0gtkpnm7xu494-nl6ljfoxsxlm.66l8ny3yejd2fqb5y.zpi2rgo-f8yhkwl0k7.a91kdxflxx4.am_ka62kebtexj97f07bko4t2.6tr1rx1cbabnk0w_dz714nmenx8bscvdw8_ay1o" - } - ), - userExpire = Nothing, - userTeam = Nothing, - userManagedBy = ManagedByWire - } - -testObject_User_user_7 :: User -testObject_User_user_7 = - User - { userId = (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000200000002"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000200000001"))), - qDomain = Domain {_domainText = "7sb.43o7z--k8.k-7"} - }, - userIdentity = Just (EmailIdentity (Email {emailLocal = "", emailDomain = "o"})), - userDisplayName = Name {fromName = "$]\EOTe<&\aKfM"}, - userPict = Pict {fromPict = []}, - userAssets = [(ImageAsset ";" (Just AssetPreview))], - userAccentId = ColourId {fromColourId = -1}, - userDeleted = True, - userLocale = Locale {lLanguage = Language Data.LanguageCodes.VE, lCountry = Just (Country {fromCountry = BS})}, - userService = - Just - ( ServiceRef - { _serviceRefId = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000001"))), - _serviceRefProvider = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000100000000"))) - } - ), - userHandle = Just (Handle {fromHandle = "t.w_8."}), - userExpire = Just (fromJust (readUTCTimeMillis "1864-05-09T16:08:44.186Z")), - userTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000200000001"))), - userManagedBy = ManagedByScim - } - -testObject_User_user_8 :: User -testObject_User_user_8 = - User - { userId = (Id (fromJust (UUID.fromString "00000002-0000-0000-0000-000100000000"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000002-0000-0000-0000-000100000002"))), - qDomain = Domain {_domainText = "2v.k55u"} - }, - userIdentity = Just (EmailIdentity (Email {emailLocal = "", emailDomain = ""})), - userDisplayName = - Name - { fromName = - "?\142624\101002w\nLi\b\DC1{[8\nd}\29988.Wh^z\74534\3120V}\vAPy\DC2sgvk\1020150 5\1049847(5\v\US_y\44245dcfc\51598\8475)fK\DC2A\996460\1061546zu\1067558GEk\vQ\1060756\144328\NUL\997313\&5\38619\v" - }, - userPict = Pict {fromPict = []}, - userAssets = [(ImageAsset "" (Just AssetComplete))], - userAccentId = ColourId {fromColourId = -2}, - userDeleted = False, - userLocale = Locale {lLanguage = Language Data.LanguageCodes.KA, lCountry = Just (Country {fromCountry = AQ})}, - userService = Nothing, - userHandle = Nothing, - userExpire = Nothing, - userTeam = Nothing, - userManagedBy = ManagedByWire - } - -testObject_User_user_9 :: User -testObject_User_user_9 = - User - { userId = (Id (fromJust (UUID.fromString "00000002-0000-0002-0000-000100000001"))), + { userId = (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000100000002"))), userQualifiedId = Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000000"))), - qDomain = Domain {_domainText = "9.fs7-3.x-0"} + { qUnqualified = (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000200000002"))), + qDomain = Domain {_domainText = "28b.cqb"} }, userIdentity = - Just (FullIdentity (Email {emailLocal = "", emailDomain = "\ESC"}) (Phone {fromPhone = "+783368053"})), - userDisplayName = Name {fromName = "P\1059549o1qr1(k\987545-\USW\SYN\92334TX9F@\GS\EM\DEL\CAN`\20651\ENQ4\EOT@"}, - userPict = Pict {fromPict = []}, - userAssets = [], - userAccentId = ColourId {fromColourId = -2}, - userDeleted = False, - userLocale = Locale {lLanguage = Language Data.LanguageCodes.TL, lCountry = Just (Country {fromCountry = MO})}, - userService = - Just - ( ServiceRef - { _serviceRefId = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000100000001"))), - _serviceRefProvider = (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000"))) - } - ), - userHandle = Just (Handle {fromHandle = "qptpyy3"}), - userExpire = Just (fromJust (readUTCTimeMillis "1864-05-11T13:40:26.091Z")), - userTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000100000001"))), - userManagedBy = ManagedByScim - } - -testObject_User_user_10 :: User -testObject_User_user_10 = - User - { userId = (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000200000002"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000002-0000-0002-0000-000100000000"))), - qDomain = Domain {_domainText = "j6-m-9-nc.b4k"} - }, - userIdentity = Just (SSOIdentity (UserSSOId "" "") (Just (Email {emailLocal = "", emailDomain = ""})) Nothing), - userDisplayName = - Name - { fromName = - "u[\68811\"W\172389\1051681\EMS\1048905x\DC1J\DC3\NAKN\1067266I\1034426\FS\"\1047349&\GS\SO\165324\DC21r\ESC1S\1016718\RS+V\v\SIt%\1085478\ACK\1072392\ENQ\t\6277Q\1028565v`\1079541q\GS\95671\RSW\67856I\1029796\1040562\aK/\DLE\1036794}\1050591\49895A5*\1050100" - }, - userPict = Pict {fromPict = []}, - userAssets = [], - userAccentId = ColourId {fromColourId = -2}, - userDeleted = True, - userLocale = Locale {lLanguage = Language Data.LanguageCodes.PL, lCountry = Just (Country {fromCountry = CN})}, - userService = - Just - ( ServiceRef - { _serviceRefId = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000001"))), - _serviceRefProvider = (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000"))) - } - ), - userHandle = - Just (Handle {fromHandle = "xyz9jol-j7bb9xtifngv1wejx-ekud7-c-koevsi-e.gcubdvvibrsjmz_1uzq8acxu62oqzn8v9nkz"}), - userExpire = Just (fromJust (readUTCTimeMillis "1864-05-07T20:52:50.974Z")), - userTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000002"))), - userManagedBy = ManagedByScim - } - -testObject_User_user_11 :: User -testObject_User_user_11 = - User - { userId = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200000001"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000000000000"))), - qDomain = Domain {_domainText = "94.eg8.s1.u"} - }, - userIdentity = Just (PhoneIdentity (Phone {fromPhone = "+9360086324"})), + Just (FullIdentity (Email {emailLocal = "", emailDomain = ""}) (Phone {fromPhone = "+837934954"})), userDisplayName = Name { fromName = - "\ENQ*U>o:\171361;\1002213+\31270'm\1067198\1088531\&3X!ELsR\GS%\29917\ETX\25722\DC2d#Q\DEL\DC1(H\1057328Al+E[\SOH\1043898\DC4)\149666\174107\1040634\NUL\1035995\ESC\GS\GS\DC1q\a_\1044144.Cq;O\1061742\t\RS\SUB\32927\20189\157326" + "^\1025896F\1083260=&o>f<7\SOq|6\DC1\EM\997351\1054148\ESCf\1014774\170183\DC3bnVAj`^L\f\1047425\USLI\ENQ!\1061384\ETB`\1041537\ETXe\26313\SUBK|" }, userPict = Pict {fromPict = []}, userAssets = [], userAccentId = ColourId {fromColourId = 0}, userDeleted = False, - userLocale = Locale {lLanguage = Language Data.LanguageCodes.EE, lCountry = Just (Country {fromCountry = PL})}, - userService = - Just - ( ServiceRef - { _serviceRefId = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000000"))), - _serviceRefProvider = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000001"))) - } - ), - userHandle = - Just - ( Handle - { fromHandle = - "qgfs79695bljg0-2gg7d7eigfry969_boy88f_pt2ecyxmaos66dluhp1r2zf1lzdbu8bksy6mq8zoxyh6lh5-nwligu0o-_4kt5zny65hsfa.ydan6c1kftchxh8jlzype-hbfz6821v.ow-ugddhvbz5cii8b23hhnrkz7xbphzz9st4nfft7" - } - ), - userExpire = Just (fromJust (readUTCTimeMillis "1864-05-10T17:03:19.878Z")), - userTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000200000000"))), - userManagedBy = ManagedByScim - } - -testObject_User_user_12 :: User -testObject_User_user_12 = - User - { userId = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000002-0000-0000-0000-000200000002"))), - qDomain = Domain {_domainText = "36c48v3.j22"} - }, - userIdentity = Nothing, - userDisplayName = - Name - { fromName = - "aM\16681\DEL\t_%\"z>3\144231\DC3!yrxp\17091\a]0RQp5}v\182602bn6\988436\995116g\FSDC\1039960\rNl\SYN\\\1095728\100544\1050922_\146297$,_kk\t.C brXI\1080901\"+p\1094835\DELH4'$\DC3\USv?rf0d5w\1072160\&0" - }, - userPict = Pict {fromPict = []}, - userAssets = [(ImageAsset "" (Just AssetComplete))], - userAccentId = ColourId {fromColourId = -2}, - userDeleted = True, - userLocale = Locale {lLanguage = Language Data.LanguageCodes.DE, lCountry = Just (Country {fromCountry = CY})}, + userLocale = Locale {lLanguage = Language Data.LanguageCodes.BI, lCountry = Just (Country {fromCountry = MQ})}, userService = Just ( ServiceRef { _serviceRefId = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000100000000"))), - _serviceRefProvider = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000100000000"))) + _serviceRefProvider = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000000"))) } ), userHandle = Just ( Handle { fromHandle = - "jor0tv5x7jcptbelj4lb8asjp6-1knhjb0y44uxc5m7apnyzwqg-v.cnnbpxmbr_7tcmygsn5wvnjtb8uzvprai6ayk4kp9gcwtkpsadfs7bqz9qk6.nyeone71vfmmfnvw0f6._4apxbqrpju3v-z-l0osvpfdaajsyyr2bvdq_sffgw12.9gr3zl_d43rrc5.zz0xhxqqvv12l85t2u31_c-gdbr" - } - ), - userExpire = Nothing, - userTeam = Nothing, - userManagedBy = ManagedByScim - } - -testObject_User_user_13 :: User -testObject_User_user_13 = - User - { userId = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000000000000"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000100000002"))), - qDomain = Domain {_domainText = "x-90ql.5.8-he1.9t.04f-0v83.4p.nic71"} - }, - userIdentity = Just (PhoneIdentity (Phone {fromPhone = "+525773726575872"})), - userDisplayName = - Name - { fromName = - "/\50476e9s\US\ACK\1033357*\1073446!;$$rF4?\12694\b~{]\ENQ~\1061469Ic&&\119840S\39434\1063726{\96735oW\151219\62244\134274?\1041546&&,\r\a>9V5&e+O\EOT?m\1048021M\176823V\DEL\1070807\1040396\v\1033296\145519#jm@\1033513x\1099446\b\7714\&1gZ" - }, - userPict = Pict {fromPict = []}, - userAssets = [(ImageAsset "" (Nothing))], - userAccentId = ColourId {fromColourId = 0}, - userDeleted = False, - userLocale = Locale {lLanguage = Language Data.LanguageCodes.MR, lCountry = Just (Country {fromCountry = HK})}, - userService = Nothing, - userHandle = Just (Handle {fromHandle = "m4o"}), - userExpire = Just (fromJust (readUTCTimeMillis "1864-05-11T17:37:12.497Z")), - userTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0002-0000-000100000000"))), - userManagedBy = ManagedByWire - } - -testObject_User_user_20 :: User -testObject_User_user_20 = - User - { userId = (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000100000001"))), - userQualifiedId = - Qualified - { qUnqualified = (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000000"))), - qDomain = Domain {_domainText = "6mlxl.2v5.gd7"} - }, - userIdentity = Just (PhoneIdentity (Phone {fromPhone = "+43245195312227"})), - userDisplayName = - Name - { fromName = - "bW\\&\166022\141394\\k\153943\25617\1075373\&0\NAKi\63940GRh\NAKh\CANO\ETBJ\1011164s_\989976jV\SI\DC1\STX\1106211~N(\ETXrj1r^\1081784Zaw\150200\1086815j\131932\1028541\185724\134546N\SOH\30641ex8*\39157A\DC2nkzr\31591{j\SOH-g\1012550=d<\\Pc+K(vZ\FS" - }, - userPict = Pict {fromPict = []}, - userAssets = [], - userAccentId = ColourId {fromColourId = 1}, - userDeleted = False, - userLocale = Locale {lLanguage = Language Data.LanguageCodes.CU, lCountry = Nothing}, - userService = - Just - ( ServiceRef - { _serviceRefId = (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000100000001"))), - _serviceRefProvider = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000000000000"))) - } - ), - userHandle = Just (Handle {fromHandle = "apdh51n9mpxew4sose_n_mu"}), - userExpire = Just (fromJust (readUTCTimeMillis "1864-05-10T13:00:07.275Z")), - userTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000000"))), - userManagedBy = ManagedByWire - } From 909a72b20eec06de0c62bdb6c052c4f030e91927 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 15 Sep 2021 15:05:37 +0200 Subject: [PATCH 23/72] Implement status updates for remote conversations (#1753) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Add migration and update queries * Fix typo * Add failing test for remote conv status update * Refactor `Conversation` to include metadata This factors out metadata fields from the `Conversation` type so that they can be reused elsewhere without duplicating code. At the moment they are only used in the internal `GET i/conversations/:cnv/meta` endpoint, but later on this extraction will be useful to improve the `get-conversations` federation RPC. * Extract `MemberStatus` from `LocalMember` This is a refactoring of `LocalMember` to extract the member status fields (hidden/muted/archived) to their own type, so that they can later be reused to transform a remote conversation to a local one. Also, the `InternalMember` type constructor has been removed, since the only used instantiation of it was the `LocalMember` type synomyn. * Make user id unqualified in get-conversations RPC The user domain has to be the same as the origin domain, so omitting it does not lose any information and saves us a check (which we weren't doing anyway). * Fix remote user self info in get-conversations RPC This removes the hack of returning a fake self member in the get-conversations RPC, by introducing a different type for remote conversations. A `RemoteConversation` object contains the same information as a normal `Conversation`, except the self member is replaced by simply a `RoleName`, which is the only bit of information for remote users that is actually stored locally. The functions in `Galley.API.Mapping` have been rewritten to fit the new convention. Notes: - the Mapping tests have been commented out; they probably should be rewritten and become unit tests; - remote conversation status flags are still always set to their default values. * Fix federated conversation fetching test Since one2one conversations with remote users are not implemented yet, the test has been simplified, and it now only creates a group conversation. * Turn Mapping tests into property tests * Get member status from db for remote convs * Implement updating member state for remote convs * Mock federator in remote conv status update test * Add more member status update tests and fix bug Attempting to set hidden flag would incorrectly set the archived flag. This is now fixed. * Remove debug prints Co-authored-by: Marko Dimjašević * Move schema closer to the definition of the type Moved the schema definition of `ConversationMetadata` closer to the type definition. * Arbitrary role names in mapping tests Replaced the hardcoded admin role for local members to a randomly generated role. * Use `randomQualifiedUser` instead of `randomUser` * Make alice remote only in get-conversation test The user alice was incorrectly created as a local user, only to be then regarded as a remote one. This didn't impact the functionality of the test, but it created an unnecessary local user, and made the logic of the test confusing. * Remove outdated FUTUREWORK comment Co-authored-by: Marko Dimjašević --- changelog.d/6-federation/self-member-status | 1 + docs/reference/cassandra-schema.cql | 6 + libs/galley-types/galley-types.cabal | 3 +- libs/galley-types/package.yaml | 1 + libs/galley-types/src/Galley/Types.hs | 64 +--- .../src/Galley/Types/Conversations/Members.hs | 74 +++-- libs/types-common/src/Data/Qualified.hs | 9 + .../src/Wire/API/Federation/API/Galley.hs | 28 +- libs/wire-api/src/Wire/API/Conversation.hs | 151 ++++++--- .../ConversationList_20Conversation_user.hs | 45 +-- .../API/Golden/Generated/Conversation_user.hs | 72 +++-- .../Wire/API/Golden/Generated/Event_user.hs | 70 +---- .../Golden/Manual/ConversationsResponse.hs | 72 +++-- services/brig/src/Brig/Provider/API.hs | 2 +- .../brig/test/integration/API/Provider.hs | 2 +- services/galley/galley.cabal | 7 +- services/galley/package.yaml | 2 +- services/galley/schema/src/Main.hs | 4 +- .../schema/src/V53_AddRemoteConvStatus.hs | 38 +++ services/galley/src/Galley/API/Create.hs | 2 +- services/galley/src/Galley/API/Federation.hs | 33 +- services/galley/src/Galley/API/LegalHold.hs | 14 +- services/galley/src/Galley/API/Mapping.hs | 168 +++++----- services/galley/src/Galley/API/Message.hs | 8 +- services/galley/src/Galley/API/Public.hs | 2 +- services/galley/src/Galley/API/Query.hs | 145 ++++++--- services/galley/src/Galley/API/Teams.hs | 2 +- services/galley/src/Galley/API/Update.hs | 114 ++++--- services/galley/src/Galley/API/Util.hs | 83 ++--- services/galley/src/Galley/Data.hs | 213 +++++++++---- services/galley/src/Galley/Data/Queries.hs | 22 +- services/galley/src/Galley/Data/Services.hs | 8 +- services/galley/src/Galley/Intra/Push.hs | 2 +- services/galley/test/integration/API.hs | 209 ++++++++++--- .../galley/test/integration/API/Federation.hs | 67 ++-- services/galley/test/integration/API/Roles.hs | 6 +- services/galley/test/integration/API/Util.hs | 51 +-- .../galley/test/unit/Test/Galley/Mapping.hs | 293 ++++++++---------- 38 files changed, 1235 insertions(+), 858 deletions(-) create mode 100644 changelog.d/6-federation/self-member-status create mode 100644 services/galley/schema/src/V53_AddRemoteConvStatus.hs diff --git a/changelog.d/6-federation/self-member-status b/changelog.d/6-federation/self-member-status new file mode 100644 index 00000000000..92794080bc6 --- /dev/null +++ b/changelog.d/6-federation/self-member-status @@ -0,0 +1 @@ +Added support for updating self member status of remote conversations diff --git a/docs/reference/cassandra-schema.cql b/docs/reference/cassandra-schema.cql index e9383b36184..fd39a8753e8 100644 --- a/docs/reference/cassandra-schema.cql +++ b/docs/reference/cassandra-schema.cql @@ -105,6 +105,12 @@ CREATE TABLE galley_test.user_remote_conv ( user uuid, conv_remote_domain text, conv_remote_id uuid, + hidden boolean, + hidden_ref text, + otr_archived boolean, + otr_archived_ref text, + otr_muted_ref text, + otr_muted_status int, PRIMARY KEY (user, conv_remote_domain, conv_remote_id) ) WITH CLUSTERING ORDER BY (conv_remote_domain ASC, conv_remote_id ASC) AND bloom_filter_fp_chance = 0.1 diff --git a/libs/galley-types/galley-types.cabal b/libs/galley-types/galley-types.cabal index 30ec27537fa..891555cac72 100644 --- a/libs/galley-types/galley-types.cabal +++ b/libs/galley-types/galley-types.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: ebbe442ba952db0f975a3f93ffa72db3b1b971f506a30baaca5615f93b4b376a +-- hash: 8d07ea070b6384ec247f4473abb198bbb9639f72543920cbe46f561df96963ca name: galley-types version: 0.81.0 @@ -43,6 +43,7 @@ library , imports , lens >=4.12 , string-conversions + , tagged , text >=0.11 , time >=1.4 , types-common >=0.16 diff --git a/libs/galley-types/package.yaml b/libs/galley-types/package.yaml index 56f849f9c9b..3c8971ad0a0 100644 --- a/libs/galley-types/package.yaml +++ b/libs/galley-types/package.yaml @@ -22,6 +22,7 @@ library: - lens >=4.12 - QuickCheck - string-conversions + - tagged - text >=0.11 - time >=1.4 - types-common >=0.16 diff --git a/libs/galley-types/src/Galley/Types.hs b/libs/galley-types/src/Galley/Types.hs index 09edac1c768..9a9e2cdca81 100644 --- a/libs/galley-types/src/Galley/Types.hs +++ b/libs/galley-types/src/Galley/Types.hs @@ -20,13 +20,21 @@ module Galley.Types ( foldrOtrRecipients, Accept (..), - ConversationMeta (..), -- * re-exports + ConversationMetadata (..), Conversation (..), - LocalMember, - RemoteMember, - InternalMember (..), + cnvQualifiedId, + cnvType, + cnvCreator, + cnvAccess, + cnvAccessRole, + cnvName, + cnvTeam, + cnvMessageTimer, + cnvReceiptMode, + RemoteMember (..), + LocalMember (..), ConvMembers (..), OtherMember (..), Connect (..), @@ -74,11 +82,9 @@ module Galley.Types where import Data.Aeson -import Data.Id (ClientId, ConvId, TeamId, UserId) -import Data.Json.Util ((#)) +import Data.Id (ClientId, UserId) import qualified Data.Map.Strict as Map -import Data.Misc (Milliseconds) -import Galley.Types.Conversations.Members (InternalMember (..), LocalMember, RemoteMember) +import Galley.Types.Conversations.Members (LocalMember (..), RemoteMember (..)) import Imports import Wire.API.Conversation hiding (Member (..)) import Wire.API.Conversation.Code @@ -89,48 +95,6 @@ import Wire.API.Message import Wire.API.User (UserIdList (..)) import Wire.API.User.Client --------------------------------------------------------------------------------- --- ConversationMeta - -data ConversationMeta = ConversationMeta - { cmId :: !ConvId, - cmType :: !ConvType, - cmCreator :: !UserId, - cmAccess :: ![Access], - cmAccessRole :: !AccessRole, - cmName :: !(Maybe Text), - cmTeam :: !(Maybe TeamId), - cmMessageTimer :: !(Maybe Milliseconds), - cmReceiptMode :: !(Maybe ReceiptMode) - } - deriving (Eq, Show) - -instance ToJSON ConversationMeta where - toJSON c = - object $ - "id" .= cmId c - # "type" .= cmType c - # "creator" .= cmCreator c - # "access" .= cmAccess c - # "access_role" .= cmAccessRole c - # "name" .= cmName c - # "team" .= cmTeam c - # "message_timer" .= cmMessageTimer c - # "receipt_mode" .= cmReceiptMode c - # [] - -instance FromJSON ConversationMeta where - parseJSON = withObject "conversation-meta" $ \o -> - ConversationMeta <$> o .: "id" - <*> o .: "type" - <*> o .: "creator" - <*> o .: "access" - <*> o .: "access_role" - <*> o .: "name" - <*> o .:? "team" - <*> o .:? "message_timer" - <*> o .:? "receipt_mode" - -------------------------------------------------------------------------------- -- Accept diff --git a/libs/galley-types/src/Galley/Types/Conversations/Members.hs b/libs/galley-types/src/Galley/Types/Conversations/Members.hs index c88e46c76e5..7e6a88c6db8 100644 --- a/libs/galley-types/src/Galley/Types/Conversations/Members.hs +++ b/libs/galley-types/src/Galley/Types/Conversations/Members.hs @@ -18,37 +18,73 @@ -- with this program. If not, see . module Galley.Types.Conversations.Members - ( LocalMember, - RemoteMember (..), - InternalMember (..), + ( RemoteMember (..), + remoteMemberToOther, + LocalMember (..), + localMemberToOther, + MemberStatus (..), + defMemberStatus, ) where +import Data.Domain import Data.Id as Id -import Data.Qualified (Remote) +import Data.Qualified +import Data.Tagged import Imports -import Wire.API.Conversation.Member (MutedStatus) +import Wire.API.Conversation import Wire.API.Conversation.Role (RoleName) import Wire.API.Provider.Service (ServiceRef) -type LocalMember = InternalMember Id.UserId - +-- | Internal (cassandra) representation of a remote conversation member. data RemoteMember = RemoteMember { rmId :: Remote UserId, rmConvRoleName :: RoleName } deriving stock (Show) --- | Internal (cassandra) representation of a conversation member. -data InternalMember id = InternalMember - { memId :: id, - memService :: Maybe ServiceRef, - memOtrMutedStatus :: Maybe MutedStatus, - memOtrMutedRef :: Maybe Text, - memOtrArchived :: Bool, - memOtrArchivedRef :: Maybe Text, - memHidden :: Bool, - memHiddenRef :: Maybe Text, - memConvRoleName :: RoleName +remoteMemberToOther :: RemoteMember -> OtherMember +remoteMemberToOther x = + OtherMember + { omQualifiedId = unTagged (rmId x), + omService = Nothing, + omConvRoleName = rmConvRoleName x + } + +-- | Internal (cassandra) representation of a local conversation member. +data LocalMember = LocalMember + { lmId :: UserId, + lmStatus :: MemberStatus, + lmService :: Maybe ServiceRef, + lmConvRoleName :: RoleName + } + deriving stock (Show) + +localMemberToOther :: Domain -> LocalMember -> OtherMember +localMemberToOther domain x = + OtherMember + { omQualifiedId = Qualified (lmId x) domain, + omService = lmService x, + omConvRoleName = lmConvRoleName x + } + +data MemberStatus = MemberStatus + { msOtrMutedStatus :: Maybe MutedStatus, + msOtrMutedRef :: Maybe Text, + msOtrArchived :: Bool, + msOtrArchivedRef :: Maybe Text, + msHidden :: Bool, + msHiddenRef :: Maybe Text } - deriving stock (Functor, Show) + deriving stock (Show) + +defMemberStatus :: MemberStatus +defMemberStatus = + MemberStatus + { msOtrMutedStatus = Nothing, + msOtrMutedRef = Nothing, + msOtrArchived = False, + msOtrArchivedRef = Nothing, + msHidden = False, + msHiddenRef = Nothing + } diff --git a/libs/types-common/src/Data/Qualified.hs b/libs/types-common/src/Data/Qualified.hs index d1162100039..779cae99080 100644 --- a/libs/types-common/src/Data/Qualified.hs +++ b/libs/types-common/src/Data/Qualified.hs @@ -23,6 +23,8 @@ module Data.Qualified Qualified (..), Remote, toRemote, + Local, + toLocal, renderQualifiedId, partitionRemoteOrLocalIds, partitionRemoteOrLocalIds', @@ -66,6 +68,13 @@ type Remote a = Tagged "remote" (Qualified a) toRemote :: Qualified a -> Remote a toRemote = Tagged +-- | A type representing a Qualified value where the domain is guaranteed to be +-- the local one. +type Local a = Tagged "local" (Qualified a) + +toLocal :: Qualified a -> Local a +toLocal = Tagged + -- | FUTUREWORK: Maybe delete this, it is only used in printing federation not -- implemented errors renderQualified :: (a -> Text) -> Qualified a -> Text 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 02a46ed39ee..d80a55a5e2d 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 @@ -30,8 +30,7 @@ import Servant.API (JSON, Post, ReqBody, Summary, (:>)) import Servant.API.Generic ((:-)) import Servant.Client.Generic (AsClientT, genericClient) import Wire.API.Arbitrary (Arbitrary, GenericUniform (..)) -import Wire.API.Conversation (Access, AccessRole, ConvType, Conversation, ReceiptMode) -import Wire.API.Conversation.Member (OtherMember) +import Wire.API.Conversation import Wire.API.Conversation.Role (RoleName) import Wire.API.Federation.Client (FederationClientFailure, FederatorClient) import Wire.API.Federation.Domain (OriginDomainHeader) @@ -60,6 +59,7 @@ data Api routes = Api routes :- "federation" :> "get-conversations" + :> OriginDomainHeader :> ReqBody '[JSON] GetConversationsRequest :> Post '[JSON] GetConversationsResponse, -- used by backend that owns the conversation to inform the backend about @@ -100,15 +100,35 @@ data Api routes = Api deriving (Generic) data GetConversationsRequest = GetConversationsRequest - { gcrUserId :: Qualified UserId, + { gcrUserId :: UserId, gcrConvIds :: [ConvId] } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform GetConversationsRequest) deriving (ToJSON, FromJSON) via (CustomEncoded GetConversationsRequest) +data RemoteConvMembers = RemoteConvMembers + { rcmSelfRole :: RoleName, + rcmOthers :: [OtherMember] + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform RemoteConvMembers) + deriving (FromJSON, ToJSON) via (CustomEncoded RemoteConvMembers) + +-- | A conversation hosted on a remote backend. This contains the same +-- information as a 'Conversation', with the exception that conversation status +-- fields (muted/archived/hidden) are omitted, since they are not known by the +-- remote backend. +data RemoteConversation = RemoteConversation + { rcnvMetadata :: ConversationMetadata, + rcnvMembers :: RemoteConvMembers + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform RemoteConversation) + deriving (FromJSON, ToJSON) via (CustomEncoded RemoteConversation) + newtype GetConversationsResponse = GetConversationsResponse - { gcresConvs :: [Conversation] + { gcresConvs :: [RemoteConversation] } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform GetConversationsResponse) diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index 36a397eb65f..735bd55f10d 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -23,7 +23,18 @@ -- modules. module Wire.API.Conversation ( -- * Conversation + ConversationMetadata (..), Conversation (..), + mkConversation, + cnvQualifiedId, + cnvType, + cnvCreator, + cnvAccess, + cnvAccessRole, + cnvName, + cnvTeam, + cnvMessageTimer, + cnvReceiptMode, ConversationCoverView (..), ConversationList (..), ListConversations (..), @@ -80,6 +91,7 @@ import Control.Applicative import Control.Lens (at, (?~)) import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as A +import qualified Data.Aeson.Types as A import qualified Data.Attoparsec.ByteString as AB import qualified Data.ByteString as BS import Data.Id @@ -105,62 +117,125 @@ import Wire.API.Conversation.Role (RoleName, roleNameWireAdmin) -------------------------------------------------------------------------------- -- Conversation +data ConversationMetadata = ConversationMetadata + { -- | A qualified conversation ID + cnvmQualifiedId :: Qualified ConvId, + cnvmType :: ConvType, + -- FUTUREWORK: Make this a qualified user ID. + cnvmCreator :: UserId, + cnvmAccess :: [Access], + cnvmAccessRole :: AccessRole, + cnvmName :: Maybe Text, + -- FUTUREWORK: Think if it makes sense to make the team ID qualified due to + -- federation. + cnvmTeam :: Maybe TeamId, + cnvmMessageTimer :: Maybe Milliseconds, + cnvmReceiptMode :: Maybe ReceiptMode + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform ConversationMetadata) + deriving (FromJSON, ToJSON) via Schema ConversationMetadata + +conversationMetadataObjectSchema :: + SchemaP + SwaggerDoc + A.Object + [A.Pair] + ConversationMetadata + ConversationMetadata +conversationMetadataObjectSchema = + ConversationMetadata + <$> cnvmQualifiedId .= field "qualified_id" schema + <* (qUnqualified . cnvmQualifiedId) + .= optional (field "id" (deprecatedSchema "qualified_id" schema)) + <*> cnvmType .= field "type" schema + <*> cnvmCreator + .= fieldWithDocModifier + "creator" + (description ?~ "The creator's user ID") + schema + <*> cnvmAccess .= field "access" (array schema) + <*> cnvmAccessRole .= field "access_role" schema + <*> cnvmName .= lax (field "name" (optWithDefault A.Null schema)) + <* const ("0.0" :: Text) .= optional (field "last_event" schema) + <* const ("1970-01-01T00:00:00.000Z" :: Text) + .= optional (field "last_event_time" schema) + <*> cnvmTeam .= lax (field "team" (optWithDefault A.Null schema)) + <*> cnvmMessageTimer + .= lax + ( fieldWithDocModifier + "message_timer" + (description ?~ "Per-conversation message timer (can be null)") + (optWithDefault A.Null schema) + ) + <*> cnvmReceiptMode .= lax (field "receipt_mode" (optWithDefault A.Null schema)) + +instance ToSchema ConversationMetadata where + schema = object "ConversationMetadata" conversationMetadataObjectSchema + -- | Public-facing conversation type. Represents information that a -- particular user is allowed to see. -- -- Can be produced from the internal one ('Galley.Data.Types.Conversation') -- by using 'Galley.API.Mapping.conversationView'. data Conversation = Conversation - { -- | A qualified conversation ID - cnvQualifiedId :: Qualified ConvId, - cnvType :: ConvType, - -- FUTUREWORK: Make this a qualified user ID. - cnvCreator :: UserId, - cnvAccess :: [Access], - cnvAccessRole :: AccessRole, - cnvName :: Maybe Text, - cnvMembers :: ConvMembers, - -- FUTUREWORK: Think if it makes sense to make the team ID qualified due to - -- federation. - cnvTeam :: Maybe TeamId, - cnvMessageTimer :: Maybe Milliseconds, - cnvReceiptMode :: Maybe ReceiptMode + { cnvMetadata :: ConversationMetadata, + cnvMembers :: ConvMembers } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform Conversation) deriving (FromJSON, ToJSON, S.ToSchema) via Schema Conversation +mkConversation :: + Qualified ConvId -> + ConvType -> + UserId -> + [Access] -> + AccessRole -> + Maybe Text -> + ConvMembers -> + Maybe TeamId -> + Maybe Milliseconds -> + Maybe ReceiptMode -> + Conversation +mkConversation qid ty uid acc role name mems tid ms rm = + Conversation (ConversationMetadata qid ty uid acc role name tid ms rm) mems + +cnvQualifiedId :: Conversation -> Qualified ConvId +cnvQualifiedId = cnvmQualifiedId . cnvMetadata + +cnvType :: Conversation -> ConvType +cnvType = cnvmType . cnvMetadata + +cnvCreator :: Conversation -> UserId +cnvCreator = cnvmCreator . cnvMetadata + +cnvAccess :: Conversation -> [Access] +cnvAccess = cnvmAccess . cnvMetadata + +cnvAccessRole :: Conversation -> AccessRole +cnvAccessRole = cnvmAccessRole . cnvMetadata + +cnvName :: Conversation -> Maybe Text +cnvName = cnvmName . cnvMetadata + +cnvTeam :: Conversation -> Maybe TeamId +cnvTeam = cnvmTeam . cnvMetadata + +cnvMessageTimer :: Conversation -> Maybe Milliseconds +cnvMessageTimer = cnvmMessageTimer . cnvMetadata + +cnvReceiptMode :: Conversation -> Maybe ReceiptMode +cnvReceiptMode = cnvmReceiptMode . cnvMetadata + instance ToSchema Conversation where schema = objectWithDocModifier "Conversation" (description ?~ "A conversation object as returned from the server") $ Conversation - <$> cnvQualifiedId .= field "qualified_id" schema - <* (qUnqualified . cnvQualifiedId) - .= optional (field "id" (deprecatedSchema "qualified_id" schema)) - <*> cnvType .= field "type" schema - <*> cnvCreator - .= fieldWithDocModifier - "creator" - (description ?~ "The creator's user ID") - schema - <*> cnvAccess .= field "access" (array schema) - <*> cnvAccessRole .= field "access_role" schema - <*> cnvName .= lax (field "name" (optWithDefault A.Null schema)) + <$> cnvMetadata .= conversationMetadataObjectSchema <*> cnvMembers .= field "members" schema - <* const ("0.0" :: Text) .= optional (field "last_event" schema) - <* const ("1970-01-01T00:00:00.000Z" :: Text) - .= optional (field "last_event_time" schema) - <*> cnvTeam .= lax (field "team" (optWithDefault A.Null schema)) - <*> cnvMessageTimer - .= lax - ( fieldWithDocModifier - "message_timer" - (description ?~ "Per-conversation message timer (can be null)") - (optWithDefault A.Null schema) - ) - <*> cnvReceiptMode .= lax (field "receipt_mode" (optWithDefault A.Null schema)) modelConversation :: Doc.Model modelConversation = Doc.defineModel "Conversation" $ do diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/ConversationList_20Conversation_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/ConversationList_20Conversation_user.hs index 02ab9eb3ba3..d23b8022f37 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/ConversationList_20Conversation_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/ConversationList_20Conversation_user.hs @@ -25,28 +25,6 @@ import Data.Qualified (Qualified (..)) import qualified Data.UUID as UUID (fromString) import Imports (Bool (False, True), Maybe (Just, Nothing), fromJust) import Wire.API.Conversation - ( AccessRole - ( PrivateAccessRole - ), - ConvMembers (ConvMembers, cmOthers, cmSelf), - ConvType (RegularConv), - Conversation (..), - ConversationList (..), - Member - ( Member, - memConvRoleName, - memHidden, - memHiddenRef, - memId, - memOtrArchived, - memOtrArchivedRef, - memOtrMutedRef, - memOtrMutedStatus, - memService - ), - MutedStatus (MutedStatus, fromMutedStatus), - ReceiptMode (ReceiptMode, unReceiptMode), - ) import Wire.API.Conversation.Role (parseRoleName) testObject_ConversationList_20Conversation_user_1 :: ConversationList Conversation @@ -54,12 +32,18 @@ testObject_ConversationList_20Conversation_user_1 = ConversationList { convList = [ Conversation - { cnvQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000"))) (Domain "golden.example.com"), - cnvType = RegularConv, - cnvCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000001")), - cnvAccess = [], - cnvAccessRole = PrivateAccessRole, - cnvName = Just "", + { cnvMetadata = + ConversationMetadata + { cnvmQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000"))) (Domain "golden.example.com"), + cnvmType = RegularConv, + cnvmCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000001")), + cnvmAccess = [], + cnvmAccessRole = PrivateAccessRole, + cnvmName = Just "", + cnvmTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000001"))), + cnvmMessageTimer = Just (Ms {ms = 4760386328981119}), + cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = 0}) + }, cnvMembers = ConvMembers { cmSelf = @@ -76,10 +60,7 @@ testObject_ConversationList_20Conversation_user_1 = fromJust (parseRoleName "71xuphsrwfoktrpiv4d08dxj6_1umizg67iisctw87gemvi114mtu") }, cmOthers = [] - }, - cnvTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000001"))), - cnvMessageTimer = Just (Ms {ms = 4760386328981119}), - cnvReceiptMode = Just (ReceiptMode {unReceiptMode = 0}) + } } ], convHasMore = False diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Conversation_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Conversation_user.hs index c59d97a208d..0ea5ad8e869 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Conversation_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/Conversation_user.hs @@ -34,12 +34,18 @@ domain = Domain "golden.example.com" testObject_Conversation_user_1 :: Conversation testObject_Conversation_user_1 = Conversation - { cnvQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000"))) (Domain "golden.example.com"), - cnvType = One2OneConv, - cnvCreator = Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200000001")), - cnvAccess = [], - cnvAccessRole = PrivateAccessRole, - cnvName = Just " 0", + { cnvMetadata = + ConversationMetadata + { cnvmQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000"))) (Domain "golden.example.com"), + cnvmType = One2OneConv, + cnvmCreator = Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200000001")), + cnvmAccess = [], + cnvmAccessRole = PrivateAccessRole, + cnvmName = Just " 0", + cnvmTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000002"))), + cnvmMessageTimer = Nothing, + cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = -2}) + }, cnvMembers = ConvMembers { cmSelf = @@ -55,34 +61,37 @@ testObject_Conversation_user_1 = memConvRoleName = fromJust (parseRoleName "rhhdzf0j0njilixx0g0vzrp06b_5us") }, cmOthers = [] - }, - cnvTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000002"))), - cnvMessageTimer = Nothing, - cnvReceiptMode = Just (ReceiptMode {unReceiptMode = -2}) + } } testObject_Conversation_user_2 :: Conversation testObject_Conversation_user_2 = Conversation - { cnvQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000002"))) (Domain "golden.example.com"), - cnvType = SelfConv, - cnvCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001")), - cnvAccess = - [ InviteAccess, - InviteAccess, - CodeAccess, - LinkAccess, - InviteAccess, - PrivateAccess, - LinkAccess, - CodeAccess, - CodeAccess, - LinkAccess, - PrivateAccess, - InviteAccess - ], - cnvAccessRole = NonActivatedAccessRole, - cnvName = Just "", + { cnvMetadata = + ConversationMetadata + { cnvmQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000002"))) (Domain "golden.example.com"), + cnvmType = SelfConv, + cnvmCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001")), + cnvmAccess = + [ InviteAccess, + InviteAccess, + CodeAccess, + LinkAccess, + InviteAccess, + PrivateAccess, + LinkAccess, + CodeAccess, + CodeAccess, + LinkAccess, + PrivateAccess, + InviteAccess + ], + cnvmAccessRole = NonActivatedAccessRole, + cnvmName = Just "", + cnvmTeam = Nothing, + cnvmMessageTimer = Just (Ms {ms = 1319272593797015}), + cnvmReceiptMode = Nothing + }, cnvMembers = ConvMembers { cmSelf = @@ -117,8 +126,5 @@ testObject_Conversation_user_2 = ) } ] - }, - cnvTeam = Nothing, - cnvMessageTimer = Just (Ms {ms = 1319272593797015}), - cnvReceiptMode = Nothing + } } 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 ae6cb47adb0..cdd9a029b20 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 @@ -28,51 +28,10 @@ import Data.Text.Ascii (validate) import qualified Data.UUID as UUID (fromString) import Imports (Bool (False, True), Maybe (Just, Nothing), fromJust, read, undefined) import Wire.API.Conversation -import Wire.API.Conversation.Code (ConversationCode (..), Key (..), Value (..)) +import Wire.API.Conversation.Code (Key (..), Value (..)) import Wire.API.Conversation.Role (parseRoleName) -import Wire.API.Conversation.Typing (TypingData (TypingData, tdStatus), TypingStatus (StoppedTyping)) +import Wire.API.Conversation.Typing (TypingStatus (..)) import Wire.API.Event.Conversation - ( Connect (Connect, cEmail, cMessage, cName, cRecipient), - Event (Event), - EventData (..), - EventType - ( ConvAccessUpdate, - ConvCodeDelete, - ConvCodeUpdate, - ConvConnect, - ConvCreate, - ConvDelete, - ConvMessageTimerUpdate, - ConvReceiptModeUpdate, - ConvRename, - MemberJoin, - MemberLeave, - MemberStateUpdate, - OtrMessageAdd, - Typing - ), - MemberUpdateData - ( MemberUpdateData, - misConvRoleName, - misHidden, - misHiddenRef, - misOtrArchived, - misOtrArchivedRef, - misOtrMutedRef, - misOtrMutedStatus, - misTarget - ), - OtrMessage - ( OtrMessage, - otrCiphertext, - otrData, - otrRecipient, - otrSender - ), - QualifiedUserIdList (QualifiedUserIdList, qualifiedUserIdList), - SimpleMember (..), - SimpleMembers (SimpleMembers, mMembers), - ) import Wire.API.Provider.Service (ServiceRef (ServiceRef, _serviceRefId, _serviceRefProvider)) domain :: Domain @@ -180,13 +139,19 @@ testObject_Event_user_8 = (read "1864-05-29 19:31:31.226 UTC") ( EdConversation ( Conversation - { cnvQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000001"))) (Domain "golden.example.com"), - cnvType = RegularConv, - cnvCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001")), - cnvAccess = - [InviteAccess, PrivateAccess, LinkAccess, InviteAccess, InviteAccess, InviteAccess, LinkAccess], - cnvAccessRole = NonActivatedAccessRole, - cnvName = Just "\a\SO\r", + { cnvMetadata = + ConversationMetadata + { cnvmQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000001"))) (Domain "golden.example.com"), + cnvmType = RegularConv, + cnvmCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001")), + cnvmAccess = + [InviteAccess, PrivateAccess, LinkAccess, InviteAccess, InviteAccess, InviteAccess, LinkAccess], + cnvmAccessRole = NonActivatedAccessRole, + cnvmName = Just "\a\SO\r", + cnvmTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000100000001"))), + cnvmMessageTimer = Just (Ms {ms = 283898987885780}), + cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = -1}) + }, cnvMembers = ConvMembers { cmSelf = @@ -223,10 +188,7 @@ testObject_Event_user_8 = ) } ] - }, - cnvTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000100000001"))), - cnvMessageTimer = Just (Ms {ms = 283898987885780}), - cnvReceiptMode = Just (ReceiptMode {unReceiptMode = -1}) + } } ) ) diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationsResponse.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationsResponse.hs index 306222effb6..f91466f0dc5 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationsResponse.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationsResponse.hs @@ -29,12 +29,18 @@ testObject_ConversationsResponse_1 = conv1 :: Conversation conv1 = Conversation - { cnvQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000"))) (Domain "golden.example.com"), - cnvType = One2OneConv, - cnvCreator = Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200000001")), - cnvAccess = [], - cnvAccessRole = PrivateAccessRole, - cnvName = Just " 0", + { cnvMetadata = + ConversationMetadata + { cnvmQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000000"))) (Domain "golden.example.com"), + cnvmType = One2OneConv, + cnvmCreator = Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200000001")), + cnvmAccess = [], + cnvmAccessRole = PrivateAccessRole, + cnvmName = Just " 0", + cnvmTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000002"))), + cnvmMessageTimer = Nothing, + cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = -2}) + }, cnvMembers = ConvMembers { cmSelf = @@ -50,34 +56,37 @@ conv1 = memConvRoleName = fromJust (parseRoleName "rhhdzf0j0njilixx0g0vzrp06b_5us") }, cmOthers = [] - }, - cnvTeam = Just (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000100000002"))), - cnvMessageTimer = Nothing, - cnvReceiptMode = Just (ReceiptMode {unReceiptMode = -2}) + } } conv2 :: Conversation conv2 = Conversation - { cnvQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000002"))) (Domain "golden.example.com"), - cnvType = SelfConv, - cnvCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001")), - cnvAccess = - [ InviteAccess, - InviteAccess, - CodeAccess, - LinkAccess, - InviteAccess, - PrivateAccess, - LinkAccess, - CodeAccess, - CodeAccess, - LinkAccess, - PrivateAccess, - InviteAccess - ], - cnvAccessRole = NonActivatedAccessRole, - cnvName = Just "", + { cnvMetadata = + ConversationMetadata + { cnvmQualifiedId = Qualified (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000002"))) (Domain "golden.example.com"), + cnvmType = SelfConv, + cnvmCreator = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000200000001")), + cnvmAccess = + [ InviteAccess, + InviteAccess, + CodeAccess, + LinkAccess, + InviteAccess, + PrivateAccess, + LinkAccess, + CodeAccess, + CodeAccess, + LinkAccess, + PrivateAccess, + InviteAccess + ], + cnvmAccessRole = NonActivatedAccessRole, + cnvmName = Just "", + cnvmTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000200000000"))), + cnvmMessageTimer = Just (Ms {ms = 1319272593797015}), + cnvmReceiptMode = Just (ReceiptMode {unReceiptMode = 2}) + }, cnvMembers = ConvMembers { cmSelf = @@ -94,8 +103,5 @@ conv2 = fromJust (parseRoleName "9b2d3thyqh4ptkwtq2n2v9qsni_ln1ca66et_z8dlhfs9oamp328knl3rj9kcj") }, cmOthers = [] - }, - cnvTeam = Just (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000200000000"))), - cnvMessageTimer = Just (Ms {ms = 1319272593797015}), - cnvReceiptMode = Just (ReceiptMode {unReceiptMode = 2}) + } } diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index 55ba100025a..ad2513d5710 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -73,7 +73,7 @@ import qualified Data.Set as Set import qualified Data.Swagger.Build.Api as Doc import qualified Data.Text.Ascii as Ascii import qualified Data.Text.Encoding as Text -import Galley.Types (AccessRole (..), ConvMembers (..), ConvType (..), Conversation (..), OtherMember (..)) +import Galley.Types import Galley.Types.Bot (newServiceRef, serviceRefId, serviceRefProvider) import Galley.Types.Conversations.Roles (roleNameWireAdmin) import qualified Galley.Types.Teams as Teams diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index 277058debf1..7af5a32541a 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 (..), QualifiedUserIdList (..), SimpleMember (..), SimpleMembers (..)) +import Galley.Types import Galley.Types.Bot (ServiceRef, newServiceRef, serviceRefId, serviceRefProvider) import Galley.Types.Conversations.Roles (roleNameWireAdmin) import qualified Galley.Types.Teams as Team diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 0357c2adca0..5122ed04e07 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 0acb724202f4ba39242c1ebbe5f5db555404624b7a6be922d5a4148d38c5786d +-- hash: 0341ec52f506f40a39b7329c4eeccdccf25bcffc81318f535602bfc17e655f58 name: galley version: 0.83.0 @@ -176,6 +176,7 @@ executable galley , raw-strings-qq >=1.0 , safe >=0.3 , ssl-util + , tagged , types-common , wire-api , wire-api-federation @@ -314,6 +315,7 @@ executable galley-migrate-data , raw-strings-qq >=1.0 , safe >=0.3 , ssl-util + , tagged , text , time , tinylog @@ -361,6 +363,7 @@ executable galley-schema V50_AddLegalholdWhitelisted V51_FeatureFileSharing V52_FeatureConferenceCalling + V53_AddRemoteConvStatus Paths_galley hs-source-dirs: schema/src @@ -376,6 +379,7 @@ executable galley-schema , raw-strings-qq >=1.0 , safe >=0.3 , ssl-util + , tagged , text , tinylog , wire-api @@ -413,6 +417,7 @@ test-suite galley-types-tests , safe >=0.3 , servant-swagger , ssl-util + , tagged , tasty , tasty-hspec , tasty-hunit diff --git a/services/galley/package.yaml b/services/galley/package.yaml index 795fe273d0b..0ba2b59e4ff 100644 --- a/services/galley/package.yaml +++ b/services/galley/package.yaml @@ -18,6 +18,7 @@ dependencies: - raw-strings-qq >=1.0 - wire-api - wire-api-federation +- tagged library: source-dirs: src @@ -76,7 +77,6 @@ library: - string-conversions - swagger >=0.1 - swagger2 - - tagged - text >=0.11 - time >=1.4 - tinylog >=0.10 diff --git a/services/galley/schema/src/Main.hs b/services/galley/schema/src/Main.hs index 5d2b408c428..c350df9f4dc 100644 --- a/services/galley/schema/src/Main.hs +++ b/services/galley/schema/src/Main.hs @@ -55,6 +55,7 @@ import qualified V49_ReAddRemoteIdentifiers import qualified V50_AddLegalholdWhitelisted import qualified V51_FeatureFileSharing import qualified V52_FeatureConferenceCalling +import qualified V53_AddRemoteConvStatus main :: IO () main = do @@ -95,7 +96,8 @@ main = do V49_ReAddRemoteIdentifiers.migration, V50_AddLegalholdWhitelisted.migration, V51_FeatureFileSharing.migration, - V52_FeatureConferenceCalling.migration + V52_FeatureConferenceCalling.migration, + V53_AddRemoteConvStatus.migration -- When adding migrations here, don't forget to update -- 'schemaVersion' in Galley.Data -- (see also docs/developer/cassandra-interaction.md) diff --git a/services/galley/schema/src/V53_AddRemoteConvStatus.hs b/services/galley/schema/src/V53_AddRemoteConvStatus.hs new file mode 100644 index 00000000000..0688e824936 --- /dev/null +++ b/services/galley/schema/src/V53_AddRemoteConvStatus.hs @@ -0,0 +1,38 @@ +-- 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 V53_AddRemoteConvStatus (migration) where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +-- This migration adds fields that track remote conversation status for a local user. +migration :: Migration +migration = + Migration 53 "Add fields for remote conversation status (hidden/archived/muted)" $ + schema' + [r| + ALTER TABLE user_remote_conv ADD ( + hidden boolean, + hidden_ref text, + otr_archived boolean, + otr_archived_ref text, + otr_muted_status int, + otr_muted_ref text + ) + |] diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index 52921e4e5a4..72f02735dac 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -332,7 +332,7 @@ notifyCreatedConversation dtime usr conn c = do toPush dom t m = do let qconv = Qualified (Data.convId c) dom qusr = Qualified usr dom - c' <- conversationView (memId m) c + c' <- conversationView (lmId m) c let e = Event ConvCreate qconv qusr t (EdConversation c') return $ newPushLocal1 ListComplete usr (ConvEvent e) (list1 (recipient m) []) diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index f8e42b75486..414e36d4210 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -27,7 +27,7 @@ import Data.Json.Util (Base64ByteString (..)) import Data.List1 (list1) import qualified Data.Map as Map import Data.Map.Lens (toMapOf) -import Data.Qualified (Qualified (..)) +import Data.Qualified (Qualified (..), toRemote) import qualified Data.Set as Set import Data.Tagged import qualified Data.Text.Lazy as LT @@ -38,7 +38,7 @@ import qualified Galley.API.Update as API import Galley.API.Util (fromNewRemoteConversation, pushConversationEvent, viewFederationDomain) import Galley.App (Galley) import qualified Galley.Data as Data -import Galley.Types.Conversations.Members (InternalMember (..), LocalMember) +import Galley.Types.Conversations.Members (LocalMember (..), defMemberStatus) import Imports import Servant (ServerT) import Servant.API.Generic (ToServantApi) @@ -96,12 +96,14 @@ onConversationCreated domain rc = do (EdConversation c) pushConversationEvent Nothing event [Public.memId mem] [] -getConversations :: GetConversationsRequest -> Galley GetConversationsResponse -getConversations (GetConversationsRequest qUid gcrConvIds) = do - domain <- viewFederationDomain - convs <- Data.conversations gcrConvIds - let convViews = Mapping.conversationViewMaybeQualified domain qUid <$> convs - pure $ GetConversationsResponse . catMaybes $ convViews +getConversations :: Domain -> GetConversationsRequest -> Galley GetConversationsResponse +getConversations domain (GetConversationsRequest uid cids) = do + let ruid = toRemote $ Qualified uid domain + localDomain <- viewFederationDomain + GetConversationsResponse + . catMaybes + . map (Mapping.conversationToRemote localDomain ruid) + <$> Data.conversations cids -- | Update the local database with information on conversation members joining -- or leaving. Finally, push out notifications to local users. @@ -186,16 +188,11 @@ onMessageSent domain rmUnqualified = do mkLocalMember :: UserId -> Galley LocalMember mkLocalMember m = pure $ - InternalMember - { memId = m, - memService = Nothing, - memOtrMutedStatus = Nothing, - memOtrMutedRef = Nothing, - memOtrArchived = False, - memOtrArchivedRef = Nothing, - memHidden = False, - memHiddenRef = Nothing, - memConvRoleName = Public.roleNameWireMember + LocalMember + { lmId = m, + lmService = Nothing, + lmStatus = defMemberStatus, + lmConvRoleName = Public.roleNameWireMember } sendMessage :: Domain -> MessageSendRequest -> Galley MessageSendResponse diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index d4f91209865..5a4bd6d8c3b 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -61,7 +61,7 @@ import qualified Galley.External.LegalHoldService as LHService import qualified Galley.Intra.Client as Client import Galley.Intra.User (getConnections, putConnectionInternal) import qualified Galley.Options as Opts -import Galley.Types (LocalMember, memConvRoleName, memId) +import Galley.Types (LocalMember, lmConvRoleName, lmId) import Galley.Types.Teams as Team import Imports import Network.HTTP.Types (status200, status404) @@ -492,12 +492,12 @@ handleGroupConvPolicyConflicts uid hypotheticalLHStatus = membersAndLHStatus :: [(LocalMember, UserLegalHoldStatus)] <- do let mems = Data.convLocalMembers conv - uidsLHStatus <- getLHStatusForUsers (memId <$> mems) + uidsLHStatus <- getLHStatusForUsers (lmId <$> mems) pure $ zipWith ( \mem (mid, status) -> - assert (memId mem == mid) $ - if memId mem == uid + assert (lmId mem == mid) $ + if lmId mem == uid then (mem, hypotheticalLHStatus) else (mem, status) ) @@ -507,10 +507,10 @@ handleGroupConvPolicyConflicts uid hypotheticalLHStatus = let qconv = Data.convId conv `Qualified` localDomain if any ((== ConsentGiven) . consentGiven . snd) - (filter ((== roleNameWireAdmin) . memConvRoleName . fst) membersAndLHStatus) + (filter ((== roleNameWireAdmin) . lmConvRoleName . fst) membersAndLHStatus) then do for_ (filter ((== ConsentNotGiven) . consentGiven . snd) membersAndLHStatus) $ \(memberNoConsent, _) -> do - removeMember (memId memberNoConsent `Qualified` localDomain) Nothing qconv (Qualified (memId memberNoConsent) localDomain) + removeMember (lmId memberNoConsent `Qualified` localDomain) Nothing qconv (Qualified (lmId memberNoConsent) localDomain) else do for_ (filter (userLHEnabled . snd) membersAndLHStatus) $ \(legalholder, _) -> do - removeMember (memId legalholder `Qualified` localDomain) Nothing qconv (Qualified (memId legalholder) localDomain) + removeMember (lmId legalholder `Qualified` localDomain) Nothing qconv (Qualified (lmId legalholder) localDomain) diff --git a/services/galley/src/Galley/API/Mapping.hs b/services/galley/src/Galley/API/Mapping.hs index 4eb47d23cbd..e99921917ec 100644 --- a/services/galley/src/Galley/API/Mapping.hs +++ b/services/galley/src/Galley/API/Mapping.hs @@ -17,31 +17,39 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Galley.API.Mapping where +module Galley.API.Mapping + ( conversationView, + conversationViewMaybe, + remoteConversationView, + conversationToRemote, + localMemberToSelf, + ) +where import Control.Monad.Catch import Data.Domain (Domain) import Data.Id (UserId, idToText) -import qualified Data.List as List -import Data.Qualified (Qualified (..)) -import Data.Tagged (unTagged) +import Data.Qualified import Galley.API.Util (viewFederationDomain) import Galley.App import qualified Galley.Data as Data import Galley.Data.Types (convId) -import qualified Galley.Types.Conversations.Members as Internal +import Galley.Types.Conversations.Members import Imports import Network.HTTP.Types.Status import Network.Wai.Utilities.Error import qualified System.Logger.Class as Log import System.Logger.Message (msg, val, (+++)) -import qualified Wire.API.Conversation as Public +import Wire.API.Conversation +import Wire.API.Federation.API.Galley -- | View for a given user of a stored conversation. +-- -- Throws "bad-state" when the user is not part of the conversation. -conversationView :: UserId -> Data.Conversation -> Galley Public.Conversation +conversationView :: UserId -> Data.Conversation -> Galley Conversation conversationView uid conv = do - mbConv <- conversationViewMaybe uid conv + localDomain <- viewFederationDomain + let mbConv = conversationViewMaybe localDomain uid conv maybe memberNotFound pure mbConv where memberNotFound = do @@ -53,73 +61,85 @@ conversationView uid conv = do throwM badState badState = mkError status500 "bad-state" "Bad internal member state." -conversationViewMaybe :: UserId -> Data.Conversation -> Galley (Maybe Public.Conversation) -conversationViewMaybe u conv = do - localDomain <- viewFederationDomain - pure $ conversationViewMaybeQualified localDomain (Qualified u localDomain) conv - -- | View for a given user of a stored conversation. --- Returns 'Nothing' when the user is not part of the conversation. -conversationViewMaybeQualified :: Domain -> Qualified UserId -> Data.Conversation -> Maybe Public.Conversation -conversationViewMaybeQualified localDomain qUid Data.Conversation {..} = do - let localMembers = localToOther localDomain <$> convLocalMembers - let remoteMembers = remoteToOther <$> convRemoteMembers - let me = List.find ((qUid ==) . Public.omQualifiedId) (localMembers <> remoteMembers) - let otherMembers = filter ((qUid /=) . Public.omQualifiedId) (localMembers <> remoteMembers) - let userAndConvOnSameBackend = find ((qUnqualified qUid ==) . Internal.memId) convLocalMembers - let selfMember = - -- if the user and the conversation are on the same backend, we can create a real self member - -- otherwise, we need to fall back to a default self member (see futurework) - -- (Note: the extra domain check is done to catch the edge case where two users in a conversation have the same unqualified UUID) - if isJust userAndConvOnSameBackend && localDomain == qDomain qUid - then toMember <$> userAndConvOnSameBackend - else incompleteSelfMember <$> me - selfMember <&> \m -> do - let mems = Public.ConvMembers m otherMembers - Public.Conversation - (Qualified convId localDomain) - convType - convCreator - convAccess - convAccessRole - convName - mems - convTeam - convMessageTimer - convReceiptMode - where - localToOther :: Domain -> Internal.LocalMember -> Public.OtherMember - localToOther domain x = - Public.OtherMember - { Public.omQualifiedId = Qualified (Internal.memId x) domain, - Public.omService = Internal.memService x, - Public.omConvRoleName = Internal.memConvRoleName x - } +-- +-- Returns 'Nothing' if the user is not part of the conversation. +conversationViewMaybe :: Domain -> UserId -> Data.Conversation -> Maybe Conversation +conversationViewMaybe localDomain uid conv = do + let (selfs, lothers) = partition ((uid ==) . lmId) (Data.convLocalMembers conv) + rothers = Data.convRemoteMembers conv + self <- localMemberToSelf <$> listToMaybe selfs + let others = + map (localMemberToOther localDomain) lothers + <> map remoteMemberToOther rothers + pure $ + Conversation + (Data.convMetadata localDomain conv) + (ConvMembers self others) - remoteToOther :: Internal.RemoteMember -> Public.OtherMember - remoteToOther x = - Public.OtherMember - { Public.omQualifiedId = unTagged (Internal.rmId x), - Public.omService = Nothing, - Public.omConvRoleName = Internal.rmConvRoleName x - } +-- | View for a local user of a remote conversation. +-- +-- If the local user is not actually present in the conversation, simply +-- discard the conversation altogether. This should only happen if the remote +-- backend is misbehaving. +remoteConversationView :: + UserId -> + MemberStatus -> + RemoteConversation -> + Maybe Conversation +remoteConversationView uid status rconv = do + let mems = rcnvMembers rconv + others = rcmOthers mems + self = + localMemberToSelf + LocalMember + { lmId = uid, + lmService = Nothing, + lmStatus = status, + lmConvRoleName = rcmSelfRole mems + } + pure $ Conversation (rcnvMetadata rconv) (ConvMembers self others) - -- FUTUREWORK(federation): we currently don't store muted, archived etc status for users who are on a different backend than a conversation - -- but we should. Once this information is available, the code should be changed to use the stored information, rather than these defaults. - incompleteSelfMember :: Public.OtherMember -> Public.Member - incompleteSelfMember m = - Public.Member - { memId = qUnqualified (Public.omQualifiedId m), - memService = Nothing, - memOtrMutedStatus = Nothing, - memOtrMutedRef = Nothing, - memOtrArchived = False, - memOtrArchivedRef = Nothing, - memHidden = False, - memHiddenRef = Nothing, - memConvRoleName = Public.omConvRoleName m - } +-- | Convert a local conversation to a structure to be returned to a remote +-- backend. +-- +-- This returns 'Nothing' if the given remote user is not part of the conversation. +conversationToRemote :: + Domain -> + Remote UserId -> + Data.Conversation -> + Maybe RemoteConversation +conversationToRemote localDomain ruid conv = do + let (selfs, rothers) = partition ((== ruid) . rmId) (Data.convRemoteMembers conv) + lothers = Data.convLocalMembers conv + selfRole <- rmConvRoleName <$> listToMaybe selfs + let others = + map (localMemberToOther localDomain) lothers + <> map remoteMemberToOther rothers + pure $ + RemoteConversation + { rcnvMetadata = Data.convMetadata localDomain conv, + rcnvMembers = + RemoteConvMembers + { rcmSelfRole = selfRole, + rcmOthers = others + } + } -toMember :: Internal.LocalMember -> Public.Member -toMember x@Internal.InternalMember {..} = - Public.Member {memId = Internal.memId x, ..} +-- | Convert a local conversation member (as stored in the DB) to a publicly +-- facing 'Member' structure. +localMemberToSelf :: LocalMember -> Member +localMemberToSelf lm = + Member + { memId = lmId lm, + memService = lmService lm, + memOtrMutedStatus = msOtrMutedStatus st, + memOtrMutedRef = msOtrMutedRef st, + memOtrArchived = msOtrArchived st, + memOtrArchivedRef = msOtrArchivedRef st, + memHidden = msHidden st, + memHiddenRef = msHiddenRef st, + memConvRoleName = lmConvRoleName lm + } + where + st = lmStatus lm diff --git a/services/galley/src/Galley/API/Message.hs b/services/galley/src/Galley/API/Message.hs index 8b2683ecaa3..ab744e355df 100644 --- a/services/galley/src/Galley/API/Message.hs +++ b/services/galley/src/Galley/API/Message.hs @@ -225,9 +225,9 @@ postQualifiedOtrMessage senderType sender mconn convId msg = runExceptT $ do localMembers <- lift $ Data.members convId remoteMembers <- Data.lookupRemoteMembers convId - let localMemberIds = memId <$> localMembers + let localMemberIds = lmId <$> localMembers localMemberMap :: Map UserId LocalMember - localMemberMap = Map.fromList (map (\mem -> (memId mem, mem)) localMembers) + localMemberMap = Map.fromList (map (\mem -> (lmId mem, mem)) localMembers) members :: Set (Qualified UserId) members = Set.map (`Qualified` localDomain) (Map.keysSet localMemberMap) @@ -246,7 +246,7 @@ postQualifiedOtrMessage senderType sender mconn convId msg = runExceptT $ do else Data.lookupClients localMemberIds let qualifiedLocalClients = Map.mapKeys (localDomain,) - . makeUserMap (Set.fromList (map memId localMembers)) + . makeUserMap (Set.fromList (map lmId localMembers)) . Clients.toMap $ localClients @@ -463,7 +463,7 @@ newMessagePush localDomain members mconn mm (k, client) e = fromMaybe mempty $ d newUserMessagePush :: LocalMember -> Maybe MessagePush newUserMessagePush member = fmap newUserPush $ - newConversationEventPush localDomain e [memId member] + newConversationEventPush localDomain e [lmId member] <&> set pushConn mconn . set pushNativePriority (mmNativePriority mm) . set pushRoute (bool RouteDirect RouteAny (mmNativePush mm)) diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index 6fb84c56646..191d37ccc2f 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -96,7 +96,7 @@ servantSitemap = GalleyAPI.updateConversationNameUnqualified = Update.updateLocalConversationName, GalleyAPI.updateConversationName = Update.updateConversationName, GalleyAPI.getConversationSelfUnqualified = Query.getLocalSelf, - GalleyAPI.updateConversationSelfUnqualified = Update.updateLocalSelfMember, + GalleyAPI.updateConversationSelfUnqualified = Update.updateUnqualifiedSelfMember, GalleyAPI.updateConversationSelf = Update.updateSelfMember, GalleyAPI.getTeamConversationRoles = Teams.getTeamConversationRoles, GalleyAPI.getTeamConversations = Teams.getTeamConversations, diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 7500ba068a8..be37e81e6d2 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -36,12 +36,13 @@ where import qualified Cassandra as C import Control.Monad.Catch (throwM) -import Control.Monad.Except (ExceptT, runExceptT) +import Control.Monad.Trans.Except import qualified Data.ByteString.Lazy as LBS import Data.Code import Data.CommaSeparatedList import Data.Domain (Domain) import Data.Id as Id +import qualified Data.Map as Map import Data.Proxy import Data.Qualified (Qualified (..), Remote, partitionRemote, partitionRemoteOrLocalIds', toRemote) import Data.Range @@ -54,12 +55,14 @@ import Galley.App import qualified Galley.Data as Data import qualified Galley.Data.Types as Data import Galley.Types +import Galley.Types.Conversations.Members import Galley.Types.Conversations.Roles import Imports import Network.HTTP.Types import Network.Wai import Network.Wai.Predicate hiding (result, setStatus) import Network.Wai.Utilities +import qualified Network.Wai.Utilities.Error as Wai import qualified System.Logger.Class as Logger import UnliftIO (pooledForConcurrentlyN) import Wire.API.Conversation (ConversationCoverView (..)) @@ -85,10 +88,10 @@ getBotConversation zbot zcnv = do where mkMember :: Domain -> LocalMember -> Maybe OtherMember mkMember domain m - | memId m == botUserId zbot = + | lmId m == botUserId zbot = Nothing -- no need to list the bot itself | otherwise = - Just (OtherMember (Qualified (memId m) domain) (memService m) (memConvRoleName m)) + Just (OtherMember (Qualified (lmId m) domain) (lmService m) (lmConvRoleName m)) getUnqualifiedConversation :: UserId -> ConvId -> Galley Public.Conversation getUnqualifiedConversation zusr cnv = do @@ -104,9 +107,6 @@ getConversation zusr cnv = do where getRemoteConversation :: Remote ConvId -> Galley Public.Conversation getRemoteConversation remoteConvId = do - foundConvs <- Data.remoteConversationIdOf zusr [remoteConvId] - unless (remoteConvId `elem` foundConvs) $ - throwErrorDescription convNotFound conversations <- getRemoteConversations zusr [remoteConvId] case conversations of [] -> throwErrorDescription convNotFound @@ -114,39 +114,90 @@ getConversation zusr cnv = do _convs -> throwM (federationUnexpectedBody "expected one conversation, got multiple") getRemoteConversations :: UserId -> [Remote ConvId] -> Galley [Public.Conversation] -getRemoteConversations zusr remoteConvs = do - localDomain <- viewFederationDomain - let qualifiedZUser = Qualified zusr localDomain - let convsByDomain = partitionRemote remoteConvs - convs <- pooledForConcurrentlyN 8 convsByDomain $ \(remoteDomain, convIds) -> do - let req = FederatedGalley.GetConversationsRequest qualifiedZUser convIds - rpc = FederatedGalley.getConversations FederatedGalley.clientRoutes req - gcresConvs <$> runFederatedGalley remoteDomain rpc - pure $ concat convs - -getRemoteConversationsWithFailures :: UserId -> [Remote ConvId] -> Galley ([Qualified ConvId], [Public.Conversation]) -getRemoteConversationsWithFailures zusr remoteConvs = do +getRemoteConversations zusr remoteConvs = + getRemoteConversationsWithFailures zusr remoteConvs >>= \case + -- throw first error + (failed : _, _) -> throwM (fgcError failed) + ([], result) -> pure result + +data FailedGetConversationReason + = FailedGetConversationLocally + | FailedGetConversationRemotely FederationError + +fgcrError :: FailedGetConversationReason -> Wai.Error +fgcrError FailedGetConversationLocally = errorDescriptionToWai convNotFound +fgcrError (FailedGetConversationRemotely e) = federationErrorToWai e + +data FailedGetConversation + = FailedGetConversation + [Qualified ConvId] + FailedGetConversationReason + +fgcError :: FailedGetConversation -> Wai.Error +fgcError (FailedGetConversation _ r) = fgcrError r + +failedGetConversationRemotely :: + [Qualified ConvId] -> FederationError -> FailedGetConversation +failedGetConversationRemotely qconvs = + FailedGetConversation qconvs . FailedGetConversationRemotely + +failedGetConversationLocally :: + [Qualified ConvId] -> FailedGetConversation +failedGetConversationLocally qconvs = + FailedGetConversation qconvs FailedGetConversationLocally + +partitionGetConversationFailures :: + [FailedGetConversation] -> ([Qualified ConvId], [Qualified ConvId]) +partitionGetConversationFailures = bimap concat concat . partitionEithers . map split + where + split (FailedGetConversation convs FailedGetConversationLocally) = Left convs + split (FailedGetConversation convs (FailedGetConversationRemotely _)) = Right convs + +getRemoteConversationsWithFailures :: + UserId -> + [Remote ConvId] -> + Galley ([FailedGetConversation], [Public.Conversation]) +getRemoteConversationsWithFailures zusr convs = do localDomain <- viewFederationDomain - let qualifiedZUser = Qualified zusr localDomain - let convsByDomain = partitionRemote remoteConvs - convs <- pooledForConcurrentlyN 8 convsByDomain $ \(remoteDomain, convIds) -> handleFailures remoteDomain convIds $ do - let req = FederatedGalley.GetConversationsRequest qualifiedZUser convIds - rpc = FederatedGalley.getConversations FederatedGalley.clientRoutes req - gcresConvs <$> executeFederated remoteDomain rpc - pure $ concatEithers convs + + -- get self member statuses from the database + statusMap <- Data.remoteConversationStatus zusr convs + let remoteView rconv = + Mapping.remoteConversationView + zusr + ( Map.findWithDefault + defMemberStatus + (toRemote (cnvmQualifiedId (FederatedGalley.rcnvMetadata rconv))) + statusMap + ) + rconv + (locallyFound, locallyNotFound) = partition (flip Map.member statusMap) convs + localFailures + | null locallyNotFound = [] + | otherwise = [failedGetConversationLocally (map unTagged locallyNotFound)] + + -- request conversations from remote backends + fmap (bimap (localFailures <>) concat . partitionEithers) + . pooledForConcurrentlyN 8 (partitionRemote locallyFound) + $ \(domain, someConvs) -> do + let req = FederatedGalley.GetConversationsRequest zusr someConvs + rpc = FederatedGalley.getConversations FederatedGalley.clientRoutes localDomain req + handleFailures (map (flip Qualified domain) someConvs) $ do + rconvs <- gcresConvs <$> executeFederated domain rpc + pure $ catMaybes (map remoteView rconvs) where - handleFailures :: Domain -> [ConvId] -> ExceptT FederationError Galley a -> Galley (Either [Qualified ConvId] a) - handleFailures domain convIds action = do - res <- runExceptT action - case res of - Right a -> pure $ Right a - Left e -> do - Logger.warn $ - Logger.msg ("Error occurred while fetching remote conversations" :: ByteString) - . Logger.field "error" (show e) - pure . Left $ map (`Qualified` domain) convIds - concatEithers :: (Monoid a, Monoid b) => [Either a b] -> (a, b) - concatEithers = bimap mconcat mconcat . partitionEithers + handleFailures :: + [Qualified ConvId] -> + ExceptT FederationError Galley a -> + Galley (Either FailedGetConversation a) + handleFailures qconvs action = runExceptT + . withExceptT (failedGetConversationRemotely qconvs) + . catchE action + $ \e -> do + lift . Logger.warn $ + Logger.msg ("Error occurred while fetching remote conversations" :: ByteString) + . Logger.field "error" (show e) + throwE e getConversationRoles :: UserId -> ConvId -> Galley Public.ConversationRolesList getConversationRoles zusr cnv = do @@ -292,7 +343,6 @@ listConversationsV2 user (Public.ListConversationsV2 ids) = do let (remoteIds, localIds) = partitionRemoteOrLocalIds' localDomain (fromRange ids) (foundLocalIds, notFoundLocalIds) <- foundsAndNotFounds (Data.localConversationIdsOf user) localIds - (foundRemoteIds, locallyNotFoundRemoteIds) <- foundsAndNotFounds (Data.remoteConversationIdOf user) remoteIds localInternalConversations <- Data.conversations foundLocalIds @@ -300,9 +350,11 @@ listConversationsV2 user (Public.ListConversationsV2 ids) = do >>= filterM (pure . isMember user . Data.convLocalMembers) localConversations <- mapM (Mapping.conversationView user) localInternalConversations - (remoteFailures, remoteConversations) <- getRemoteConversationsWithFailures user foundRemoteIds - let fetchedOrFailedRemoteIds = Set.fromList $ map Public.cnvQualifiedId remoteConversations <> remoteFailures - remoteNotFoundRemoteIds = filter (`Set.notMember` fetchedOrFailedRemoteIds) $ map unTagged foundRemoteIds + (remoteFailures, remoteConversations) <- getRemoteConversationsWithFailures user remoteIds + let (failedConvsLocally, failedConvsRemotely) = partitionGetConversationFailures remoteFailures + failedConvs = failedConvsLocally <> failedConvsRemotely + fetchedOrFailedRemoteIds = Set.fromList $ map Public.cnvQualifiedId remoteConversations <> failedConvs + remoteNotFoundRemoteIds = filter (`Set.notMember` fetchedOrFailedRemoteIds) $ map unTagged remoteIds unless (null remoteNotFoundRemoteIds) $ -- FUTUREWORK: This implies that the backends are out of sync. Maybe the -- current user should be considered removed from this conversation at this @@ -316,10 +368,10 @@ listConversationsV2 user (Public.ListConversationsV2 ids) = do Public.ConversationsResponse { crFound = allConvs, crNotFound = - map unTagged locallyNotFoundRemoteIds + failedConvsLocally <> remoteNotFoundRemoteIds <> map (`Qualified` localDomain) notFoundLocalIds, - crFailed = remoteFailures + crFailed = failedConvsRemotely } where removeDeleted :: Data.Conversation -> Galley Bool @@ -355,7 +407,7 @@ getLocalSelf :: UserId -> ConvId -> Galley (Maybe Public.Member) getLocalSelf usr cnv = do alive <- Data.isConvAlive cnv if alive - then Mapping.toMember <$$> Data.member cnv usr + then Mapping.localMemberToSelf <$$> Data.member cnv usr else Nothing <$ Data.deleteConversation cnv getConversationMetaH :: ConvId -> Galley Response @@ -364,11 +416,12 @@ getConversationMetaH cnv = do Nothing -> setStatus status404 empty Just meta -> json meta -getConversationMeta :: ConvId -> Galley (Maybe ConversationMeta) +getConversationMeta :: ConvId -> Galley (Maybe ConversationMetadata) getConversationMeta cnv = do alive <- Data.isConvAlive cnv + localDomain <- viewFederationDomain if alive - then Data.conversationMeta cnv + then Data.conversationMeta localDomain cnv else do Data.deleteConversation cnv pure Nothing diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index b2f8e53e38f..49e6ee477be 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -742,7 +742,7 @@ uncheckedDeleteTeamMember zusr zcon tid remove mems = do let qconvId = Qualified (Data.convId dc) localDomain qusr = Qualified zusr localDomain let (bots, users) = localBotsAndUsers (Data.convLocalMembers dc) - let x = filter (\m -> not (Conv.memId m `Set.member` exceptTo)) users + let x = filter (\m -> not (Conv.lmId 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 -> push1 $ p & pushConn .~ zcon diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 7d6b656f7e4..0d2ea6c72ed 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -36,7 +36,7 @@ module Galley.API.Update -- * Managing Members addMembersH, addMembers, - updateLocalSelfMember, + updateUnqualifiedSelfMember, updateSelfMember, updateOtherMemberH, removeMember, @@ -99,7 +99,6 @@ 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 @@ -255,16 +254,16 @@ uncheckedUpdateConversationAccess body usr zcon conv (currentAccess, targetAcces -- to make assumption about the order of roles and implement policy -- based on those assumptions. when (currentRole > ActivatedAccessRole && targetRole <= ActivatedAccessRole) $ do - mIds <- map memId <$> use usersL + mIds <- map lmId <$> use usersL activated <- fmap User.userId <$> lift (lookupActivatedUsers mIds) - let isActivated user = memId user `elem` activated + let isActivated user = lmId user `elem` activated usersL %= filter isActivated -- In a team-only conversation we also want to remove bots and guests case (targetRole, Data.convTeam conv) of (TeamAccessRole, Just tid) -> do currentUsers <- use usersL onlyTeamUsers <- flip filterM currentUsers $ \user -> - lift $ isJust <$> Data.teamMember tid (memId user) + lift $ isJust <$> Data.teamMember tid (lmId user) assign usersL onlyTeamUsers botsL .= [] _ -> return () @@ -272,9 +271,9 @@ uncheckedUpdateConversationAccess body usr zcon conv (currentAccess, targetAcces now <- liftIO getCurrentTime let accessEvent = Event ConvAccessUpdate qcnv qusr now (EdConvAccessUpdate body) Data.updateConversationAccess cnv targetAccess targetRole - pushConversationEvent (Just zcon) accessEvent (map memId users) bots + pushConversationEvent (Just zcon) accessEvent (map lmId users) bots -- Remove users and bots - let removedUsers = map memId users \\ map memId newUsers + let removedUsers = map lmId users \\ map lmId newUsers removedBots = map botMemId bots \\ map botMemId newBots mapM_ (deleteBot cnv) removedBots case removedUsers of @@ -316,7 +315,7 @@ updateConversationReceiptMode usr zcon cnv receiptModeUpdate@(Public.Conversatio Data.updateConversationReceiptMode cnv target now <- liftIO getCurrentTime let receiptEvent = Event ConvReceiptModeUpdate qcnv qusr now (EdConvReceiptModeUpdate receiptModeUpdate) - pushConversationEvent (Just zcon) receiptEvent (map memId users) bots + pushConversationEvent (Just zcon) receiptEvent (map lmId users) bots pure receiptEvent updateConversationMessageTimerH :: UserId ::: ConnId ::: ConvId ::: JsonRequest Public.ConversationMessageTimerUpdate -> Galley Response @@ -345,7 +344,7 @@ updateConversationMessageTimer usr zcon cnv timerUpdate@(Public.ConversationMess now <- liftIO getCurrentTime let timerEvent = Event ConvMessageTimerUpdate qcnv qusr now (EdConvMessageTimerUpdate timerUpdate) Data.updateConversationMessageTimer cnv target - pushConversationEvent (Just zcon) timerEvent (map memId users) bots + pushConversationEvent (Just zcon) timerEvent (map lmId users) bots pure timerEvent addCodeH :: UserId ::: ConnId ::: ConvId -> Galley Response @@ -376,7 +375,7 @@ addCode usr zcon cnv = do now <- liftIO getCurrentTime conversationCode <- createCode code let event = Event ConvCodeUpdate qcnv qusr now (EdConvCodeUpdate conversationCode) - pushConversationEvent (Just zcon) event (map memId users) bots + pushConversationEvent (Just zcon) event (map lmId users) bots pure $ CodeAdded event Just code -> do conversationCode <- createCode code @@ -404,7 +403,7 @@ rmCode usr zcon cnv = do Data.deleteCode key ReusableCode now <- liftIO getCurrentTime let event = Event ConvCodeDelete qcnv qusr now EdConvCodeDelete - pushConversationEvent (Just zcon) event (map memId users) bots + pushConversationEvent (Just zcon) event (map lmId users) bots pure event getCodeH :: UserId ::: ConvId -> Galley Response @@ -494,7 +493,7 @@ addMembers zusr zcon convId invite = do checkRemoteUsersExist newRemotes checkLHPolicyConflictsLocal conv newLocals checkLHPolicyConflictsRemote (FutureWork newRemotes) - addToConversation mems rMems (zusr, memConvRoleName self) zcon (withRoles newLocals) (withRoles newRemotes) conv + addToConversation mems rMems (zusr, lmConvRoleName self) zcon (withRoles newLocals) (withRoles newRemotes) conv where userIsMember u = (^. userId . to (== u)) @@ -520,7 +519,7 @@ addMembers zusr zcon convId invite = do allNewUsersGaveConsent <- allLegalholdConsentGiven newUsers - whenM (anyLegalholdActivated (memId <$> convUsers)) $ + whenM (anyLegalholdActivated (lmId <$> convUsers)) $ unless allNewUsersGaveConsent $ throwErrorDescription missingLegalholdConsent @@ -529,12 +528,12 @@ addMembers zusr zcon convId invite = do throwErrorDescription missingLegalholdConsent convUsersLHStatus <- do - uidsStatus <- getLHStatusForUsers (memId <$> convUsers) + uidsStatus <- getLHStatusForUsers (lmId <$> convUsers) pure $ zipWith (\mem (_, status) -> (mem, status)) convUsers uidsStatus if any ( \(mem, status) -> - memConvRoleName mem == roleNameWireAdmin + lmConvRoleName mem == roleNameWireAdmin && consentGiven status == ConsentGiven ) convUsersLHStatus @@ -542,9 +541,9 @@ addMembers zusr zcon convId invite = do localDomain <- viewFederationDomain for_ convUsersLHStatus $ \(mem, status) -> when (consentGiven status == ConsentNotGiven) $ - let qvictim = Qualified (memId mem) localDomain + let qvictim = Qualified (lmId mem) localDomain in void $ - removeMember (memId mem `Qualified` localDomain) Nothing (Data.convId conv `Qualified` localDomain) qvictim + removeMember (lmId mem `Qualified` localDomain) Nothing (Data.convId conv `Qualified` localDomain) qvictim else throwErrorDescription missingLegalholdConsent checkLHPolicyConflictsRemote :: FutureWork 'LegalholdPlusFederationNotImplemented [Remote UserId] -> Galley () @@ -554,14 +553,36 @@ updateSelfMember :: UserId -> ConnId -> Qualified ConvId -> Public.MemberUpdate updateSelfMember zusr zcon qcnv update = do localDomain <- viewFederationDomain if qDomain qcnv == localDomain - then updateLocalSelfMember zusr zcon (qUnqualified qcnv) update - else throwM federationNotImplemented + then updateLocalSelfMember zusr zcon (toLocal qcnv) update + else updateRemoteSelfMember zusr zcon (toRemote qcnv) update -updateLocalSelfMember :: UserId -> ConnId -> ConvId -> Public.MemberUpdate -> Galley () -updateLocalSelfMember zusr zcon cid update = do - conv <- getConversationAndCheckMembership zusr cid +updateUnqualifiedSelfMember :: UserId -> ConnId -> ConvId -> Public.MemberUpdate -> Galley () +updateUnqualifiedSelfMember zusr zcon cid update = do + localDomain <- viewFederationDomain + updateLocalSelfMember zusr zcon (toLocal (Qualified cid localDomain)) update + +updateLocalSelfMember :: UserId -> ConnId -> Local ConvId -> Public.MemberUpdate -> Galley () +updateLocalSelfMember zusr zcon (Tagged qcid) update = do + -- FUTUREWORK: no need to fetch the whole conversation here: the + -- getConversationAndCheckMembership function results in 3 queries (for the + -- conversation metadata, remote members and local members respectively), but + -- only one is really needed (local members). + conv <- getConversationAndCheckMembership zusr (qUnqualified qcid) m <- getSelfMemberFromLocalsLegacy zusr (Data.convLocalMembers conv) - void $ processUpdateMemberEvent zusr zcon cid [m] m update + void $ processUpdateMemberEvent zusr zcon qcid [lmId m] (lmId m) update + +updateRemoteSelfMember :: + UserId -> + ConnId -> + Remote ConvId -> + Public.MemberUpdate -> + Galley () +updateRemoteSelfMember zusr zcon rcid update = do + statusMap <- Data.remoteConversationStatus zusr [rcid] + case Map.lookup rcid statusMap of + Nothing -> throwM convMemberNotFound + Just _ -> + void $ processUpdateMemberEvent zusr zcon (unTagged rcid) [zusr] zusr update updateOtherMemberH :: UserId ::: ConnId ::: ConvId ::: UserId ::: JsonRequest Public.OtherMemberUpdate -> Galley Response updateOtherMemberH (zusr ::: zcon ::: cid ::: victim ::: req) = do @@ -571,13 +592,15 @@ updateOtherMemberH (zusr ::: zcon ::: cid ::: victim ::: req) = do updateOtherMember :: UserId -> ConnId -> ConvId -> UserId -> Public.OtherMemberUpdate -> Galley () updateOtherMember zusr zcon cid victim update = do + localDomain <- viewFederationDomain when (zusr == victim) $ throwM invalidTargetUserOp conv <- getConversationAndCheckMembership zusr cid let (bots, users) = localBotsAndUsers (Data.convLocalMembers conv) ensureActionAllowedThrowing ModifyOtherConversationMember =<< getSelfMemberFromLocalsLegacy zusr users + -- this has the side effect of checking that the victim is indeed part of the conversation memTarget <- getOtherMemberLegacy victim users - e <- processUpdateMemberEvent zusr zcon cid users memTarget update + e <- processUpdateMemberEvent zusr zcon (Qualified cid localDomain) (map lmId users) (lmId memTarget) update void . forkIO $ void $ External.deliver (bots `zip` repeat e) -- | A general conversation member removal function used both by the unqualified @@ -647,7 +670,7 @@ removeMemberFromLocalConv remover@(Qualified removerUid removerDomain) zcon conv removerRole <- withExceptT (const @_ @ConvNotFound RemoveFromConversationErrorNotFound) $ if localDomain == removerDomain - then memConvRoleName <$> getSelfMemberFromLocals removerUid locals + then lmConvRoleName <$> getSelfMemberFromLocals removerUid locals else rmConvRoleName <$> getSelfMemberFromRemotes (toRemote remover) (Data.convRemoteMembers conv) generalConvChecks localDomain removerRole conv @@ -838,7 +861,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 $ lmId m) qcnv e = Event OtrMessageAdd qconv qusr now (EdOtrMessage o) r = recipient m & recipientClients .~ RecipientClientsSome (singleton c) in case newBotMember m of @@ -1024,7 +1047,7 @@ addToConversation (bots, existingLocals) existingRemotes (usr, usrRole) conn new localDomain <- viewFederationDomain (e, lmm, rmm) <- Data.addMembersWithRole localDomain now (Data.convId c) (usr, usrRole) mems let newMembersWithRoles = - ((flip Qualified localDomain . memId &&& memConvRoleName) <$> lmm) + ((flip Qualified localDomain . lmId &&& lmConvRoleName) <$> lmm) <> ((unTagged . rmId &&& rmConvRoleName) <$> rmm) case newMembersWithRoles of [] -> @@ -1033,7 +1056,7 @@ addToConversation (bots, existingLocals) existingRemotes (usr, usrRole) conn new 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 + let localsToNotify = nubOrd . fmap lmId $ existingLocals <> lmm pushConversationEvent (Just conn) e localsToNotify bots pure $ Updated e @@ -1074,23 +1097,34 @@ ensureConvMember users usr = unless (usr `isMember` users) $ throwErrorDescription convNotFound +-- | Update a member of a conversation and propagate events. +-- +-- Note: the target is assumed to be a member of the conversation. processUpdateMemberEvent :: Data.IsMemberUpdate mu => + -- | Originating user UserId -> + -- | Connection ID for the originating user ConnId -> - ConvId -> - [LocalMember] -> - LocalMember -> + -- | Conversation whose members are being updated + Qualified ConvId -> + -- | Recipients of the notification + [UserId] -> + -- | User being updated + UserId -> + -- | Update structure mu -> Galley Event -processUpdateMemberEvent zusr zcon cid users target update = do +processUpdateMemberEvent zusr zcon qcid users target update = do localDomain <- viewFederationDomain - let qcnv = Qualified cid localDomain - qusr = Qualified zusr localDomain - up <- Data.updateMember cid (memId target) update + let qusr = Qualified zusr localDomain + up <- + if localDomain == qDomain qcid + then Data.updateMember (qUnqualified qcid) target update + else Data.updateMemberRemoteConv (toRemote qcid) target update now <- liftIO getCurrentTime - let e = Event MemberStateUpdate qcnv qusr now (EdMemberUpdate up) - let recipients = fmap recipient (target : filter ((/= memId target) . memId) users) + let e = Event MemberStateUpdate qcid qusr now (EdMemberUpdate up) + let recipients = fmap userRecipient (target : filter (/= target) users) for_ (newPushLocal ListComplete zusr (ConvEvent e) recipients) $ \p -> push1 $ p @@ -1175,7 +1209,7 @@ withValidOtrRecipients utype usr clt cnv rcps val now go = do pure $ OtrConversationNotFound convNotFound else do localMembers <- Data.members cnv - let localMemberIds = memId <$> localMembers + let localMemberIds = lmId <$> localMembers isInternal <- view $ options . optSettings . setIntraListing clts <- if isInternal @@ -1254,8 +1288,8 @@ checkOtrRecipients usr sid prs vms vcs val now | otherwise = Nothing -- Valid recipient members & clients - vmembers :: Map UserId (InternalMember UserId) - vmembers = Map.fromList $ map (\m -> (memId m, m)) vms + vmembers :: Map UserId LocalMember + vmembers = Map.fromList $ map (\m -> (lmId m, m)) vms vclients :: Clients vclients = Clients.rmClient usr sid vcs diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 98020dcfc98..e7bbd6d43a4 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -50,8 +50,7 @@ import Galley.Intra.Push import Galley.Intra.User import Galley.Options (optSettings, setFeatureFlags, setFederationDomain) import Galley.Types -import Galley.Types.Conversations.Members (RemoteMember (..)) -import qualified Galley.Types.Conversations.Members as Members +import Galley.Types.Conversations.Members (localMemberToOther, remoteMemberToOther) import Galley.Types.Conversations.Roles import Galley.Types.Teams hiding (Event) import Imports @@ -143,9 +142,9 @@ ensureActionAllowed action role = case isActionAllowed action role of -- 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. -ensureActionAllowedThrowing :: Action -> InternalMember a -> Galley () +ensureActionAllowedThrowing :: Action -> LocalMember -> Galley () ensureActionAllowedThrowing action mem = - case ensureActionAllowed action (memConvRoleName mem) of + case ensureActionAllowed action (lmConvRoleName mem) of ACOAllowed -> return () ACOActionDenied _ -> throwErrorDescription (actionDenied action) ACOCustomRolesNotSupported -> throwM (badRequest "Custom roles not supported") @@ -157,9 +156,9 @@ ensureActionAllowedThrowing action mem = -- own. This is used to ensure users cannot "elevate" allowed actions -- This function needs to be review when custom roles are introduced since only -- custom roles can cause `roleNameToActions` to return a Nothing -ensureConvRoleNotElevated :: InternalMember a -> RoleName -> Galley () +ensureConvRoleNotElevated :: LocalMember -> RoleName -> Galley () ensureConvRoleNotElevated origMember targetRole = do - case (roleNameToActions targetRole, roleNameToActions (memConvRoleName origMember)) of + case (roleNameToActions targetRole, roleNameToActions (lmConvRoleName origMember)) of (Just targetActions, Just memberActions) -> unless (Set.isSubsetOf targetActions memberActions) $ throwM invalidActions @@ -220,7 +219,7 @@ acceptOne2One usr conv conn = do throwM badConvState now <- liftIO getCurrentTime (e, mm) <- Data.addMember localDomain now cid usr - conv' <- if isJust (find ((usr /=) . memId) mems) then promote else pure conv + conv' <- if isJust (find ((usr /=) . lmId) mems) then promote else pure conv let mems' = mems <> toList mm for_ (newPushLocal ListComplete usr (ConvEvent e) (recipient <$> mems')) $ \p -> push1 $ p & pushConn .~ conn & pushRoute .~ RouteDirect @@ -237,22 +236,19 @@ acceptOne2One usr conv conn = do "Connect conversation with more than 2 members: " <> LT.pack (show cid) -isBot :: InternalMember a -> Bool -isBot = isJust . memService +isBot :: LocalMember -> Bool +isBot = isJust . lmService -isMember :: (Eq a, Foldable m) => a -> m (InternalMember a) -> Bool -isMember u = isJust . find ((u ==) . memId) +isMember :: Foldable m => UserId -> m LocalMember -> Bool +isMember u = isJust . find ((u ==) . lmId) -isRemoteMember :: (Foldable m) => Remote UserId -> m RemoteMember -> Bool +isRemoteMember :: Foldable m => Remote UserId -> m RemoteMember -> Bool isRemoteMember u = isJust . find ((u ==) . rmId) -findMember :: Data.Conversation -> UserId -> Maybe LocalMember -findMember c u = find ((u ==) . memId) (Data.convLocalMembers c) - localBotsAndUsers :: Foldable f => f LocalMember -> ([BotMember], [LocalMember]) localBotsAndUsers = foldMap botOrUser where - botOrUser m = case memService m of + botOrUser m = case lmService m of -- we drop invalid bots here, which shouldn't happen Just _ -> (toList (newBotMember m), []) Nothing -> ([], [m]) @@ -261,7 +257,7 @@ location :: ToByteString a => a -> Response -> Response location = addHeader hLocation . toByteString' nonTeamMembers :: [LocalMember] -> [TeamMember] -> [LocalMember] -nonTeamMembers cm tm = filter (not . isMemberOfTeam . memId) cm +nonTeamMembers cm tm = filter (not . isMemberOfTeam . lmId) cm where -- FUTUREWORK: remote members: teams and their members are always on the same backend isMemberOfTeam = \case @@ -269,7 +265,7 @@ nonTeamMembers cm tm = filter (not . isMemberOfTeam . memId) cm convMembsAndTeamMembs :: [LocalMember] -> [TeamMember] -> [Recipient] convMembsAndTeamMembs convMembs teamMembs = - fmap userRecipient . setnub $ map memId convMembs <> map (view userId) teamMembs + fmap userRecipient . setnub $ map lmId convMembs <> map (view userId) teamMembs where setnub = Set.toList . Set.fromList @@ -339,7 +335,7 @@ getLocalMember :: UserId -> t LocalMember -> ExceptT e m LocalMember -getLocalMember = getMember memId +getLocalMember = getMember lmId -- | Since we search by remote user ID, we know that the member must be remote. getRemoteMember :: @@ -498,21 +494,9 @@ toNewRemoteConversation now localDomain Data.Conversation {..} = [RemoteMember] -> Set OtherMember toMembers ls rs = - Set.fromList $ fmap localToOther ls <> fmap remoteToOther rs - localToOther :: LocalMember -> OtherMember - localToOther Members.InternalMember {..} = - OtherMember - { omQualifiedId = Qualified memId localDomain, - omService = Nothing, - omConvRoleName = memConvRoleName - } - remoteToOther :: RemoteMember -> OtherMember - remoteToOther RemoteMember {..} = - OtherMember - { omQualifiedId = unTagged rmId, - omService = Nothing, - omConvRoleName = rmConvRoleName - } + Set.fromList $ + map (localMemberToOther localDomain) ls + <> map remoteMemberToOther rs -- | The function converts a 'NewRemoteConversation' value to a -- 'Wire.API.Conversation.Conversation' value for each user that is on the given @@ -553,21 +537,22 @@ fromNewRemoteConversation d NewRemoteConversation {..} = conv :: Public.Member -> [OtherMember] -> Public.Conversation conv this others = Public.Conversation - { cnvQualifiedId = rcCnvId, - cnvType = rcCnvType, - -- FUTUREWORK: Document this is the same domain as the conversation - -- domain - cnvCreator = qUnqualified rcOrigUserId, - cnvAccess = rcCnvAccess, - cnvAccessRole = rcCnvAccessRole, - cnvName = rcCnvName, - cnvMembers = ConvMembers this others, - -- FUTUREWORK: Document this is the same domain as the conversation - -- domain. - cnvTeam = Nothing, - cnvMessageTimer = rcMessageTimer, - cnvReceiptMode = rcReceiptMode - } + ConversationMetadata + { cnvmQualifiedId = rcCnvId, + cnvmType = rcCnvType, + -- FUTUREWORK: Document this is the same domain as the conversation + -- domain + cnvmCreator = qUnqualified rcOrigUserId, + cnvmAccess = rcCnvAccess, + cnvmAccessRole = rcCnvAccessRole, + cnvmName = rcCnvName, + -- FUTUREWORK: Document this is the same domain as the conversation + -- domain. + cnvmTeam = Nothing, + cnvmMessageTimer = rcMessageTimer, + cnvmReceiptMode = rcReceiptMode + } + (ConvMembers this others) -- | Notify remote users of being added to a new conversation registerRemoteConversationMemberships :: diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index ef4d8f8a4b3..3592ab08e66 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -55,15 +55,16 @@ module Galley.Data -- * Conversations Conversation (..), + convMetadata, acceptConnect, conversation, conversationIdsFrom, localConversationIdsOf, - remoteConversationIdOf, + remoteConversationStatus, localConversationIdsPageFrom, conversationIdRowsForPagination, - conversationMeta, conversations, + conversationMeta, conversationsRemote, createConnectConversation, createConversation, @@ -191,7 +192,7 @@ mkResultSet page = ResultSet (result page) typ | otherwise = ResultSetComplete schemaVersion :: Int32 -schemaVersion = 52 +schemaVersion = 53 -- | Insert a conversation code insertCode :: MonadClient m => Code -> m () @@ -535,12 +536,22 @@ toConv cid mms remoteMems conv = where f ms (cty, uid, acc, role, nme, ti, del, timer, rm) = Conversation cid cty uid nme (defAccess cty acc) (maybeRole cty role) ms remoteMems ti del timer rm -conversationMeta :: MonadClient m => ConvId -> m (Maybe ConversationMeta) -conversationMeta conv = +conversationMeta :: MonadClient m => Domain -> ConvId -> m (Maybe ConversationMetadata) +conversationMeta localDomain conv = fmap toConvMeta <$> retry x1 (query1 Cql.selectConv (params Quorum (Identity conv))) where - toConvMeta (t, c, a, r, n, i, _, mt, rm) = ConversationMeta conv t c (defAccess t a) (maybeRole t r) n i mt rm + toConvMeta (t, c, a, r, n, i, _, mt, rm) = + ConversationMetadata + (Qualified conv localDomain) + t + c + (defAccess t a) + (maybeRole t r) + n + i + mt + rm -- | Deprecated, use 'localConversationIdsPageFrom' conversationIdsFrom :: @@ -582,16 +593,27 @@ localConversationIdsOf :: forall m. (MonadClient m, MonadUnliftIO m) => UserId - localConversationIdsOf usr cids = do runIdentity <$$> retry x1 (query Cql.selectUserConvsIn (params Quorum (usr, cids))) --- | Takes a list of remote conversation ids and splits them by those found for --- the given user -remoteConversationIdOf :: forall m. (MonadClient m, MonadLogger m, MonadUnliftIO m) => UserId -> [Remote ConvId] -> m [Remote ConvId] -remoteConversationIdOf usr cnvs = do - concat <$$> pooledMapConcurrentlyN 8 findRemoteConvs . Map.assocs . partitionQualified . map unTagged $ cnvs +-- | Takes a list of remote conversation ids and fetches member status flags +-- for the given user +remoteConversationStatus :: + (MonadClient m, MonadUnliftIO m) => + UserId -> + [Remote ConvId] -> + m (Map (Remote ConvId) MemberStatus) +remoteConversationStatus uid = + fmap mconcat + . pooledMapConcurrentlyN 8 (uncurry (remoteConversationStatusOnDomain uid)) + . partitionRemote + +remoteConversationStatusOnDomain :: MonadClient m => UserId -> Domain -> [ConvId] -> m (Map (Remote ConvId) MemberStatus) +remoteConversationStatusOnDomain uid domain convs = + Map.fromList . map toPair + <$> query Cql.selectRemoteConvMembers (params Quorum (uid, domain, convs)) where - findRemoteConvs :: (Domain, [ConvId]) -> m [Remote ConvId] - findRemoteConvs (domain, remoteConvIds) = do - foundCnvs <- runIdentity <$$> query Cql.selectRemoteConvMembershipIn (params Quorum (usr, domain, remoteConvIds)) - pure $ toRemote . (`Qualified` domain) <$> foundCnvs + toPair (conv, omus, omur, oar, oarr, hid, hidr) = + ( toRemote (Qualified conv domain), + toMemberStatus (omus, omur, oar, oarr, hid, hidr) + ) conversationsRemote :: (MonadClient m) => UserId -> m [Remote ConvId] conversationsRemote usr = do @@ -701,7 +723,7 @@ deleteConversation :: (MonadClient m, Log.MonadLogger m, MonadThrow m) => ConvId deleteConversation cid = do retry x5 $ write Cql.markConvDeleted (params Quorum (Identity cid)) mm <- members cid - for_ mm $ \m -> removeMember (memId m) cid + for_ mm $ \m -> removeMember (lmId m) cid retry x5 $ write Cql.deleteConv (params Quorum (Identity cid)) acceptConnect :: MonadClient m => ConvId -> m () @@ -743,6 +765,19 @@ newConv cid ct usr mems rMems acc role name tid mtimer rMode = convReceiptMode = rMode } +convMetadata :: Domain -> Conversation -> ConversationMetadata +convMetadata localDomain c = + ConversationMetadata + (Qualified (convId c) localDomain) + (convType c) + (convCreator c) + (convAccess c) + (convAccessRole c) + (convName c) + (convTeam c) + (convMessageTimer c) + (convReceiptMode c) + defAccess :: ConvType -> Maybe (Set Access) -> [Access] defAccess SelfConv Nothing = [PrivateAccess] defAccess ConnectConv Nothing = [PrivateAccess] @@ -781,8 +816,8 @@ member :: UserId -> m (Maybe LocalMember) member cnv usr = - fmap (join @Maybe) . traverse toMember - =<< retry x1 (query1 Cql.selectMember (params Quorum (cnv, usr))) + (toMember =<<) + <$> retry x1 (query1 Cql.selectMember (params Quorum (cnv, usr))) remoteMemberLists :: (MonadClient m) => @@ -807,15 +842,15 @@ memberLists :: m [[LocalMember]] memberLists convs = do mems <- retry x1 $ query Cql.selectMembers (params Quorum (Identity convs)) - convMembers <- foldrM (\m acc -> liftA2 insert (mkMem m) (pure acc)) Map.empty mems + let convMembers = foldr (\m acc -> insert (mkMem m) acc) mempty mems return $ map (\c -> fromMaybe [] (Map.lookup c convMembers)) convs where - insert Nothing acc = acc - insert (Just (conv, mem)) acc = + insert (_, Nothing) acc = acc + insert (conv, Just mem) acc = let f = (Just . maybe [mem] (mem :)) in Map.alter f conv acc mkMem (cnv, usr, srv, prv, st, omus, omur, oar, oarr, hid, hidr, crn) = - fmap (cnv,) <$> toMember (usr, srv, prv, st, omus, omur, oar, oarr, hid, hidr, crn) + (cnv, toMember (usr, srv, prv, st, omus, omur, oar, oarr, hid, hidr, crn)) members :: (MonadClient m, Log.MonadLogger m, MonadThrow m) => ConvId -> m [LocalMember] members conv = join <$> memberLists [conv] @@ -900,6 +935,20 @@ addLocalMembersToRemoteConv users qconv = do class IsMemberUpdate mu where updateMember :: MonadClient m => ConvId -> UserId -> mu -> m MemberUpdateData + updateMemberRemoteConv :: MonadClient m => Remote ConvId -> UserId -> mu -> m MemberUpdateData + +memberUpdateToData :: UserId -> MemberUpdate -> MemberUpdateData +memberUpdateToData uid mup = + MemberUpdateData + { misTarget = Just uid, + misOtrMutedStatus = mupOtrMuteStatus mup, + misOtrMutedRef = mupOtrMuteRef mup, + misOtrArchived = mupOtrArchive mup, + misOtrArchivedRef = mupOtrArchiveRef mup, + misHidden = mupHidden mup, + misHiddenRef = mupHiddenRef mup, + misConvRoleName = Nothing + } instance IsMemberUpdate MemberUpdate where updateMember cid uid mup = do @@ -912,17 +961,24 @@ instance IsMemberUpdate MemberUpdate where addPrepQuery Cql.updateOtrMemberArchived (a, mupOtrArchiveRef mup, cid, uid) for_ (mupHidden mup) $ \h -> addPrepQuery Cql.updateMemberHidden (h, mupHiddenRef mup, cid, uid) - return - MemberUpdateData - { misTarget = Just uid, - misOtrMutedStatus = mupOtrMuteStatus mup, - misOtrMutedRef = mupOtrMuteRef mup, - misOtrArchived = mupOtrArchive mup, - misOtrArchivedRef = mupOtrArchiveRef mup, - misHidden = mupHidden mup, - misHiddenRef = mupHiddenRef mup, - misConvRoleName = Nothing - } + pure (memberUpdateToData uid mup) + updateMemberRemoteConv (Tagged (Qualified cid domain)) uid mup = do + retry x5 . batch $ do + setType BatchUnLogged + setConsistency Quorum + for_ (mupOtrMuteStatus mup) $ \ms -> + addPrepQuery + Cql.updateRemoteOtrMemberMutedStatus + (ms, mupOtrMuteRef mup, domain, cid, uid) + for_ (mupOtrArchive mup) $ \a -> + addPrepQuery + Cql.updateRemoteOtrMemberArchived + (a, mupOtrArchiveRef mup, domain, cid, uid) + for_ (mupHidden mup) $ \h -> + addPrepQuery + Cql.updateRemoteMemberHidden + (h, mupHiddenRef mup, domain, cid, uid) + pure (memberUpdateToData uid mup) instance IsMemberUpdate OtherMemberUpdate where updateMember cid uid omu = do @@ -943,6 +999,20 @@ instance IsMemberUpdate OtherMemberUpdate where misConvRoleName = omuConvRoleName omu } + -- FUTUREWORK: https://wearezeta.atlassian.net/browse/SQCORE-887 + updateMemberRemoteConv _ _ _ = + pure + MemberUpdateData + { misTarget = Nothing, + misOtrMutedStatus = Nothing, + misOtrMutedRef = Nothing, + misOtrArchived = Nothing, + misOtrArchivedRef = Nothing, + misHidden = Nothing, + misHiddenRef = Nothing, + misConvRoleName = Nothing + } + -- | Select only the members of a remote conversation from a list of users. -- Return the filtered list and a boolean indicating whether the all the input -- users are members. @@ -953,9 +1023,10 @@ filterRemoteConvMembers users (Qualified conv dom) = <$> pooledMapConcurrentlyN 8 filterMember users where filterMember :: MonadClient m => UserId -> m [UserId] - filterMember user = do - let q = query Cql.selectRemoteConvMembership (params Quorum (user, dom, conv)) - map runIdentity <$> retry x1 q + filterMember user = + fmap (map (const user)) + . retry x1 + $ query Cql.selectRemoteConvMembers (params Quorum (user, dom, [conv])) removeLocalMembersFromLocalConv :: MonadClient m => @@ -1015,25 +1086,41 @@ removeMember usr cnv = retry x5 . batch $ do addPrepQuery Cql.removeMember (cnv, usr) addPrepQuery Cql.deleteUserConv (usr, cnv) -newMember :: a -> InternalMember a +newMember :: UserId -> LocalMember newMember = flip newMemberWithRole roleNameWireAdmin -newMemberWithRole :: a -> RoleName -> InternalMember a +newMemberWithRole :: UserId -> RoleName -> LocalMember newMemberWithRole u r = - InternalMember - { memId = u, - memService = Nothing, - memOtrMutedStatus = Nothing, - memOtrMutedRef = Nothing, - memOtrArchived = False, - memOtrArchivedRef = Nothing, - memHidden = False, - memHiddenRef = Nothing, - memConvRoleName = r + LocalMember + { lmId = u, + lmService = Nothing, + lmStatus = defMemberStatus, + lmConvRoleName = r + } + +toMemberStatus :: + ( -- otr muted + Maybe MutedStatus, + Maybe Text, + -- otr archived + Maybe Bool, + Maybe Text, + -- hidden + Maybe Bool, + Maybe Text + ) -> + MemberStatus +toMemberStatus (omus, omur, oar, oarr, hid, hidr) = + MemberStatus + { msOtrMutedStatus = omus, + msOtrMutedRef = omur, + msOtrArchived = fromMaybe False oar, + msOtrArchivedRef = oarr, + msHidden = fromMaybe False hid, + msHiddenRef = hidr } toMember :: - (Log.MonadLogger m, MonadThrow m) => ( UserId, Maybe ServiceId, Maybe ProviderId, @@ -1050,24 +1137,16 @@ toMember :: -- conversation role name Maybe RoleName ) -> - m (Maybe LocalMember) -- FUTUREWORK: remove monad -toMember (usr, srv, prv, sta, omus, omur, oar, oarr, hid, hidr, crn) = - pure $ - if sta /= Just 0 - then Nothing - else - Just $ - InternalMember - { memId = usr, - memService = newServiceRef <$> srv <*> prv, - memOtrMutedStatus = omus, - memOtrMutedRef = omur, - memOtrArchived = fromMaybe False oar, - memOtrArchivedRef = oarr, - memHidden = fromMaybe False hid, - memHiddenRef = hidr, - memConvRoleName = fromMaybe roleNameWireAdmin crn - } + Maybe LocalMember +toMember (usr, srv, prv, Just 0, omus, omur, oar, oarr, hid, hidr, crn) = + Just $ + LocalMember + { lmId = usr, + lmService = newServiceRef <$> srv <*> prv, + lmStatus = toMemberStatus (omus, omur, oar, oarr, hid, hidr), + lmConvRoleName = fromMaybe roleNameWireAdmin crn + } +toMember _ = Nothing -- Clients ------------------------------------------------------------------ diff --git a/services/galley/src/Galley/Data/Queries.hs b/services/galley/src/Galley/Data/Queries.hs index a54d3dcbf03..a07facd611c 100644 --- a/services/galley/src/Galley/Data/Queries.hs +++ b/services/galley/src/Galley/Data/Queries.hs @@ -283,7 +283,6 @@ updateMemberConvRoleName = "update member set conversation_role = ? where conv = -- Federated conversations ----------------------------------------------------- -- -- FUTUREWORK(federation): allow queries for pagination to support more than 500 (?) conversations for a user. --- FUTUREWORK(federation): support other conversation attributes such as muted, archived, etc -- local conversation with remote members @@ -304,15 +303,26 @@ insertUserRemoteConv = "insert into user_remote_conv (user, conv_remote_domain, selectUserRemoteConvs :: PrepQuery R (Identity UserId) (Domain, ConvId) selectUserRemoteConvs = "select conv_remote_domain, conv_remote_id from user_remote_conv where user = ?" -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 = ?" - -selectRemoteConvMembershipIn :: PrepQuery R (UserId, Domain, [ConvId]) (Identity ConvId) -selectRemoteConvMembershipIn = "select conv_remote_id from user_remote_conv where user = ? and conv_remote_domain = ? and conv_remote_id in ?" +selectRemoteConvMembers :: PrepQuery R (UserId, Domain, [ConvId]) (ConvId, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text) +selectRemoteConvMembers = "select conv_remote_id, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref from user_remote_conv where user = ? and conv_remote_domain = ? and conv_remote_id in ?" deleteUserRemoteConv :: PrepQuery W (UserId, Domain, ConvId) () deleteUserRemoteConv = "delete from user_remote_conv where user = ? and conv_remote_domain = ? and conv_remote_id = ?" +-- remote conversation status for local user + +updateRemoteOtrMemberMutedStatus :: PrepQuery W (MutedStatus, Maybe Text, Domain, ConvId, UserId) () +updateRemoteOtrMemberMutedStatus = "update user_remote_conv set otr_muted_status = ?, otr_muted_ref = ? where conv_remote_domain = ? and conv_remote_id = ? and user = ?" + +updateRemoteOtrMemberArchived :: PrepQuery W (Bool, Maybe Text, Domain, ConvId, UserId) () +updateRemoteOtrMemberArchived = "update user_remote_conv set otr_archived = ?, otr_archived_ref = ? where conv_remote_domain = ? and conv_remote_id = ? and user = ?" + +updateRemoteMemberHidden :: PrepQuery W (Bool, Maybe Text, Domain, ConvId, UserId) () +updateRemoteMemberHidden = "update user_remote_conv set hidden = ?, hidden_ref = ? where conv_remote_domain = ? and conv_remote_id = ? and user = ?" + +selectRemoteMemberStatus :: PrepQuery R (Domain, ConvId, UserId) (Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text) +selectRemoteMemberStatus = "select otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref from user_remote_conv where conv_remote_domain = ? and conv_remote_id = ? and user = ?" + -- Clients ------------------------------------------------------------------ selectClients :: PrepQuery R (Identity [UserId]) (UserId, C.Set ClientId) diff --git a/services/galley/src/Galley/Data/Services.hs b/services/galley/src/Galley/Data/Services.hs index 3ab4ab474fd..0b633476bb3 100644 --- a/services/galley/src/Galley/Data/Services.hs +++ b/services/galley/src/Galley/Data/Services.hs @@ -53,13 +53,13 @@ import Imports newtype BotMember = BotMember {fromBotMember :: LocalMember} newBotMember :: LocalMember -> Maybe BotMember -newBotMember m = const (BotMember m) <$> memService m +newBotMember m = const (BotMember m) <$> lmService m botMemId :: BotMember -> BotId -botMemId = BotId . memId . fromBotMember +botMemId = BotId . lmId . fromBotMember botMemService :: BotMember -> ServiceRef -botMemService = fromJust . memService . fromBotMember +botMemService = fromJust . lmService . fromBotMember addBotMember :: Qualified UserId -> ServiceRef -> BotId -> ConvId -> UTCTime -> Galley (Event, BotMember) addBotMember qorig s bot cnv now = do @@ -77,7 +77,7 @@ addBotMember qorig s bot cnv now = do localDomain = qDomain qorig -- FUTUREWORK: support remote bots e = Event MemberJoin qcnv qorig now (EdMembersJoin . SimpleMembers $ (fmap toSimpleMember [botUserId bot])) - mem = (newMember (botUserId bot)) {memService = Just s} + mem = (newMember (botUserId bot)) {lmService = Just s} toSimpleMember :: UserId -> SimpleMember toSimpleMember u = SimpleMember (Qualified u localDomain) roleNameWireAdmin diff --git a/services/galley/src/Galley/Intra/Push.hs b/services/galley/src/Galley/Intra/Push.hs index 036ec3d8565..04c2e48b3e1 100644 --- a/services/galley/src/Galley/Intra/Push.hs +++ b/services/galley/src/Galley/Intra/Push.hs @@ -105,7 +105,7 @@ data RecipientBy user = Recipient makeLenses ''RecipientBy recipient :: LocalMember -> Recipient -recipient = userRecipient . memId +recipient = userRecipient . lmId userRecipient :: user -> RecipientBy user userRecipient u = Recipient u RecipientClientsAll diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index aede4721e2c..289ee3c0b2d 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -59,8 +59,10 @@ import Data.String.Conversions (cs) import qualified Data.Text as T import qualified Data.Text.Ascii as Ascii import Data.Time.Clock (getCurrentTime) +import Galley.API.Mapping import Galley.Options (Opts, optFederator) -import Galley.Types hiding (InternalMember (..)) +import Galley.Types hiding (LocalMember (..)) +import Galley.Types.Conversations.Members import Galley.Types.Conversations.Roles import qualified Galley.Types.Teams as Teams import Gundeck.Types.Notification @@ -79,7 +81,11 @@ import TestSetup import Util.Options (Endpoint (Endpoint)) import Wire.API.Conversation import qualified Wire.API.Federation.API.Brig as FederatedBrig -import Wire.API.Federation.API.Galley (GetConversationsResponse (..)) +import Wire.API.Federation.API.Galley + ( GetConversationsResponse (..), + RemoteConvMembers (..), + RemoteConversation (..), + ) import qualified Wire.API.Federation.API.Galley as FederatedGalley import qualified Wire.API.Federation.GRPC.Types as F import qualified Wire.API.Message as Message @@ -181,6 +187,10 @@ tests s = test s "member update (otr archive)" putMemberOtrArchiveOk, test s "member update (hidden)" putMemberHiddenOk, test s "member update (everything b)" putMemberAllOk, + test s "remote conversation member update (otr mute)" putRemoteConvMemberOtrMuteOk, + test s "remote conversation member update (otr archive)" putRemoteConvMemberOtrArchiveOk, + test s "remote conversation member update (otr hidden)" putRemoteConvMemberHiddenOk, + test s "remote conversation member update (everything)" putRemoteConvMemberAllOk, test s "conversation receipt mode update" putReceiptModeOk, test s "send typing indicators" postTypingIndicators, test s "leave connect conversation" leaveConnectConversation, @@ -225,7 +235,7 @@ emptyFederatedGalley = e s = throwError err501 {errBody = cs ("mock not implemented: " <> s)} in FederatedGalley.Api { FederatedGalley.onConversationCreated = \_ _ -> e "onConversationCreated", - FederatedGalley.getConversations = \_ -> e "getConversations", + FederatedGalley.getConversations = \_ _ -> e "getConversations", FederatedGalley.onConversationMembershipsChanged = \_ _ -> e "onConversationMembershipsChanged", FederatedGalley.leaveConversation = \_ _ -> e "leaveConversation", FederatedGalley.onMessageSent = \_ _ -> e "onMessageSent", @@ -880,7 +890,7 @@ postMessageQualifiedLocalOwningBackendFailedToSendClients = do } galleyApi = emptyFederatedGalley - { FederatedGalley.onMessageSent = \_ _ -> throwError err503 {errBody = "Down for maintanance."} + { FederatedGalley.onMessageSent = \_ _ -> throwError err503 {errBody = "Down for maintenance."} } (resp2, _requests) <- postProteusMessageQualifiedWithMockFederator aliceUnqualified aliceClient convId message "data" Message.MismatchReportAll brigApi galleyApi @@ -914,7 +924,7 @@ postMessageQualifiedRemoteOwningBackendFailure = do let galleyApi = emptyFederatedGalley - { FederatedGalley.sendMessage = \_ _ -> throwError err503 {errBody = "Down for maintanance."} + { FederatedGalley.sendMessage = \_ _ -> throwError err503 {errBody = "Down for maintenance."} } (resp2, _requests) <- @@ -1773,13 +1783,24 @@ getConvQualifiedOk = do accessConvMeta :: TestM () accessConvMeta = do + localDomain <- viewFederationDomain g <- view tsGalley alice <- randomUser bob <- randomUser chuck <- randomUser connectUsers alice (list1 bob [chuck]) conv <- decodeConvId <$> postConv alice [bob, chuck] (Just "gossip") [] Nothing Nothing - let meta = ConversationMeta conv RegularConv alice [InviteAccess] ActivatedAccessRole (Just "gossip") Nothing Nothing Nothing + let meta = + ConversationMetadata + (Qualified conv localDomain) + RegularConv + alice + [InviteAccess] + ActivatedAccessRole + (Just "gossip") + Nothing + Nothing + Nothing get (g . paths ["i/conversations", toByteString' conv, "meta"] . zUser alice) !!! do const 200 === statusCode const (Just meta) === (decode <=< responseBody) @@ -1874,26 +1895,19 @@ testGetQualifiedRemoteConv = do let remoteDomain = Domain "far-away.example.com" bobQ = Qualified bobId remoteDomain remoteConvId = Qualified convId remoteDomain - aliceAsOtherMember = OtherMember aliceQ Nothing roleNameWireAdmin bobAsOtherMember = OtherMember bobQ Nothing roleNameWireAdmin - aliceAsMember = Member aliceId Nothing Nothing Nothing False Nothing False Nothing roleNameWireAdmin + aliceAsLocal = LocalMember aliceId defMemberStatus Nothing roleNameWireAdmin + aliceAsOtherMember = localMemberToOther (qDomain aliceQ) aliceAsLocal + aliceAsSelfMember = localMemberToSelf aliceAsLocal registerRemoteConv remoteConvId bobQ Nothing (Set.fromList [aliceAsOtherMember]) - let mockConversation = - Conversation - { cnvQualifiedId = remoteConvId, - cnvType = RegularConv, - cnvCreator = bobId, - cnvAccess = [], - cnvAccessRole = ActivatedAccessRole, - cnvName = Just "federated gossip", - cnvMembers = ConvMembers aliceAsMember [bobAsOtherMember], - cnvTeam = Nothing, - cnvMessageTimer = Nothing, - cnvReceiptMode = Nothing - } + let mockConversation = mkConv remoteConvId bobId roleNameWireAdmin [bobAsOtherMember] remoteConversationResponse = GetConversationsResponse [mockConversation] + expected = + Conversation + (rcnvMetadata mockConversation) + (ConvMembers aliceAsSelfMember (rcmOthers (rcnvMembers mockConversation))) opts <- view tsGConf (respAll, _) <- @@ -1904,9 +1918,7 @@ testGetQualifiedRemoteConv = do (getConvQualified aliceId remoteConvId) conv <- responseJsonUnsafe <$> (pure respAll (pure respAll (pure respAll maybeToList (remoteConversationView alice defMemberStatus mockConversationB) + <> [localConv] actualFound = sortOn cnvQualifiedId $ crFound convs assertEqual "found conversations" expectedFound actualFound @@ -2578,6 +2581,34 @@ putMemberAllOk = } ) +putRemoteConvMemberOtrMuteOk :: TestM () +putRemoteConvMemberOtrMuteOk = do + putRemoteConvMemberOk (memberUpdate {mupOtrMuteStatus = Just 1, mupOtrMuteRef = Just "ref"}) + putRemoteConvMemberOk (memberUpdate {mupOtrMuteStatus = Just 0}) + +putRemoteConvMemberOtrArchiveOk :: TestM () +putRemoteConvMemberOtrArchiveOk = do + putRemoteConvMemberOk (memberUpdate {mupOtrArchive = Just True, mupOtrArchiveRef = Just "ref"}) + putRemoteConvMemberOk (memberUpdate {mupOtrArchive = Just False}) + +putRemoteConvMemberHiddenOk :: TestM () +putRemoteConvMemberHiddenOk = do + putRemoteConvMemberOk (memberUpdate {mupHidden = Just True, mupHiddenRef = Just "ref"}) + putRemoteConvMemberOk (memberUpdate {mupHidden = Just False}) + +putRemoteConvMemberAllOk :: TestM () +putRemoteConvMemberAllOk = + putRemoteConvMemberOk + ( memberUpdate + { mupOtrMuteStatus = Just 0, + mupOtrMuteRef = Just "mref", + mupOtrArchive = Just True, + mupOtrArchiveRef = Just "aref", + mupHidden = Just True, + mupHiddenRef = Just "href" + } + ) + putMemberOk :: MemberUpdate -> TestM () putMemberOk update = do c <- view tsCannon @@ -2603,7 +2634,7 @@ putMemberOk update = do } -- Update member state & verify push notification WS.bracketR c bob $ \ws -> do - putMember bob update conv !!! const 200 === statusCode + putMember bob update qconv !!! const 200 === statusCode void . liftIO . WS.assertMatch (5 # Second) ws $ \n -> do let e = List1.head (WS.unpackPayload n) ntfTransient n @?= False @@ -2633,6 +2664,92 @@ putMemberOk update = do assertEqual "hidden" (memHidden memberBob) (memHidden newBob) assertEqual "hidden_ref" (memHiddenRef memberBob) (memHiddenRef newBob) +putRemoteConvMemberOk :: MemberUpdate -> TestM () +putRemoteConvMemberOk update = do + c <- view tsCannon + qalice <- randomQualifiedUser + let alice = qUnqualified qalice + + -- create a remote conversation with alice + let remoteDomain = Domain "bobland.example.com" + qbob <- Qualified <$> randomId <*> pure remoteDomain + qconv <- Qualified <$> randomId <*> pure remoteDomain + fedGalleyClient <- view tsFedGalleyClient + now <- liftIO getCurrentTime + let cmu = + FederatedGalley.ConversationMemberUpdate + { cmuTime = now, + cmuOrigUserId = qbob, + cmuConvId = qUnqualified qconv, + cmuAlreadyPresentUsers = [], + cmuAction = + FederatedGalley.ConversationMembersActionAdd (pure (qalice, roleNameWireMember)) + } + FederatedGalley.onConversationMembershipsChanged fedGalleyClient remoteDomain cmu + + -- Expected member state + let memberAlice = + Member + { memId = alice, + memService = Nothing, + memOtrMutedStatus = mupOtrMuteStatus update, + memOtrMutedRef = mupOtrMuteRef update, + memOtrArchived = Just True == mupOtrArchive update, + memOtrArchivedRef = mupOtrArchiveRef update, + memHidden = Just True == mupHidden update, + memHiddenRef = mupHiddenRef update, + memConvRoleName = roleNameWireMember + } + -- Update member state & verify push notification + WS.bracketR c alice $ \ws -> do + putMember alice update qconv !!! const 200 === statusCode + void . liftIO . WS.assertMatch (5 # Second) ws $ \n -> do + let e = List1.head (WS.unpackPayload n) + ntfTransient n @?= False + evtConv e @?= qconv + evtType e @?= MemberStateUpdate + evtFrom e @?= qalice + case evtData e of + EdMemberUpdate mis -> do + assertEqual "otr_muted_status" (mupOtrMuteStatus update) (misOtrMutedStatus mis) + assertEqual "otr_muted_ref" (mupOtrMuteRef update) (misOtrMutedRef mis) + assertEqual "otr_archived" (mupOtrArchive update) (misOtrArchived mis) + assertEqual "otr_archived_ref" (mupOtrArchiveRef update) (misOtrArchivedRef mis) + assertEqual "hidden" (mupHidden update) (misHidden mis) + assertEqual "hidden_ref" (mupHiddenRef update) (misHiddenRef mis) + x -> assertFailure $ "Unexpected event data: " ++ show x + + -- Fetch remote conversation + let bobAsLocal = LocalMember (qUnqualified qbob) defMemberStatus Nothing roleNameWireAdmin + let mockConversation = + mkConv + qconv + (qUnqualified qbob) + roleNameWireMember + [localMemberToOther remoteDomain bobAsLocal] + remoteConversationResponse = GetConversationsResponse [mockConversation] + opts <- view tsGConf + (rs, _) <- + withTempMockFederator + opts + remoteDomain + (const remoteConversationResponse) + $ getConvQualified alice qconv + responseJsonUnsafe rs + liftIO $ do + assertBool "user" (isJust alice') + let newAlice = fromJust alice' + assertEqual "id" (memId memberAlice) (memId newAlice) + assertEqual "otr_muted_status" (memOtrMutedStatus memberAlice) (memOtrMutedStatus newAlice) + assertEqual "otr_muted_ref" (memOtrMutedRef memberAlice) (memOtrMutedRef newAlice) + assertEqual "otr_archived" (memOtrArchived memberAlice) (memOtrArchived newAlice) + assertEqual "otr_archived_ref" (memOtrArchivedRef memberAlice) (memOtrArchivedRef newAlice) + assertEqual "hidden" (memHidden memberAlice) (memHidden newAlice) + assertEqual "hidden_ref" (memHiddenRef memberAlice) (memHiddenRef newAlice) + putReceiptModeOk :: TestM () putReceiptModeOk = do c <- view tsCannon diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 1cb70905681..0daa10e4c52 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -48,8 +48,9 @@ import qualified Test.Tasty.Cannon as WS import Test.Tasty.HUnit import TestHelpers import TestSetup +import Wire.API.Conversation.Member (Member (..)) import Wire.API.Conversation.Role -import Wire.API.Federation.API.Galley (GetConversationsRequest (..), GetConversationsResponse (..)) +import Wire.API.Federation.API.Galley (GetConversationsRequest (..), GetConversationsResponse (..), RemoteConvMembers (..), RemoteConversation (..)) import qualified Wire.API.Federation.API.Galley as FedGalley import qualified Wire.API.Federation.GRPC.Types as F import Wire.API.Message (ClientMismatchStrategy (..), MessageSendingStatus (mssDeletedClients, mssFailedToSend, mssRedundantClients), mkQualifiedOtrPayload, mssMissingClients) @@ -73,45 +74,51 @@ tests s = getConversationsAllFound :: TestM () getConversationsAllFound = do - -- FUTUREWORK: make alice / bob remote users - [alice, bob] <- randomUsers 2 - connectUsers alice (singleton bob) - -- create & get one2one conv - cnv1 <- responseJsonUnsafeWithMsg "conversation" <$> postO2OConv alice bob (Just "gossip1") - getConvs alice (Just $ Left [qUnqualified . cnvQualifiedId $ cnv1]) Nothing !!! do - const 200 === statusCode - const (Just [cnvQualifiedId cnv1]) === fmap (map cnvQualifiedId . convList) . responseJsonUnsafe + bob <- randomUser + -- create & get group conv - carl <- randomUser - connectUsers alice (singleton carl) - cnv2 <- responseJsonUnsafeWithMsg "conversation" <$> postConv alice [bob, carl] (Just "gossip2") [] Nothing Nothing - getConvs alice (Just $ Left [qUnqualified . cnvQualifiedId $ cnv2]) Nothing !!! do + aliceQ <- Qualified <$> randomId <*> pure (Domain "far-away.example.com") + carlQ <- randomQualifiedUser + connectUsers bob (singleton (qUnqualified carlQ)) + + cnv2 <- + responseJsonError + =<< postConvWithRemoteUser (qDomain aliceQ) (mkProfile aliceQ (Name "alice")) bob [aliceQ, carlQ] + + getConvs bob (Just $ Left [qUnqualified (cnvQualifiedId cnv2)]) Nothing !!! do const 200 === statusCode - const (Just [cnvQualifiedId cnv2]) === fmap (map cnvQualifiedId . convList) . responseJsonUnsafe - -- get both + const (Just (Just [cnvQualifiedId cnv2])) + === fmap (fmap (map cnvQualifiedId . convList)) . responseJsonMaybe + + -- FUTUREWORK: also create a one2one conversation + + -- get conversations fedGalleyClient <- view tsFedGalleyClient - localDomain <- viewFederationDomain - let aliceQualified = Qualified alice localDomain GetConversationsResponse cs <- FedGalley.getConversations fedGalleyClient - (GetConversationsRequest aliceQualified $ qUnqualified . cnvQualifiedId <$> [cnv1, cnv2]) - let c1 = find ((== cnvQualifiedId cnv1) . cnvQualifiedId) cs - let c2 = find ((== cnvQualifiedId cnv2) . cnvQualifiedId) cs - liftIO . forM_ [(cnv1, c1), (cnv2, c2)] $ \(expected, actual) -> do + (qDomain aliceQ) + ( GetConversationsRequest + (qUnqualified aliceQ) + (map (qUnqualified . cnvQualifiedId) [cnv2]) + ) + + let c2 = find ((== cnvQualifiedId cnv2) . cnvmQualifiedId . rcnvMetadata) cs + + liftIO $ do assertEqual "name mismatch" - (Just $ cnvName expected) - (cnvName <$> actual) + (Just $ cnvName cnv2) + (cnvmName . rcnvMetadata <$> c2) assertEqual - "self member mismatch" - (Just . cmSelf $ cnvMembers expected) - (cmSelf . cnvMembers <$> actual) + "self member role mismatch" + (Just . memConvRoleName . cmSelf $ cnvMembers cnv2) + (rcmSelfRole . rcnvMembers <$> c2) assertEqual "other members mismatch" - (Just []) - ((\c -> cmOthers (cnvMembers c) \\ cmOthers (cnvMembers expected)) <$> actual) + (Just (sort [bob, qUnqualified carlQ])) + (fmap (sort . map (qUnqualified . omQualifiedId) . rcmOthers . rcnvMembers) c2) getConversationsNotPartOf :: TestM () getConversationsNotPartOf = do @@ -127,11 +134,11 @@ getConversationsNotPartOf = do fedGalleyClient <- view tsFedGalleyClient localDomain <- viewFederationDomain rando <- Id <$> liftIO nextRandom - let randoQualified = Qualified rando localDomain GetConversationsResponse cs <- FedGalley.getConversations fedGalleyClient - (GetConversationsRequest randoQualified [qUnqualified . cnvQualifiedId $ cnv1]) + localDomain + (GetConversationsRequest rando [qUnqualified . cnvQualifiedId $ cnv1]) liftIO $ assertEqual "conversation list not empty" [] cs addLocalUser :: TestM () diff --git a/services/galley/test/integration/API/Roles.hs b/services/galley/test/integration/API/Roles.hs index 72928b13335..ae5d11d529d 100644 --- a/services/galley/test/integration/API/Roles.hs +++ b/services/galley/test/integration/API/Roles.hs @@ -154,6 +154,7 @@ wireAdminChecks :: TestM () wireAdminChecks cid admin otherAdmin mem = do let role = roleNameWireAdmin + qcid <- Qualified cid <$> viewFederationDomain other <- randomUser connectUsers admin (singleton other) -- Admins can perform all operations on the conversation; creator is not relevant @@ -183,7 +184,7 @@ wireAdminChecks cid admin otherAdmin mem = do putAccessUpdate admin cid activatedAccess !!! assertActionSucceeded -- Update your own member state let memUpdate = memberUpdate {mupOtrArchive = Just True} - putMember admin memUpdate cid !!! assertActionSucceeded + putMember admin memUpdate qcid !!! assertActionSucceeded -- You can also leave a conversation deleteMemberUnqualified admin admin cid !!! assertActionSucceeded -- Readding the user @@ -199,6 +200,7 @@ wireMemberChecks :: TestM () wireMemberChecks cid mem admin otherMem = do let role = roleNameWireMember + qcid <- Qualified cid <$> viewFederationDomain other <- randomUser connectUsers mem (singleton other) -- Members cannot perform pretty much any action on the conversation @@ -227,7 +229,7 @@ wireMemberChecks cid mem admin otherMem = do -- Update your own member state let memUpdate = memberUpdate {mupOtrArchive = Just True} - putMember mem memUpdate cid !!! assertActionSucceeded + putMember mem memUpdate qcid !!! assertActionSucceeded -- Last option is to leave a conversation deleteMemberUnqualified mem mem cid !!! assertActionSucceeded -- Let's readd the user to make tests easier diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index aaea6c8a7ba..1fd5a930404 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -70,7 +70,7 @@ import Data.UUID.V4 import Galley.Intra.User (chunkify) import qualified Galley.Options as Opts import qualified Galley.Run as Run -import Galley.Types hiding (InternalMember, MemberJoin, MemberLeave, memConvRoleName, memId, memOtrArchived, memOtrArchivedRef, memOtrMutedRef) +import Galley.Types import qualified Galley.Types as Conv import Galley.Types.Conversations.Roles hiding (DeleteConversation) import Galley.Types.Teams hiding (Event, EventType (..)) @@ -107,7 +107,6 @@ import Util.Options import Web.Cookie import Wire.API.Conversation import qualified Wire.API.Conversation as Public -import Wire.API.Event.Team (EventType (MemberJoin, MemberLeave, TeamDelete, TeamUpdate)) import qualified Wire.API.Event.Team as TE import qualified Wire.API.Federation.API.Brig as FederatedBrig import qualified Wire.API.Federation.API.Galley as FederatedGalley @@ -945,12 +944,12 @@ getSelfMember u c = do . zConn "conn" . zType "access" -putMember :: UserId -> MemberUpdate -> ConvId -> TestM ResponseLBS -putMember u m c = do +putMember :: UserId -> MemberUpdate -> Qualified ConvId -> TestM ResponseLBS +putMember u m (Qualified c dom) = do g <- view tsGalley put $ g - . paths ["conversations", toByteString' c, "self"] + . paths ["conversations", toByteString' dom, toByteString' c, "self"] . zUser u . zConn "conn" . zType "access" @@ -1868,20 +1867,26 @@ someLastPrekeys = lastPrekey "pQABARn//wKhAFgg1rZEY6vbAnEz+Ern5kRny/uKiIrXTb/usQxGnceV2HADoQChAFgglacihnqg/YQJHkuHNFU7QD6Pb3KN4FnubaCF2EVOgRkE9g==" ] -mkConv :: Qualified ConvId -> UserId -> Member -> [OtherMember] -> Conversation -mkConv cnvId creator selfMember otherMembers = - Conversation - { cnvQualifiedId = cnvId, - cnvType = RegularConv, - cnvCreator = creator, - cnvAccess = [], - cnvAccessRole = ActivatedAccessRole, - cnvName = Just "federated gossip", - cnvMembers = ConvMembers selfMember otherMembers, - cnvTeam = Nothing, - cnvMessageTimer = Nothing, - cnvReceiptMode = Nothing - } +mkConv :: + Qualified ConvId -> + UserId -> + RoleName -> + [OtherMember] -> + FederatedGalley.RemoteConversation +mkConv cnvId creator selfRole otherMembers = + FederatedGalley.RemoteConversation + ( ConversationMetadata + cnvId + RegularConv + creator + [] + ActivatedAccessRole + (Just "federated gossip") + Nothing + Nothing + Nothing + ) + (FederatedGalley.RemoteConvMembers selfRole otherMembers) -- | ES is only refreshed occasionally; we don't want to wait for that in tests. refreshIndex :: TestM () @@ -2183,7 +2188,7 @@ checkTeamMemberJoin :: HasCallStack => TeamId -> UserId -> WS.WebSocket -> TestM checkTeamMemberJoin tid uid w = WS.awaitMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) - e ^. eventType @?= MemberJoin + e ^. eventType @?= TE.MemberJoin e ^. eventTeam @?= tid e ^. eventData @?= Just (EdMemberJoin uid) @@ -2191,7 +2196,7 @@ checkTeamMemberLeave :: HasCallStack => TeamId -> UserId -> WS.WebSocket -> Test checkTeamMemberLeave tid usr w = WS.assertMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) - e ^. eventType @?= MemberLeave + e ^. eventType @?= TE.MemberLeave e ^. eventTeam @?= tid e ^. eventData @?= Just (EdMemberLeave usr) @@ -2199,7 +2204,7 @@ checkTeamUpdateEvent :: (HasCallStack, MonadIO m, MonadCatch m) => TeamId -> Tea checkTeamUpdateEvent tid upd w = WS.assertMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) - e ^. eventType @?= TeamUpdate + e ^. eventType @?= TE.TeamUpdate e ^. eventTeam @?= tid e ^. eventData @?= Just (EdTeamUpdate upd) @@ -2216,7 +2221,7 @@ checkTeamDeleteEvent :: HasCallStack => TeamId -> WS.WebSocket -> TestM () checkTeamDeleteEvent tid w = WS.assertMatch_ checkTimeout w $ \notif -> do ntfTransient notif @?= False let e = List1.head (WS.unpackPayload notif) - e ^. eventType @?= TeamDelete + e ^. eventType @?= TE.TeamDelete e ^. eventTeam @?= tid e ^. eventData @?= Nothing diff --git a/services/galley/test/unit/Test/Galley/Mapping.hs b/services/galley/test/unit/Test/Galley/Mapping.hs index 2f77de53b23..f48ac6d312b 100644 --- a/services/galley/test/unit/Test/Galley/Mapping.hs +++ b/services/galley/test/unit/Test/Galley/Mapping.hs @@ -23,184 +23,139 @@ module Test.Galley.Mapping where import Data.Domain import Data.Id import Data.Qualified -import Galley.API () +import Data.Tagged import Galley.API.Mapping import qualified Galley.Data as Data -import Galley.Types (LocalMember, RemoteMember) -import qualified Galley.Types.Conversations.Members as I +import Galley.Types.Conversations.Members import Imports import Test.Tasty -import Test.Tasty.HUnit +import Test.Tasty.QuickCheck +-- import Test.Tasty.HUnit import Wire.API.Conversation -import Wire.API.Conversation.Role (roleNameWireAdmin) +import Wire.API.Conversation.Role +import Wire.API.Federation.API.Galley + ( RemoteConvMembers (..), + RemoteConversation (..), + ) tests :: TestTree tests = testGroup "ConversationMapping" - [ testCase "Alice@A Conv@A" runMappingSimple, - testCase "Alice@A Conv@A requester=not a member@A" runMappingNotAMemberA, - testCase "Alice@A Conv@A requester=not a member@B" runMappingNotAMemberB, - testCase "Alice@A Conv@A Bob@B" runMappingRemoteUser, - testCase "Alice@A Conv@B Bob@B" runMappingRemoteConv, - testCase "Alice@A Conv@B Bob@B bobUUID=aliceUUID" runMappingSameUnqualifiedUUID + [ testProperty "conversation view for a valid user is non-empty" $ + \(ConvWithLocalUser c uid) dom -> isJust (conversationViewMaybe dom uid c), + testProperty "self user in conversation view is correct" $ + \(ConvWithLocalUser c uid) dom -> + fmap (memId . cmSelf . cnvMembers) (conversationViewMaybe dom uid c) + == Just uid, + testProperty "conversation view metadata is correct" $ + \(ConvWithLocalUser c uid) dom -> + fmap cnvMetadata (conversationViewMaybe dom uid c) + == Just (Data.convMetadata dom c), + testProperty "other members in conversation view do not contain self" $ + \(ConvWithLocalUser c uid) dom -> case conversationViewMaybe dom uid c of + Nothing -> False + Just cnv -> + not + ( Qualified uid dom + `elem` (map omQualifiedId (cmOthers (cnvMembers cnv))) + ), + testProperty "conversation view contains all users" $ + \(ConvWithLocalUser c uid) dom -> + fmap (sort . cnvUids dom) (conversationViewMaybe dom uid c) + == Just (sort (convUids dom c)), + testProperty "conversation view for an invalid user is empty" $ + \(RandomConversation c) dom uid -> + not (elem uid (map lmId (Data.convLocalMembers c))) + ==> isNothing (conversationViewMaybe dom uid c), + testProperty "remote conversation view for a valid user is non-empty" $ + \(ConvWithRemoteUser c ruid) dom -> + qDomain (unTagged ruid) /= dom + ==> isJust (conversationToRemote dom ruid c), + testProperty "self user role in remote conversation view is correct" $ + \(ConvWithRemoteUser c ruid) dom -> + qDomain (unTagged ruid) /= dom + ==> fmap (rcmSelfRole . rcnvMembers) (conversationToRemote dom ruid c) + == Just roleNameWireMember, + testProperty "remote conversation view metadata is correct" $ + \(ConvWithRemoteUser c ruid) dom -> + qDomain (unTagged ruid) /= dom + ==> fmap (rcnvMetadata) (conversationToRemote dom ruid c) + == Just (Data.convMetadata dom c), + testProperty "remote conversation view does not contain self" $ + \(ConvWithRemoteUser c ruid) dom -> case conversationToRemote dom ruid c of + Nothing -> False + Just rcnv -> + not + ( unTagged ruid + `elem` (map omQualifiedId (rcmOthers (rcnvMembers rcnv))) + ) ] -runMappingSimple :: HasCallStack => IO () -runMappingSimple = do - let convDomain = Domain "backendA.example.com" - let userDomain = Domain "backendA.example.com" - alice <- randomId - let requester = Qualified alice userDomain - let expectedSelf = Just $ mkMember requester - let expectedOthers = Just [] - - let locals = [mkInternalMember requester] - let remotes = [] - conv <- mkInternalConv locals remotes - let actual = cnvMembers <$> conversationViewMaybeQualified convDomain requester conv - - assertEqual "self:" expectedSelf (cmSelf <$> actual) - assertEqual "others:" expectedOthers (cmOthers <$> actual) - -runMappingNotAMemberA :: HasCallStack => IO () -runMappingNotAMemberA = do - let convDomain = Domain "backendA.example.com" - let aliceDomain = Domain "backendA.example.com" - alice <- flip Qualified aliceDomain <$> randomId - requester <- flip Qualified aliceDomain <$> randomId - - let locals = [mkInternalMember alice] - let remotes = [] - conv <- mkInternalConv locals remotes - let actual = cnvMembers <$> conversationViewMaybeQualified convDomain requester conv - - assertEqual "members:" Nothing actual - -runMappingNotAMemberB :: HasCallStack => IO () -runMappingNotAMemberB = do - let convDomain = Domain "backendA.example.com" - let aliceDomain = Domain "backendA.example.com" - let requesterDomain = Domain "backendB.example.com" - alice <- flip Qualified aliceDomain <$> randomId - requester <- flip Qualified requesterDomain <$> randomId - - let locals = [mkInternalMember alice] - let remotes = [] - conv <- mkInternalConv locals remotes - let actual = cnvMembers <$> conversationViewMaybeQualified convDomain requester conv - - assertEqual "members:" Nothing actual - -runMappingRemoteUser :: HasCallStack => IO () -runMappingRemoteUser = do - let aliceDomain = Domain "backendA.example.com" - let convDomain = Domain "backendA.example.com" - let bobDomain = Domain "backendB.example.com" - alice <- flip Qualified aliceDomain <$> randomId - bob <- flip Qualified bobDomain <$> randomId - let expectedSelf = Just $ mkMember alice - let expectedOthers = Just [mkOtherMember bob] - - let locals = [mkInternalMember alice] - let remotes = [mkRemoteMember bob] - conv <- mkInternalConv locals remotes - let actual = cnvMembers <$> conversationViewMaybeQualified convDomain alice conv - - assertEqual "self:" expectedSelf (cmSelf <$> actual) - assertEqual "others:" expectedOthers (cmOthers <$> actual) - -runMappingRemoteConv :: HasCallStack => IO () -runMappingRemoteConv = do - let aliceDomain = Domain "backendA.example.com" - let convDomain = Domain "backendB.example.com" - let bobDomain = Domain "backendB.example.com" - alice <- flip Qualified aliceDomain <$> randomId - bob <- flip Qualified bobDomain <$> randomId - let expectedSelf = Just $ mkMember alice - let expectedOthers = Just [mkOtherMember bob] - - let locals = [mkInternalMember bob] - let remotes = [mkRemoteMember alice] - conv <- mkInternalConv locals remotes - let actual = cnvMembers <$> conversationViewMaybeQualified convDomain alice conv - - assertEqual "self:" expectedSelf (cmSelf <$> actual) - assertEqual "others:" expectedOthers (cmOthers <$> actual) - --- Here we expect the conversationView to return nothing, because Alice (the --- requester) is not part of the conversation (Her unqualified UUID is part of --- the conversation, but the function should catch this possibly malicious --- edge case) -runMappingSameUnqualifiedUUID :: HasCallStack => IO () -runMappingSameUnqualifiedUUID = do - let aliceDomain = Domain "backendA.example.com" - let convDomain = Domain "backendB.example.com" - let bobDomain = Domain "backendB.example.com" - uuid <- randomId - let alice = Qualified uuid aliceDomain - let bob = Qualified uuid bobDomain - - let locals = [mkInternalMember bob] - let remotes = [] - conv <- mkInternalConv locals remotes - let actual = cnvMembers <$> conversationViewMaybeQualified convDomain alice conv - - assertEqual "members:" Nothing actual - --------------------------------------------------------------- - -mkOtherMember :: Qualified UserId -> OtherMember -mkOtherMember u = OtherMember u Nothing roleNameWireAdmin - -mkRemoteMember :: Qualified UserId -> RemoteMember -mkRemoteMember u = I.RemoteMember (toRemote u) roleNameWireAdmin - -mkInternalConv :: [LocalMember] -> [RemoteMember] -> IO Data.Conversation -mkInternalConv locals remotes = do - -- for the conversationView unit tests, the creator plays no importance, so for simplicity this is set to a random value. - creator <- randomId - cnv <- randomId - pure $ - Data.Conversation - { Data.convId = cnv, - Data.convType = RegularConv, - Data.convCreator = creator, - Data.convName = Just "unit testing gossip", - Data.convAccess = [], - Data.convAccessRole = ActivatedAccessRole, - Data.convLocalMembers = locals, - Data.convRemoteMembers = remotes, - Data.convTeam = Nothing, - Data.convDeleted = Just False, - Data.convMessageTimer = Nothing, - Data.convReceiptMode = Nothing - } - -mkMember :: Qualified UserId -> Member -mkMember (Qualified userId _domain) = - Member - { memId = userId, - memService = Nothing, - memOtrMutedStatus = Nothing, - memOtrMutedRef = Nothing, - memOtrArchived = False, - memOtrArchivedRef = Nothing, - memHidden = False, - memHiddenRef = Nothing, - memConvRoleName = roleNameWireAdmin - } - -mkInternalMember :: Qualified UserId -> LocalMember -mkInternalMember (Qualified userId _domain) = - I.InternalMember - { I.memId = userId, - I.memService = Nothing, - I.memOtrMutedStatus = Nothing, - I.memOtrMutedRef = Nothing, - I.memOtrArchived = False, - I.memOtrArchivedRef = Nothing, - I.memHidden = False, - I.memHiddenRef = Nothing, - I.memConvRoleName = roleNameWireAdmin - } +cnvUids :: Domain -> Conversation -> [Qualified UserId] +cnvUids dom c = + let mems = cnvMembers c + in Qualified (memId (cmSelf mems)) dom : + map omQualifiedId (cmOthers mems) + +convUids :: Domain -> Data.Conversation -> [Qualified UserId] +convUids dom c = + map ((`Qualified` dom) . lmId) (Data.convLocalMembers c) + <> map (unTagged . rmId) (Data.convRemoteMembers c) + +genLocalMember :: Gen LocalMember +genLocalMember = + LocalMember + <$> arbitrary + <*> pure defMemberStatus + <*> pure Nothing + <*> arbitrary + +genRemoteMember :: Gen RemoteMember +genRemoteMember = RemoteMember <$> arbitrary <*> pure roleNameWireMember + +genConversation :: [LocalMember] -> [RemoteMember] -> Gen Data.Conversation +genConversation locals remotes = + Data.Conversation + <$> arbitrary + <*> pure RegularConv + <*> arbitrary + <*> arbitrary + <*> pure [] + <*> pure ActivatedAccessRole + <*> pure locals + <*> pure remotes + <*> pure Nothing + <*> pure (Just False) + <*> pure Nothing + <*> pure Nothing + +newtype RandomConversation = RandomConversation Data.Conversation + deriving (Show) + +instance Arbitrary RandomConversation where + arbitrary = + RandomConversation <$> do + locals <- listOf genLocalMember + remotes <- listOf genRemoteMember + genConversation locals remotes + +data ConvWithLocalUser = ConvWithLocalUser Data.Conversation UserId + deriving (Show) + +instance Arbitrary ConvWithLocalUser where + arbitrary = do + RandomConversation conv <- arbitrary + member <- genLocalMember + let conv' = conv {Data.convLocalMembers = member : Data.convLocalMembers conv} + pure $ ConvWithLocalUser conv' (lmId member) + +data ConvWithRemoteUser = ConvWithRemoteUser Data.Conversation (Remote UserId) + deriving (Show) + +instance Arbitrary ConvWithRemoteUser where + arbitrary = do + RandomConversation conv <- arbitrary + member <- genRemoteMember + let conv' = conv {Data.convRemoteMembers = member : Data.convRemoteMembers conv} + pure $ ConvWithRemoteUser conv' (rmId member) From c829a7d3e5224371097e70b51e33a99ff17ee045 Mon Sep 17 00:00:00 2001 From: jschaul Date: Wed, 15 Sep 2021 21:38:59 +0200 Subject: [PATCH 24/72] Servantify /connections endpoints (#1770) --- changelog.d/5-internal/servantify-connections | 1 + .../wire-api/src/Wire/API/ErrorDescription.hs | 10 ++ .../src/Wire/API/Routes/Public/Brig.hs | 51 +++++++++- .../src/Wire/API/Routes/Public/Galley.hs | 20 +--- .../src/Wire/API/Routes/Public/Util.hs | 21 ++++ services/brig/src/Brig/API/Error.hs | 5 +- services/brig/src/Brig/API/Public.hs | 97 ++++--------------- services/brig/test/integration/API/Metrics.hs | 12 +-- services/galley/src/Galley/API/Update.hs | 22 ++--- 9 files changed, 120 insertions(+), 119 deletions(-) create mode 100644 changelog.d/5-internal/servantify-connections diff --git a/changelog.d/5-internal/servantify-connections b/changelog.d/5-internal/servantify-connections new file mode 100644 index 00000000000..d99ace3e49d --- /dev/null +++ b/changelog.d/5-internal/servantify-connections @@ -0,0 +1 @@ +Move /connections/* endpoints to Servant diff --git a/libs/wire-api/src/Wire/API/ErrorDescription.hs b/libs/wire-api/src/Wire/API/ErrorDescription.hs index d9c0def1b3a..7f58762ec40 100644 --- a/libs/wire-api/src/Wire/API/ErrorDescription.hs +++ b/libs/wire-api/src/Wire/API/ErrorDescription.hs @@ -231,6 +231,11 @@ type InvalidUser = ErrorDescription 400 "invalid-user" "Invalid user." invalidUser :: InvalidUser invalidUser = mkErrorDescription +type InvalidTransition = ErrorDescription 403 "bad-conn-update" "Invalid status transition." + +invalidTransition :: InvalidTransition +invalidTransition = mkErrorDescription + type NoIdentity = ErrorDescription 403 "no-identity" "The user has no verified identity (email or phone number)." noIdentity :: forall code lbl desc. (NoIdentity ~ ErrorDescription code lbl desc) => Int -> NoIdentity @@ -275,6 +280,11 @@ type UserNotFound = ErrorDescription 404 "not-found" "User not found" userNotFound :: UserNotFound userNotFound = mkErrorDescription +type ConnectionNotFound = ErrorDescription 404 "not-found" "Connection not found" + +connectionNotFound :: ConnectionNotFound +connectionNotFound = mkErrorDescription + type HandleNotFound = ErrorDescription 404 "not-found" "Handle not found" handleNotFound :: HandleNotFound diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index b31097c67a3..47ebc4b7734 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -65,6 +65,8 @@ type CaptureClientId name = Capture' '[Description "ClientId"] name ClientId type NewClientResponse = Headers '[Header "Location" ClientId] Client +type ConnectionUpdateResponses = UpdateResponses "Connection unchanged" "Connection updated" UserConnection + data Api routes = Api { -- See Note [ephemeral user sideeffect] getUserUnqualified :: @@ -303,6 +305,7 @@ data Api routes = Api :> CaptureClientId "client" :> "prekeys" :> Get '[JSON] [PrekeyId], + -- Connection API ----------------------------------------------------- -- -- This endpoint can lead to the following events being sent: -- - ConnectionUpdated event to self and other, if any side's connection state changes @@ -310,9 +313,8 @@ data Api routes = Api -- - ConvCreate event to self, if creating a connect conversation (via galley) -- - ConvConnect event to self, in some cases (via galley), -- for details see 'Galley.API.Create.createConnectConversation' - -- - createConnection :: - routes :- Summary "Create a connection to another user." + createConnectionUnqualified :: + routes :- Summary "Create a connection to another user. (deprecated)" :> CanThrow MissingLegalholdConsent :> CanThrow InvalidUser :> CanThrow ConnectionLimitReached @@ -331,6 +333,49 @@ data Api routes = Api '[JSON] (ResponsesForExistedCreated "Connection existed" "Connection was created" UserConnection) (ResponseForExistedCreated UserConnection), + listConnections :: + routes :- Summary "List the connections to other users." + :> ZUser + :> "connections" + :> QueryParam' '[Optional, Strict, Description "User ID to start from when paginating"] "start" UserId + :> QueryParam' '[Optional, Strict, Description "Number of results to return (default 100, max 500)"] "size" (Range 1 500 Int32) + :> Get '[JSON] UserConnectionList, + getConnectionUnqualified :: + routes :- Summary "Get an existing connection to another user. (deprecated)" + :> ZUser + :> "connections" + :> CaptureUserId "uid" + :> MultiVerb + 'GET + '[JSON] + '[ EmptyErrorForLegacyReasons 404 "Connection not found", + Respond 200 "Connection found" UserConnection + ] + (Maybe UserConnection), + -- This endpoint can lead to the following events being sent: + -- - ConnectionUpdated event to self and other, if their connection states change + -- + -- When changing the connection state to Sent or Accepted, this can cause events to be sent + -- when joining the connect conversation: + -- - MemberJoin event to self and other (via galley) + updateConnectionUnqualified :: + routes :- Summary "Update a connection to another user. (deprecated)" + :> CanThrow MissingLegalholdConsent + :> CanThrow InvalidUser + :> CanThrow ConnectionLimitReached + :> CanThrow NotConnected + :> CanThrow InvalidTransition + :> CanThrow NoIdentity + :> ZUser + :> ZConn + :> "connections" + :> CaptureUserId "uid" + :> ReqBody '[JSON] ConnectionUpdate + :> MultiVerb + 'PUT + '[JSON] + ConnectionUpdateResponses + (UpdateResult UserConnection), searchContacts :: routes :- Summary "Search for users" :> ZUser 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 3ded88e7732..fab65f297a4 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -25,7 +25,6 @@ import Data.CommaSeparatedList import Data.Id (ConvId, TeamId, UserId) import Data.Qualified (Qualified (..)) import Data.Range -import Data.SOP (I (..), NS (..)) import qualified Data.Swagger as Swagger import GHC.TypeLits (AppendSymbol) import Imports hiding (head) @@ -71,22 +70,7 @@ type ConversationVerb = ] ConversationResponse -type UpdateResponses = - '[ RespondEmpty 204 "Conversation unchanged", - Respond 200 "Conversation updated" Event - ] - -data UpdateResult - = Unchanged - | Updated Event - -instance AsUnion UpdateResponses UpdateResult where - toUnion Unchanged = inject (I ()) - toUnion (Updated e) = inject (I e) - - fromUnion (Z (I ())) = Unchanged - fromUnion (S (Z (I e))) = Updated e - fromUnion (S (S x)) = case x of +type ConvUpdateResponses = UpdateResponses "Conversation unchanged" "Conversation updated" Event data Api routes = Api { -- Conversations @@ -249,7 +233,7 @@ data Api routes = Api :> "members" :> "v2" :> ReqBody '[Servant.JSON] InviteQualified - :> MultiVerb 'POST '[Servant.JSON] UpdateResponses UpdateResult, + :> MultiVerb 'POST '[Servant.JSON] ConvUpdateResponses (UpdateResult Event), -- This endpoint can lead to the following events being sent: -- - MemberLeave event to members removeMemberUnqualified :: diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Util.hs b/libs/wire-api/src/Wire/API/Routes/Public/Util.hs index e3efc84ba12..fc54cdf9ad5 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Util.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Util.hs @@ -21,6 +21,7 @@ module Wire.API.Routes.Public.Util where import Data.SOP (I (..), NS (..)) +import Servant import Servant.Swagger.Internal.Orphans () import Wire.API.Routes.MultiVerb @@ -46,3 +47,23 @@ type ResponsesForExistedCreated eDesc cDesc a = '[ Respond 200 eDesc a, Respond 201 cDesc a ] + +data UpdateResult a + = Unchanged + | Updated !a + +type UpdateResponses unchangedDesc updatedDesc a = + '[ RespondEmpty 204 unchangedDesc, + Respond 200 updatedDesc a + ] + +instance + (ResponseType r1 ~ (), ResponseType r2 ~ a) => + AsUnion '[r1, r2] (UpdateResult a) + where + toUnion Unchanged = inject (I ()) + toUnion (Updated a) = inject (I a) + + fromUnion (Z (I ())) = Unchanged + fromUnion (S (Z (I a))) = Updated a + fromUnion (S (S x)) = case x of diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index f4c63aa8112..63f2bd5b68d 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -86,7 +86,7 @@ instance ToJSON Error where connError :: ConnectionError -> Error connError TooManyConnections {} = StdError (errorDescriptionToWai connectionLimitReached) -connError InvalidTransition {} = StdError invalidTransition +connError InvalidTransition {} = StdError (errorDescriptionToWai invalidTransition) connError NotConnected {} = StdError (errorDescriptionToWai notConnected) connError InvalidUser {} = StdError (errorDescriptionToWai invalidUser) connError ConnectNoIdentity {} = StdError (errorDescriptionToWai (noIdentity 0)) @@ -257,9 +257,6 @@ propertyValueTooLarge = Wai.mkError status403 "property-value-too-large" "The pr clientCapabilitiesCannotBeRemoved :: Wai.Error clientCapabilitiesCannotBeRemoved = Wai.mkError status409 "client-capabilities-cannot-be-removed" "You can only add capabilities to a client, not remove them." -invalidTransition :: Wai.Error -invalidTransition = Wai.mkError status403 "bad-conn-update" "Invalid status transition." - noEmail :: Wai.Error noEmail = Wai.mkError status403 "no-email" "This operation requires the user to have a verified email address." diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index e2ce8904bac..e3a0fe11985 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -252,7 +252,10 @@ servantSitemap = BrigAPI.getClient = getClient, BrigAPI.getClientCapabilities = getClientCapabilities, BrigAPI.getClientPrekeys = getClientPrekeys, - BrigAPI.createConnection = createConnection, + BrigAPI.createConnectionUnqualified = createConnection, + BrigAPI.listConnections = listConnections, + BrigAPI.getConnectionUnqualified = getConnection, + BrigAPI.updateConnectionUnqualified = updateConnection, BrigAPI.searchContacts = Search.search } @@ -446,64 +449,6 @@ sitemap = do Doc.response 200 "Deletion is initiated." Doc.end Doc.errorResponse invalidCode - -- Connection API ----------------------------------------------------- - - -- This endpoint is used to test /i/metrics, when this is servantified, please - -- make sure some other endpoint is used to test that routes defined in this - -- function are recorded and reported correctly in /i/metrics. - get "/connections" (continue listConnectionsH) $ - accept "application" "json" - .&. zauthUserId - .&. opt (query "start") - .&. def (unsafeRange 100) (query "size") - document "GET" "connections" $ do - Doc.summary "List the connections to other users." - Doc.parameter Doc.Query "start" Doc.string' $ do - Doc.description "User ID to start from" - Doc.optional - Doc.parameter Doc.Query "size" Doc.int32' $ do - Doc.description "Number of results to return (default 100, max 500)." - Doc.optional - Doc.returns (Doc.ref Public.modelConnectionList) - Doc.response 200 "List of connections" Doc.end - - -- This endpoint can lead to the following events being sent: - -- - ConnectionUpdated event to self and other, if their connection states change - -- - -- When changing the connection state to Sent or Accepted, this can cause events to be sent - -- when joining the connect conversation: - -- - MemberJoin event to self and other (via galley) - put "/connections/:id" (continue updateConnectionH) $ - accept "application" "json" - .&. zauthUserId - .&. zauthConnId - .&. capture "id" - .&. jsonRequest @Public.ConnectionUpdate - document "PUT" "updateConnection" $ do - Doc.summary "Update a connection." - Doc.parameter Doc.Path "id" Doc.bytes' $ - Doc.description "User ID" - Doc.body (Doc.ref Public.modelConnectionUpdate) $ - Doc.description "JSON body" - Doc.returns (Doc.ref Public.modelConnection) - Doc.response 200 "Connection updated." Doc.end - Doc.response 204 "No change." Doc.end - Doc.errorResponse (errorDescriptionToWai connectionLimitReached) - Doc.errorResponse invalidTransition - Doc.errorResponse (errorDescriptionToWai notConnected) - Doc.errorResponse (errorDescriptionToWai invalidUser) - - get "/connections/:id" (continue getConnectionH) $ - accept "application" "json" - .&. zauthUserId - .&. capture "id" - document "GET" "connection" $ do - Doc.summary "Get an existing connection to another user." - Doc.parameter Doc.Path "id" Doc.bytes' $ - Doc.description "User ID" - Doc.returns (Doc.ref Public.modelConnection) - Doc.response 200 "Connection" Doc.end - -- Properties API ----------------------------------------------------- -- This endpoint can lead to the following events being sent: @@ -553,6 +498,10 @@ sitemap = do Doc.returns (Doc.ref Public.modelPropertyValue) Doc.response 200 "The property value." Doc.end + -- This endpoint is used to test /i/metrics, when this is servantified, please + -- make sure some other endpoint is used to test that routes defined in this + -- function are recorded and reported correctly in /i/metrics. + -- see test/integration/API/Metrics.hs get "/properties" (continue listPropertyKeysH) $ zauthUserId .&. accept "application" "json" @@ -1150,25 +1099,19 @@ createConnection :: UserId -> ConnId -> Public.ConnectionRequest -> Handler (Pub createConnection self conn cr = do API.createConnection self cr conn !>> connError -updateConnectionH :: JSON ::: UserId ::: ConnId ::: UserId ::: JsonRequest Public.ConnectionUpdate -> Handler Response -updateConnectionH (_ ::: self ::: conn ::: other ::: req) = do - newStatus <- Public.cuStatus <$> parseJsonBody req +updateConnection :: UserId -> ConnId -> UserId -> Public.ConnectionUpdate -> Handler (Public.UpdateResult Public.UserConnection) +updateConnection self conn other update = do + let newStatus = Public.cuStatus update mc <- API.updateConnection self other newStatus (Just conn) !>> connError - return $ case mc of - Just c -> json (c :: Public.UserConnection) - Nothing -> setStatus status204 empty - -listConnectionsH :: JSON ::: UserId ::: Maybe UserId ::: Range 1 500 Int32 -> Handler Response -listConnectionsH (_ ::: uid ::: start ::: size) = - json @Public.UserConnectionList - <$> lift (API.lookupConnections uid start size) - -getConnectionH :: JSON ::: UserId ::: UserId -> Handler Response -getConnectionH (_ ::: uid ::: uid') = lift $ do - conn <- API.lookupConnection uid uid' - return $ case conn of - Just c -> json (c :: Public.UserConnection) - Nothing -> setStatus status404 empty + return $ maybe Public.Unchanged Public.Updated mc + +listConnections :: UserId -> Maybe UserId -> Maybe (Range 1 500 Int32) -> Handler Public.UserConnectionList +listConnections uid start msize = do + let defaultSize = toRange (Proxy @100) + lift $ API.lookupConnections uid start (fromMaybe defaultSize msize) + +getConnection :: UserId -> UserId -> Handler (Maybe Public.UserConnection) +getConnection uid uid' = lift $ API.lookupConnection uid uid' deleteUserH :: UserId ::: JsonRequest Public.DeleteUser ::: JSON -> Handler Response deleteUserH (u ::: r ::: _) = do diff --git a/services/brig/test/integration/API/Metrics.hs b/services/brig/test/integration/API/Metrics.hs index c57d419947a..461a25b2c07 100644 --- a/services/brig/test/integration/API/Metrics.hs +++ b/services/brig/test/integration/API/Metrics.hs @@ -57,23 +57,23 @@ testMetricsEndpoint :: Brig -> Http () testMetricsEndpoint brig = do let p1 = "/self" p2 uid = "/users/" <> uid <> "/clients" - p3 = "/connections" + p3 = "/properties" beforeSelf <- getCount "/self" beforeClients <- getCount "/users/:uid/clients" - beforeConnections <- getCount "/connections" + beforeProperties <- getCount "/properties" uid <- userId <$> randomUser brig uid' <- userId <$> randomUser brig _ <- get (brig . path p1 . zAuthAccess uid "conn" . expect2xx) _ <- get (brig . path (p2 $ toByteString' uid) . zAuthAccess uid "conn" . expect2xx) _ <- get (brig . path (p2 $ toByteString' uid') . zAuthAccess uid "conn" . expect2xx) - _ <- get (brig . path p3 . zAuthAccess uid "conn" . queryItem "size" "10" . expect2xx) - _ <- get (brig . path p3 . zAuthAccess uid "conn" . queryItem "extra-undefined" "42" . expect2xx) + _ <- get (brig . path p3 . zAuthAccess uid "conn" . expect2xx) + _ <- get (brig . path p3 . zAuthAccess uid "conn" . expect2xx) countSelf <- getCount "/self" liftIO $ assertEqual "/self was called once" (beforeSelf + 1) countSelf countClients <- getCount "/users/:uid/clients" liftIO $ assertEqual "/users/:uid/clients was called twice" (beforeClients + 2) countClients - countConnections <- getCount "/connections" - liftIO $ assertEqual "/connections was called twice" (beforeConnections + 2) countConnections + countProperties <- getCount "/properties" + liftIO $ assertEqual "/properties was called twice" (beforeProperties + 2) countProperties where getCount endpoint = do rsp <- responseBody <$> get (brig . path "i/metrics") diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 0d2ea6c72ed..8a16b281b61 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -124,8 +124,8 @@ import qualified Wire.API.Event.Conversation as Public import qualified Wire.API.Federation.API.Galley as FederatedGalley import Wire.API.Federation.Error (federationNotImplemented) import qualified Wire.API.Message as Public -import Wire.API.Routes.Public.Galley (UpdateResult (..)) import Wire.API.Routes.Public.Galley.Responses +import Wire.API.Routes.Public.Util (UpdateResult (..)) import Wire.API.ServantProto (RawProto (..)) import Wire.API.Team.LegalHold (LegalholdProtectee (..)) import Wire.API.User.Client @@ -168,7 +168,7 @@ unblockConv usr conn cnv = do -- conversation updates -handleUpdateResult :: UpdateResult -> Response +handleUpdateResult :: UpdateResult Event -> Response handleUpdateResult = \case Updated ev -> json ev & setStatus status200 Unchanged -> empty & setStatus status204 @@ -178,7 +178,7 @@ updateConversationAccessH (usr ::: zcon ::: cnv ::: req) = do update <- fromJsonBody req handleUpdateResult <$> updateConversationAccess usr zcon cnv update -updateConversationAccess :: UserId -> ConnId -> ConvId -> Public.ConversationAccessUpdate -> Galley UpdateResult +updateConversationAccess :: UserId -> ConnId -> ConvId -> Public.ConversationAccessUpdate -> Galley (UpdateResult Event) updateConversationAccess usr zcon cnv update = do let targetAccess = Set.fromList (toList (cupAccess update)) targetRole = cupAccessRole update @@ -298,7 +298,7 @@ updateConversationReceiptModeH (usr ::: zcon ::: cnv ::: req ::: _) = do update <- fromJsonBody req handleUpdateResult <$> updateConversationReceiptMode usr zcon cnv update -updateConversationReceiptMode :: UserId -> ConnId -> ConvId -> Public.ConversationReceiptModeUpdate -> Galley UpdateResult +updateConversationReceiptMode :: UserId -> ConnId -> ConvId -> Public.ConversationReceiptModeUpdate -> Galley (UpdateResult Event) updateConversationReceiptMode usr zcon cnv receiptModeUpdate@(Public.ConversationReceiptModeUpdate target) = do localDomain <- viewFederationDomain let qcnv = Qualified cnv localDomain @@ -323,7 +323,7 @@ updateConversationMessageTimerH (usr ::: zcon ::: cnv ::: req) = do timerUpdate <- fromJsonBody req handleUpdateResult <$> updateConversationMessageTimer usr zcon cnv timerUpdate -updateConversationMessageTimer :: UserId -> ConnId -> ConvId -> Public.ConversationMessageTimerUpdate -> Galley UpdateResult +updateConversationMessageTimer :: UserId -> ConnId -> ConvId -> Public.ConversationMessageTimerUpdate -> Galley (UpdateResult Event) updateConversationMessageTimer usr zcon cnv timerUpdate@(Public.ConversationMessageTimerUpdate target) = do localDomain <- viewFederationDomain let qcnv = Qualified cnv localDomain @@ -441,7 +441,7 @@ joinConversationByReusableCodeH (zusr ::: zcon ::: req) = do convCode <- fromJsonBody req handleUpdateResult <$> joinConversationByReusableCode zusr zcon convCode -joinConversationByReusableCode :: UserId -> ConnId -> Public.ConversationCode -> Galley UpdateResult +joinConversationByReusableCode :: UserId -> ConnId -> Public.ConversationCode -> Galley (UpdateResult Event) joinConversationByReusableCode zusr zcon convCode = do c <- verifyReusableCode convCode joinConversation zusr zcon (codeConversation c) CodeAccess @@ -450,11 +450,11 @@ joinConversationByIdH :: UserId ::: ConnId ::: ConvId ::: JSON -> Galley Respons joinConversationByIdH (zusr ::: zcon ::: cnv ::: _) = handleUpdateResult <$> joinConversationById zusr zcon cnv -joinConversationById :: UserId -> ConnId -> ConvId -> Galley UpdateResult +joinConversationById :: UserId -> ConnId -> ConvId -> Galley (UpdateResult Event) joinConversationById zusr zcon cnv = joinConversation zusr zcon cnv LinkAccess -joinConversation :: UserId -> ConnId -> ConvId -> Access -> Galley UpdateResult +joinConversation :: UserId -> ConnId -> ConvId -> Access -> Galley (UpdateResult Event) joinConversation zusr zcon cnv access = do conv <- ensureConversationAccess zusr cnv access let newUsers = filter (notIsMember conv) [zusr] @@ -474,7 +474,7 @@ addMembersH (zusr ::: zcon ::: cid ::: req) = do let qInvite = Public.InviteQualified (flip Qualified domain <$> toNonEmpty u) r handleUpdateResult <$> addMembers zusr zcon cid qInvite -addMembers :: UserId -> ConnId -> ConvId -> Public.InviteQualified -> Galley UpdateResult +addMembers :: UserId -> ConnId -> ConvId -> Public.InviteQualified -> Galley (UpdateResult Event) addMembers zusr zcon convId invite = do conv <- Data.conversation convId >>= ifNothing (errorDescriptionToWai convNotFound) let mems = localBotsAndUsers (Data.convLocalMembers conv) @@ -998,7 +998,7 @@ rmBotH (zusr ::: zcon ::: req) = do bot <- fromJsonBody req handleUpdateResult <$> rmBot zusr zcon bot -rmBot :: UserId -> Maybe ConnId -> RemoveBot -> Galley UpdateResult +rmBot :: UserId -> Maybe ConnId -> RemoveBot -> Galley (UpdateResult Event) rmBot zusr zcon b = do c <- Data.conversation (b ^. rmBotConv) >>= ifNothing (errorDescriptionToWai convNotFound) localDomain <- viewFederationDomain @@ -1038,7 +1038,7 @@ addToConversation :: [(Remote UserId, RoleName)] -> -- | The conversation to modify Data.Conversation -> - Galley UpdateResult + Galley (UpdateResult Event) addToConversation _ _ _ _ [] [] _ = pure Unchanged addToConversation (bots, existingLocals) existingRemotes (usr, usrRole) conn newLocals newRemotes c = do ensureGroupConvThrowing c From 7c82d381851eb0b82ea3eda668c697f816f758db Mon Sep 17 00:00:00 2001 From: fisx Date: Thu, 16 Sep 2021 13:17:16 +0200 Subject: [PATCH 25/72] #1755 follow-up; bug fixes for multi-team IdP issuers (#1763) * document #1755 in spar-braindump.md * Fix: do not fail on registering same IdP entityID for *third* team. * Fix: do not allow authenticating same `UserRef` for two different teams. (didn't work before, not it throws an error.) * Flip the order of two commutative db calls. (idp by issuer is stored either in one or the other table, never in both, so this doesn't matter except for considerations as to which is most likely to fail and should therefore be tried last.) * Simplify code. `guardReplaceeV2` was never called, and what it checks is already checked in the beginning of `validateNewIdP`; `guardSameTeam` was either testing a tautology or a falsehood, depending on the call side, so it was easy to simplify. * Haddocks. * Don't use `-` in query params; use `_` instead. * Add failing integration test. * Cleanup: obey (optional) field order in cassandra insert. * More error info. * Whitespace. * Improve test coverage. --- changelog.d/0-release-notes/pr-1763 | 1 + changelog.d/3-bug-fixes/pr-1763 | 1 + changelog.d/3-bug-fixes/pr-1763-2 | 1 + changelog.d/4-docs/pr-1763 | 1 + changelog.d/5-internal/pr-1763 | 6 ++ docs/reference/spar-braindump.md | 77 ++++++++++++++++ .../src/Wire/API/Routes/Public/Spar.hs | 2 +- .../src/Wire/API/User/IdentityProvider.hs | 1 + services/spar/src/Spar/API.hs | 59 +++++------- services/spar/src/Spar/App.hs | 91 ++++++++++++------- services/spar/src/Spar/Data.hs | 26 +++--- services/spar/src/Spar/Error.hs | 4 +- services/spar/src/Spar/Scim/User.hs | 35 +++++-- .../test-integration/Test/Spar/APISpec.hs | 55 +++++++++++ services/spar/test-integration/Util/Core.hs | 10 +- services/spar/test-integration/Util/Types.hs | 10 ++ 16 files changed, 286 insertions(+), 94 deletions(-) create mode 100644 changelog.d/0-release-notes/pr-1763 create mode 100644 changelog.d/3-bug-fixes/pr-1763 create mode 100644 changelog.d/3-bug-fixes/pr-1763-2 create mode 100644 changelog.d/4-docs/pr-1763 create mode 100644 changelog.d/5-internal/pr-1763 diff --git a/changelog.d/0-release-notes/pr-1763 b/changelog.d/0-release-notes/pr-1763 new file mode 100644 index 00000000000..80f3c3a16b2 --- /dev/null +++ b/changelog.d/0-release-notes/pr-1763 @@ -0,0 +1 @@ +*Only if you are an early adopter of multi-team IdP issuers on release* [2021-09-14](https://github.com/wireapp/wire-server/releases/tag/v2021-09-14): that the [query parameter for IdP creation has changed](https://github.com/wireapp/wire-server/pull/1763/files#diff-bd66bf2f3a2445e08650535a431fc33cc1f6a9e0763c7afd9c9d3f2d67fac196). This only affects future calls to this one end-point. \ No newline at end of file diff --git a/changelog.d/3-bug-fixes/pr-1763 b/changelog.d/3-bug-fixes/pr-1763 new file mode 100644 index 00000000000..0fe1a26a91c --- /dev/null +++ b/changelog.d/3-bug-fixes/pr-1763 @@ -0,0 +1 @@ +An attempt to create a 3rd IdP with the same issuer was triggering an exception. \ No newline at end of file diff --git a/changelog.d/3-bug-fixes/pr-1763-2 b/changelog.d/3-bug-fixes/pr-1763-2 new file mode 100644 index 00000000000..93dd86ef48c --- /dev/null +++ b/changelog.d/3-bug-fixes/pr-1763-2 @@ -0,0 +1 @@ +When a user was auto-provisioned into two teams under the same pair of `Issuer` and `NameID`, they where directed into the wrong team, and not rejected. \ No newline at end of file diff --git a/changelog.d/4-docs/pr-1763 b/changelog.d/4-docs/pr-1763 new file mode 100644 index 00000000000..9ad084f071d --- /dev/null +++ b/changelog.d/4-docs/pr-1763 @@ -0,0 +1 @@ +Document how to use IdP issuers for multiple teams diff --git a/changelog.d/5-internal/pr-1763 b/changelog.d/5-internal/pr-1763 new file mode 100644 index 00000000000..361a2a74245 --- /dev/null +++ b/changelog.d/5-internal/pr-1763 @@ -0,0 +1,6 @@ +Minor changes around SAML and multi-team Issuers. + +- Change query param to not contain `-`, but `_`. (This is considered an internal change because the feature has been release in the last release, but only been documented in this one.) +- Haddocks. +- Simplify code. +- Remove unnecessary calls to cassandra. diff --git a/docs/reference/spar-braindump.md b/docs/reference/spar-braindump.md index d6fe65a4149..f92775becaf 100644 --- a/docs/reference/spar-braindump.md +++ b/docs/reference/spar-braindump.md @@ -326,3 +326,80 @@ TODO (probably little difference between this and "user deletes herself"?) #### delete via scim TODO + + +## using the same IdP (same entityID, or Issuer) with different teams + +Some SAML IdP vendors do not allow to set up fresh entityIDs (issuers) +for fresh apps; instead, all apps controlled by the IdP are receiving +SAML credentials from the same issuer. + +In the past, wire has used the a tuple of IdP issuer and 'NameID' +(Haskell type 'UserRef') to uniquely identity users (tables +`spar.user_v2` and `spar.issuer_idp`). + +In order to allow one IdP to serve more than one team, this has been +changed: we now allow to identity an IdP by a combination of +entityID/issuer and wire `TeamId`. The necessary tweaks to the +protocol are listed here. + +For everybody using IdPs that do not have this limitation, we have +taken great care to not change the behavior. + + +### what you need to know when operating a team or an instance + +No instance-level configuration is required. + +If your IdP supports different entityID / issuer for different apps, +you don't need to change anything. We hope to deprecate the old +flavor of the SAML protocol eventually, but we will keep you posted in +the release notes, and give you time to react. + +If your IdP does not support different entityID / issuer for different +apps, keep reading. At the time of writing this section, there is no +support for multi-team IdP issuers in team-settings, so you have two +options: (1) use the rest API directly; or (2) contact our customer +support and send them the link to this section. + +If you feel up to calling the rest API, try the following: + +- Use the above end-point `GET /sso/metadata/:tid` with your `TeamId` + for pulling the SP metadata. +- When calling `POST /identity-provider`, make sure to add + `?api_version=v2`. (`?api_version=v1` or no omission of the query + param both invoke the old behavior.) + +NB: Neither version of the API allows you to provision a user with the +same Issuer and same NamdID. RATIONALE: this allows us to implement +'getSAMLUser' without adding 'TeamId' to 'UserRef', which in turn +would break the (admittedly leaky) abstarctions of saml2-web-sso. + + +### API changes in more detail + +- New query param `api_version=` for `POST + /identity-providers`. The version is stored in `spar.idp` together + with the rest of the IdP setup, and is used by `GET + /sso/initiate-login` (see below). +- `GET /sso/initiate-login` sends audience based on api_version stored + in `spar.idp`: for v1, the audience is `/sso/finalize-login`; for + v2, it's `/sso/finalize-login/:tid`. +- New end-point `POST /sso/finalize-login/:tid` that behaves + indistinguishable from `POST /sso/finalize-login`, except when more + than one IdP with the same issuer, but different teams are + registered. In that case, this end-point can process the + credentials by discriminating on the `TeamId`. +- `POST /sso/finalize-login/:tid` remains unchanged. +- New end-point `GET /sso/metadata/:tid` returns the same SP metadata as + `GET /sso/metadata`, with the exception that it lists + `"/sso/finalize-login/:tid"` as the path of the + `AssertionConsumerService` (rather than `"/sso/finalize-login"` as + before). +- `GET /sso/metadata` remains unchanged, and still returns the old SP + metadata, without the `TeamId` in the paths. + + +### database schema changes + +[V15](https://github.com/wireapp/wire-server/blob/b97439756cfe0721164934db1f80658b60de1e5e/services/spar/schema/src/V15.hs#L29-L43) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs b/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs index 5492a0be769..de7886cbf55 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs @@ -166,7 +166,7 @@ type IdpGetAll = Get '[JSON] IdPList type IdpCreate = ReqBodyCustomError '[RawXML, JSON] "wai-error" IdPMetadataInfo :> QueryParam' '[Optional, Strict] "replaces" SAML.IdPId - :> QueryParam' '[Optional, Strict] "api-version" WireIdPAPIVersion + :> QueryParam' '[Optional, Strict] "api_version" WireIdPAPIVersion :> PostCreated '[JSON] IdP type IdpUpdate = diff --git a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs index f3d88cfd958..6cca0754def 100644 --- a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs +++ b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs @@ -65,6 +65,7 @@ data WireIdPAPIVersion deriving stock (Eq, Show, Enum, Bounded, Generic) deriving (Arbitrary) via (GenericUniform WireIdPAPIVersion) +-- | (Internal issue for making v2 the default: https://wearezeta.atlassian.net/browse/SQSERVICES-781) defWireIdPAPIVersion :: WireIdPAPIVersion defWireIdPAPIVersion = WireIdPAPIV1 diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 9b5b6923dec..19969954c5c 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -315,19 +315,23 @@ assertNoScimOrNoIdP teamid = do SparProvisioningMoreThanOneIdP "Teams with SCIM tokens can only have at most one IdP" --- | Check that issuer is not used for any team in the system (it is a database keys for --- finding IdPs), and request URI is https. +-- | Check that issuer is not used anywhere in the system ('WireIdPAPIV1', here it is a +-- database keys for finding IdPs), or anywhere in this team ('WireIdPAPIV2'), that request +-- URI is https, that the replacement IdPId, if present, points to our team, and possibly +-- other things (see source code for the definitive answer). -- -- About the @mReplaces@ argument: the information whether the idp is replacing an old one is -- in query parameter, because the body can be both XML and JSON. The JSON body could carry -- the replaced idp id fine, but the XML is defined in the SAML standard and cannot be --- changed. +-- changed. NB: if you want to replace an IdP by one with the same issuer, you probably +-- want to use `PUT` instead of `POST`. -- -- FUTUREWORK: find out if anybody uses the XML body type and drop it if not. -- --- FUTUREWORK: using the same issuer for two teams may be possible, but only if we stop --- supporting implicit user creating via SAML. If unknown users present IdP credentials, the --- issuer is our only way of finding the team in which the user must be created. +-- FUTUREWORK: using the same issuer for two teams even in `WireIdPAPIV1` may be possible, but +-- only if we stop supporting implicit user creating via SAML. If unknown users present IdP +-- credentials, the issuer is our only way of finding the team in which the user must be +-- created. -- -- FUTUREWORK: move this to the saml2-web-sso package. (same probably goes for get, create, -- update, delete of idps.) @@ -353,40 +357,25 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces = withDebugLog "validate SAML.logger SAML.Debug $ show (apiversion, _idpMetadata, teamId, mReplaces) SAML.logger SAML.Debug $ show (_idpId, oldIssuers, idp) - let handleIdPClash :: Either SAML.IdPId IdP -> m () + let handleIdPClash :: Either id idp -> m () + -- (HINT: using type vars above instead of the actual types constitutes a proof that + -- we're not using any properties of the arguments in this function.) handleIdPClash = case apiversion of WireIdPAPIV1 -> const $ do - throwSpar $ SparNewIdPAlreadyInUse "you can't create an IdP with api-version v1 if the issuer is already in use on the wire instance." + throwSpar $ SparNewIdPAlreadyInUse "you can't create an IdP with api_version v1 if the issuer is already in use on the wire instance." WireIdPAPIV2 -> \case - (Right idp') -> do - guardSameTeam idp' - guardReplaceeV2 - (Left id') -> do - idp' <- do - let err = throwSpar $ SparIdPNotFound (cs $ show id') -- database inconsistency - wrapMonadClient (Data.getIdPConfig id') >>= maybe err pure - handleIdPClash (Right idp') - - guardSameTeam :: IdP -> m () - guardSameTeam idp' = do - when ((idp' ^. SAML.idpExtraInfo . wiTeam) == teamId) $ do - throwSpar $ SparNewIdPAlreadyInUse "if the exisitng IdP is registered for a team, the new one can't have it." - - guardReplaceeV2 :: m () - guardReplaceeV2 = forM_ mReplaces $ \rid -> do - ridp <- do - let err = throwSpar $ SparIdPNotFound (cs $ show rid) -- database inconsistency - wrapMonadClient (Data.getIdPConfig rid) >>= maybe err pure - when (fromMaybe defWireIdPAPIVersion (ridp ^. SAML.idpExtraInfo . wiApiVersion) /= WireIdPAPIV2) $ do - throwSpar $ - SparNewIdPAlreadyInUse - (cs $ "api-version mismatch: " <> show ((ridp ^. SAML.idpExtraInfo . wiApiVersion), WireIdPAPIV2)) + (Right _) -> do + -- idp' was found by lookup with teamid, so it's in the same team. + throwSpar $ SparNewIdPAlreadyInUse "if the exisitng IdP is registered for a team, the new one can't have it." + (Left _) -> do + -- this idp *id* is from a different team, and we're in the 'WireIdPAPIV2' case, so this is fine. + pure () case idp of Data.GetIdPFound idp' {- same team -} -> handleIdPClash (Right idp') Data.GetIdPNotFound -> pure () - res@(Data.GetIdPDanglingId _) -> throwSpar . SparIdPNotFound . cs . show $ res -- database inconsistency - res@(Data.GetIdPNonUnique _) -> throwSpar . SparIdPNotFound . cs . show $ res -- impossible + res@(Data.GetIdPDanglingId _) -> throwSpar . SparIdPNotFound . ("validateNewIdP: " <>) . cs . show $ res -- database inconsistency + Data.GetIdPNonUnique ids' {- same team didn't yield anything, but there are at least two other teams with this issuer already -} -> handleIdPClash (Left ids') Data.GetIdPWrongTeam id' {- different team -} -> handleIdPClash (Left id') pure SAML.IdPConfig {..} @@ -437,8 +426,8 @@ validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateNewIdP" (Just notInUseByOthers <- case foundConfig of Data.GetIdPFound c -> pure $ c ^. SAML.idpId == _idpId Data.GetIdPNotFound -> pure True - res@(Data.GetIdPDanglingId _) -> throwSpar . SparIdPNotFound . cs . show $ res -- impossible - res@(Data.GetIdPNonUnique _) -> throwSpar . SparIdPNotFound . cs . show $ res -- impossible (because team id was used in lookup) + res@(Data.GetIdPDanglingId _) -> throwSpar . SparIdPNotFound . ("validateIdPUpdate: " <>) . cs . show $ res -- impossible + res@(Data.GetIdPNonUnique _) -> throwSpar . SparIdPNotFound . ("validateIdPUpdate: " <>) . cs . show $ res -- impossible (because team id was used in lookup) Data.GetIdPWrongTeam _ -> pure False if notInUseByOthers then pure $ (previousIdP ^. SAML.idpExtraInfo) & wiOldIssuers %~ nub . (previousIssuer :) diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index 2e243d33d64..79e8ae0474b 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -26,8 +26,9 @@ module Spar.App wrapMonadClientWithEnv, wrapMonadClient, verdictHandler, - getUserByUref, - getUserByScimExternalId, + GetUserResult (..), + getUserIdByUref, + getUserIdByScimExternalId, insertUser, validateEmailIfExists, errorPage, @@ -35,7 +36,7 @@ module Spar.App where import Bilge -import Brig.Types (ManagedBy (..), userTeam) +import Brig.Types (ManagedBy (..), User, userId, userTeam) import Brig.Types.Intra (AccountStatus (..), accountStatus, accountUser) import Cassandra import qualified Cassandra as Cas @@ -199,19 +200,39 @@ insertUser uref uid = wrapMonadClient $ Data.insertSAMLUser uref uid -- the team with valid SAML credentials. -- -- FUTUREWORK: Remove and reinstatate getUser, in AuthID refactoring PR. (in https://github.com/wireapp/wire-server/pull/1410, undo https://github.com/wireapp/wire-server/pull/1418) -getUserByUref :: SAML.UserRef -> Spar (Maybe UserId) -getUserByUref uref = do +getUserIdByUref :: Maybe TeamId -> SAML.UserRef -> Spar (GetUserResult UserId) +getUserIdByUref mbteam uref = userId <$$> getUserByUref mbteam uref + +getUserByUref :: Maybe TeamId -> SAML.UserRef -> Spar (GetUserResult User) +getUserByUref mbteam uref = do muid <- wrapMonadClient $ Data.getSAMLUser uref case muid of - Nothing -> pure Nothing + Nothing -> pure GetUserNotFound Just uid -> do let withpending = Intra.WithPendingInvitations -- see haddocks above - itis <- isJust <$> Intra.getBrigUserTeam withpending uid - pure $ if itis then Just uid else Nothing + Intra.getBrigUser withpending uid >>= \case + Nothing -> pure GetUserNotFound + Just user + | isNothing (userTeam user) -> pure GetUserNoTeam + | isJust mbteam && mbteam /= userTeam user -> pure GetUserWrongTeam + | otherwise -> pure $ GetUserFound user + +data GetUserResult usr + = GetUserFound usr + | GetUserNotFound + | GetUserNoTeam + | GetUserWrongTeam + deriving (Eq, Show) + +instance Functor GetUserResult where + fmap f (GetUserFound usr) = GetUserFound (f usr) + fmap _ GetUserNotFound = GetUserNotFound + fmap _ GetUserNoTeam = GetUserNoTeam + fmap _ GetUserWrongTeam = GetUserWrongTeam -- FUTUREWORK: Remove and reinstatate getUser, in AuthID refactoring PR -getUserByScimExternalId :: TeamId -> Email -> Spar (Maybe UserId) -getUserByScimExternalId tid email = do +getUserIdByScimExternalId :: TeamId -> Email -> Spar (Maybe UserId) +getUserIdByScimExternalId tid email = do muid <- wrapMonadClient $ (Data.lookupScimExternalId tid email) case muid of Nothing -> pure Nothing @@ -236,9 +257,8 @@ getUserByScimExternalId tid email = do -- FUTUREWORK: once we support , brig will refuse to delete -- users that have an sso id, unless the request comes from spar. then we can make users -- undeletable in the team admin page, and ask admins to go talk to their IdP system. -createSamlUserWithId :: IdP -> UserId -> SAML.UserRef -> Spar () -createSamlUserWithId idp buid suid = do - let teamid = idp ^. idpExtraInfo . wiTeam +createSamlUserWithId :: TeamId -> UserId -> SAML.UserRef -> Spar () +createSamlUserWithId teamid buid suid = do uname <- either (throwSpar . SparBadUserName . cs) pure $ Intra.mkUserName Nothing (UrefOnly suid) buid' <- Intra.createBrigUserSAML suid buid teamid uname ManagedByWire assert (buid == buid') $ pure () @@ -258,7 +278,7 @@ autoprovisionSamlUserWithId mbteam buid suid = do idp <- getIdPConfigByIssuerOptionalSPId (suid ^. uidTenant) mbteam guardReplacedIdP idp guardScimTokens idp - createSamlUserWithId idp buid suid + createSamlUserWithId (idp ^. idpExtraInfo . wiTeam) buid suid validateEmailIfExists buid suid where -- Replaced IdPs are not allowed to create new wire accounts. @@ -306,7 +326,7 @@ bindUser buid userref = do Data.GetIdPFound idp -> pure $ idp ^. idpExtraInfo . wiTeam Data.GetIdPNotFound -> err Data.GetIdPDanglingId _ -> err -- database inconsistency - Data.GetIdPNonUnique is -> throwSpar $ SparUserRefInMultipleTeams (cs $ show (buid, is)) + Data.GetIdPNonUnique is -> throwSpar $ SparUserRefInNoOrMultipleTeams (cs $ show (buid, is)) Data.GetIdPWrongTeam _ -> err -- impossible acc <- Intra.getBrigUserAccount Intra.WithPendingInvitations buid >>= maybe err pure teamid' :: TeamId <- userTeam (accountUser acc) & maybe err pure @@ -407,15 +427,15 @@ catchVerdictErrors = (`catchError` hndlr) -- | If a user attempts to login presenting a new IdP issuer, but there is no entry in -- @"spar.user"@ for her: lookup @"old_issuers"@ from @"spar.idp"@ for the new IdP, and -- traverse the old IdPs in search for the old entry. Return that old entry. -findUserWithOldIssuer :: Maybe TeamId -> SAML.UserRef -> Spar (Maybe (SAML.UserRef, UserId)) -findUserWithOldIssuer mbteam (SAML.UserRef issuer subject) = do +findUserIdWithOldIssuer :: Maybe TeamId -> SAML.UserRef -> Spar (GetUserResult (SAML.UserRef, UserId)) +findUserIdWithOldIssuer mbteam (SAML.UserRef issuer subject) = do idp <- getIdPConfigByIssuerOptionalSPId issuer mbteam - let tryFind :: Maybe (SAML.UserRef, UserId) -> Issuer -> Spar (Maybe (SAML.UserRef, UserId)) - tryFind found@(Just _) _ = pure found - tryFind Nothing oldIssuer = (uref,) <$$> getUserByUref uref + let tryFind :: GetUserResult (SAML.UserRef, UserId) -> Issuer -> Spar (GetUserResult (SAML.UserRef, UserId)) + tryFind found@(GetUserFound _) _ = pure found + tryFind _ oldIssuer = (uref,) <$$> getUserIdByUref mbteam uref where uref = SAML.UserRef oldIssuer subject - foldM tryFind Nothing (idp ^. idpExtraInfo . wiOldIssuers) + foldM tryFind GetUserNotFound (idp ^. idpExtraInfo . wiOldIssuers) -- | After a user has been found using 'findUserWithOldIssuer', update it everywhere so that -- the old IdP is not needed any more next time. @@ -432,35 +452,42 @@ verdictHandlerResultCore bindCky mbteam = \case SAML.AccessGranted userref -> do uid :: UserId <- do viaBindCookie <- maybe (pure Nothing) (wrapMonadClient . Data.lookupBindCookie) bindCky - viaSparCassandra <- getUserByUref userref + viaSparCassandra <- getUserIdByUref mbteam userref -- race conditions: if the user has been created on spar, but not on brig, 'getUser' -- returns 'Nothing'. this is ok assuming 'createUser', 'bindUser' (called below) are -- idempotent. viaSparCassandraOldIssuer <- - if isJust viaSparCassandra - then pure Nothing - else findUserWithOldIssuer mbteam userref + case viaSparCassandra of + GetUserFound _ -> pure GetUserNotFound + _ -> findUserIdWithOldIssuer mbteam userref + let err = + SparUserRefInNoOrMultipleTeams . cs $ + show (userref, viaBindCookie, viaSparCassandra, viaSparCassandraOldIssuer) case (viaBindCookie, viaSparCassandra, viaSparCassandraOldIssuer) of + (_, GetUserNoTeam, _) -> throwSpar err + (_, GetUserWrongTeam, _) -> throwSpar err + (_, _, GetUserNoTeam) -> throwSpar err + (_, _, GetUserWrongTeam) -> throwSpar err -- This is the first SSO authentication, so we auto-create a user. We know the user -- has not been created via SCIM because then we would've ended up in the -- "reauthentication" branch. - (Nothing, Nothing, Nothing) -> autoprovisionSamlUser mbteam userref + (Nothing, GetUserNotFound, GetUserNotFound) -> autoprovisionSamlUser mbteam userref -- If the user is only found under an old (previous) issuer, move it here. - (Nothing, Nothing, Just (oldUserRef, uid)) -> moveUserToNewIssuer oldUserRef userref uid >> pure uid + (Nothing, GetUserNotFound, GetUserFound (oldUserRef, uid)) -> moveUserToNewIssuer oldUserRef userref uid >> pure uid -- SSO re-authentication (the most common case). - (Nothing, Just uid, _) -> pure uid + (Nothing, GetUserFound uid, _) -> pure uid -- Bind existing user (non-SSO or SSO) to ssoid - (Just uid, Nothing, Nothing) -> bindUser uid userref - (Just uid, Just uid', Nothing) + (Just uid, GetUserNotFound, GetUserNotFound) -> bindUser uid userref + (Just uid, GetUserFound uid', GetUserNotFound) -- Redundant binding (no change to Brig or Spar) | uid == uid' -> pure uid -- Attempt to use ssoid for a second Wire user | otherwise -> throwSpar SparBindUserRefTaken -- same two cases as above, but between last login and bind there was an issuer update. - (Just uid, Nothing, Just (oldUserRef, uid')) + (Just uid, GetUserNotFound, GetUserFound (oldUserRef, uid')) | uid == uid' -> moveUserToNewIssuer oldUserRef userref uid >> pure uid | otherwise -> throwSpar SparBindUserRefTaken - (Just _, Just _, Just _) -> + (Just _, GetUserFound _, GetUserFound _) -> -- to see why, consider the condition on the call to 'findUserWithOldIssuer' above. error "impossible." SAML.logger SAML.Debug ("granting sso login for " <> show uid) diff --git a/services/spar/src/Spar/Data.hs b/services/spar/src/Spar/Data.hs index bbe5c2ca8cb..d523149563e 100644 --- a/services/spar/src/Spar/Data.hs +++ b/services/spar/src/Spar/Data.hs @@ -445,9 +445,9 @@ storeIdPConfig idp = retry x5 . batch $ do ) addPrepQuery byIssuer - ( idp ^. SAML.idpId, + ( idp ^. SAML.idpMetadata . SAML.edIssuer, idp ^. SAML.idpExtraInfo . wiTeam, - idp ^. SAML.idpMetadata . SAML.edIssuer + idp ^. SAML.idpId ) addPrepQuery byTeam @@ -459,8 +459,8 @@ storeIdPConfig idp = retry x5 . batch $ do ins = "INSERT INTO idp (idp, issuer, request_uri, public_key, extra_public_keys, team, api_version, old_issuers, replaced_by) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?)" -- FUTUREWORK: migrate `spar.issuer_idp` away, `spar.issuer_idp_v2` is enough. - byIssuer :: PrepQuery W (SAML.IdPId, TeamId, SAML.Issuer) () - byIssuer = "INSERT INTO issuer_idp_v2 (idp, team, issuer) VALUES (?, ?, ?)" + byIssuer :: PrepQuery W (SAML.Issuer, TeamId, SAML.IdPId) () + byIssuer = "INSERT INTO issuer_idp_v2 (issuer, team, idp) VALUES (?, ?, ?)" byTeam :: PrepQuery W (SAML.IdPId, TeamId) () byTeam = "INSERT INTO team_idp (idp, team) VALUES (?, ?)" @@ -593,20 +593,22 @@ getIdPIdByIssuerAllowOld issuer mbteam = do else mbv1v2 _ -> pure mbv1v2 --- | Find 'IdPId' without team. Search both `issuer_idp` and `issuer_idp_v2`; in the latter, +-- | Find 'IdPId' without team. Search both `issuer_idp_v2` and `issuer_idp`; in the former, -- make sure the result is unique (no two IdPs for two different teams). getIdPIdByIssuerWithoutTeam :: (HasCallStack, MonadClient m) => SAML.Issuer -> m (GetIdPResult SAML.IdPId) getIdPIdByIssuerWithoutTeam issuer = do - (runIdentity <$$> retry x1 (query1 sel $ params Quorum (Identity issuer))) >>= \case - Just idpid -> pure $ GetIdPFound idpid - Nothing -> - (runIdentity <$$> retry x1 (query selv2 $ params Quorum (Identity issuer))) >>= \case - [] -> pure GetIdPNotFound - [idpid] -> pure $ GetIdPFound idpid - idpids@(_ : _ : _) -> pure $ GetIdPNonUnique idpids + (runIdentity <$$> retry x1 (query selv2 $ params Quorum (Identity issuer))) >>= \case + [] -> + (runIdentity <$$> retry x1 (query1 sel $ params Quorum (Identity issuer))) >>= \case + Just idpid -> pure $ GetIdPFound idpid + Nothing -> pure GetIdPNotFound + [idpid] -> + pure $ GetIdPFound idpid + idpids@(_ : _ : _) -> + pure $ GetIdPNonUnique idpids where sel :: PrepQuery R (Identity SAML.Issuer) (Identity SAML.IdPId) sel = "SELECT idp FROM issuer_idp WHERE issuer = ?" diff --git a/services/spar/src/Spar/Error.hs b/services/spar/src/Spar/Error.hs index ddbc57321c0..fb96e017b7e 100644 --- a/services/spar/src/Spar/Error.hs +++ b/services/spar/src/Spar/Error.hs @@ -84,7 +84,7 @@ data SparCustomError | SparBindFromWrongOrNoTeam LT | SparBindFromBadAccountStatus LT | SparBindUserRefTaken - | SparUserRefInMultipleTeams LT + | SparUserRefInNoOrMultipleTeams LT | SparBadUserName LT | SparCannotCreateUsersOnReplacedIdP LT | SparCouldNotParseRfcResponse LT LT @@ -141,7 +141,7 @@ renderSparError (SAML.CustomError (SparBadInitiateLoginQueryParams label)) = Rig renderSparError (SAML.CustomError (SparBindFromWrongOrNoTeam msg)) = Right $ Wai.mkError status403 "bad-team" ("Forbidden: wrong user team " <> msg) renderSparError (SAML.CustomError (SparBindFromBadAccountStatus msg)) = Right $ Wai.mkError status403 "bad-account-status" ("Forbidden: user has account status " <> msg <> "; only Active, PendingInvitation are supported") renderSparError (SAML.CustomError SparBindUserRefTaken) = Right $ Wai.mkError status403 "subject-id-taken" "Forbidden: SubjectID is used by another wire user. If you have an old user bound to this IdP, unbind or delete that user." -renderSparError (SAML.CustomError (SparUserRefInMultipleTeams msg)) = Right $ Wai.mkError status403 "bad-team" ("Forbidden: multiple teams for same UserRef " <> msg) +renderSparError (SAML.CustomError (SparUserRefInNoOrMultipleTeams msg)) = Right $ Wai.mkError status403 "bad-team" ("Forbidden: multiple teams or no team for same UserRef " <> msg) renderSparError (SAML.CustomError (SparBadUserName msg)) = Right $ Wai.mkError status400 "bad-username" ("Bad UserName in SAML response, except len [1, 128]: " <> msg) renderSparError (SAML.CustomError (SparCannotCreateUsersOnReplacedIdP replacingIdPId)) = Right $ Wai.mkError status400 "cannont-provision-on-replaced-idp" ("This IdP has been replaced, users can only be auto-provisioned on the replacing IdP " <> replacingIdPId) -- RFC-specific errors diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index ee3d938404e..72a4e8b3fcb 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -64,7 +64,7 @@ import qualified Data.UUID.V4 as UUID import Imports import Network.URI (URI, parseURI) import qualified SAML2.WebSSO as SAML -import Spar.App (Spar, getUserByScimExternalId, getUserByUref, sparCtxOpts, validateEmailIfExists, wrapMonadClient) +import Spar.App (GetUserResult (..), Spar, getUserIdByScimExternalId, getUserIdByUref, sparCtxOpts, validateEmailIfExists, wrapMonadClient) import qualified Spar.Data as Data import qualified Spar.Intra.Brig as Brig import Spar.Scim.Auth () @@ -633,9 +633,11 @@ calculateVersion uid usr = Scim.Weak (Text.pack (show h)) -- to a single `externalId`. assertExternalIdUnused :: TeamId -> ST.ValidExternalId -> Scim.ScimHandler Spar () assertExternalIdUnused tid veid = do - mExistingUserId <- lift $ ST.runValidExternalId (getUserByUref) (getUserByScimExternalId tid) veid - unless (isNothing mExistingUserId) $ - throwError Scim.conflict {Scim.detail = Just "externalId is already taken"} + assertExternalIdInAllowedValues + [Nothing] + "externalId is already taken" + tid + veid -- | -- Check that the UserRef is not taken any user other than the passed 'UserId' @@ -645,9 +647,28 @@ assertExternalIdUnused tid veid = do -- to a single `externalId`. assertExternalIdNotUsedElsewhere :: TeamId -> ST.ValidExternalId -> UserId -> Scim.ScimHandler Spar () assertExternalIdNotUsedElsewhere tid veid wireUserId = do - mExistingUserId <- lift $ ST.runValidExternalId getUserByUref (getUserByScimExternalId tid) veid - unless (mExistingUserId `elem` [Nothing, Just wireUserId]) $ do - throwError Scim.conflict {Scim.detail = Just "externalId already in use by another Wire user"} + assertExternalIdInAllowedValues + [Nothing, Just wireUserId] + "externalId already in use by another Wire user" + tid + veid + +assertExternalIdInAllowedValues :: [Maybe UserId] -> Text -> TeamId -> ST.ValidExternalId -> Scim.ScimHandler Spar () +assertExternalIdInAllowedValues allowedValues errmsg tid veid = do + isGood <- + lift $ + ST.runValidExternalId + ( \uref -> + getUserIdByUref (Just tid) uref <&> \case + (Spar.App.GetUserFound uid) -> Just uid `elem` allowedValues + Spar.App.GetUserNotFound -> Nothing `elem` allowedValues + Spar.App.GetUserNoTeam -> False -- this is never allowed (and also hopefully impossible) + Spar.App.GetUserWrongTeam -> False -- this can happen, but it's violating all our assertions + ) + (fmap (`elem` allowedValues) . getUserIdByScimExternalId tid) + veid + unless isGood $ + throwError Scim.conflict {Scim.detail = Just errmsg} assertHandleUnused :: Handle -> Scim.ScimHandler Spar () assertHandleUnused = assertHandleUnused' "userName is already taken" diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs index e932ffa42d5..0a26514b2a3 100644 --- a/services/spar/test-integration/Test/Spar/APISpec.hs +++ b/services/spar/test-integration/Test/Spar/APISpec.hs @@ -235,6 +235,22 @@ specFinalizeLogin = do bdy `shouldContain` "wire:sso:success" bdy `shouldContain` "window.opener.postMessage({type: 'AUTH_SUCCESS'}, receiverOrigin)" hasPersistentCookieHeader sparresp `shouldBe` Right () + + let loginFailure :: HasCallStack => ResponseLBS -> TestSpar () + loginFailure sparresp = liftIO $ do + statusCode sparresp `shouldBe` 200 + let bdy = maybe "" (cs @LBS @String) (responseBody sparresp) + bdy `shouldContain` "" + bdy `shouldContain` "" + bdy `shouldNotContain` "wire:sso:error:success" + bdy `shouldContain` "wire:sso:error:bad-team" + bdy `shouldContain` "window.opener.postMessage({" + bdy `shouldContain` "\"type\":\"AUTH_ERROR\"" + bdy `shouldContain` "\"payload\":{" + bdy `shouldContain` "\"label\":\"forbidden\"" + bdy `shouldContain` "}, receiverOrigin)" + hasPersistentCookieHeader sparresp `shouldBe` Left "no set-cookie header" + context "happy flow" $ do it "responds with a very peculiar 'allowed' HTTP response" $ do env <- ask @@ -249,6 +265,7 @@ specFinalizeLogin = do liftIO $ authnreq ^. rqIssuer . fromIssuer . to URI.uriPath `shouldBe` audiencePath authnresp <- runSimpleSP $ mkAuthnResponse privcreds idp spmeta authnreq True loginSuccess =<< submitAuthnResponse tid authnresp + context "happy flow (two teams, fixed IdP entityID)" $ do it "works" $ do skipIdPAPIVersions @@ -261,6 +278,10 @@ specFinalizeLogin = do (owner2, tid2) <- createUserWithTeam (env ^. teBrig) (env ^. teGalley) idp2 :: IdP <- callIdpCreate (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner2) metadata pure (tid2, idp2) + (tid3, idp3) <- liftIO . runHttpT (env ^. teMgr) $ do + (owner3, tid3) <- createUserWithTeam (env ^. teBrig) (env ^. teGalley) + idp3 :: IdP <- callIdpCreate (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner3) metadata + pure (tid3, idp3) do spmeta <- getTestSPMetadata tid1 authnreq <- negotiateAuthnRequest idp1 @@ -271,6 +292,36 @@ specFinalizeLogin = do authnreq <- negotiateAuthnRequest idp2 authnresp <- runSimpleSP $ mkAuthnResponse privcreds idp2 spmeta authnreq True loginSuccess =<< submitAuthnResponse tid2 authnresp + do + spmeta <- getTestSPMetadata tid3 + authnreq <- negotiateAuthnRequest idp3 + authnresp <- runSimpleSP $ mkAuthnResponse privcreds idp3 spmeta authnreq True + loginSuccess =<< submitAuthnResponse tid3 authnresp + + context "idp sends user to two teams with same issuer, nameid" $ do + it "fails" $ do + skipIdPAPIVersions + [ WireIdPAPIV1 + -- (In fact, to get this to work was the reason to introduce 'WireIdPAPIVesion'.) + ] + env <- ask + (_, tid1, idp1, (IdPMetadataValue _ metadata, privcreds)) <- registerTestIdPWithMeta + (tid2, idp2) <- liftIO . runHttpT (env ^. teMgr) $ do + (owner2, tid2) <- createUserWithTeam (env ^. teBrig) (env ^. teGalley) + idp2 :: IdP <- callIdpCreate (env ^. teWireIdPAPIVersion) (env ^. teSpar) (Just owner2) metadata + pure (tid2, idp2) + subj <- liftIO $ SAML.unspecifiedNameID . UUID.toText <$> UUID.nextRandom + do + spmeta <- getTestSPMetadata tid1 + authnreq <- negotiateAuthnRequest idp1 + authnresp <- runSimpleSP $ mkAuthnResponseWithSubj subj privcreds idp1 spmeta authnreq True + loginSuccess =<< submitAuthnResponse tid1 authnresp + do + spmeta <- getTestSPMetadata tid2 + authnreq <- negotiateAuthnRequest idp2 + authnresp <- runSimpleSP $ mkAuthnResponseWithSubj subj privcreds idp2 spmeta authnreq True + loginFailure =<< submitAuthnResponse tid2 authnresp + context "user is created once, then deleted in team settings, then can login again." $ do it "responds with 'allowed'" $ do (ownerid, teamid, idp, (_, privcreds)) <- registerTestIdPWithMeta @@ -313,18 +364,22 @@ specFinalizeLogin = do authnreq <- negotiateAuthnRequest idp authnresp <- runSimpleSP $ mkAuthnResponseWithSubj subj privcreds idp spmeta authnreq True loginSuccess =<< submitAuthnResponse teamid authnresp + context "unknown user" $ do it "creates the user" $ do pending + context "known user A, but client device (probably a browser?) is already authenticated as another (probably non-sso) user B" $ do it "logs out user B, logs in user A" $ do pending -- TODO(arianvp): Ask Matthias what this even means + context "more than one dsig cert" $ do it "accepts the first of two certs for signatures" $ do pending it "accepts the second of two certs for signatures" $ do pending + context "unknown IdP Issuer" $ do it "rejects" $ do (_, teamid, idp, (_, privcreds)) <- registerTestIdPWithMeta diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index 03bda6dc4b1..d876a3735c7 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -1079,7 +1079,7 @@ callIdpCreate apiversion sparreq_ muid metadata = do callIdpCreate' :: (MonadIO m, MonadHttp m) => WireIdPAPIVersion -> SparReq -> Maybe UserId -> SAML.IdPMetadata -> m ResponseLBS callIdpCreate' apiversion sparreq_ muid metadata = do explicitQueryParam <- do - -- `&api-version=v1` is implicit and can be omitted from the query, but we want to test + -- `&api_version=v1` is implicit and can be omitted from the query, but we want to test -- both, and not spend extra time on it. liftIO $ randomRIO (True, False) post $ @@ -1087,8 +1087,8 @@ callIdpCreate' apiversion sparreq_ muid metadata = do . maybe id zUser muid . path "/identity-providers/" . ( case apiversion of - WireIdPAPIV1 -> Bilge.query [("api-version", Just "v1") | explicitQueryParam] - WireIdPAPIV2 -> Bilge.query [("api-version", Just "v2")] + WireIdPAPIV1 -> Bilge.query [("api_version", Just "v1") | explicitQueryParam] + WireIdPAPIV2 -> Bilge.query [("api_version", Just "v2")] ) . body (RequestBodyLBS . cs $ SAML.encode metadata) . header "Content-Type" "application/xml" @@ -1117,7 +1117,7 @@ callIdpCreateReplace apiversion sparreq_ muid metadata idpid = do callIdpCreateReplace' :: (HasCallStack, MonadIO m, MonadHttp m) => WireIdPAPIVersion -> SparReq -> Maybe UserId -> IdPMetadata -> IdPId -> m ResponseLBS callIdpCreateReplace' apiversion sparreq_ muid metadata idpid = do explicitQueryParam <- do - -- `&api-version=v1` is implicit and can be omitted from the query, but we want to test + -- `&api_version=v1` is implicit and can be omitted from the query, but we want to test -- both, and not spend extra time on it. liftIO $ randomRIO (True, False) post $ @@ -1125,7 +1125,7 @@ callIdpCreateReplace' apiversion sparreq_ muid metadata idpid = do . maybe id zUser muid . path "/identity-providers/" . Bilge.query - ( [ ( "api-version", + ( [ ( "api_version", case apiversion of WireIdPAPIV1 -> if explicitQueryParam then Just "v1" else Nothing WireIdPAPIV2 -> Just "v2" diff --git a/services/spar/test-integration/Util/Types.hs b/services/spar/test-integration/Util/Types.hs index 67b5631d623..be65f433444 100644 --- a/services/spar/test-integration/Util/Types.hs +++ b/services/spar/test-integration/Util/Types.hs @@ -120,6 +120,16 @@ _unitTestTestErrorLabel = do throwIO . ErrorCall . show $ val +-- | FUTUREWORK(fisx): we're running all tests for all constructors of `WireIdPAPIVersion`, +-- which sometimes makes little sense. 'skipIdPAPIVersions' can be used to pend individual +-- tests that do not even work in both versions (most of them should), or ones that aren't +-- that interesting to run twice (like if SAML is not involved at all). A more scalable +-- solution would be to pass the versions that a test should be run on as an argument to +-- describe ('skipIdPAPIVersions' only works on individual leafs of the test tree, not on +-- sub-trees), but that would be slightly (only slightly) more involved than I would like. +-- so, some other time. (Context: `make -C services/spar i` takes currently takes 3m22.476s +-- on my laptop, including all the uninteresting tests. So this is the maximum time +-- improvement that we can get out of this.) skipIdPAPIVersions :: (MonadIO m, MonadReader TestEnv m) => [WireIdPAPIVersion] -> m () skipIdPAPIVersions skip = do asks (^. teWireIdPAPIVersion) >>= \vers -> when (vers `elem` skip) . liftIO $ do From 8c8eebd265dba105a2a12cc731e913a2503aa9a4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Thu, 16 Sep 2021 15:24:59 +0200 Subject: [PATCH 26/72] Servantify the DELETE /self endpoint (#1771) * Migrate Brig's `DELETE /self` endpoint to Servant * Change MultiVerb's AsUnion to avoid overlapping instances * Derive JSON instances from schema for the Timeout type Co-authored-by: Paolo Capriotti --- changelog.d/5-internal/delete-self-to-servant | 1 + libs/types-common/src/Data/Code.hs | 35 ++++++-------- .../wire-api/src/Wire/API/ErrorDescription.hs | 36 +++++++++++++++ .../wire-api/src/Wire/API/Routes/MultiVerb.hs | 3 +- .../src/Wire/API/Routes/Public/Brig.hs | 46 +++++++++++++++++++ libs/wire-api/src/Wire/API/User.hs | 14 ++++++ services/brig/src/Brig/API/Error.hs | 46 +++++++++---------- services/brig/src/Brig/API/Public.hs | 40 ++++------------ services/brig/src/Brig/Provider/API.hs | 12 ++--- 9 files changed, 150 insertions(+), 83 deletions(-) create mode 100644 changelog.d/5-internal/delete-self-to-servant diff --git a/changelog.d/5-internal/delete-self-to-servant b/changelog.d/5-internal/delete-self-to-servant new file mode 100644 index 00000000000..fc715936157 --- /dev/null +++ b/changelog.d/5-internal/delete-self-to-servant @@ -0,0 +1 @@ +Rewrite the DELETE /self endpoint to Servant diff --git a/libs/types-common/src/Data/Code.hs b/libs/types-common/src/Data/Code.hs index 8c9242a569e..2e831444ec2 100644 --- a/libs/types-common/src/Data/Code.hs +++ b/libs/types-common/src/Data/Code.hs @@ -26,7 +26,7 @@ module Data.Code where import Cassandra hiding (Value) -import Data.Aeson hiding (Value) +import qualified Data.Aeson as A import Data.Aeson.TH import Data.Bifunctor (Bifunctor (first)) import Data.ByteString.Conversion @@ -34,7 +34,6 @@ import Data.Json.Util import Data.Proxy (Proxy (Proxy)) import Data.Range import Data.Schema -import Data.Scientific (toBoundedInteger) import Data.String.Conversions (cs) import qualified Data.Swagger as S import Data.Swagger.ParamSchema @@ -50,8 +49,8 @@ import Test.QuickCheck (Arbitrary (arbitrary)) newtype Key = Key {asciiKey :: Range 20 20 AsciiBase64Url} deriving (Eq, Show) deriving newtype - ( FromJSON, - ToJSON, + ( A.FromJSON, + A.ToJSON, ToSchema, S.ToSchema, FromByteString, @@ -73,8 +72,8 @@ instance ToHttpApiData Key where newtype Value = Value {asciiValue :: Range 6 20 AsciiBase64Url} deriving (Eq, Show) deriving newtype - ( FromJSON, - ToJSON, + ( A.FromJSON, + A.ToJSON, ToSchema, S.ToSchema, FromByteString, @@ -92,29 +91,23 @@ instance FromHttpApiData Value where instance ToHttpApiData Value where toQueryParam key = cs (toByteString' key) +-- | A 'Timeout' is rendered in/parsed from JSON as an integer representing the +-- number of seconds remaining. newtype Timeout = Timeout {timeoutDiffTime :: NominalDiffTime} deriving (Eq, Show, Ord, Enum, Num, Fractional, Real, RealFrac) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema Timeout) + +instance ToSchema Timeout where + schema = Timeout . fromIntegral <$> (roundDiffTime . timeoutDiffTime) .= schema + where + roundDiffTime :: NominalDiffTime -> Int32 + roundDiffTime = round -- | A 'Timeout' is rendered as an integer representing the number of seconds remaining. instance ToByteString Timeout where builder (Timeout t) = builder (round t :: Int32) --- | A 'Timeout' is rendered in JSON as an integer representing the --- number of seconds remaining. -instance ToJSON Timeout where - toJSON (Timeout t) = toJSON (round t :: Int32) - --- | A 'Timeout' is parsed from JSON as an integer representing the --- number of seconds remaining. -instance FromJSON Timeout where - parseJSON = withScientific "Timeout" $ \n -> - let t = toBoundedInteger n :: Maybe Int32 - in maybe - (fail "Invalid timeout value") - (pure . Timeout . fromIntegral) - t - instance Arbitrary Timeout where arbitrary = Timeout . fromIntegral <$> arbitrary @Int diff --git a/libs/wire-api/src/Wire/API/ErrorDescription.hs b/libs/wire-api/src/Wire/API/ErrorDescription.hs index 7f58762ec40..a74daa75636 100644 --- a/libs/wire-api/src/Wire/API/ErrorDescription.hs +++ b/libs/wire-api/src/Wire/API/ErrorDescription.hs @@ -231,6 +231,15 @@ type InvalidUser = ErrorDescription 400 "invalid-user" "Invalid user." invalidUser :: InvalidUser invalidUser = mkErrorDescription +type InvalidCode = + ErrorDescription + 403 + "invalid-code" + "Invalid verification code" + +invalidCode :: InvalidCode +invalidCode = mkErrorDescription + type InvalidTransition = ErrorDescription 403 "bad-conn-update" "Invalid status transition." invalidTransition :: InvalidTransition @@ -304,6 +313,33 @@ type MissingAuth = missingAuthError :: MissingAuth missingAuthError = mkErrorDescription +type BadCredentials = + ErrorDescription + 403 + "invalid-credentials" + "Authentication failed." + +badCredentials :: BadCredentials +badCredentials = mkErrorDescription + +type DeleteCodePending = + ErrorDescription + 403 + "pending-delete" + "A verification code for account deletion is still pending." + +deleteCodePending :: DeleteCodePending +deleteCodePending = mkErrorDescription + +type OwnerDeletingSelf = + ErrorDescription + 403 + "no-self-delete-for-team-owner" + "Team owners are not allowed to delete themselves. Ask a fellow owner." + +ownerDeletingSelf :: OwnerDeletingSelf +ownerDeletingSelf = mkErrorDescription + type MalformedPrekeys = ErrorDescription 400 "bad-request" "Malformed prekeys uploaded" malformedPrekeys :: MalformedPrekeys diff --git a/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs b/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs index 1eb1d56fcf5..be89caee6c5 100644 --- a/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs +++ b/libs/wire-api/src/Wire/API/Routes/MultiVerb.hs @@ -516,9 +516,8 @@ instance -- "failure" case, normally represented by 'Nothing', corresponds to the /first/ -- response. instance - (ResponseType r2 ~ a) => AsUnion - '[RespondEmpty s1 desc1, r2] + '[RespondEmpty s1 desc1, Respond s2 desc2 a] (Maybe a) where toUnion Nothing = Z (I ()) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 47ebc4b7734..4cb4d0078ff 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DerivingVia #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- This file is part of the Wire Server implementation. -- @@ -19,6 +20,7 @@ module Wire.API.Routes.Public.Brig where +import Data.Code (Timeout) import Data.CommaSeparatedList (CommaSeparatedList) import Data.Domain import Data.Handle @@ -26,6 +28,7 @@ import Data.Id as Id import Data.Misc (IpAddr) import Data.Qualified (Qualified (..)) import Data.Range +import Data.SOP (I (..), NS (..)) import Data.Swagger hiding (Contact, Header) import Imports hiding (head) import Servant (JSON) @@ -65,6 +68,25 @@ type CaptureClientId name = Capture' '[Description "ClientId"] name ClientId type NewClientResponse = Headers '[Header "Location" ClientId] Client +type DeleteSelfResponses = + '[ RespondEmpty 200 "Deletion is initiated.", + RespondWithDeletionCodeTimeout + ] + +newtype RespondWithDeletionCodeTimeout + = RespondWithDeletionCodeTimeout + (Respond 202 "Deletion is pending verification with a code." DeletionCodeTimeout) + deriving (IsResponse '[JSON], IsSwaggerResponse) + +type instance ResponseType RespondWithDeletionCodeTimeout = DeletionCodeTimeout + +instance AsUnion DeleteSelfResponses (Maybe Timeout) where + toUnion (Just t) = S (Z (I (DeletionCodeTimeout t))) + toUnion Nothing = Z (I ()) + fromUnion (Z (I ())) = Nothing + fromUnion (S (Z (I (DeletionCodeTimeout t)))) = Just t + fromUnion (S (S x)) = case x of + type ConnectionUpdateResponses = UpdateResponses "Connection unchanged" "Connection updated" UserConnection data Api routes = Api @@ -90,6 +112,30 @@ data Api routes = Api :> ZUser :> "self" :> Get '[JSON] SelfProfile, + -- This endpoint can lead to the following events being sent: + -- - UserDeleted event to contacts of self + -- - MemberLeave event to members for all conversations the user was in (via galley) + deleteSelf :: + routes + -- TODO: Add custom AsUnion + :- Summary "Initiate account deletion." + :> Description + "if the account has a verified identity, a verification \ + \code is sent and needs to be confirmed to authorise the \ + \deletion. if the account has no verified identity but a \ + \password, it must be provided. if password is correct, or if neither \ + \a verified identity nor a password exists, account deletion \ + \is scheduled immediately." + :> CanThrow InvalidUser + :> CanThrow InvalidCode + :> CanThrow BadCredentials + :> CanThrow MissingAuth + :> CanThrow DeleteCodePending + :> CanThrow OwnerDeletingSelf + :> ZUser + :> "self" + :> ReqBody '[JSON] DeleteUser + :> MultiVerb 'DELETE '[JSON] DeleteSelfResponses (Maybe Timeout), getHandleInfoUnqualified :: routes :- Summary "(deprecated, use /search/contacts) Get information on a user handle" diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index ffef5aa6762..07ab1e05df6 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -978,6 +978,13 @@ newtype DeleteUser = DeleteUser } deriving stock (Eq, Show, Generic) deriving newtype (Arbitrary) + deriving (S.ToSchema) via (Schema DeleteUser) + +instance ToSchema DeleteUser where + schema = + object "DeleteUser" $ + DeleteUser + <$> deleteUserPassword .= opt (field "password" schema) mkDeleteUser :: Maybe PlainTextPassword -> DeleteUser mkDeleteUser = DeleteUser @@ -1036,6 +1043,13 @@ newtype DeletionCodeTimeout = DeletionCodeTimeout {fromDeletionCodeTimeout :: Code.Timeout} deriving stock (Eq, Show, Generic) deriving newtype (Arbitrary) + deriving (S.ToSchema) via (Schema DeletionCodeTimeout) + +instance ToSchema DeletionCodeTimeout where + schema = + object "DeletionCodeTimeout" $ + DeletionCodeTimeout + <$> fromDeletionCodeTimeout .= field "expires_in" schema instance ToJSON DeletionCodeTimeout where toJSON (DeletionCodeTimeout t) = A.object ["expires_in" A..= t] diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index 63f2bd5b68d..32e5b447d6c 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -37,16 +37,16 @@ import Network.HTTP.Types.Header import Network.HTTP.Types.Status import qualified Network.Wai.Utilities.Error as Wai import Servant.API.Status -import Wire.API.ErrorDescription +import qualified Wire.API.ErrorDescription as ErrDesc import Wire.API.Federation.Client (FederationError (..)) import Wire.API.Federation.Error errorDescriptionToWai :: forall (code :: Nat) (lbl :: Symbol) (desc :: Symbol). (KnownStatus code, KnownSymbol lbl) => - ErrorDescription code lbl desc -> + ErrDesc.ErrorDescription code lbl desc -> Wai.Error -errorDescriptionToWai (ErrorDescription msg) = +errorDescriptionToWai (ErrDesc.ErrorDescription msg) = Wai.mkError (statusVal (Proxy @code)) (LT.pack (symbolVal (Proxy @lbl))) @@ -72,7 +72,7 @@ throwRich e x h = throwError (RichError e x h) throwErrorDescription :: (KnownStatus code, KnownSymbol lbl, MonadError Error m) => - ErrorDescription code lbl desc -> + ErrDesc.ErrorDescription code lbl desc -> m a throwErrorDescription = throwStd . errorDescriptionToWai @@ -85,16 +85,16 @@ instance ToJSON Error where -- Error Mapping ---------------------------------------------------------- connError :: ConnectionError -> Error -connError TooManyConnections {} = StdError (errorDescriptionToWai connectionLimitReached) -connError InvalidTransition {} = StdError (errorDescriptionToWai invalidTransition) -connError NotConnected {} = StdError (errorDescriptionToWai notConnected) -connError InvalidUser {} = StdError (errorDescriptionToWai invalidUser) -connError ConnectNoIdentity {} = StdError (errorDescriptionToWai (noIdentity 0)) +connError TooManyConnections {} = StdError (errorDescriptionToWai ErrDesc.connectionLimitReached) +connError InvalidTransition {} = StdError (errorDescriptionToWai ErrDesc.invalidTransition) +connError NotConnected {} = StdError (errorDescriptionToWai ErrDesc.notConnected) +connError InvalidUser {} = StdError (errorDescriptionToWai ErrDesc.invalidUser) +connError ConnectNoIdentity {} = StdError (errorDescriptionToWai (ErrDesc.noIdentity 0)) connError (ConnectBlacklistedUserKey k) = StdError $ foldKey (const blacklistedEmail) (const blacklistedPhone) k connError (ConnectInvalidEmail _ _) = StdError invalidEmail connError ConnectInvalidPhone {} = StdError invalidPhone connError ConnectSameBindingTeamUsers = StdError sameBindingTeamUsers -connError ConnectMissingLegalholdConsent = StdError (errorDescriptionToWai missingLegalholdConsent) +connError ConnectMissingLegalholdConsent = StdError (errorDescriptionToWai ErrDesc.missingLegalholdConsent) actError :: ActivationError -> Error actError (UserKeyExists _) = StdError userKeyExists @@ -148,11 +148,11 @@ changePhoneError (BlacklistedNewPhone _) = StdError blacklistedPhone changePwError :: ChangePasswordError -> Error changePwError InvalidCurrentPassword = StdError badCredentials -changePwError ChangePasswordNoIdentity = StdError (errorDescriptionToWai (noIdentity 1)) +changePwError ChangePasswordNoIdentity = StdError (errorDescriptionToWai (ErrDesc.noIdentity 1)) changePwError ChangePasswordMustDiffer = StdError changePasswordMustDiffer changeHandleError :: ChangeHandleError -> Error -changeHandleError ChangeHandleNoIdentity = StdError (errorDescriptionToWai (noIdentity 2)) +changeHandleError ChangeHandleNoIdentity = StdError (errorDescriptionToWai (ErrDesc.noIdentity 2)) changeHandleError ChangeHandleExists = StdError handleExists changeHandleError ChangeHandleInvalid = StdError invalidHandle changeHandleError ChangeHandleManagedByScim = StdError $ propertyManagedByScim "handle" @@ -187,7 +187,7 @@ authError AuthEphemeral = StdError accountEphemeral authError AuthPendingInvitation = StdError accountPending reauthError :: ReAuthError -> Error -reauthError ReAuthMissingPassword = StdError (errorDescriptionToWai missingAuthError) +reauthError ReAuthMissingPassword = StdError (errorDescriptionToWai ErrDesc.missingAuthError) reauthError (ReAuthError e) = authError e zauthError :: ZAuth.Failure -> Error @@ -197,14 +197,14 @@ zauthError ZAuth.Invalid = StdError authTokenInvalid zauthError ZAuth.Unsupported = StdError authTokenUnsupported clientError :: ClientError -> Error -clientError ClientNotFound = StdError (errorDescriptionToWai clientNotFound) +clientError ClientNotFound = StdError (errorDescriptionToWai ErrDesc.clientNotFound) clientError (ClientDataError e) = clientDataError e -clientError (ClientUserNotFound _) = StdError (errorDescriptionToWai invalidUser) +clientError (ClientUserNotFound _) = StdError (errorDescriptionToWai ErrDesc.invalidUser) clientError ClientLegalHoldCannotBeRemoved = StdError can'tDeleteLegalHoldClient clientError ClientLegalHoldCannotBeAdded = StdError can'tAddLegalHoldClient clientError (ClientFederationError e) = fedError e clientError ClientCapabilitiesCannotBeRemoved = StdError clientCapabilitiesCannotBeRemoved -clientError ClientMissingLegalholdConsent = StdError (errorDescriptionToWai missingLegalholdConsent) +clientError ClientMissingLegalholdConsent = StdError (errorDescriptionToWai ErrDesc.missingLegalholdConsent) fedError :: FederationError -> Error fedError = StdError . federationErrorToWai @@ -212,22 +212,22 @@ fedError = StdError . federationErrorToWai idtError :: RemoveIdentityError -> Error idtError LastIdentity = StdError lastIdentity idtError NoPassword = StdError noPassword -idtError NoIdentity = StdError (errorDescriptionToWai (noIdentity 3)) +idtError NoIdentity = StdError (errorDescriptionToWai (ErrDesc.noIdentity 3)) propDataError :: PropertiesDataError -> Error propDataError TooManyProperties = StdError tooManyProperties clientDataError :: ClientDataError -> Error -clientDataError TooManyClients = StdError (errorDescriptionToWai tooManyClients) +clientDataError TooManyClients = StdError (errorDescriptionToWai ErrDesc.tooManyClients) clientDataError (ClientReAuthError e) = reauthError e -clientDataError ClientMissingAuth = StdError (errorDescriptionToWai missingAuthError) -clientDataError MalformedPrekeys = StdError (errorDescriptionToWai malformedPrekeys) +clientDataError ClientMissingAuth = StdError (errorDescriptionToWai ErrDesc.missingAuthError) +clientDataError MalformedPrekeys = StdError (errorDescriptionToWai ErrDesc.malformedPrekeys) deleteUserError :: DeleteUserError -> Error -deleteUserError DeleteUserInvalid = StdError (errorDescriptionToWai invalidUser) +deleteUserError DeleteUserInvalid = StdError (errorDescriptionToWai ErrDesc.invalidUser) deleteUserError DeleteUserInvalidCode = StdError invalidCode deleteUserError DeleteUserInvalidPassword = StdError badCredentials -deleteUserError DeleteUserMissingPassword = StdError (errorDescriptionToWai missingAuthError) +deleteUserError DeleteUserMissingPassword = StdError (errorDescriptionToWai ErrDesc.missingAuthError) deleteUserError (DeleteUserPendingCode t) = RichError deletionCodePending (DeletionCodeTimeout t) [] deleteUserError DeleteUserOwnerDeletingSelf = StdError ownerDeletingSelf @@ -241,7 +241,7 @@ phoneError (PhoneBudgetExhausted t) = RichError phoneBudgetExhausted (PhoneBudge updateProfileError :: UpdateProfileError -> Error updateProfileError DisplayNameManagedByScim = StdError (propertyManagedByScim "name") -updateProfileError (ProfileNotFound _) = StdError (errorDescriptionToWai userNotFound) +updateProfileError (ProfileNotFound _) = StdError (errorDescriptionToWai ErrDesc.userNotFound) -- WAI Errors ----------------------------------------------------------------- diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index e3a0fe11985..63d95bc657f 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -58,6 +58,7 @@ import Control.Monad.Catch (throwM) import Data.Aeson hiding (json) import Data.ByteString.Conversion import qualified Data.ByteString.Lazy as Lazy +import qualified Data.Code as Code import Data.CommaSeparatedList (CommaSeparatedList (fromCommaSeparatedList)) import Data.Containers.ListUtils (nubOrd) import Data.Domain @@ -92,7 +93,7 @@ import Servant.Swagger.UI import qualified System.Logger.Class as Log import Util.Logging (logFunction, logHandle, logTeam, logUser) import qualified Wire.API.Connection as Public -import Wire.API.ErrorDescription +import Wire.API.ErrorDescription hiding (badCredentials, invalidCode) import qualified Wire.API.Properties as Public import qualified Wire.API.Routes.Public.Brig as BrigAPI import qualified Wire.API.Routes.Public.Galley as GalleyAPI @@ -229,6 +230,7 @@ servantSitemap = { BrigAPI.getUserUnqualified = getUserUnqualifiedH, BrigAPI.getUserQualified = getUser, BrigAPI.getSelf = getSelf, + BrigAPI.deleteSelf = deleteUser, BrigAPI.getHandleInfoUnqualified = getHandleInfoUnqualifiedH, BrigAPI.getUserByHandleQualified = Handle.getHandleInfo, BrigAPI.listUsersByUnqualifiedIdsOrHandles = listUsersByUnqualifiedIdsOrHandles, @@ -411,29 +413,6 @@ sitemap = do Doc.response 200 "Email address removed." Doc.end Doc.errorResponse lastIdentity - -- This endpoint can lead to the following events being sent: - -- - UserDeleted event to contacts of self - -- - MemberLeave event to members for all conversations the user was in (via galley) - delete "/self" (continue deleteUserH) $ - zauthUserId - .&. jsonRequest @Public.DeleteUser - .&. accept "application" "json" - document "DELETE" "deleteUser" $ do - Doc.summary "Initiate account deletion." - Doc.notes - "If the account has a verified identity, a verification \ - \code is sent and needs to be confirmed to authorise the \ - \deletion. If the account has no verified identity but a \ - \password, it must be provided. If password is correct, or if neither \ - \a verified identity nor a password exists, account deletion \ - \is scheduled immediately." - Doc.body (Doc.ref Public.modelDelete) $ - Doc.description "JSON body" - Doc.response 202 "Deletion is pending verification with a code." Doc.end - Doc.response 200 "Deletion is initiated." Doc.end - Doc.errorResponse badCredentials - Doc.errorResponse (errorDescriptionToWai missingAuthError) - -- TODO put where? -- This endpoint can lead to the following events being sent: @@ -1113,13 +1092,12 @@ listConnections uid start msize = do getConnection :: UserId -> UserId -> Handler (Maybe Public.UserConnection) getConnection uid uid' = lift $ API.lookupConnection uid uid' -deleteUserH :: UserId ::: JsonRequest Public.DeleteUser ::: JSON -> Handler Response -deleteUserH (u ::: r ::: _) = do - body <- parseJsonBody r - res <- API.deleteUser u (Public.deleteUserPassword body) !>> deleteUserError - return $ case res of - Nothing -> setStatus status200 empty - Just ttl -> setStatus status202 (json (Public.DeletionCodeTimeout ttl)) +deleteUser :: + UserId -> + Public.DeleteUser -> + Handler (Maybe Code.Timeout) +deleteUser u body = + API.deleteUser u (Public.deleteUserPassword body) !>> deleteUserError verifyDeleteUserH :: JsonRequest Public.VerifyDeleteUser ::: JSON -> Handler Response verifyDeleteUserH (r ::: _) = do diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index ad2513d5710..326a4f41e43 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -96,7 +96,7 @@ import qualified Ssl.Util as SSL import UnliftIO.Async (pooledMapConcurrentlyN_) import qualified Web.Cookie as Cookie import qualified Wire.API.Conversation.Bot as Public -import Wire.API.ErrorDescription +import qualified Wire.API.ErrorDescription as ErrDesc import qualified Wire.API.Event.Conversation as Public (Event) import qualified Wire.API.Provider as Public import qualified Wire.API.Provider.Bot as Public (BotUserView) @@ -907,11 +907,11 @@ botGetSelfH bot = json <$> botGetSelf bot botGetSelf :: BotId -> Handler Public.UserProfile botGetSelf bot = do p <- lift $ User.lookupUser NoPendingInvitations (botUserId bot) - maybe (throwErrorDescription userNotFound) (return . (`Public.publicProfile` UserLegalHoldNoConsent)) p + maybe (throwErrorDescription ErrDesc.userNotFound) (return . (`Public.publicProfile` UserLegalHoldNoConsent)) p botGetClientH :: BotId -> Handler Response botGetClientH bot = do - maybe (throwErrorDescription clientNotFound) (pure . json) =<< lift (botGetClient bot) + maybe (throwErrorDescription ErrDesc.clientNotFound) (pure . json) =<< lift (botGetClient bot) botGetClient :: BotId -> AppIO (Maybe Public.Client) botGetClient bot = do @@ -936,7 +936,7 @@ botUpdatePrekeys :: BotId -> Public.UpdateBotPrekeys -> Handler () botUpdatePrekeys bot upd = do clt <- lift $ listToMaybe <$> User.lookupClients (botUserId bot) case clt of - Nothing -> throwErrorDescription clientNotFound + Nothing -> throwErrorDescription ErrDesc.clientNotFound Just c -> do let pks = updateBotPrekeyList upd User.updatePrekeys (botUserId bot) (clientId c) pks !>> clientDataError @@ -949,7 +949,7 @@ botClaimUsersPrekeys :: Public.UserClients -> Handler Public.UserClientPrekeyMap botClaimUsersPrekeys body = do maxSize <- fromIntegral . setMaxConvSize <$> view settings when (Map.size (Public.userClients body) > maxSize) $ - throwErrorDescription tooManyClients + throwErrorDescription ErrDesc.tooManyClients Client.claimLocalMultiPrekeyBundles UnprotectedBot body !>> clientError botListUserProfilesH :: List UserId -> Handler Response @@ -1086,7 +1086,7 @@ maybeInvalidBot :: Maybe a -> Handler a maybeInvalidBot = maybe (throwStd invalidBot) return maybeInvalidUser :: Maybe a -> Handler a -maybeInvalidUser = maybe (throwStd (errorDescriptionToWai invalidUser)) return +maybeInvalidUser = maybe (throwStd (errorDescriptionToWai ErrDesc.invalidUser)) return rangeChecked :: Within a n m => a -> Handler (Range n m a) rangeChecked = either (throwStd . invalidRange . fromString) return . checkedEither From 133b2ac48c359690391211acc74d01120132e4b2 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 16 Sep 2021 15:57:40 +0200 Subject: [PATCH 27/72] Fix conversation generator in mapping test (#1778) The `ConvWithLocalUser` and `ConvWithRemoteUser` generators were potentially duplicating members. This makes sure that the member added by the generator was not already present. --- changelog.d/5-internal/fix-conv-generator | 1 + services/galley/test/unit/Test/Galley/Mapping.hs | 12 ++++++++++-- 2 files changed, 11 insertions(+), 2 deletions(-) create mode 100644 changelog.d/5-internal/fix-conv-generator diff --git a/changelog.d/5-internal/fix-conv-generator b/changelog.d/5-internal/fix-conv-generator new file mode 100644 index 00000000000..9cbc05efcb6 --- /dev/null +++ b/changelog.d/5-internal/fix-conv-generator @@ -0,0 +1 @@ +Fix conversation generator in mapping test diff --git a/services/galley/test/unit/Test/Galley/Mapping.hs b/services/galley/test/unit/Test/Galley/Mapping.hs index f48ac6d312b..52807d670c6 100644 --- a/services/galley/test/unit/Test/Galley/Mapping.hs +++ b/services/galley/test/unit/Test/Galley/Mapping.hs @@ -147,7 +147,11 @@ instance Arbitrary ConvWithLocalUser where arbitrary = do RandomConversation conv <- arbitrary member <- genLocalMember - let conv' = conv {Data.convLocalMembers = member : Data.convLocalMembers conv} + let conv' + | lmId member `elem` map lmId (Data.convLocalMembers conv) = + conv + | otherwise = + conv {Data.convLocalMembers = member : Data.convLocalMembers conv} pure $ ConvWithLocalUser conv' (lmId member) data ConvWithRemoteUser = ConvWithRemoteUser Data.Conversation (Remote UserId) @@ -157,5 +161,9 @@ instance Arbitrary ConvWithRemoteUser where arbitrary = do RandomConversation conv <- arbitrary member <- genRemoteMember - let conv' = conv {Data.convRemoteMembers = member : Data.convRemoteMembers conv} + let conv' + | rmId member `elem` map rmId (Data.convRemoteMembers conv) = + conv + | otherwise = + conv {Data.convRemoteMembers = member : Data.convRemoteMembers conv} pure $ ConvWithRemoteUser conv' (rmId member) From 1178f984377a90fca42dc86a624f9dcc00699452 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Thu, 16 Sep 2021 18:10:50 +0200 Subject: [PATCH 28/72] Servantify Galley's DELETE /i/user endpoint (#1772) * Define a type for an optional Servant modifier for connection IDs * Move the `DELETE /i/user` Galley endpoint to Servant --- .../5-internal/servantify-delete-i-user | 1 + libs/wire-api/src/Wire/API/Routes/Public.hs | 4 ++- services/galley/src/Galley/API/Internal.hs | 27 +++++++++++-------- 3 files changed, 20 insertions(+), 12 deletions(-) create mode 100644 changelog.d/5-internal/servantify-delete-i-user diff --git a/changelog.d/5-internal/servantify-delete-i-user b/changelog.d/5-internal/servantify-delete-i-user new file mode 100644 index 00000000000..4749699e651 --- /dev/null +++ b/changelog.d/5-internal/servantify-delete-i-user @@ -0,0 +1 @@ +Servantify Galley's DELETE /i/user endpoint diff --git a/libs/wire-api/src/Wire/API/Routes/Public.hs b/libs/wire-api/src/Wire/API/Routes/Public.hs index c893f0b0bb3..9dcf9066518 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public.hs @@ -59,7 +59,9 @@ type ZUser = ZAuthServant 'ZAuthUser InternalAuthDefOpts type ZConn = ZAuthServant 'ZAuthConn InternalAuthDefOpts -type ZOptUser = ZAuthServant 'ZAuthUser '[Servant.Strict] +type ZOptUser = ZAuthServant 'ZAuthUser '[Servant.Optional, Servant.Strict] + +type ZOptConn = ZAuthServant 'ZAuthConn '[Servant.Optional, Servant.Strict] instance HasSwagger api => HasSwagger (ZAuthServant 'ZAuthUser _opts :> api) where toSwagger _ = diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index f78cdbfc294..9711ee9cc82 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -73,6 +73,8 @@ import Servant.Server import Servant.Server.Generic (genericServerT) import System.Logger.Class hiding (Path, name) import Wire.API.ErrorDescription (missingLegalholdConsent) +import Wire.API.Routes.MultiVerb (MultiVerb, RespondEmpty) +import Wire.API.Routes.Public (ZOptConn, ZUser) import qualified Wire.API.Team.Feature as Public data InternalApi routes = InternalApi @@ -158,7 +160,18 @@ data InternalApi routes = InternalApi :- IFeatureStatusPut 'Public.TeamFeatureConferenceCalling, iTeamFeatureStatusConferenceCallingGet :: routes - :- IFeatureStatusGet 'Public.TeamFeatureConferenceCalling + :- IFeatureStatusGet 'Public.TeamFeatureConferenceCalling, + -- This endpoint can lead to the following events being sent: + -- - MemberLeave event to members for all conversations the user was in + iDeleteUser :: + routes + :- Summary + "Remove a user from their teams and conversations and erase their clients" + :> ZUser + :> ZOptConn + :> "i" + :> "user" + :> MultiVerb 'DELETE '[Servant.JSON] '[RespondEmpty 200 "Remove a user from Galley"] () } deriving (Generic) @@ -232,7 +245,8 @@ servantSitemap = iTeamFeatureStatusFileSharingPut = iPutTeamFeature @'Public.TeamFeatureFileSharing Features.setFileSharingInternal, iTeamFeatureStatusClassifiedDomainsGet = iGetTeamFeature @'Public.TeamFeatureClassifiedDomains Features.getClassifiedDomainsInternal, iTeamFeatureStatusConferenceCallingPut = iPutTeamFeature @'Public.TeamFeatureConferenceCalling Features.setConferenceCallingInternal, - iTeamFeatureStatusConferenceCallingGet = iGetTeamFeature @'Public.TeamFeatureConferenceCalling Features.getConferenceCallingInternal + iTeamFeatureStatusConferenceCallingGet = iGetTeamFeature @'Public.TeamFeatureConferenceCalling Features.getConferenceCallingInternal, + iDeleteUser = rmUser } iGetTeamFeature :: @@ -372,11 +386,6 @@ sitemap = do zauthUserId .&. capture "client" - -- This endpoint can lead to the following events being sent: - -- - MemberLeave event to members for all conversations the user was in - delete "/i/user" (continue rmUserH) $ - zauthUserId .&. opt zauthConnId - post "/i/services" (continue Update.addServiceH) $ jsonRequest @Service @@ -427,10 +436,6 @@ sitemap = do get "/i/legalhold/whitelisted-teams/:tid" (continue getTeamLegalholdWhitelistedH) $ capture "tid" -rmUserH :: UserId ::: Maybe ConnId -> Galley Response -rmUserH (user ::: conn) = do - empty <$ rmUser user conn - rmUser :: UserId -> Maybe ConnId -> Galley () rmUser user conn = do let n = unsafeRange 100 :: Range 1 100 Int32 From 0df39af5f5b4a2a07dfb1a553e3972ec39c425f6 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 17 Sep 2021 10:03:55 +0200 Subject: [PATCH 29/72] Expand documentation of `list-ids` endpoint (#1779) --- changelog.d/4-docs/list-ids | 1 + libs/wire-api/src/Wire/API/Routes/Public/Galley.hs | 12 +++++++++++- 2 files changed, 12 insertions(+), 1 deletion(-) create mode 100644 changelog.d/4-docs/list-ids diff --git a/changelog.d/4-docs/list-ids b/changelog.d/4-docs/list-ids new file mode 100644 index 00000000000..bfaf84fc366 --- /dev/null +++ b/changelog.d/4-docs/list-ids @@ -0,0 +1 @@ +Expand documentation of `conversations/list-ids` endpoint 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 fab65f297a4..63621c8d7bf 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -122,7 +122,17 @@ data Api routes = Api listConversationIds :: routes :- Summary "Get all conversation IDs." - :> Description "To retrieve the next page, a client must pass the paging_state returned by the previous page." + :> Description + "The IDs returned by this endpoint are paginated. To\ + \ get the first page, make a call with the `paging_state` field set to\ + \ `null` (or omitted). Whenever the `has_more` field of the response is\ + \ set to `true`, more results are available, and they can be obtained\ + \ by calling the endpoint again, but this time passing the value of\ + \ `paging_state` returned by the previous call. One can continue in\ + \ this fashion until all results are returned, which is indicated by\ + \ `has_more` being `false`. Note that `paging_state` should be\ + \ considered an opaque token. It should not be inspected, or stored, or\ + \ reused across multiple unrelated invokations of the endpoint." :> ZUser :> "conversations" :> "list-ids" From 863ec7f09710e32c548fdcbde9b41eeb24fc4646 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Fri, 17 Sep 2021 12:50:49 +0200 Subject: [PATCH 30/72] Testing: Rewrite Conversation Generators in an Applicative Style (#1782) * Rewrite conversation generators in an applicative style --- .../5-internal/applicative-style-generators | 1 + .../galley/test/unit/Test/Galley/Mapping.hs | 45 +++++++++---------- 2 files changed, 21 insertions(+), 25 deletions(-) create mode 100644 changelog.d/5-internal/applicative-style-generators diff --git a/changelog.d/5-internal/applicative-style-generators b/changelog.d/5-internal/applicative-style-generators new file mode 100644 index 00000000000..d9d4c5a4346 --- /dev/null +++ b/changelog.d/5-internal/applicative-style-generators @@ -0,0 +1 @@ +Testing: rewrite monadic to applicative style generators diff --git a/services/galley/test/unit/Test/Galley/Mapping.hs b/services/galley/test/unit/Test/Galley/Mapping.hs index 52807d670c6..f1c8b23780f 100644 --- a/services/galley/test/unit/Test/Galley/Mapping.hs +++ b/services/galley/test/unit/Test/Galley/Mapping.hs @@ -20,6 +20,7 @@ module Test.Galley.Mapping where +import Data.Containers.ListUtils (nubOrdOn) import Data.Domain import Data.Id import Data.Qualified @@ -30,7 +31,6 @@ import Galley.Types.Conversations.Members import Imports import Test.Tasty import Test.Tasty.QuickCheck --- import Test.Tasty.HUnit import Wire.API.Conversation import Wire.API.Conversation.Role import Wire.API.Federation.API.Galley @@ -114,8 +114,8 @@ genLocalMember = genRemoteMember :: Gen RemoteMember genRemoteMember = RemoteMember <$> arbitrary <*> pure roleNameWireMember -genConversation :: [LocalMember] -> [RemoteMember] -> Gen Data.Conversation -genConversation locals remotes = +genConversation :: Gen Data.Conversation +genConversation = Data.Conversation <$> arbitrary <*> pure RegularConv @@ -123,47 +123,42 @@ genConversation locals remotes = <*> arbitrary <*> pure [] <*> pure ActivatedAccessRole - <*> pure locals - <*> pure remotes + <*> listOf genLocalMember + <*> listOf genRemoteMember <*> pure Nothing <*> pure (Just False) <*> pure Nothing <*> pure Nothing -newtype RandomConversation = RandomConversation Data.Conversation +newtype RandomConversation = RandomConversation + {unRandomConversation :: Data.Conversation} deriving (Show) instance Arbitrary RandomConversation where - arbitrary = - RandomConversation <$> do - locals <- listOf genLocalMember - remotes <- listOf genRemoteMember - genConversation locals remotes + arbitrary = RandomConversation <$> genConversation data ConvWithLocalUser = ConvWithLocalUser Data.Conversation UserId deriving (Show) instance Arbitrary ConvWithLocalUser where arbitrary = do - RandomConversation conv <- arbitrary member <- genLocalMember - let conv' - | lmId member `elem` map lmId (Data.convLocalMembers conv) = - conv - | otherwise = - conv {Data.convLocalMembers = member : Data.convLocalMembers conv} - pure $ ConvWithLocalUser conv' (lmId member) + ConvWithLocalUser <$> genConv member <*> pure (lmId member) + where + genConv m = uniqueMembers m . unRandomConversation <$> arbitrary + uniqueMembers :: LocalMember -> Data.Conversation -> Data.Conversation + uniqueMembers m c = + c {Data.convLocalMembers = nubOrdOn lmId (m : Data.convLocalMembers c)} data ConvWithRemoteUser = ConvWithRemoteUser Data.Conversation (Remote UserId) deriving (Show) instance Arbitrary ConvWithRemoteUser where arbitrary = do - RandomConversation conv <- arbitrary member <- genRemoteMember - let conv' - | rmId member `elem` map rmId (Data.convRemoteMembers conv) = - conv - | otherwise = - conv {Data.convRemoteMembers = member : Data.convRemoteMembers conv} - pure $ ConvWithRemoteUser conv' (rmId member) + ConvWithRemoteUser <$> genConv member <*> pure (rmId member) + where + genConv m = uniqueMembers m . unRandomConversation <$> arbitrary + uniqueMembers :: RemoteMember -> Data.Conversation -> Data.Conversation + uniqueMembers m c = + c {Data.convRemoteMembers = nubOrdOn rmId (m : Data.convRemoteMembers c)} From 36f51b59914c0112b1181199534048c22f37f59e Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Fri, 17 Sep 2021 17:45:19 +0200 Subject: [PATCH 31/72] Add polysemy to spar; promote the SAMLUser CRUD interface to an effect --- changelog.d/5-internal/raw-effect-row | 1 + services/spar/package.yaml | 2 + services/spar/spar.cabal | 16 +- services/spar/src/Spar/API.hs | 70 ++++---- services/spar/src/Spar/App.hs | 150 +++++++++++------- services/spar/src/Spar/Scim.hs | 66 ++++---- services/spar/src/Spar/Scim/Auth.hs | 14 +- services/spar/src/Spar/Scim/User.hs | 64 ++++---- services/spar/src/Spar/Sem/SAMLUser.hs | 17 ++ .../spar/src/Spar/Sem/SAMLUser/Cassandra.hs | 28 ++++ services/spar/test-integration/Util/Core.hs | 7 +- 11 files changed, 271 insertions(+), 164 deletions(-) create mode 100644 changelog.d/5-internal/raw-effect-row create mode 100644 services/spar/src/Spar/Sem/SAMLUser.hs create mode 100644 services/spar/src/Spar/Sem/SAMLUser/Cassandra.hs diff --git a/changelog.d/5-internal/raw-effect-row b/changelog.d/5-internal/raw-effect-row new file mode 100644 index 00000000000..4222e97f7d8 --- /dev/null +++ b/changelog.d/5-internal/raw-effect-row @@ -0,0 +1 @@ +Add polysemy to spar; promote the SAMLUser CRUD interface to an effect diff --git a/services/spar/package.yaml b/services/spar/package.yaml index 74ca416b2cc..312376a6ae5 100644 --- a/services/spar/package.yaml +++ b/services/spar/package.yaml @@ -52,6 +52,8 @@ dependencies: - mtl - network-uri - optparse-applicative + - polysemy + - polysemy-plugin - raw-strings-qq - retry - saml2-web-sso >= 0.18 diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index ec6623400fb..6dc4680d412 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 6a8deefc6739b8a56d89eae84bd4333254d31f2b1bf1ab22b830d7d120992bbf +-- hash: 2cfc4799f7bb3c53ef52f608770146174871fda0b611e679cb5e0747eca566dc name: spar version: 0.1 @@ -34,6 +34,8 @@ library Spar.Scim.Auth Spar.Scim.Types Spar.Scim.User + Spar.Sem.SAMLUser + Spar.Sem.SAMLUser.Cassandra other-modules: Paths_spar hs-source-dirs: @@ -76,6 +78,8 @@ library , mtl , network-uri , optparse-applicative + , polysemy + , polysemy-plugin , raw-strings-qq , retry , saml2-web-sso >=0.18 @@ -147,6 +151,8 @@ executable spar , mtl , network-uri , optparse-applicative + , polysemy + , polysemy-plugin , raw-strings-qq , retry , saml2-web-sso >=0.18 @@ -241,6 +247,8 @@ executable spar-integration , mtl , network-uri , optparse-applicative + , polysemy + , polysemy-plugin , random , raw-strings-qq , retry @@ -326,6 +334,8 @@ executable spar-migrate-data , mtl , network-uri , optparse-applicative + , polysemy + , polysemy-plugin , raw-strings-qq , retry , saml2-web-sso >=0.18 @@ -414,6 +424,8 @@ executable spar-schema , mtl , network-uri , optparse-applicative + , polysemy + , polysemy-plugin , raw-strings-qq , retry , saml2-web-sso >=0.18 @@ -499,6 +511,8 @@ test-suite spec , mtl , network-uri , optparse-applicative + , polysemy + , polysemy-plugin , raw-strings-qq , retry , saml2-web-sso >=0.18 diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 19969954c5c..022716edaef 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -53,6 +53,7 @@ import Data.Time import Galley.Types.Teams (HiddenPerm (CreateUpdateDeleteIdp, ReadIdp)) import Imports import OpenSSL.Random (randBytes) +import Polysemy import qualified SAML2.WebSSO as SAML import Servant import qualified Servant.Multipart as Multipart @@ -63,6 +64,7 @@ import qualified Spar.Intra.Brig as Brig import qualified Spar.Intra.Galley as Galley import Spar.Orphans () import Spar.Scim +import Spar.Sem.SAMLUser (SAMLUser) import qualified URI.ByteString as URI import Wire.API.Cookie import Wire.API.Routes.Public.Spar @@ -72,9 +74,9 @@ import Wire.API.User.Saml app :: Env -> Application app ctx = SAML.setHttpCachePolicy $ - serve (Proxy @API) (hoistServer (Proxy @API) (SAML.nt @SparError @Spar ctx) (api $ sparCtxOpts ctx) :: Server API) + serve (Proxy @API) (hoistServer (Proxy @API) (SAML.nt @SparError @(Spar _) ctx) (api $ sparCtxOpts ctx) :: Server API) -api :: Opts -> ServerT API Spar +api :: Member SAMLUser r => Opts -> ServerT API (Spar r) api opts = apiSSO opts :<|> authreqPrecheck @@ -83,7 +85,7 @@ api opts = :<|> apiScim :<|> apiINTERNAL -apiSSO :: Opts -> ServerT APISSO Spar +apiSSO :: Member SAMLUser r => Opts -> ServerT APISSO (Spar r) apiSSO opts = SAML.meta appName (sparSPIssuer Nothing) (sparResponseURI Nothing) :<|> (\tid -> SAML.meta appName (sparSPIssuer (Just tid)) (sparResponseURI (Just tid))) @@ -93,7 +95,7 @@ apiSSO opts = :<|> authresp . Just :<|> ssoSettings -apiIDP :: ServerT APIIDP Spar +apiIDP :: ServerT APIIDP (Spar r) apiIDP = idpGet :<|> idpGetRaw @@ -102,7 +104,7 @@ apiIDP = :<|> idpUpdate :<|> idpDelete -apiINTERNAL :: ServerT APIINTERNAL Spar +apiINTERNAL :: ServerT APIINTERNAL (Spar r) apiINTERNAL = internalStatus :<|> internalDeleteTeam @@ -114,7 +116,7 @@ appName = "spar" ---------------------------------------------------------------------------- -- SSO API -authreqPrecheck :: Maybe URI.URI -> Maybe URI.URI -> SAML.IdPId -> Spar NoContent +authreqPrecheck :: Maybe URI.URI -> Maybe URI.URI -> SAML.IdPId -> Spar r NoContent authreqPrecheck msucc merr idpid = validateAuthreqParams msucc merr *> SAML.getIdPConfig idpid @@ -127,7 +129,7 @@ authreq :: Maybe URI.URI -> Maybe URI.URI -> SAML.IdPId -> - Spar (WithSetBindCookie (SAML.FormRedirect SAML.AuthnRequest)) + Spar r (WithSetBindCookie (SAML.FormRedirect SAML.AuthnRequest)) authreq _ DoInitiateLogin (Just _) _ _ _ = throwSpar SparInitLoginWithAuth authreq _ DoInitiateBind Nothing _ _ _ = throwSpar SparInitBindWithoutAuth authreq authreqttl _ zusr msucc merr idpid = do @@ -147,7 +149,7 @@ authreq authreqttl _ zusr msucc merr idpid = do -- | If the user is already authenticated, create bind cookie with a given life expectancy and our -- domain, and store it in C*. If the user is not authenticated, return a deletion 'SetCookie' -- value that deletes any bind cookies on the client. -initializeBindCookie :: Maybe UserId -> NominalDiffTime -> Spar SetBindCookie +initializeBindCookie :: Maybe UserId -> NominalDiffTime -> Spar r SetBindCookie initializeBindCookie zusr authreqttl = do DerivedOpts {derivedOptsBindCookiePath} <- asks (derivedOpts . sparCtxOpts) msecret <- @@ -161,7 +163,7 @@ initializeBindCookie zusr authreqttl = do redirectURLMaxLength :: Int redirectURLMaxLength = 140 -validateAuthreqParams :: Maybe URI.URI -> Maybe URI.URI -> Spar VerdictFormat +validateAuthreqParams :: Maybe URI.URI -> Maybe URI.URI -> Spar r VerdictFormat validateAuthreqParams msucc merr = case (msucc, merr) of (Nothing, Nothing) -> pure VerdictFormatWeb (Just ok, Just err) -> do @@ -169,25 +171,25 @@ validateAuthreqParams msucc merr = case (msucc, merr) of pure $ VerdictFormatMobile ok err _ -> throwSpar $ SparBadInitiateLoginQueryParams "need-both-redirect-urls" -validateRedirectURL :: URI.URI -> Spar () +validateRedirectURL :: URI.URI -> Spar r () validateRedirectURL uri = do unless ((SBS.take 4 . URI.schemeBS . URI.uriScheme $ uri) == "wire") $ do throwSpar $ SparBadInitiateLoginQueryParams "invalid-schema" unless ((SBS.length $ URI.serializeURIRef' uri) <= redirectURLMaxLength) $ do throwSpar $ SparBadInitiateLoginQueryParams "url-too-long" -authresp :: Maybe TeamId -> Maybe ST -> SAML.AuthnResponseBody -> Spar Void +authresp :: forall r. Member SAMLUser r => Maybe TeamId -> Maybe ST -> SAML.AuthnResponseBody -> Spar r Void authresp mbtid ckyraw arbody = logErrors $ SAML.authresp mbtid (sparSPIssuer mbtid) (sparResponseURI mbtid) go arbody where cky :: Maybe BindCookie cky = ckyraw >>= bindCookieFromHeader - go :: SAML.AuthnResponse -> SAML.AccessVerdict -> Spar Void + go :: SAML.AuthnResponse -> SAML.AccessVerdict -> Spar r Void go resp verdict = do result :: SAML.ResponseVerdict <- verdictHandler cky mbtid resp verdict throwError $ SAML.CustomServant result - logErrors :: Spar Void -> Spar Void + logErrors :: Spar r Void -> Spar r Void logErrors = flip catchError $ \case e@(SAML.CustomServant _) -> throwError e e -> do @@ -197,20 +199,20 @@ authresp mbtid ckyraw arbody = logErrors $ SAML.authresp mbtid (sparSPIssuer mbt (Multipart.inputs (SAML.authnResponseBodyRaw arbody)) ckyraw -ssoSettings :: Spar SsoSettings +ssoSettings :: Spar r SsoSettings ssoSettings = do SsoSettings <$> wrapMonadClient Data.getDefaultSsoCode ---------------------------------------------------------------------------- -- IdP API -idpGet :: Maybe UserId -> SAML.IdPId -> Spar IdP +idpGet :: Maybe UserId -> SAML.IdPId -> Spar r IdP idpGet zusr idpid = withDebugLog "idpGet" (Just . show . (^. SAML.idpId)) $ do idp <- SAML.getIdPConfig idpid _ <- authorizeIdP zusr idp pure idp -idpGetRaw :: Maybe UserId -> SAML.IdPId -> Spar RawIdPMetadata +idpGetRaw :: Maybe UserId -> SAML.IdPId -> Spar r RawIdPMetadata idpGetRaw zusr idpid = do idp <- SAML.getIdPConfig idpid _ <- authorizeIdP zusr idp @@ -218,7 +220,7 @@ idpGetRaw zusr idpid = do Just txt -> pure $ RawIdPMetadata txt Nothing -> throwSpar $ SparIdPNotFound (cs $ show idpid) -idpGetAll :: Maybe UserId -> Spar IdPList +idpGetAll :: Maybe UserId -> Spar r IdPList idpGetAll zusr = withDebugLog "idpGetAll" (const Nothing) $ do teamid <- Brig.getZUsrCheckPerm zusr ReadIdp _idplProviders <- wrapMonadClientWithEnv $ Data.getIdPConfigsByTeam teamid @@ -232,7 +234,7 @@ idpGetAll zusr = withDebugLog "idpGetAll" (const Nothing) $ do -- matter what the team size, it shouldn't choke any servers, just the client (which is -- probably curl running locally on one of the spar instances). -- https://github.com/zinfra/backend-issues/issues/1314 -idpDelete :: Maybe UserId -> SAML.IdPId -> Maybe Bool -> Spar NoContent +idpDelete :: Maybe UserId -> SAML.IdPId -> Maybe Bool -> Spar r NoContent idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (const Nothing) $ do idp <- SAML.getIdPConfig idpid _ <- authorizeIdP zusr idp @@ -240,7 +242,7 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons team = idp ^. SAML.idpExtraInfo . wiTeam -- if idp is not empty: fail or purge idpIsEmpty <- wrapMonadClient $ isNothing <$> Data.getSAMLAnyUserByIssuer issuer - let doPurge :: Spar () + let doPurge :: Spar r () doPurge = do some <- wrapMonadClient (Data.getSAMLSomeUsersByIssuer issuer) forM_ some $ \(uref, uid) -> do @@ -265,7 +267,7 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons Data.deleteIdPRawMetadata idpid return NoContent where - updateOldIssuers :: IdP -> Spar () + updateOldIssuers :: IdP -> Spar r () updateOldIssuers _ = pure () -- we *could* update @idp ^. SAML.idpExtraInfo . wiReplacedBy@ to not keep the idp about -- to be deleted in its old issuers list, but it's tricky to avoid race conditions, and @@ -274,7 +276,7 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons -- won't find any users to migrate. still, doesn't hurt mucht to look either. so we -- leave old issuers dangling for now. - updateReplacingIdP :: IdP -> Spar () + updateReplacingIdP :: IdP -> Spar r () updateReplacingIdP idp = forM_ (idp ^. SAML.idpExtraInfo . wiOldIssuers) $ \oldIssuer -> do wrapMonadClient $ do Data.getIdPIdByIssuer oldIssuer (idp ^. SAML.idpExtraInfo . wiTeam) >>= \case @@ -286,11 +288,11 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons -- | This handler only does the json parsing, and leaves all authorization checks and -- application logic to 'idpCreateXML'. -idpCreate :: Maybe UserId -> IdPMetadataInfo -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Spar IdP +idpCreate :: Maybe UserId -> IdPMetadataInfo -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Spar r IdP idpCreate zusr (IdPMetadataValue raw xml) midpid apiversion = idpCreateXML zusr raw xml midpid apiversion -- | We generate a new UUID for each IdP used as IdPConfig's path, thereby ensuring uniqueness. -idpCreateXML :: Maybe UserId -> Text -> SAML.IdPMetadata -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Spar IdP +idpCreateXML :: Maybe UserId -> Text -> SAML.IdPMetadata -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Spar r IdP idpCreateXML zusr raw idpmeta mReplaces (fromMaybe defWireIdPAPIVersion -> apiversion) = withDebugLog "idpCreate" (Just . show . (^. SAML.idpId)) $ do teamid <- Brig.getZUsrCheckPerm zusr CreateUpdateDeleteIdp Galley.assertSSOEnabled teamid @@ -306,7 +308,7 @@ idpCreateXML zusr raw idpmeta mReplaces (fromMaybe defWireIdPAPIVersion -> apive -- data contains no information about the idp issuer, only the user name, so no valid saml -- credentials can be created. To fix this, we need to implement a way to associate scim -- tokens with IdPs. https://wearezeta.atlassian.net/browse/SQSERVICES-165 -assertNoScimOrNoIdP :: TeamId -> Spar () +assertNoScimOrNoIdP :: TeamId -> Spar r () assertNoScimOrNoIdP teamid = do numTokens <- length <$> wrapMonadClient (Data.getScimTokens teamid) numIdps <- length <$> wrapMonadClientWithEnv (Data.getIdPConfigsByTeam teamid) @@ -336,8 +338,8 @@ assertNoScimOrNoIdP teamid = do -- FUTUREWORK: move this to the saml2-web-sso package. (same probably goes for get, create, -- update, delete of idps.) validateNewIdP :: - forall m. - (HasCallStack, m ~ Spar) => + forall m r. + (HasCallStack, m ~ Spar r) => WireIdPAPIVersion -> SAML.IdPMetadata -> TeamId -> @@ -383,10 +385,10 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces = withDebugLog "validate -- | FUTUREWORK: 'idpUpdateXML' is only factored out of this function for symmetry with -- 'idpCreate', which is not a good reason. make this one function and pass around -- 'IdPMetadataInfo' directly where convenient. -idpUpdate :: Maybe UserId -> IdPMetadataInfo -> SAML.IdPId -> Spar IdP +idpUpdate :: Maybe UserId -> IdPMetadataInfo -> SAML.IdPId -> Spar r IdP idpUpdate zusr (IdPMetadataValue raw xml) idpid = idpUpdateXML zusr raw xml idpid -idpUpdateXML :: Maybe UserId -> Text -> SAML.IdPMetadata -> SAML.IdPId -> Spar IdP +idpUpdateXML :: Maybe UserId -> Text -> SAML.IdPMetadata -> SAML.IdPId -> Spar r IdP idpUpdateXML zusr raw idpmeta idpid = withDebugLog "idpUpdate" (Just . show . (^. SAML.idpId)) $ do (teamid, idp) <- validateIdPUpdate zusr idpmeta idpid Galley.assertSSOEnabled teamid @@ -402,8 +404,8 @@ idpUpdateXML zusr raw idpmeta idpid = withDebugLog "idpUpdate" (Just . show . (^ -- an earlier IdP under the same ID); request uri is https. Keep track of old issuer in extra -- info if issuer has changed. validateIdPUpdate :: - forall m. - (HasCallStack, m ~ Spar) => + forall m r. + (HasCallStack, m ~ Spar r) => Maybe UserId -> SAML.IdPMetadata -> SAML.IdPId -> @@ -461,7 +463,7 @@ authorizeIdP (Just zusr) idp = do Galley.assertHasPermission teamid CreateUpdateDeleteIdp zusr pure teamid -enforceHttps :: URI.URI -> Spar () +enforceHttps :: URI.URI -> Spar r () enforceHttps uri = do unless ((uri ^. URI.uriSchemeL . URI.schemeBSL) == "https") $ do throwSpar . SparNewIdPWantHttps . cs . SAML.renderURI $ uri @@ -469,17 +471,17 @@ enforceHttps uri = do ---------------------------------------------------------------------------- -- Internal API -internalStatus :: Spar NoContent +internalStatus :: Spar r NoContent internalStatus = pure NoContent -- | Cleanup handler that is called by Galley whenever a team is about to -- get deleted. -internalDeleteTeam :: TeamId -> Spar NoContent +internalDeleteTeam :: TeamId -> Spar r NoContent internalDeleteTeam team = do wrapMonadClient $ Data.deleteTeam team pure NoContent -internalPutSsoSettings :: SsoSettings -> Spar NoContent +internalPutSsoSettings :: SsoSettings -> Spar r NoContent internalPutSsoSettings SsoSettings {defaultSsoCode = Nothing} = do wrapMonadClient $ Data.deleteDefaultSsoCode pure NoContent diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index 79e8ae0474b..41c05271c34 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -1,5 +1,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-} -- This file is part of the Wire Server implementation. -- @@ -56,6 +58,8 @@ import qualified Data.UUID.V4 as UUID import Imports hiding (log) import qualified Network.HTTP.Types.Status as Http import qualified Network.Wai.Utilities.Error as Wai +import Polysemy +import Polysemy.Final import SAML2.Util (renderURI) import SAML2.WebSSO ( Assertion (..), @@ -80,11 +84,14 @@ import qualified SAML2.WebSSO as SAML import qualified SAML2.WebSSO.Types.Email as SAMLEmail import Servant import qualified Servant.Multipart as Multipart -import qualified Spar.Data as Data +import qualified Spar.Data as Data hiding (deleteSAMLUser, deleteSAMLUsersByIssuer, getSAMLAnyUserByIssuer, getSAMLSomeUsersByIssuer, getSAMLUser, insertSAMLUser) import Spar.Error import qualified Spar.Intra.Brig as Intra import qualified Spar.Intra.Galley as Intra import Spar.Orphans () +import Spar.Sem.SAMLUser (SAMLUser) +import qualified Spar.Sem.SAMLUser as SAMLUser +import Spar.Sem.SAMLUser.Cassandra (interpretClientToIO, samlUserToCassandra) import qualified System.Logger as Log import System.Logger.Class (MonadLogger (log)) import URI.ByteString as URI @@ -95,8 +102,30 @@ import Wire.API.User.IdentityProvider import Wire.API.User.Saml import Wire.API.User.Scim (ValidExternalId (..)) -newtype Spar a = Spar {fromSpar :: ReaderT Env (ExceptT SparError IO) a} - deriving (Functor, Applicative, Monad, MonadIO, MonadReader Env, MonadError SparError) +newtype Spar r a = Spar {fromSpar :: Member (Final IO) r => ReaderT Env (ExceptT SparError (Sem r)) a} + deriving (Functor) + +liftSem :: (Member (Final IO) r => Sem r a) -> Spar r a +liftSem r = Spar $ lift $ lift r + +instance Applicative (Spar r) where + pure a = Spar $ pure a + liftA2 f a b = Spar $ liftA2 f (fromSpar a) (fromSpar b) + +instance Monad (Spar r) where + return = pure + f >>= a = Spar $ fromSpar f >>= fromSpar . a + +instance MonadReader Env (Spar r) where + ask = Spar ask + local f m = Spar $ local f $ fromSpar m + +instance MonadError SparError (Spar r) where + throwError err = Spar $ throwError err + catchError m handler = Spar $ catchError (fromSpar m) $ fromSpar . handler + +instance MonadIO (Spar r) where + liftIO m = liftSem $ embedFinal m data Env = Env { sparCtxOpts :: Opts, @@ -108,23 +137,23 @@ data Env = Env sparCtxRequestId :: RequestId } -instance HasConfig Spar where +instance HasConfig (Spar r) where getConfig = asks (saml . sparCtxOpts) -instance HasNow Spar +instance HasNow (Spar r) -instance HasCreateUUID Spar +instance HasCreateUUID (Spar r) -instance HasLogger Spar where +instance HasLogger (Spar r) where -- FUTUREWORK: optionally use 'field' to index user or idp ids for easier logfile processing. logger lv = log (toLevel lv) . Log.msg -instance MonadLogger Spar where +instance MonadLogger (Spar r) where log level mg = do lg <- asks sparCtxLogger reqid <- asks sparCtxRequestId let fields = Log.field "request" (unRequestId reqid) - Spar . Log.log lg level $ fields Log.~~ mg + liftSem $ embedFinal $ Log.log lg level $ fields Log.~~ mg toLevel :: SAML.Level -> Log.Level toLevel = \case @@ -135,27 +164,27 @@ toLevel = \case SAML.Debug -> Log.Debug SAML.Trace -> Log.Trace -instance SPStoreID AuthnRequest Spar where +instance SPStoreID AuthnRequest (Spar r) where storeID i r = wrapMonadClientWithEnv $ Data.storeAReqID i r unStoreID r = wrapMonadClient $ Data.unStoreAReqID r isAliveID r = wrapMonadClient $ Data.isAliveAReqID r -instance SPStoreID Assertion Spar where +instance SPStoreID Assertion (Spar r) where storeID i r = wrapMonadClientWithEnv $ Data.storeAssID i r unStoreID r = wrapMonadClient $ Data.unStoreAssID r isAliveID r = wrapMonadClient $ Data.isAliveAssID r -instance SPStoreIdP SparError Spar where - type IdPConfigExtra Spar = WireIdP - type IdPConfigSPId Spar = TeamId +instance SPStoreIdP SparError (Spar r) where + type IdPConfigExtra (Spar r) = WireIdP + type IdPConfigSPId (Spar r) = TeamId - storeIdPConfig :: IdP -> Spar () + storeIdPConfig :: IdP -> Spar r () storeIdPConfig idp = wrapMonadClient $ Data.storeIdPConfig idp - getIdPConfig :: IdPId -> Spar IdP + getIdPConfig :: IdPId -> Spar r IdP getIdPConfig = (>>= maybe (throwSpar (SparIdPNotFound mempty)) pure) . wrapMonadClientWithEnv . Data.getIdPConfig - getIdPConfigByIssuerOptionalSPId :: Issuer -> Maybe TeamId -> Spar IdP + getIdPConfigByIssuerOptionalSPId :: Issuer -> Maybe TeamId -> Spar r IdP getIdPConfigByIssuerOptionalSPId issuer mbteam = do wrapMonadClientWithEnv (Data.getIdPConfigByIssuerAllowOld issuer mbteam) >>= \case Data.GetIdPFound idp -> pure idp @@ -166,22 +195,35 @@ instance SPStoreIdP SparError Spar where -- | 'wrapMonadClient' with an 'Env' in a 'ReaderT', and exceptions. If you -- don't need either of those, 'wrapMonadClient' will suffice. -wrapMonadClientWithEnv :: forall a. ReaderT Data.Env (ExceptT TTLError Cas.Client) a -> Spar a +wrapMonadClientWithEnv :: forall r a. ReaderT Data.Env (ExceptT TTLError Cas.Client) a -> Spar r a wrapMonadClientWithEnv action = do denv <- Data.mkEnv <$> (sparCtxOpts <$> ask) <*> (fromTime <$> getNow) either (throwSpar . SparCassandraTTLError) pure =<< wrapMonadClient (runExceptT $ action `runReaderT` denv) +instance Member (Final IO) r => Catch.MonadThrow (Sem r) where + throwM = embedFinal . Catch.throwM @IO + +instance Member (Final IO) r => Catch.MonadCatch (Sem r) where + catch m handler = withStrategicToFinal @IO $ do + m' <- runS m + st <- getInitialStateS + handler' <- bindS handler + pure $ m' `Catch.catch` \e -> handler' $ e <$ st + -- | Call a cassandra command in the 'Spar' monad. Catch all exceptions and re-throw them as 500 in -- Handler. -wrapMonadClient :: Cas.Client a -> Spar a +wrapMonadClient :: Cas.Client a -> Spar r a wrapMonadClient action = do Spar $ do ctx <- asks sparCtxCas - runClient ctx action + lift (lift $ embedFinal @IO $ runClient ctx action) `Catch.catch` (throwSpar . SparCassandraError . cs . show @SomeException) -insertUser :: SAML.UserRef -> UserId -> Spar () -insertUser uref uid = wrapMonadClient $ Data.insertSAMLUser uref uid +wrapMonadClientSem :: Sem r a -> Spar r a +wrapMonadClientSem action = liftSem $ action + +insertUser :: Member SAMLUser r => SAML.UserRef -> UserId -> Spar r () +insertUser uref uid = wrapMonadClientSem $ SAMLUser.insert uref uid -- | Look up user locally in table @spar.user@ or @spar.scim_user@ (depending on the -- argument), then in brig, then return the 'UserId'. If either lookup fails, or user is not @@ -200,12 +242,12 @@ insertUser uref uid = wrapMonadClient $ Data.insertSAMLUser uref uid -- the team with valid SAML credentials. -- -- FUTUREWORK: Remove and reinstatate getUser, in AuthID refactoring PR. (in https://github.com/wireapp/wire-server/pull/1410, undo https://github.com/wireapp/wire-server/pull/1418) -getUserIdByUref :: Maybe TeamId -> SAML.UserRef -> Spar (GetUserResult UserId) +getUserIdByUref :: Member SAMLUser r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult UserId) getUserIdByUref mbteam uref = userId <$$> getUserByUref mbteam uref -getUserByUref :: Maybe TeamId -> SAML.UserRef -> Spar (GetUserResult User) +getUserByUref :: Member SAMLUser r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult User) getUserByUref mbteam uref = do - muid <- wrapMonadClient $ Data.getSAMLUser uref + muid <- wrapMonadClientSem $ SAMLUser.get uref case muid of Nothing -> pure GetUserNotFound Just uid -> do @@ -231,7 +273,7 @@ instance Functor GetUserResult where fmap _ GetUserWrongTeam = GetUserWrongTeam -- FUTUREWORK: Remove and reinstatate getUser, in AuthID refactoring PR -getUserIdByScimExternalId :: TeamId -> Email -> Spar (Maybe UserId) +getUserIdByScimExternalId :: TeamId -> Email -> Spar r (Maybe UserId) getUserIdByScimExternalId tid email = do muid <- wrapMonadClient $ (Data.lookupScimExternalId tid email) case muid of @@ -257,7 +299,7 @@ getUserIdByScimExternalId tid email = do -- FUTUREWORK: once we support , brig will refuse to delete -- users that have an sso id, unless the request comes from spar. then we can make users -- undeletable in the team admin page, and ask admins to go talk to their IdP system. -createSamlUserWithId :: TeamId -> UserId -> SAML.UserRef -> Spar () +createSamlUserWithId :: Member SAMLUser r => TeamId -> UserId -> SAML.UserRef -> Spar r () createSamlUserWithId teamid buid suid = do uname <- either (throwSpar . SparBadUserName . cs) pure $ Intra.mkUserName Nothing (UrefOnly suid) buid' <- Intra.createBrigUserSAML suid buid teamid uname ManagedByWire @@ -266,14 +308,14 @@ createSamlUserWithId teamid buid suid = do -- | If the team has no scim token, call 'createSamlUser'. Otherwise, raise "invalid -- credentials". -autoprovisionSamlUser :: Maybe TeamId -> SAML.UserRef -> Spar UserId +autoprovisionSamlUser :: Member SAMLUser r => Maybe TeamId -> SAML.UserRef -> Spar r UserId autoprovisionSamlUser mbteam suid = do buid <- Id <$> liftIO UUID.nextRandom autoprovisionSamlUserWithId mbteam buid suid pure buid -- | Like 'autoprovisionSamlUser', but for an already existing 'UserId'. -autoprovisionSamlUserWithId :: Maybe TeamId -> UserId -> SAML.UserRef -> Spar () +autoprovisionSamlUserWithId :: forall r. Member SAMLUser r => Maybe TeamId -> UserId -> SAML.UserRef -> Spar r () autoprovisionSamlUserWithId mbteam buid suid = do idp <- getIdPConfigByIssuerOptionalSPId (suid ^. uidTenant) mbteam guardReplacedIdP idp @@ -282,13 +324,13 @@ autoprovisionSamlUserWithId mbteam buid suid = do validateEmailIfExists buid suid where -- Replaced IdPs are not allowed to create new wire accounts. - guardReplacedIdP :: IdP -> Spar () + guardReplacedIdP :: IdP -> Spar r () guardReplacedIdP idp = do unless (isNothing $ idp ^. idpExtraInfo . wiReplacedBy) $ do throwSpar $ SparCannotCreateUsersOnReplacedIdP (cs . SAML.idPIdToST $ idp ^. idpId) -- IdPs in teams with scim tokens are not allowed to auto-provision. - guardScimTokens :: IdP -> Spar () + guardScimTokens :: IdP -> Spar r () guardScimTokens idp = do let teamid = idp ^. idpExtraInfo . wiTeam scimtoks <- wrapMonadClient $ Data.getScimTokens teamid @@ -297,12 +339,12 @@ autoprovisionSamlUserWithId mbteam buid suid = do -- | If user's 'NameID' is an email address and the team has email validation for SSO enabled, -- make brig initiate the email validate procedure. -validateEmailIfExists :: UserId -> SAML.UserRef -> Spar () +validateEmailIfExists :: forall r. UserId -> SAML.UserRef -> Spar r () validateEmailIfExists uid = \case (SAML.UserRef _ (view SAML.nameID -> UNameIDEmail email)) -> doValidate (CI.original email) _ -> pure () where - doValidate :: SAMLEmail.Email -> Spar () + doValidate :: SAMLEmail.Email -> Spar r () doValidate email = do enabled <- do tid <- Intra.getBrigUserTeam Intra.NoPendingInvitations uid @@ -316,10 +358,10 @@ validateEmailIfExists uid = \case -- -- Before returning, change account status or fail if account is nto active or pending an -- invitation. -bindUser :: UserId -> SAML.UserRef -> Spar UserId +bindUser :: Member SAMLUser r => UserId -> SAML.UserRef -> Spar r UserId bindUser buid userref = do oldStatus <- do - let err :: Spar a + let err :: Spar r a err = throwSpar . SparBindFromWrongOrNoTeam . cs . show $ buid teamid :: TeamId <- wrapMonadClient (Data.getIdPConfigByIssuerAllowOld (userref ^. uidTenant) Nothing) >>= \case @@ -343,31 +385,31 @@ bindUser buid userref = do Ephemeral -> err oldStatus PendingInvitation -> Intra.setStatus buid Active -instance SPHandler SparError Spar where - type NTCTX Spar = Env - nt :: forall a. Env -> Spar a -> Handler a +instance (r ~ '[SAMLUser, Embed (Cas.Client), Embed IO, Final IO]) => SPHandler SparError (Spar r) where + type NTCTX (Spar r) = Env + nt :: forall a. Env -> Spar r a -> Handler a nt ctx (Spar action) = do err <- actionHandler throwErrorAsHandlerException err where actionHandler :: Handler (Either SparError a) - actionHandler = liftIO $ runExceptT $ runReaderT action ctx + actionHandler = liftIO $ runFinal $ embedToFinal @IO $ interpretClientToIO (sparCtxCas ctx) $ samlUserToCassandra @Cas.Client $ runExceptT $ runReaderT action ctx throwErrorAsHandlerException :: Either SparError a -> Handler a throwErrorAsHandlerException (Left err) = sparToServerErrorWithLogging (sparCtxLogger ctx) err >>= throwError throwErrorAsHandlerException (Right a) = pure a -instance MonadHttp Spar where +instance MonadHttp (Spar r) where handleRequestWithCont req handler = do manager <- asks sparCtxHttpManager liftIO $ withResponse req manager handler -instance Intra.MonadSparToBrig Spar where +instance Intra.MonadSparToBrig (Spar r) where call modreq = do req <- asks sparCtxHttpBrig httpLbs req modreq -instance Intra.MonadSparToGalley Spar where +instance Intra.MonadSparToGalley (Spar r) where call modreq = do req <- asks sparCtxHttpGalley httpLbs req modreq @@ -381,7 +423,7 @@ instance Intra.MonadSparToGalley Spar where -- signed in-response-to info in the assertions matches the unsigned in-response-to field in the -- 'SAML.Response', and fills in the response id in the header if missing, we can just go for the -- latter. -verdictHandler :: HasCallStack => Maybe BindCookie -> Maybe TeamId -> SAML.AuthnResponse -> SAML.AccessVerdict -> Spar SAML.ResponseVerdict +verdictHandler :: HasCallStack => Member SAMLUser r => Maybe BindCookie -> Maybe TeamId -> SAML.AuthnResponse -> SAML.AccessVerdict -> Spar r SAML.ResponseVerdict verdictHandler cky mbteam aresp verdict = do -- [3/4.1.4.2] -- [...] If the containing message is in response to an , then @@ -406,17 +448,17 @@ data VerdictHandlerResult | VerifyHandlerError {_vhrLabel :: ST, _vhrMessage :: ST} deriving (Eq, Show) -verdictHandlerResult :: HasCallStack => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> Spar VerdictHandlerResult +verdictHandlerResult :: HasCallStack => Member SAMLUser r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> Spar r VerdictHandlerResult verdictHandlerResult bindCky mbteam verdict = do SAML.logger SAML.Debug $ "entering verdictHandlerResult: " <> show (fromBindCookie <$> bindCky) result <- catchVerdictErrors $ verdictHandlerResultCore bindCky mbteam verdict SAML.logger SAML.Debug $ "leaving verdictHandlerResult" <> show result pure result -catchVerdictErrors :: Spar VerdictHandlerResult -> Spar VerdictHandlerResult +catchVerdictErrors :: Spar r VerdictHandlerResult -> Spar r VerdictHandlerResult catchVerdictErrors = (`catchError` hndlr) where - hndlr :: SparError -> Spar VerdictHandlerResult + hndlr :: SparError -> Spar r VerdictHandlerResult hndlr err = do logr <- asks sparCtxLogger waiErr <- renderSparErrorWithLogging logr err @@ -427,10 +469,10 @@ catchVerdictErrors = (`catchError` hndlr) -- | If a user attempts to login presenting a new IdP issuer, but there is no entry in -- @"spar.user"@ for her: lookup @"old_issuers"@ from @"spar.idp"@ for the new IdP, and -- traverse the old IdPs in search for the old entry. Return that old entry. -findUserIdWithOldIssuer :: Maybe TeamId -> SAML.UserRef -> Spar (GetUserResult (SAML.UserRef, UserId)) +findUserIdWithOldIssuer :: forall r. Member SAMLUser r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult (SAML.UserRef, UserId)) findUserIdWithOldIssuer mbteam (SAML.UserRef issuer subject) = do idp <- getIdPConfigByIssuerOptionalSPId issuer mbteam - let tryFind :: GetUserResult (SAML.UserRef, UserId) -> Issuer -> Spar (GetUserResult (SAML.UserRef, UserId)) + let tryFind :: GetUserResult (SAML.UserRef, UserId) -> Issuer -> Spar r (GetUserResult (SAML.UserRef, UserId)) tryFind found@(GetUserFound _) _ = pure found tryFind _ oldIssuer = (uref,) <$$> getUserIdByUref mbteam uref where @@ -439,13 +481,13 @@ findUserIdWithOldIssuer mbteam (SAML.UserRef issuer subject) = do -- | After a user has been found using 'findUserWithOldIssuer', update it everywhere so that -- the old IdP is not needed any more next time. -moveUserToNewIssuer :: SAML.UserRef -> SAML.UserRef -> UserId -> Spar () +moveUserToNewIssuer :: Member SAMLUser r => SAML.UserRef -> SAML.UserRef -> UserId -> Spar r () moveUserToNewIssuer oldUserRef newUserRef uid = do - wrapMonadClient $ Data.insertSAMLUser newUserRef uid + wrapMonadClientSem $ SAMLUser.insert newUserRef uid Intra.setBrigUserVeid uid (UrefOnly newUserRef) - wrapMonadClient $ Data.deleteSAMLUser uid oldUserRef + wrapMonadClientSem $ SAMLUser.delete uid oldUserRef -verdictHandlerResultCore :: HasCallStack => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> Spar VerdictHandlerResult +verdictHandlerResultCore :: HasCallStack => Member SAMLUser r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> Spar r VerdictHandlerResult verdictHandlerResultCore bindCky mbteam = \case SAML.AccessDenied reasons -> do pure $ VerifyHandlerDenied reasons @@ -501,7 +543,7 @@ verdictHandlerResultCore bindCky mbteam = \case -- - A title element with contents @wire:sso:@. This is chosen to be easily parseable and -- not be the title of any page sent by the IdP while it negotiates with the user. -- - The page broadcasts a message to '*', to be picked up by the app. -verdictHandlerWeb :: HasCallStack => VerdictHandlerResult -> Spar SAML.ResponseVerdict +verdictHandlerWeb :: HasCallStack => VerdictHandlerResult -> Spar r SAML.ResponseVerdict verdictHandlerWeb = pure . \case VerifyHandlerGranted cky _uid -> successPage cky @@ -572,7 +614,7 @@ easyHtml doc = -- | If the client is mobile, it has picked error and success redirect urls (see -- 'mkVerdictGrantedFormatMobile', 'mkVerdictDeniedFormatMobile'); variables in these URLs are here -- substituted and the client is redirected accordingly. -verdictHandlerMobile :: HasCallStack => URI.URI -> URI.URI -> VerdictHandlerResult -> Spar SAML.ResponseVerdict +verdictHandlerMobile :: HasCallStack => URI.URI -> URI.URI -> VerdictHandlerResult -> Spar r SAML.ResponseVerdict verdictHandlerMobile granted denied = \case VerifyHandlerGranted cky uid -> mkVerdictGrantedFormatMobile granted cky uid diff --git a/services/spar/src/Spar/Scim.hs b/services/spar/src/Spar/Scim.hs index f37763ab96b..48eb9f6be07 100644 --- a/services/spar/src/Spar/Scim.hs +++ b/services/spar/src/Spar/Scim.hs @@ -64,11 +64,11 @@ module Spar.Scim ) where -import Control.Lens import Control.Monad.Catch (try) import Control.Monad.Except import Data.String.Conversions (cs) import Imports +import Polysemy import qualified SAML2.WebSSO as SAML import Servant import Servant.API.Generic @@ -82,6 +82,7 @@ import Spar.Error ) import Spar.Scim.Auth import Spar.Scim.User +import Spar.Sem.SAMLUser (SAMLUser) import qualified Web.Scim.Capabilities.MetaSchema as Scim.Meta import qualified Web.Scim.Class.Auth as Scim.Auth import qualified Web.Scim.Class.User as Scim.User @@ -99,7 +100,7 @@ import Wire.API.User.Scim configuration :: Scim.Meta.Configuration configuration = Scim.Meta.empty -apiScim :: ServerT APIScim Spar +apiScim :: Member SAMLUser r => ServerT APIScim (Spar r) apiScim = hoistScim (toServant (server configuration)) :<|> apiScimToken @@ -115,32 +116,33 @@ apiScim = -- Let's hope that SCIM clients can handle non-SCIM-formatted errors -- properly. See -- for why it's hard to catch impure exceptions. - wrapScimErrors :: Spar a -> Spar a - wrapScimErrors = over _Spar $ \act -> \env -> do - result :: Either SomeException (Either SparError a) <- try (act env) - case result of - Left someException -> do - -- We caught an exception that's not a Spar exception at all. It is wrapped into - -- Scim.serverError. - pure . Left . SAML.CustomError . SparScimError $ - Scim.serverError (cs (displayException someException)) - Right err@(Left (SAML.CustomError (SparScimError _))) -> - -- We caught a 'SparScimError' exception. It is left as-is. - pure err - Right (Left sparError) -> do - -- We caught some other Spar exception. It is rendered and wrapped into a scim error - -- with the same status and message, and no scim error type. - err :: ServerError <- sparToServerErrorWithLogging (sparCtxLogger env) sparError - pure . Left . SAML.CustomError . SparScimError $ - Scim.ScimError - { schemas = [Scim.Schema.Error20], - status = Scim.Status $ errHTTPCode err, - scimType = Nothing, - detail = Just . cs $ errBody err - } - Right (Right x) -> do - -- No exceptions! Good. - pure $ Right x + wrapScimErrors :: Spar r a -> Spar r a + wrapScimErrors act = Spar $ + ReaderT $ \env -> ExceptT $ do + result :: Either SomeException (Either SparError a) <- try $ runExceptT $ runReaderT (fromSpar $ act) env + case result of + Left someException -> do + -- We caught an exception that's not a Spar exception at all. It is wrapped into + -- Scim.serverError. + pure . Left . SAML.CustomError . SparScimError $ + Scim.serverError (cs (displayException someException)) + Right err@(Left (SAML.CustomError (SparScimError _))) -> + -- We caught a 'SparScimError' exception. It is left as-is. + pure err + Right (Left sparError) -> do + -- We caught some other Spar exception. It is rendered and wrapped into a scim error + -- with the same status and message, and no scim error type. + err :: ServerError <- embedFinal @IO $ sparToServerErrorWithLogging (sparCtxLogger env) sparError + pure . Left . SAML.CustomError . SparScimError $ + Scim.ScimError + { schemas = [Scim.Schema.Error20], + status = Scim.Status $ errHTTPCode err, + scimType = Nothing, + detail = Just . cs $ errBody err + } + Right (Right x) -> do + -- No exceptions! Good. + pure $ Right x -- | This is similar to 'Scim.siteServer, but does not include the 'Scim.groupServer', -- as we don't support it (we don't implement 'Web.Scim.Class.Group.GroupDB'). @@ -154,11 +156,3 @@ server conf = { config = toServant $ Scim.configServer conf, users = \authData -> toServant (Scim.userServer @tag authData) } - ----------------------------------------------------------------------------- --- Utilities - --- | An isomorphism that unwraps the Spar stack (@Spar . ReaderT . ExceptT@) into a --- newtype-less form that's easier to work with. -_Spar :: Iso' (Spar a) (Env -> IO (Either SparError a)) -_Spar = coerced diff --git a/services/spar/src/Spar/Scim/Auth.hs b/services/spar/src/Spar/Scim/Auth.hs index 28b68fdd8c6..cfb76293bf8 100644 --- a/services/spar/src/Spar/Scim/Auth.hs +++ b/services/spar/src/Spar/Scim/Auth.hs @@ -57,9 +57,9 @@ import Wire.API.User.Saml (maxScimTokens) import Wire.API.User.Scim -- | An instance that tells @hscim@ how authentication should be done for SCIM routes. -instance Scim.Class.Auth.AuthDB SparTag Spar where +instance Scim.Class.Auth.AuthDB SparTag (Spar r) where -- Validate and resolve a given token - authCheck :: Maybe ScimToken -> Scim.ScimHandler Spar ScimTokenInfo + authCheck :: Maybe ScimToken -> Scim.ScimHandler (Spar r) ScimTokenInfo authCheck Nothing = Scim.throwScim (Scim.unauthorized "Token not provided") authCheck (Just token) = @@ -73,7 +73,7 @@ instance Scim.Class.Auth.AuthDB SparTag Spar where -- | API for manipulating SCIM tokens (protected by normal Wire authentication and available -- only to team owners). -apiScimToken :: ServerT APIScimToken Spar +apiScimToken :: ServerT APIScimToken (Spar r) apiScimToken = createScimToken :<|> deleteScimToken @@ -87,7 +87,7 @@ createScimToken :: Maybe UserId -> -- | Request body CreateScimToken -> - Spar CreateScimTokenResponse + Spar r CreateScimTokenResponse createScimToken zusr CreateScimToken {..} = do let descr = createScimTokenDescr teamid <- Intra.Brig.authorizeScimTokenManagement zusr @@ -98,7 +98,7 @@ createScimToken zusr CreateScimToken {..} = do E.throwSpar E.SparProvisioningTokenLimitReached idps <- wrapMonadClient $ Data.getIdPConfigsByTeam teamid - let caseOneOrNoIdP :: Maybe SAML.IdPId -> Spar CreateScimTokenResponse + let caseOneOrNoIdP :: Maybe SAML.IdPId -> Spar r CreateScimTokenResponse caseOneOrNoIdP midpid = do token <- ScimToken . cs . ES.encode <$> liftIO (randBytes 32) tokenid <- randomId @@ -132,7 +132,7 @@ deleteScimToken :: -- | Who is trying to delete a token Maybe UserId -> ScimTokenId -> - Spar NoContent + Spar r NoContent deleteScimToken zusr tokenid = do teamid <- Intra.Brig.authorizeScimTokenManagement zusr wrapMonadClient $ Data.deleteScimToken teamid tokenid @@ -145,7 +145,7 @@ deleteScimToken zusr tokenid = do listScimTokens :: -- | Who is trying to list tokens Maybe UserId -> - Spar ScimTokenList + Spar r ScimTokenList listScimTokens zusr = do teamid <- Intra.Brig.authorizeScimTokenManagement zusr ScimTokenList <$> wrapMonadClient (Data.getScimTokens teamid) diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 72a4e8b3fcb..2acf2bf75d1 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -63,12 +63,14 @@ import qualified Data.UUID as UUID import qualified Data.UUID.V4 as UUID import Imports import Network.URI (URI, parseURI) +import Polysemy import qualified SAML2.WebSSO as SAML import Spar.App (GetUserResult (..), Spar, getUserIdByScimExternalId, getUserIdByUref, sparCtxOpts, validateEmailIfExists, wrapMonadClient) import qualified Spar.Data as Data import qualified Spar.Intra.Brig as Brig import Spar.Scim.Auth () import qualified Spar.Scim.Types as ST +import Spar.Sem.SAMLUser (SAMLUser) import qualified System.Logger.Class as Log import System.Logger.Message (Msg) import qualified URI.ByteString as URIBS @@ -94,11 +96,11 @@ import qualified Wire.API.User.Scim as ST ---------------------------------------------------------------------------- -- UserDB instance -instance Scim.UserDB ST.SparTag Spar where +instance Member SAMLUser r => Scim.UserDB ST.SparTag (Spar r) where getUsers :: ScimTokenInfo -> Maybe Scim.Filter -> - Scim.ScimHandler Spar (Scim.ListResponse (Scim.StoredUser ST.SparTag)) + Scim.ScimHandler (Spar r) (Scim.ListResponse (Scim.StoredUser ST.SparTag)) getUsers _ Nothing = do throwError $ Scim.badRequest Scim.TooMany (Just "Please specify a filter when getting users.") getUsers tokeninfo@ScimTokenInfo {stiTeam, stiIdP} (Just filter') = @@ -123,7 +125,7 @@ instance Scim.UserDB ST.SparTag Spar where getUser :: ScimTokenInfo -> UserId -> - Scim.ScimHandler Spar (Scim.StoredUser ST.SparTag) + Scim.ScimHandler (Spar r) (Scim.StoredUser ST.SparTag) getUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = logScim ( logFunction "Spar.Scim.User.getUser" @@ -142,18 +144,18 @@ instance Scim.UserDB ST.SparTag Spar where postUser :: ScimTokenInfo -> Scim.User ST.SparTag -> - Scim.ScimHandler Spar (Scim.StoredUser ST.SparTag) + Scim.ScimHandler (Spar r) (Scim.StoredUser ST.SparTag) postUser tokinfo user = createValidScimUser tokinfo =<< validateScimUser tokinfo user putUser :: ScimTokenInfo -> UserId -> Scim.User ST.SparTag -> - Scim.ScimHandler Spar (Scim.StoredUser ST.SparTag) + Scim.ScimHandler (Spar r) (Scim.StoredUser ST.SparTag) putUser tokinfo uid newScimUser = updateValidScimUser tokinfo uid =<< validateScimUser tokinfo newScimUser - deleteUser :: ScimTokenInfo -> UserId -> Scim.ScimHandler Spar () + deleteUser :: ScimTokenInfo -> UserId -> Scim.ScimHandler (Spar r) () deleteUser tokeninfo uid = logScim ( logFunction "Spar.Scim.User.deleteUser" @@ -168,8 +170,8 @@ instance Scim.UserDB ST.SparTag Spar where -- | Validate a raw SCIM user record and extract data that we care about. See also: -- 'ValidScimUser''. validateScimUser :: - forall m. - (m ~ Scim.ScimHandler Spar) => + forall m r. + (m ~ Scim.ScimHandler (Spar r)) => -- | Used to decide what IdP to assign the user to ScimTokenInfo -> Scim.User ST.SparTag -> @@ -179,7 +181,7 @@ validateScimUser tokinfo user = do richInfoLimit <- lift $ asks (richInfoLimit . sparCtxOpts) validateScimUser' mIdpConfig richInfoLimit user -tokenInfoToIdP :: ScimTokenInfo -> Scim.ScimHandler Spar (Maybe IdP) +tokenInfoToIdP :: ScimTokenInfo -> Scim.ScimHandler (Spar r) (Maybe IdP) tokenInfoToIdP ScimTokenInfo {stiIdP} = do maybe (pure Nothing) (lift . wrapMonadClient . Data.getIdPConfig) stiIdP @@ -307,7 +309,7 @@ mkValidExternalId (Just idp) (Just extid) = do Scim.InvalidValue (Just $ "Can't construct a subject ID from externalId: " <> Text.pack err) -logScim :: forall m a. (m ~ Scim.ScimHandler Spar) => (Msg -> Msg) -> m a -> m a +logScim :: forall m r a. (m ~ Scim.ScimHandler (Spar r)) => (Msg -> Msg) -> m a -> m a logScim context action = flip mapExceptT action $ \action' -> do eith <- action' @@ -359,8 +361,9 @@ veidEmail (ST.EmailOnly email) = Just email -- FUTUREWORK(arianvp): Get rid of manual lifting. Needs to be SCIM instances for ExceptT -- This is the pain and the price you pay for the horribleness called MTL createValidScimUser :: - forall m. - (m ~ Scim.ScimHandler Spar) => + forall m r. + (m ~ Scim.ScimHandler (Spar r)) => + Member SAMLUser r => ScimTokenInfo -> ST.ValidScimUser -> m (Scim.StoredUser ST.SparTag) @@ -441,8 +444,9 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid -- TODO(arianvp): how do we get this safe w.r.t. race conditions / crashes? updateValidScimUser :: - forall m. - (m ~ Scim.ScimHandler Spar) => + forall m r. + Member SAMLUser r => + (m ~ Scim.ScimHandler (Spar r)) => ScimTokenInfo -> UserId -> ST.ValidScimUser -> @@ -500,7 +504,7 @@ updateVsuUref :: UserId -> ST.ValidExternalId -> ST.ValidExternalId -> - Spar () + Spar r () updateVsuUref team uid old new = do let geturef = ST.runValidExternalId Just (const Nothing) case (geturef old, geturef new) of @@ -567,7 +571,7 @@ updScimStoredUser' now usr (Scim.WithMeta meta (Scim.WithId scimuid _)) = Scim.version = calculateVersion scimuid usr } -deleteScimUser :: ScimTokenInfo -> UserId -> Scim.ScimHandler Spar () +deleteScimUser :: ScimTokenInfo -> UserId -> Scim.ScimHandler (Spar r) () deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = logScim ( logFunction "Spar.Scim.User.deleteScimUser" @@ -631,7 +635,7 @@ calculateVersion uid usr = Scim.Weak (Text.pack (show h)) -- -- ASSUMPTION: every scim user has a 'SAML.UserRef', and the `SAML.NameID` in it corresponds -- to a single `externalId`. -assertExternalIdUnused :: TeamId -> ST.ValidExternalId -> Scim.ScimHandler Spar () +assertExternalIdUnused :: Member SAMLUser r => TeamId -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) () assertExternalIdUnused tid veid = do assertExternalIdInAllowedValues [Nothing] @@ -645,7 +649,7 @@ assertExternalIdUnused tid veid = do -- -- ASSUMPTION: every scim user has a 'SAML.UserRef', and the `SAML.NameID` in it corresponds -- to a single `externalId`. -assertExternalIdNotUsedElsewhere :: TeamId -> ST.ValidExternalId -> UserId -> Scim.ScimHandler Spar () +assertExternalIdNotUsedElsewhere :: Member SAMLUser r => TeamId -> ST.ValidExternalId -> UserId -> Scim.ScimHandler (Spar r) () assertExternalIdNotUsedElsewhere tid veid wireUserId = do assertExternalIdInAllowedValues [Nothing, Just wireUserId] @@ -653,7 +657,7 @@ assertExternalIdNotUsedElsewhere tid veid wireUserId = do tid veid -assertExternalIdInAllowedValues :: [Maybe UserId] -> Text -> TeamId -> ST.ValidExternalId -> Scim.ScimHandler Spar () +assertExternalIdInAllowedValues :: Member SAMLUser r => [Maybe UserId] -> Text -> TeamId -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) () assertExternalIdInAllowedValues allowedValues errmsg tid veid = do isGood <- lift $ @@ -670,16 +674,16 @@ assertExternalIdInAllowedValues allowedValues errmsg tid veid = do unless isGood $ throwError Scim.conflict {Scim.detail = Just errmsg} -assertHandleUnused :: Handle -> Scim.ScimHandler Spar () +assertHandleUnused :: Handle -> Scim.ScimHandler (Spar r) () assertHandleUnused = assertHandleUnused' "userName is already taken" -assertHandleUnused' :: Text -> Handle -> Scim.ScimHandler Spar () +assertHandleUnused' :: Text -> Handle -> Scim.ScimHandler (Spar r) () assertHandleUnused' msg hndl = lift (Brig.checkHandleAvailable hndl) >>= \case True -> pure () False -> throwError Scim.conflict {Scim.detail = Just msg} -assertHandleNotUsedElsewhere :: UserId -> Handle -> Scim.ScimHandler Spar () +assertHandleNotUsedElsewhere :: UserId -> Handle -> Scim.ScimHandler (Spar r) () assertHandleNotUsedElsewhere uid hndl = do musr <- lift $ Brig.getBrigUser Brig.WithPendingInvitations uid unless ((userHandle =<< musr) == Just hndl) $ @@ -688,7 +692,7 @@ assertHandleNotUsedElsewhere uid hndl = do -- | Helper function that translates a given brig user into a 'Scim.StoredUser', with some -- effects like updating the 'ManagedBy' field in brig and storing creation and update time -- stamps. -synthesizeStoredUser :: UserAccount -> ST.ValidExternalId -> Scim.ScimHandler Spar (Scim.StoredUser ST.SparTag) +synthesizeStoredUser :: UserAccount -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) (Scim.StoredUser ST.SparTag) synthesizeStoredUser usr veid = logScim ( logFunction "Spar.Scim.User.synthesizeStoredUser" @@ -701,14 +705,14 @@ synthesizeStoredUser usr veid = let uid = userId (accountUser usr) accStatus = accountStatus usr - let readState :: Spar (RI.RichInfo, Maybe (UTCTimeMillis, UTCTimeMillis), URIBS.URI) + let readState :: Spar r (RI.RichInfo, Maybe (UTCTimeMillis, UTCTimeMillis), URIBS.URI) readState = do richInfo <- Brig.getBrigUserRichInfo uid accessTimes <- wrapMonadClient (Data.readScimUserTimes uid) baseuri <- asks $ derivedOptsScimBaseURI . derivedOpts . sparCtxOpts pure (richInfo, accessTimes, baseuri) - let writeState :: Maybe (UTCTimeMillis, UTCTimeMillis) -> ManagedBy -> RI.RichInfo -> Scim.StoredUser ST.SparTag -> Spar () + let writeState :: Maybe (UTCTimeMillis, UTCTimeMillis) -> ManagedBy -> RI.RichInfo -> Scim.StoredUser ST.SparTag -> Spar r () writeState oldAccessTimes oldManagedBy oldRichInfo storedUser = do when (isNothing oldAccessTimes) $ do wrapMonadClient $ Data.writeScimUserTimes storedUser @@ -774,7 +778,7 @@ synthesizeScimUser info = Scim.active = Just . Scim.ScimBool $ info ^. ST.vsuActive } -scimFindUserByHandle :: Maybe IdP -> TeamId -> Text -> MaybeT (Scim.ScimHandler Spar) (Scim.StoredUser ST.SparTag) +scimFindUserByHandle :: Maybe IdP -> TeamId -> Text -> MaybeT (Scim.ScimHandler (Spar r)) (Scim.StoredUser ST.SparTag) scimFindUserByHandle mIdpConfig stiTeam hndl = do handle <- MaybeT . pure . parseHandle . Text.toLower $ hndl brigUser <- MaybeT . lift . Brig.getBrigUserByHandle $ handle @@ -789,7 +793,7 @@ scimFindUserByHandle mIdpConfig stiTeam hndl = do -- -- Note the user won't get an entry in `spar.user`. That will only happen on their first -- successful authentication with their SAML credentials. -scimFindUserByEmail :: Maybe IdP -> TeamId -> Text -> MaybeT (Scim.ScimHandler Spar) (Scim.StoredUser ST.SparTag) +scimFindUserByEmail :: Maybe IdP -> TeamId -> Text -> MaybeT (Scim.ScimHandler (Spar r)) (Scim.StoredUser ST.SparTag) scimFindUserByEmail mIdpConfig stiTeam email = do -- Azure has been observed to search for externalIds that are not emails, even if the -- mapping is set up like it should be. This is a problem: if there is no SAML IdP, 'mkValidExternalId' @@ -803,18 +807,18 @@ scimFindUserByEmail mIdpConfig stiTeam email = do guard $ userTeam (accountUser brigUser) == Just stiTeam lift $ synthesizeStoredUser brigUser veid where - withUref :: SAML.UserRef -> Spar (Maybe UserId) + withUref :: SAML.UserRef -> Spar r (Maybe UserId) withUref uref = do wrapMonadClient (Data.getSAMLUser uref) >>= \case Nothing -> maybe (pure Nothing) withEmailOnly $ Brig.urefToEmail uref Just uid -> pure (Just uid) - withEmailOnly :: BT.Email -> Spar (Maybe UserId) + withEmailOnly :: BT.Email -> Spar r (Maybe UserId) withEmailOnly eml = maybe inbrig (pure . Just) =<< inspar where -- FUTUREWORK: we could also always lookup brig, that's simpler and possibly faster, -- and it never should be visible in spar, but not in brig. - inspar, inbrig :: Spar (Maybe UserId) + inspar, inbrig :: Spar r (Maybe UserId) inspar = wrapMonadClient $ Data.lookupScimExternalId stiTeam eml inbrig = userId . accountUser <$$> Brig.getBrigUserByEmail eml diff --git a/services/spar/src/Spar/Sem/SAMLUser.hs b/services/spar/src/Spar/Sem/SAMLUser.hs new file mode 100644 index 00000000000..0ddd7d51322 --- /dev/null +++ b/services/spar/src/Spar/Sem/SAMLUser.hs @@ -0,0 +1,17 @@ +module Spar.Sem.SAMLUser where + +import Data.Id +import Imports +import Polysemy +import qualified SAML2.WebSSO as SAML + +data SAMLUser m a where + Insert :: SAML.UserRef -> UserId -> SAMLUser m () + Get :: SAML.UserRef -> SAMLUser m (Maybe UserId) + GetAnyByIssuer :: SAML.Issuer -> SAMLUser m (Maybe UserId) + GetSomeByIssuer :: SAML.Issuer -> SAMLUser m [(SAML.UserRef, UserId)] + DeleteByIssuer :: SAML.Issuer -> SAMLUser m () + Delete :: UserId -> SAML.UserRef -> SAMLUser m () + +-- TODO(sandy): Inline this definition --- no TH +makeSem ''SAMLUser diff --git a/services/spar/src/Spar/Sem/SAMLUser/Cassandra.hs b/services/spar/src/Spar/Sem/SAMLUser/Cassandra.hs new file mode 100644 index 00000000000..77a8f200f7e --- /dev/null +++ b/services/spar/src/Spar/Sem/SAMLUser/Cassandra.hs @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-} + +module Spar.Sem.SAMLUser.Cassandra where + +import Cassandra +import Imports +import Polysemy +import qualified Spar.Data as Data +import Spar.Sem.SAMLUser + +samlUserToCassandra :: + forall m r a. + (MonadClient m, Member (Embed m) r) => + Sem (SAMLUser ': r) a -> + Sem r a +samlUserToCassandra = + interpret $ + embed . \case + Insert ur uid -> Data.insertSAMLUser ur uid + Get ur -> Data.getSAMLUser ur + GetAnyByIssuer is -> Data.getSAMLAnyUserByIssuer is + GetSomeByIssuer is -> Data.getSAMLSomeUsersByIssuer is + DeleteByIssuer is -> Data.deleteSAMLUsersByIssuer is + Delete uid ur -> Data.deleteSAMLUser uid ur + +interpretClientToIO :: Member (Final IO) r => ClientState -> Sem (Embed Client ': r) a -> Sem r a +interpretClientToIO ctx = interpret $ \case + Embed action -> embedFinal $ runClient ctx action diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index d876a3735c7..17526e05c25 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -169,6 +169,7 @@ import Network.HTTP.Client.MultipartFormData import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Handler.Warp.Internal as Warp import qualified Options.Applicative as OPA +import Polysemy import SAML2.WebSSO as SAML import qualified SAML2.WebSSO.API.Example as SAML import SAML2.WebSSO.Test.Lenses (userRefL) @@ -180,6 +181,8 @@ import qualified Spar.Data as Data import qualified Spar.Intra.Brig as Intra import qualified Spar.Options import Spar.Run +import Spar.Sem.SAMLUser (SAMLUser) +import Spar.Sem.SAMLUser.Cassandra import qualified System.Logger.Extended as Log import System.Random (randomRIO) import Test.Hspec hiding (it, pending, pendingWith, xit) @@ -1239,11 +1242,11 @@ runSimpleSP action = do result <- SAML.runSimpleSP ctx action either (throwIO . ErrorCall . show) pure result -runSpar :: (MonadReader TestEnv m, MonadIO m) => Spar.Spar a -> m a +runSpar :: (MonadReader TestEnv m, MonadIO m) => Spar.Spar '[SAMLUser, Embed Client, Embed IO, Final IO] a -> m a runSpar (Spar.Spar action) = do env <- (^. teSparEnv) <$> ask liftIO $ do - result <- runExceptT $ action `runReaderT` env + result <- runFinal $ embedToFinal @IO $ interpretClientToIO (Spar.sparCtxCas env) $ samlUserToCassandra @Cas.Client $ runExceptT $ action `runReaderT` env either (throwIO . ErrorCall . show) pure result getSsoidViaSelf :: HasCallStack => UserId -> TestSpar UserSSOId From 5ff5cb79c9b3244b906d8baf6a44bb270a73281f Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 17 Sep 2021 20:46:03 +0200 Subject: [PATCH 32/72] CHANGELOG --- changelog.d/5-internal/pr-1763 | 1 - changelog.d/5-internal/raw-effect-row | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/changelog.d/5-internal/pr-1763 b/changelog.d/5-internal/pr-1763 index 361a2a74245..b9c57ee39c2 100644 --- a/changelog.d/5-internal/pr-1763 +++ b/changelog.d/5-internal/pr-1763 @@ -1,5 +1,4 @@ Minor changes around SAML and multi-team Issuers. - - Change query param to not contain `-`, but `_`. (This is considered an internal change because the feature has been release in the last release, but only been documented in this one.) - Haddocks. - Simplify code. diff --git a/changelog.d/5-internal/raw-effect-row b/changelog.d/5-internal/raw-effect-row index 4222e97f7d8..2842f6dd03c 100644 --- a/changelog.d/5-internal/raw-effect-row +++ b/changelog.d/5-internal/raw-effect-row @@ -1 +1 @@ -Add polysemy to spar; promote the SAMLUser CRUD interface to an effect +Add polysemy to spar; promote the SAMLUser CRUD interface to an effect (#1781) From 499c299682e5615a302e5883763de0126adb3dbd Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Mon, 20 Sep 2021 01:56:23 -0700 Subject: [PATCH 33/72] Make sure to actually wrap the action in 'wrapMonadClientSem' (#1786) * Make sure to actually wrap the action in 'wrapMonadClientSem' * Implement wrapMonadClient in terms of wrapMonadClientSem --- changelog.d/5-internal/raw-effect-row | 2 +- services/spar/src/Spar/App.hs | 12 ++++++++---- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/changelog.d/5-internal/raw-effect-row b/changelog.d/5-internal/raw-effect-row index 2842f6dd03c..1ecad681e03 100644 --- a/changelog.d/5-internal/raw-effect-row +++ b/changelog.d/5-internal/raw-effect-row @@ -1 +1 @@ -Add polysemy to spar; promote the SAMLUser CRUD interface to an effect (#1781) +Add polysemy to spar; promote the SAMLUser CRUD interface to an effect (#1781, #1786) \ No newline at end of file diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index 41c05271c34..89815164131 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -213,14 +213,18 @@ instance Member (Final IO) r => Catch.MonadCatch (Sem r) where -- | Call a cassandra command in the 'Spar' monad. Catch all exceptions and re-throw them as 500 in -- Handler. wrapMonadClient :: Cas.Client a -> Spar r a -wrapMonadClient action = do +wrapMonadClient action = Spar $ do ctx <- asks sparCtxCas - lift (lift $ embedFinal @IO $ runClient ctx action) - `Catch.catch` (throwSpar . SparCassandraError . cs . show @SomeException) + fromSpar $ wrapMonadClientSem $ embedFinal @IO $ runClient ctx action +-- | Call a 'Sem' command in the 'Spar' monad. Catch all (IO) exceptions and +-- re-throw them as 500 in Handler. wrapMonadClientSem :: Sem r a -> Spar r a -wrapMonadClientSem action = liftSem $ action +wrapMonadClientSem action = + Spar $ + (lift $ lift action) + `Catch.catch` (throwSpar . SparCassandraError . cs . show @SomeException) insertUser :: Member SAMLUser r => SAML.UserRef -> UserId -> Spar r () insertUser uref uid = wrapMonadClientSem $ SAMLUser.insert uref uid From 5c10cd26dc1c50490309f20553ee529d4f89cad5 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 20 Sep 2021 15:26:42 +0200 Subject: [PATCH 34/72] Servantify message timer update endpoint (#1780) * Convert updateMessageTimerEndpoint to Servant. * Add qualified endpoint for message-timer updates Also deprecate the unqualified endpoint and add a test. Note that no federation behaviour is implemented at this point. --- .../deprecate-messager-timer-update | 1 + .../qualified-message-timer-update | 1 + .../5-internal/servantify-message-timer | 1 + .../src/Wire/API/Routes/Public/Galley.hs | 37 +++++++++++++++++++ services/galley/src/Galley/API/Public.hs | 25 ++----------- services/galley/src/Galley/API/Update.hs | 17 +++++---- .../test/integration/API/MessageTimer.hs | 31 ++++++++++++++++ services/galley/test/integration/API/Util.hs | 17 +++++++++ 8 files changed, 101 insertions(+), 29 deletions(-) create mode 100644 changelog.d/1-api-changes/deprecate-messager-timer-update create mode 100644 changelog.d/1-api-changes/qualified-message-timer-update create mode 100644 changelog.d/5-internal/servantify-message-timer diff --git a/changelog.d/1-api-changes/deprecate-messager-timer-update b/changelog.d/1-api-changes/deprecate-messager-timer-update new file mode 100644 index 00000000000..07756d902fb --- /dev/null +++ b/changelog.d/1-api-changes/deprecate-messager-timer-update @@ -0,0 +1 @@ +Deprecate `PUT /conversations/:cnv/message-timer` endpoint diff --git a/changelog.d/1-api-changes/qualified-message-timer-update b/changelog.d/1-api-changes/qualified-message-timer-update new file mode 100644 index 00000000000..f80853678c3 --- /dev/null +++ b/changelog.d/1-api-changes/qualified-message-timer-update @@ -0,0 +1 @@ +Add qualified endpoint for updating message timer diff --git a/changelog.d/5-internal/servantify-message-timer b/changelog.d/5-internal/servantify-message-timer new file mode 100644 index 00000000000..ffdd35057f5 --- /dev/null +++ b/changelog.d/5-internal/servantify-message-timer @@ -0,0 +1 @@ +Convert the `PUT /conversations/:cnv/message-timer` endpoint to Servant 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 63621c8d7bf..e8ad817c4de 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -327,6 +327,43 @@ data Api routes = Api Respond 200 "Conversation updated" Event ] (Maybe Event), + -- This endpoint can lead to the following events being sent: + -- - ConvMessageTimerUpdate event to members + updateConversationMessageTimerUnqualified :: + routes + :- Summary "Update the message timer for a conversation (deprecated)" + :> Description "Use `/conversations/:domain/:cnv/message-timer` instead." + :> ZUser + :> ZConn + :> CanThrow ConvAccessDenied + :> CanThrow ConvNotFound + :> CanThrow (InvalidOp "Invalid operation") + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> "message-timer" + :> ReqBody '[JSON] ConversationMessageTimerUpdate + :> MultiVerb + 'PUT + '[JSON] + (UpdateResponses "Message timer unchanged" "Message timer updated" Event) + (UpdateResult Event), + updateConversationMessageTimer :: + routes + :- Summary "Update the message timer for a conversation" + :> ZUser + :> ZConn + :> CanThrow ConvAccessDenied + :> CanThrow ConvNotFound + :> CanThrow (InvalidOp "Invalid operation") + :> "conversations" + :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId + :> "message-timer" + :> ReqBody '[JSON] ConversationMessageTimerUpdate + :> MultiVerb + 'PUT + '[JSON] + (UpdateResponses "Message timer unchanged" "Message timer updated" Event) + (UpdateResult Event), getConversationSelfUnqualified :: routes :- Summary "Get self membership properties (deprecated)" diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index 191d37ccc2f..a4c1a29787e 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -95,6 +95,9 @@ servantSitemap = GalleyAPI.updateConversationNameDeprecated = Update.updateLocalConversationName, GalleyAPI.updateConversationNameUnqualified = Update.updateLocalConversationName, GalleyAPI.updateConversationName = Update.updateConversationName, + GalleyAPI.updateConversationMessageTimerUnqualified = + Update.updateLocalConversationMessageTimer, + GalleyAPI.updateConversationMessageTimer = Update.updateConversationMessageTimer, GalleyAPI.getConversationSelfUnqualified = Query.getLocalSelf, GalleyAPI.updateConversationSelfUnqualified = Update.updateUnqualifiedSelfMember, GalleyAPI.updateConversationSelf = Update.updateSelfMember, @@ -677,28 +680,6 @@ sitemap = do errorResponse (Error.errorDescriptionToWai Error.convNotFound) errorResponse (Error.errorDescriptionToWai Error.convAccessDenied) - -- This endpoint can lead to the following events being sent: - -- - ConvMessageTimerUpdate event to members - put "/conversations/:cnv/message-timer" (continue Update.updateConversationMessageTimerH) $ - zauthUserId - .&. zauthConnId - .&. capture "cnv" - .&. jsonRequest @Public.ConversationMessageTimerUpdate - document "PUT" "updateConversationMessageTimer" $ do - summary "Update the message timer for a conversation" - parameter Path "cnv" bytes' $ - description "Conversation ID" - returns (ref Public.modelEvent) - response 200 "Message timer updated." end - response 204 "Message timer unchanged." end - body (ref Public.modelConversationMessageTimerUpdate) $ - description "JSON body" - errorResponse (Error.errorDescriptionToWai Error.convNotFound) - errorResponse (Error.errorDescriptionToWai Error.convAccessDenied) - errorResponse Error.invalidSelfOp - errorResponse Error.invalidOne2OneOp - errorResponse Error.invalidConnectOp - -- This endpoint can lead to the following events being sent: -- - MemberJoin event to members post "/conversations/:cnv/members" (continue Update.addMembersH) $ diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 8a16b281b61..04d7ef7f367 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -31,7 +31,8 @@ module Galley.API.Update updateConversationName, updateConversationAccessH, updateConversationReceiptModeH, - updateConversationMessageTimerH, + updateLocalConversationMessageTimer, + updateConversationMessageTimer, -- * Managing Members addMembersH, @@ -318,13 +319,15 @@ updateConversationReceiptMode usr zcon cnv receiptModeUpdate@(Public.Conversatio pushConversationEvent (Just zcon) receiptEvent (map lmId users) bots pure receiptEvent -updateConversationMessageTimerH :: UserId ::: ConnId ::: ConvId ::: JsonRequest Public.ConversationMessageTimerUpdate -> Galley Response -updateConversationMessageTimerH (usr ::: zcon ::: cnv ::: req) = do - timerUpdate <- fromJsonBody req - handleUpdateResult <$> updateConversationMessageTimer usr zcon cnv timerUpdate +updateConversationMessageTimer :: UserId -> ConnId -> Qualified ConvId -> Public.ConversationMessageTimerUpdate -> Galley (UpdateResult Event) +updateConversationMessageTimer usr zcon qcnv update = do + localDomain <- viewFederationDomain + if qDomain qcnv == localDomain + then updateLocalConversationMessageTimer usr zcon (qUnqualified qcnv) update + else throwM federationNotImplemented -updateConversationMessageTimer :: UserId -> ConnId -> ConvId -> Public.ConversationMessageTimerUpdate -> Galley (UpdateResult Event) -updateConversationMessageTimer usr zcon cnv timerUpdate@(Public.ConversationMessageTimerUpdate target) = do +updateLocalConversationMessageTimer :: UserId -> ConnId -> ConvId -> Public.ConversationMessageTimerUpdate -> Galley (UpdateResult Event) +updateLocalConversationMessageTimer usr zcon cnv timerUpdate@(Public.ConversationMessageTimerUpdate target) = do localDomain <- viewFederationDomain let qcnv = Qualified cnv localDomain qusr = Qualified usr localDomain diff --git a/services/galley/test/integration/API/MessageTimer.hs b/services/galley/test/integration/API/MessageTimer.hs index 0328e97942f..d8f77579dc4 100644 --- a/services/galley/test/integration/API/MessageTimer.hs +++ b/services/galley/test/integration/API/MessageTimer.hs @@ -50,6 +50,7 @@ tests s = test s "nothing" (messageTimerInit Nothing) ], test s "timer can be changed" messageTimerChange, + test s "timer can be changed with the qualified endpoint" messageTimerChangeQualified, test s "timer can't be set by conv member without allowed action" messageTimerChangeWithoutAllowedAction, test s "timer can't be set in 1:1 conversations" messageTimerChangeO2O, test s "setting the timer generates an event" messageTimerEvent @@ -99,6 +100,36 @@ messageTimerChange = do getConv jane cid !!! const timer1year === (cnvMessageTimer <=< responseJsonUnsafe) +messageTimerChangeQualified :: TestM () +messageTimerChangeQualified = do + localDomain <- viewFederationDomain + -- Create a conversation without a timer + [alice, bob, jane] <- randomUsers 3 + connectUsers alice (list1 bob [jane]) + rsp <- + postConv alice [bob, jane] Nothing [] Nothing Nothing + Qualified ConvId -> ConversationMessageTimerUpdate -> TestM ResponseLBS +putMessageTimerUpdateQualified u c acc = do + g <- view tsGalley + put $ + g + . paths + [ "/conversations", + toByteString' (qDomain c), + toByteString' (qUnqualified c), + "message-timer" + ] + . zUser u + . zConn "conn" + . zType "access" + . json acc + putMessageTimerUpdate :: UserId -> ConvId -> ConversationMessageTimerUpdate -> TestM ResponseLBS putMessageTimerUpdate u c acc = do From 6eb4ffbdf0b6fcc85cee4a619edac1ca6723b0ed Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 20 Sep 2021 21:37:33 +0200 Subject: [PATCH 35/72] Add ncurses dependency (#1791) (Needed for polysemy plugin, which makes type checking nicer.) --- build/alpine/Dockerfile.deps | 3 ++- changelog.d/5-internal/ncurses-deps | 1 + 2 files changed, 3 insertions(+), 1 deletion(-) create mode 100644 changelog.d/5-internal/ncurses-deps diff --git a/build/alpine/Dockerfile.deps b/build/alpine/Dockerfile.deps index 212d8df510a..9ef4958bb15 100644 --- a/build/alpine/Dockerfile.deps +++ b/build/alpine/Dockerfile.deps @@ -27,4 +27,5 @@ RUN apk add --no-cache \ llvm-libunwind \ ca-certificates \ dumb-init \ - libxml2 + libxml2 \ + ncurses diff --git a/changelog.d/5-internal/ncurses-deps b/changelog.d/5-internal/ncurses-deps new file mode 100644 index 00000000000..cde9f1140d1 --- /dev/null +++ b/changelog.d/5-internal/ncurses-deps @@ -0,0 +1 @@ +Some executables now have a runtime dependency on ncurses From 9a67ffc36cafb51514604ae847e04ffa422f7536 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Mon, 20 Sep 2021 14:04:37 -0700 Subject: [PATCH 36/72] Polysemy: Extract IdP effect from Spar (#1787) * Make sure to actually wrap the action in 'wrapMonadClientSem' * Implement wrapMonadClient in terms of wrapMonadClientSem * Pull out IdP effect * Push Member IdP constraints throughout * Pull application logic out of Data and into App * Use application-level functions instead * Remove deleteTeam from Data too * Get rid of wrapMonadClientWithEnvSem * Implement wrapSpar * Undo accidental formatting * Update cabal * make format * Update changelog * Get rid of the untouchable variable in liftSem * Be very careful about wrapping in the same places * Resort exports * Changelog * Forgot some callsites * Get tests compiling again * Get everything compiling * remove runSparCassSem * Change the tests to use IdP * Finish all SAMLUser and IdP effects refs in tests * Excise all references to IdP and SAMLUser effects * make format * Cleanup * Fix stale haddocks. * Add polysemy-zoo * Revert "Add polysemy-zoo" This reverts commit e567af2c99d1b52a9b184208f9fc88d5c4338ca9. Co-authored-by: Matthias Fischmann --- changelog.d/5-internal/idp-effect | 1 + services/spar/spar.cabal | 4 +- services/spar/src/Spar/API.hs | 92 ++++++------ services/spar/src/Spar/App.hs | 139 +++++++++++++++--- services/spar/src/Spar/Data.hs | 100 +------------ services/spar/src/Spar/Scim.hs | 3 +- services/spar/src/Spar/Scim/Auth.hs | 16 +- services/spar/src/Spar/Scim/User.hs | 47 +++--- services/spar/src/Spar/Sem/IdP.hs | 43 ++++++ services/spar/src/Spar/Sem/IdP/Cassandra.hs | 27 ++++ .../test-integration/Test/Spar/APISpec.hs | 7 +- .../test-integration/Test/Spar/AppSpec.hs | 5 +- .../test-integration/Test/Spar/DataSpec.hs | 91 ++++++------ .../Test/Spar/Scim/UserSpec.hs | 4 +- services/spar/test-integration/Util/Core.hs | 17 ++- 15 files changed, 352 insertions(+), 244 deletions(-) create mode 100644 changelog.d/5-internal/idp-effect create mode 100644 services/spar/src/Spar/Sem/IdP.hs create mode 100644 services/spar/src/Spar/Sem/IdP/Cassandra.hs diff --git a/changelog.d/5-internal/idp-effect b/changelog.d/5-internal/idp-effect new file mode 100644 index 00000000000..0a75abbd1b6 --- /dev/null +++ b/changelog.d/5-internal/idp-effect @@ -0,0 +1 @@ +Spar: Extract IdP effect into Polysemy (#1787) diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index 6dc4680d412..a53360f1e4f 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 2cfc4799f7bb3c53ef52f608770146174871fda0b611e679cb5e0747eca566dc +-- hash: 5b06ec7a50a1803f0f0aefbe72aad10c986a9becf2aa984b53f253d6a8caf237 name: spar version: 0.1 @@ -34,6 +34,8 @@ library Spar.Scim.Auth Spar.Scim.Types Spar.Scim.User + Spar.Sem.IdP + Spar.Sem.IdP.Cassandra Spar.Sem.SAMLUser Spar.Sem.SAMLUser.Cassandra other-modules: diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 022716edaef..18eeb481b0f 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -58,13 +58,15 @@ import qualified SAML2.WebSSO as SAML import Servant import qualified Servant.Multipart as Multipart import Spar.App -import qualified Spar.Data as Data +import qualified Spar.Data as Data hiding (clearReplacedBy, deleteIdPRawMetadata, getIdPConfig, getIdPConfigsByTeam, getIdPIdByIssuerWithTeam, getIdPIdByIssuerWithoutTeam, getIdPRawMetadata, setReplacedBy, storeIdPConfig, storeIdPRawMetadata) import Spar.Error import qualified Spar.Intra.Brig as Brig import qualified Spar.Intra.Galley as Galley import Spar.Orphans () import Spar.Scim +import qualified Spar.Sem.IdP as IdPEffect import Spar.Sem.SAMLUser (SAMLUser) +import qualified Spar.Sem.SAMLUser as SAMLUser import qualified URI.ByteString as URI import Wire.API.Cookie import Wire.API.Routes.Public.Spar @@ -76,7 +78,7 @@ app ctx = SAML.setHttpCachePolicy $ serve (Proxy @API) (hoistServer (Proxy @API) (SAML.nt @SparError @(Spar _) ctx) (api $ sparCtxOpts ctx) :: Server API) -api :: Member SAMLUser r => Opts -> ServerT API (Spar r) +api :: Members [IdPEffect.IdP, SAMLUser] r => Opts -> ServerT API (Spar r) api opts = apiSSO opts :<|> authreqPrecheck @@ -85,7 +87,7 @@ api opts = :<|> apiScim :<|> apiINTERNAL -apiSSO :: Member SAMLUser r => Opts -> ServerT APISSO (Spar r) +apiSSO :: Members [IdPEffect.IdP, SAMLUser] r => Opts -> ServerT APISSO (Spar r) apiSSO opts = SAML.meta appName (sparSPIssuer Nothing) (sparResponseURI Nothing) :<|> (\tid -> SAML.meta appName (sparSPIssuer (Just tid)) (sparResponseURI (Just tid))) @@ -95,7 +97,7 @@ apiSSO opts = :<|> authresp . Just :<|> ssoSettings -apiIDP :: ServerT APIIDP (Spar r) +apiIDP :: Members [IdPEffect.IdP, SAMLUser] r => ServerT APIIDP (Spar r) apiIDP = idpGet :<|> idpGetRaw @@ -104,7 +106,7 @@ apiIDP = :<|> idpUpdate :<|> idpDelete -apiINTERNAL :: ServerT APIINTERNAL (Spar r) +apiINTERNAL :: Members [IdPEffect.IdP, SAMLUser] r => ServerT APIINTERNAL (Spar r) apiINTERNAL = internalStatus :<|> internalDeleteTeam @@ -116,13 +118,14 @@ appName = "spar" ---------------------------------------------------------------------------- -- SSO API -authreqPrecheck :: Maybe URI.URI -> Maybe URI.URI -> SAML.IdPId -> Spar r NoContent +authreqPrecheck :: Member IdPEffect.IdP r => Maybe URI.URI -> Maybe URI.URI -> SAML.IdPId -> Spar r NoContent authreqPrecheck msucc merr idpid = validateAuthreqParams msucc merr *> SAML.getIdPConfig idpid *> return NoContent authreq :: + Member IdPEffect.IdP r => NominalDiffTime -> DoInitiate -> Maybe UserId -> @@ -135,7 +138,7 @@ authreq _ DoInitiateBind Nothing _ _ _ = throwSpar SparInitBindWithoutAuth authreq authreqttl _ zusr msucc merr idpid = do vformat <- validateAuthreqParams msucc merr form@(SAML.FormRedirect _ ((^. SAML.rqID) -> reqid)) <- do - idp :: IdP <- wrapMonadClient (Data.getIdPConfig idpid) >>= maybe (throwSpar (SparIdPNotFound (cs $ show idpid))) pure + idp :: IdP <- wrapMonadClientSem (IdPEffect.getConfig idpid) >>= maybe (throwSpar (SparIdPNotFound (cs $ show idpid))) pure let mbtid :: Maybe TeamId mbtid = case fromMaybe defWireIdPAPIVersion (idp ^. SAML.idpExtraInfo . wiApiVersion) of WireIdPAPIV1 -> Nothing @@ -178,7 +181,7 @@ validateRedirectURL uri = do unless ((SBS.length $ URI.serializeURIRef' uri) <= redirectURLMaxLength) $ do throwSpar $ SparBadInitiateLoginQueryParams "url-too-long" -authresp :: forall r. Member SAMLUser r => Maybe TeamId -> Maybe ST -> SAML.AuthnResponseBody -> Spar r Void +authresp :: forall r. Members [IdPEffect.IdP, SAMLUser] r => Maybe TeamId -> Maybe ST -> SAML.AuthnResponseBody -> Spar r Void authresp mbtid ckyraw arbody = logErrors $ SAML.authresp mbtid (sparSPIssuer mbtid) (sparResponseURI mbtid) go arbody where cky :: Maybe BindCookie @@ -206,24 +209,24 @@ ssoSettings = do ---------------------------------------------------------------------------- -- IdP API -idpGet :: Maybe UserId -> SAML.IdPId -> Spar r IdP +idpGet :: Member IdPEffect.IdP r => Maybe UserId -> SAML.IdPId -> Spar r IdP idpGet zusr idpid = withDebugLog "idpGet" (Just . show . (^. SAML.idpId)) $ do idp <- SAML.getIdPConfig idpid _ <- authorizeIdP zusr idp pure idp -idpGetRaw :: Maybe UserId -> SAML.IdPId -> Spar r RawIdPMetadata +idpGetRaw :: Member IdPEffect.IdP r => Maybe UserId -> SAML.IdPId -> Spar r RawIdPMetadata idpGetRaw zusr idpid = do idp <- SAML.getIdPConfig idpid _ <- authorizeIdP zusr idp - wrapMonadClient (Data.getIdPRawMetadata idpid) >>= \case + wrapMonadClientSem (IdPEffect.getRawMetadata idpid) >>= \case Just txt -> pure $ RawIdPMetadata txt Nothing -> throwSpar $ SparIdPNotFound (cs $ show idpid) -idpGetAll :: Maybe UserId -> Spar r IdPList +idpGetAll :: Member IdPEffect.IdP r => Maybe UserId -> Spar r IdPList idpGetAll zusr = withDebugLog "idpGetAll" (const Nothing) $ do teamid <- Brig.getZUsrCheckPerm zusr ReadIdp - _idplProviders <- wrapMonadClientWithEnv $ Data.getIdPConfigsByTeam teamid + _idplProviders <- wrapMonadClientSem $ IdPEffect.getConfigsByTeam teamid pure IdPList {..} -- | Delete empty IdPs, or if @"purge=true"@ in the HTTP query, delete all users @@ -234,20 +237,20 @@ idpGetAll zusr = withDebugLog "idpGetAll" (const Nothing) $ do -- matter what the team size, it shouldn't choke any servers, just the client (which is -- probably curl running locally on one of the spar instances). -- https://github.com/zinfra/backend-issues/issues/1314 -idpDelete :: Maybe UserId -> SAML.IdPId -> Maybe Bool -> Spar r NoContent +idpDelete :: forall r. Members [SAMLUser, IdPEffect.IdP] r => Maybe UserId -> SAML.IdPId -> Maybe Bool -> Spar r NoContent idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (const Nothing) $ do idp <- SAML.getIdPConfig idpid _ <- authorizeIdP zusr idp let issuer = idp ^. SAML.idpMetadata . SAML.edIssuer team = idp ^. SAML.idpExtraInfo . wiTeam -- if idp is not empty: fail or purge - idpIsEmpty <- wrapMonadClient $ isNothing <$> Data.getSAMLAnyUserByIssuer issuer + idpIsEmpty <- wrapMonadClientSem $ isNothing <$> SAMLUser.getAnyByIssuer issuer let doPurge :: Spar r () doPurge = do - some <- wrapMonadClient (Data.getSAMLSomeUsersByIssuer issuer) + some <- wrapMonadClientSem (SAMLUser.getSomeByIssuer issuer) forM_ some $ \(uref, uid) -> do Brig.deleteBrigUser uid - wrapMonadClient (Data.deleteSAMLUser uid uref) + wrapMonadClientSem (SAMLUser.delete uid uref) unless (null some) doPurge when (not idpIsEmpty) $ do if purge @@ -255,16 +258,17 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons else throwSpar SparIdPHasBoundUsers updateOldIssuers idp updateReplacingIdP idp - wrapMonadClient $ do + wrapSpar $ do -- Delete tokens associated with given IdP (we rely on the fact that -- each IdP has exactly one team so we can look up all tokens -- associated with the team and then filter them) - tokens <- Data.getScimTokens team + tokens <- liftMonadClient $ Data.getScimTokens team for_ tokens $ \ScimTokenInfo {..} -> - when (stiIdP == Just idpid) $ Data.deleteScimToken team stiId + when (stiIdP == Just idpid) $ liftMonadClient $ Data.deleteScimToken team stiId -- Delete IdP config - Data.deleteIdPConfig idpid issuer team - Data.deleteIdPRawMetadata idpid + liftSem $ do + IdPEffect.deleteConfig idpid issuer team + IdPEffect.deleteRawMetadata idpid return NoContent where updateOldIssuers :: IdP -> Spar r () @@ -278,9 +282,9 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons updateReplacingIdP :: IdP -> Spar r () updateReplacingIdP idp = forM_ (idp ^. SAML.idpExtraInfo . wiOldIssuers) $ \oldIssuer -> do - wrapMonadClient $ do - Data.getIdPIdByIssuer oldIssuer (idp ^. SAML.idpExtraInfo . wiTeam) >>= \case - Data.GetIdPFound iid -> Data.clearReplacedBy $ Data.Replaced iid + wrapSpar $ do + getIdPIdByIssuer oldIssuer (idp ^. SAML.idpExtraInfo . wiTeam) >>= \case + Data.GetIdPFound iid -> liftSem $ IdPEffect.clearReplacedBy $ Data.Replaced iid Data.GetIdPNotFound -> pure () Data.GetIdPDanglingId _ -> pure () Data.GetIdPNonUnique _ -> pure () @@ -288,30 +292,30 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons -- | This handler only does the json parsing, and leaves all authorization checks and -- application logic to 'idpCreateXML'. -idpCreate :: Maybe UserId -> IdPMetadataInfo -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Spar r IdP +idpCreate :: Member IdPEffect.IdP r => Maybe UserId -> IdPMetadataInfo -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Spar r IdP idpCreate zusr (IdPMetadataValue raw xml) midpid apiversion = idpCreateXML zusr raw xml midpid apiversion -- | We generate a new UUID for each IdP used as IdPConfig's path, thereby ensuring uniqueness. -idpCreateXML :: Maybe UserId -> Text -> SAML.IdPMetadata -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Spar r IdP +idpCreateXML :: Member IdPEffect.IdP r => Maybe UserId -> Text -> SAML.IdPMetadata -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Spar r IdP idpCreateXML zusr raw idpmeta mReplaces (fromMaybe defWireIdPAPIVersion -> apiversion) = withDebugLog "idpCreate" (Just . show . (^. SAML.idpId)) $ do teamid <- Brig.getZUsrCheckPerm zusr CreateUpdateDeleteIdp Galley.assertSSOEnabled teamid assertNoScimOrNoIdP teamid idp <- validateNewIdP apiversion idpmeta teamid mReplaces - wrapMonadClient $ Data.storeIdPRawMetadata (idp ^. SAML.idpId) raw + wrapMonadClientSem $ IdPEffect.storeRawMetadata (idp ^. SAML.idpId) raw SAML.storeIdPConfig idp - forM_ mReplaces $ \replaces -> wrapMonadClient $ do - Data.setReplacedBy (Data.Replaced replaces) (Data.Replacing (idp ^. SAML.idpId)) + forM_ mReplaces $ \replaces -> wrapMonadClientSem $ do + IdPEffect.setReplacedBy (Data.Replaced replaces) (Data.Replacing (idp ^. SAML.idpId)) pure idp -- | In teams with a scim access token, only one IdP is allowed. The reason is that scim user -- data contains no information about the idp issuer, only the user name, so no valid saml -- credentials can be created. To fix this, we need to implement a way to associate scim -- tokens with IdPs. https://wearezeta.atlassian.net/browse/SQSERVICES-165 -assertNoScimOrNoIdP :: TeamId -> Spar r () +assertNoScimOrNoIdP :: Member IdPEffect.IdP r => TeamId -> Spar r () assertNoScimOrNoIdP teamid = do numTokens <- length <$> wrapMonadClient (Data.getScimTokens teamid) - numIdps <- length <$> wrapMonadClientWithEnv (Data.getIdPConfigsByTeam teamid) + numIdps <- length <$> wrapMonadClientSem (IdPEffect.getConfigsByTeam teamid) when (numTokens > 0 && numIdps > 0) $ do throwSpar $ SparProvisioningMoreThanOneIdP @@ -340,6 +344,7 @@ assertNoScimOrNoIdP teamid = do validateNewIdP :: forall m r. (HasCallStack, m ~ Spar r) => + Member IdPEffect.IdP r => WireIdPAPIVersion -> SAML.IdPMetadata -> TeamId -> @@ -350,12 +355,12 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces = withDebugLog "validate oldIssuers :: [SAML.Issuer] <- case mReplaces of Nothing -> pure [] Just replaces -> do - idp <- wrapMonadClient (Data.getIdPConfig replaces) >>= maybe (throwSpar (SparIdPNotFound (cs $ show mReplaces))) pure + idp <- wrapMonadClientSem (IdPEffect.getConfig replaces) >>= maybe (throwSpar (SparIdPNotFound (cs $ show mReplaces))) pure pure $ (idp ^. SAML.idpMetadata . SAML.edIssuer) : (idp ^. SAML.idpExtraInfo . wiOldIssuers) let requri = _idpMetadata ^. SAML.edRequestURI _idpExtraInfo = WireIdP teamId (Just apiversion) oldIssuers Nothing enforceHttps requri - idp <- wrapMonadClient (Data.getIdPConfigByIssuer (_idpMetadata ^. SAML.edIssuer) teamId) + idp <- wrapSpar $ getIdPConfigByIssuer (_idpMetadata ^. SAML.edIssuer) teamId SAML.logger SAML.Debug $ show (apiversion, _idpMetadata, teamId, mReplaces) SAML.logger SAML.Debug $ show (_idpId, oldIssuers, idp) @@ -385,14 +390,14 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces = withDebugLog "validate -- | FUTUREWORK: 'idpUpdateXML' is only factored out of this function for symmetry with -- 'idpCreate', which is not a good reason. make this one function and pass around -- 'IdPMetadataInfo' directly where convenient. -idpUpdate :: Maybe UserId -> IdPMetadataInfo -> SAML.IdPId -> Spar r IdP +idpUpdate :: Member IdPEffect.IdP r => Maybe UserId -> IdPMetadataInfo -> SAML.IdPId -> Spar r IdP idpUpdate zusr (IdPMetadataValue raw xml) idpid = idpUpdateXML zusr raw xml idpid -idpUpdateXML :: Maybe UserId -> Text -> SAML.IdPMetadata -> SAML.IdPId -> Spar r IdP +idpUpdateXML :: Member IdPEffect.IdP r => Maybe UserId -> Text -> SAML.IdPMetadata -> SAML.IdPId -> Spar r IdP idpUpdateXML zusr raw idpmeta idpid = withDebugLog "idpUpdate" (Just . show . (^. SAML.idpId)) $ do (teamid, idp) <- validateIdPUpdate zusr idpmeta idpid Galley.assertSSOEnabled teamid - wrapMonadClient $ Data.storeIdPRawMetadata (idp ^. SAML.idpId) raw + wrapMonadClientSem $ IdPEffect.storeRawMetadata (idp ^. SAML.idpId) raw -- (if raw metadata is stored and then spar goes out, raw metadata won't match the -- structured idp config. since this will lead to a 5xx response, the client is epected to -- try again, which would clean up cassandra state.) @@ -406,13 +411,14 @@ idpUpdateXML zusr raw idpmeta idpid = withDebugLog "idpUpdate" (Just . show . (^ validateIdPUpdate :: forall m r. (HasCallStack, m ~ Spar r) => + Member IdPEffect.IdP r => Maybe UserId -> SAML.IdPMetadata -> SAML.IdPId -> m (TeamId, IdP) validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateNewIdP" (Just . show . (_2 %~ (^. SAML.idpId))) $ do previousIdP <- - wrapMonadClient (Data.getIdPConfig _idpId) >>= \case + wrapMonadClientSem (IdPEffect.getConfig _idpId) >>= \case Nothing -> throwError errUnknownIdPId Just idp -> pure idp teamId <- authorizeIdP zusr previousIdP @@ -424,7 +430,7 @@ validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateNewIdP" (Just if previousIssuer == newIssuer then pure $ previousIdP ^. SAML.idpExtraInfo else do - foundConfig <- wrapMonadClient (Data.getIdPConfigByIssuerAllowOld newIssuer (Just teamId)) + foundConfig <- wrapSpar $ getIdPConfigByIssuerAllowOld newIssuer (Just teamId) notInUseByOthers <- case foundConfig of Data.GetIdPFound c -> pure $ c ^. SAML.idpId == _idpId Data.GetIdPNotFound -> pure True @@ -476,17 +482,17 @@ internalStatus = pure NoContent -- | Cleanup handler that is called by Galley whenever a team is about to -- get deleted. -internalDeleteTeam :: TeamId -> Spar r NoContent +internalDeleteTeam :: Members [IdPEffect.IdP, SAMLUser] r => TeamId -> Spar r NoContent internalDeleteTeam team = do - wrapMonadClient $ Data.deleteTeam team + wrapSpar $ deleteTeam team pure NoContent -internalPutSsoSettings :: SsoSettings -> Spar r NoContent +internalPutSsoSettings :: Member IdPEffect.IdP r => SsoSettings -> Spar r NoContent internalPutSsoSettings SsoSettings {defaultSsoCode = Nothing} = do wrapMonadClient $ Data.deleteDefaultSsoCode pure NoContent internalPutSsoSettings SsoSettings {defaultSsoCode = Just code} = do - wrapMonadClient (Data.getIdPConfig code) >>= \case + wrapMonadClientSem (IdPEffect.getConfig code) >>= \case Nothing -> -- this will return a 404, which is not quite right, -- but it's an internal endpoint and the message clearly says diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index 89815164131..0990c0f4dd5 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -27,6 +27,7 @@ module Spar.App toLevel, wrapMonadClientWithEnv, wrapMonadClient, + wrapMonadClientSem, verdictHandler, GetUserResult (..), getUserIdByUref, @@ -34,6 +35,13 @@ module Spar.App insertUser, validateEmailIfExists, errorPage, + getIdPIdByIssuer, + getIdPConfigByIssuer, + getIdPConfigByIssuerAllowOld, + deleteTeam, + wrapSpar, + liftSem, + liftMonadClient, ) where @@ -46,6 +54,7 @@ import Control.Exception (assert) import Control.Lens hiding ((.=)) import qualified Control.Monad.Catch as Catch import Control.Monad.Except +import Control.Monad.Trans.Except (except) import Data.Aeson as Aeson (encode, object, (.=)) import Data.Aeson.Text as Aeson (encodeToLazyText) import qualified Data.ByteString.Builder as Builder @@ -72,7 +81,7 @@ import SAML2.WebSSO Issuer (..), SPHandler (..), SPStoreID (..), - SPStoreIdP (..), + SPStoreIdP (getIdPConfigByIssuerOptionalSPId), UnqualifiedNameID (..), explainDeniedReason, fromTime, @@ -84,11 +93,14 @@ import qualified SAML2.WebSSO as SAML import qualified SAML2.WebSSO.Types.Email as SAMLEmail import Servant import qualified Servant.Multipart as Multipart -import qualified Spar.Data as Data hiding (deleteSAMLUser, deleteSAMLUsersByIssuer, getSAMLAnyUserByIssuer, getSAMLSomeUsersByIssuer, getSAMLUser, insertSAMLUser) +import qualified Spar.Data as Data hiding (deleteSAMLUser, deleteSAMLUsersByIssuer, getIdPConfig, getSAMLAnyUserByIssuer, getSAMLSomeUsersByIssuer, getSAMLUser, insertSAMLUser, storeIdPConfig) import Spar.Error import qualified Spar.Intra.Brig as Intra import qualified Spar.Intra.Galley as Intra import Spar.Orphans () +import Spar.Sem.IdP (GetIdPResult (..)) +import qualified Spar.Sem.IdP as IdPEffect +import Spar.Sem.IdP.Cassandra (idPToCassandra) import Spar.Sem.SAMLUser (SAMLUser) import qualified Spar.Sem.SAMLUser as SAMLUser import Spar.Sem.SAMLUser.Cassandra (interpretClientToIO, samlUserToCassandra) @@ -105,7 +117,7 @@ import Wire.API.User.Scim (ValidExternalId (..)) newtype Spar r a = Spar {fromSpar :: Member (Final IO) r => ReaderT Env (ExceptT SparError (Sem r)) a} deriving (Functor) -liftSem :: (Member (Final IO) r => Sem r a) -> Spar r a +liftSem :: Sem r a -> Spar r a liftSem r = Spar $ lift $ lift r instance Applicative (Spar r) where @@ -125,7 +137,7 @@ instance MonadError SparError (Spar r) where catchError m handler = Spar $ catchError (fromSpar m) $ fromSpar . handler instance MonadIO (Spar r) where - liftIO m = liftSem $ embedFinal m + liftIO m = Spar $ lift $ lift $ embedFinal m data Env = Env { sparCtxOpts :: Opts, @@ -153,7 +165,7 @@ instance MonadLogger (Spar r) where lg <- asks sparCtxLogger reqid <- asks sparCtxRequestId let fields = Log.field "request" (unRequestId reqid) - liftSem $ embedFinal $ Log.log lg level $ fields Log.~~ mg + Spar $ lift $ lift $ embedFinal $ Log.log lg level $ fields Log.~~ mg toLevel :: SAML.Level -> Log.Level toLevel = \case @@ -174,19 +186,19 @@ instance SPStoreID Assertion (Spar r) where unStoreID r = wrapMonadClient $ Data.unStoreAssID r isAliveID r = wrapMonadClient $ Data.isAliveAssID r -instance SPStoreIdP SparError (Spar r) where +instance Member IdPEffect.IdP r => SPStoreIdP SparError (Spar r) where type IdPConfigExtra (Spar r) = WireIdP type IdPConfigSPId (Spar r) = TeamId storeIdPConfig :: IdP -> Spar r () - storeIdPConfig idp = wrapMonadClient $ Data.storeIdPConfig idp + storeIdPConfig idp = wrapMonadClientSem $ IdPEffect.storeConfig idp getIdPConfig :: IdPId -> Spar r IdP - getIdPConfig = (>>= maybe (throwSpar (SparIdPNotFound mempty)) pure) . wrapMonadClientWithEnv . Data.getIdPConfig + getIdPConfig = (>>= maybe (throwSpar (SparIdPNotFound mempty)) pure) . wrapMonadClientSem . IdPEffect.getConfig getIdPConfigByIssuerOptionalSPId :: Issuer -> Maybe TeamId -> Spar r IdP getIdPConfigByIssuerOptionalSPId issuer mbteam = do - wrapMonadClientWithEnv (Data.getIdPConfigByIssuerAllowOld issuer mbteam) >>= \case + wrapSpar (getIdPConfigByIssuerAllowOld issuer mbteam) >>= \case Data.GetIdPFound idp -> pure idp Data.GetIdPNotFound -> throwSpar $ SparIdPNotFound mempty res@(Data.GetIdPDanglingId _) -> throwSpar $ SparIdPNotFound (cs $ show res) @@ -218,6 +230,14 @@ wrapMonadClient action = ctx <- asks sparCtxCas fromSpar $ wrapMonadClientSem $ embedFinal @IO $ runClient ctx action +-- | Lift a cassandra command into the 'Spar' monad. Like 'wrapMonadClient', +-- but doesn't catch any exceptions. +liftMonadClient :: Cas.Client a -> Spar r a +liftMonadClient action = + Spar $ do + ctx <- asks sparCtxCas + lift $ lift $ embedFinal @IO $ runClient ctx action + -- | Call a 'Sem' command in the 'Spar' monad. Catch all (IO) exceptions and -- re-throw them as 500 in Handler. wrapMonadClientSem :: Sem r a -> Spar r a @@ -226,6 +246,12 @@ wrapMonadClientSem action = (lift $ lift action) `Catch.catch` (throwSpar . SparCassandraError . cs . show @SomeException) +wrapSpar :: Spar r a -> Spar r a +wrapSpar action = Spar $ do + env <- ask + fromSpar $ + wrapMonadClientSem (runExceptT $ flip runReaderT env $ fromSpar action) >>= Spar . lift . except + insertUser :: Member SAMLUser r => SAML.UserRef -> UserId -> Spar r () insertUser uref uid = wrapMonadClientSem $ SAMLUser.insert uref uid @@ -312,14 +338,14 @@ createSamlUserWithId teamid buid suid = do -- | If the team has no scim token, call 'createSamlUser'. Otherwise, raise "invalid -- credentials". -autoprovisionSamlUser :: Member SAMLUser r => Maybe TeamId -> SAML.UserRef -> Spar r UserId +autoprovisionSamlUser :: Members [IdPEffect.IdP, SAMLUser] r => Maybe TeamId -> SAML.UserRef -> Spar r UserId autoprovisionSamlUser mbteam suid = do buid <- Id <$> liftIO UUID.nextRandom autoprovisionSamlUserWithId mbteam buid suid pure buid -- | Like 'autoprovisionSamlUser', but for an already existing 'UserId'. -autoprovisionSamlUserWithId :: forall r. Member SAMLUser r => Maybe TeamId -> UserId -> SAML.UserRef -> Spar r () +autoprovisionSamlUserWithId :: forall r. Members [IdPEffect.IdP, SAMLUser] r => Maybe TeamId -> UserId -> SAML.UserRef -> Spar r () autoprovisionSamlUserWithId mbteam buid suid = do idp <- getIdPConfigByIssuerOptionalSPId (suid ^. uidTenant) mbteam guardReplacedIdP idp @@ -362,13 +388,13 @@ validateEmailIfExists uid = \case -- -- Before returning, change account status or fail if account is nto active or pending an -- invitation. -bindUser :: Member SAMLUser r => UserId -> SAML.UserRef -> Spar r UserId +bindUser :: Members [IdPEffect.IdP, SAMLUser] r => UserId -> SAML.UserRef -> Spar r UserId bindUser buid userref = do oldStatus <- do let err :: Spar r a err = throwSpar . SparBindFromWrongOrNoTeam . cs . show $ buid teamid :: TeamId <- - wrapMonadClient (Data.getIdPConfigByIssuerAllowOld (userref ^. uidTenant) Nothing) >>= \case + wrapSpar (getIdPConfigByIssuerAllowOld (userref ^. uidTenant) Nothing) >>= \case Data.GetIdPFound idp -> pure $ idp ^. idpExtraInfo . wiTeam Data.GetIdPNotFound -> err Data.GetIdPDanglingId _ -> err -- database inconsistency @@ -389,7 +415,7 @@ bindUser buid userref = do Ephemeral -> err oldStatus PendingInvitation -> Intra.setStatus buid Active -instance (r ~ '[SAMLUser, Embed (Cas.Client), Embed IO, Final IO]) => SPHandler SparError (Spar r) where +instance (r ~ '[IdPEffect.IdP, SAMLUser, Embed (Cas.Client), Embed IO, Final IO]) => SPHandler SparError (Spar r) where type NTCTX (Spar r) = Env nt :: forall a. Env -> Spar r a -> Handler a nt ctx (Spar action) = do @@ -397,7 +423,7 @@ instance (r ~ '[SAMLUser, Embed (Cas.Client), Embed IO, Final IO]) => SPHandler throwErrorAsHandlerException err where actionHandler :: Handler (Either SparError a) - actionHandler = liftIO $ runFinal $ embedToFinal @IO $ interpretClientToIO (sparCtxCas ctx) $ samlUserToCassandra @Cas.Client $ runExceptT $ runReaderT action ctx + actionHandler = liftIO $ runFinal $ embedToFinal @IO $ interpretClientToIO (sparCtxCas ctx) $ samlUserToCassandra @Cas.Client $ idPToCassandra @Cas.Client $ runExceptT $ runReaderT action ctx throwErrorAsHandlerException :: Either SparError a -> Handler a throwErrorAsHandlerException (Left err) = sparToServerErrorWithLogging (sparCtxLogger ctx) err >>= throwError @@ -427,7 +453,7 @@ instance Intra.MonadSparToGalley (Spar r) where -- signed in-response-to info in the assertions matches the unsigned in-response-to field in the -- 'SAML.Response', and fills in the response id in the header if missing, we can just go for the -- latter. -verdictHandler :: HasCallStack => Member SAMLUser r => Maybe BindCookie -> Maybe TeamId -> SAML.AuthnResponse -> SAML.AccessVerdict -> Spar r SAML.ResponseVerdict +verdictHandler :: HasCallStack => Members [IdPEffect.IdP, SAMLUser] r => Maybe BindCookie -> Maybe TeamId -> SAML.AuthnResponse -> SAML.AccessVerdict -> Spar r SAML.ResponseVerdict verdictHandler cky mbteam aresp verdict = do -- [3/4.1.4.2] -- [...] If the containing message is in response to an , then @@ -452,7 +478,7 @@ data VerdictHandlerResult | VerifyHandlerError {_vhrLabel :: ST, _vhrMessage :: ST} deriving (Eq, Show) -verdictHandlerResult :: HasCallStack => Member SAMLUser r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> Spar r VerdictHandlerResult +verdictHandlerResult :: HasCallStack => Members [IdPEffect.IdP, SAMLUser] r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> Spar r VerdictHandlerResult verdictHandlerResult bindCky mbteam verdict = do SAML.logger SAML.Debug $ "entering verdictHandlerResult: " <> show (fromBindCookie <$> bindCky) result <- catchVerdictErrors $ verdictHandlerResultCore bindCky mbteam verdict @@ -473,7 +499,7 @@ catchVerdictErrors = (`catchError` hndlr) -- | If a user attempts to login presenting a new IdP issuer, but there is no entry in -- @"spar.user"@ for her: lookup @"old_issuers"@ from @"spar.idp"@ for the new IdP, and -- traverse the old IdPs in search for the old entry. Return that old entry. -findUserIdWithOldIssuer :: forall r. Member SAMLUser r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult (SAML.UserRef, UserId)) +findUserIdWithOldIssuer :: forall r. Members [IdPEffect.IdP, SAMLUser] r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult (SAML.UserRef, UserId)) findUserIdWithOldIssuer mbteam (SAML.UserRef issuer subject) = do idp <- getIdPConfigByIssuerOptionalSPId issuer mbteam let tryFind :: GetUserResult (SAML.UserRef, UserId) -> Issuer -> Spar r (GetUserResult (SAML.UserRef, UserId)) @@ -491,7 +517,7 @@ moveUserToNewIssuer oldUserRef newUserRef uid = do Intra.setBrigUserVeid uid (UrefOnly newUserRef) wrapMonadClientSem $ SAMLUser.delete uid oldUserRef -verdictHandlerResultCore :: HasCallStack => Member SAMLUser r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> Spar r VerdictHandlerResult +verdictHandlerResultCore :: HasCallStack => Members [IdPEffect.IdP, SAMLUser] r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> Spar r VerdictHandlerResult verdictHandlerResultCore bindCky mbteam = \case SAML.AccessDenied reasons -> do pure $ VerifyHandlerDenied reasons @@ -680,3 +706,78 @@ errorPage err inputs mcky = " 
" <> (cs . toText . encodeBase64 . cs . show $ (err, inputs, mcky)) <> "
", "" ] + +-- | Like 'getIdPIdByIssuer', but do not require a 'TeamId'. If none is provided, see if a +-- single solution can be found without. +getIdPIdByIssuerAllowOld :: + (HasCallStack) => + Member IdPEffect.IdP r => + SAML.Issuer -> + Maybe TeamId -> + Spar r (GetIdPResult SAML.IdPId) +getIdPIdByIssuerAllowOld issuer mbteam = do + mbv2 <- liftSem $ maybe (pure Nothing) (IdPEffect.getIdByIssuerWithTeam issuer) mbteam + mbv1v2 <- liftSem $ maybe (IdPEffect.getIdByIssuerWithoutTeam issuer) (pure . GetIdPFound) mbv2 + case (mbv1v2, mbteam) of + (GetIdPFound idpid, Just team) -> do + liftSem (IdPEffect.getConfig idpid) >>= \case + Nothing -> do + pure $ GetIdPDanglingId idpid + Just idp -> + pure $ + if idp ^. SAML.idpExtraInfo . wiTeam /= team + then GetIdPWrongTeam idpid + else mbv1v2 + _ -> pure mbv1v2 + +-- | See 'getIdPIdByIssuer' and 'mapGetIdPResult'. +getIdPConfigByIssuer :: + (HasCallStack, Member IdPEffect.IdP r) => + SAML.Issuer -> + TeamId -> + Spar r (GetIdPResult IdP) +getIdPConfigByIssuer issuer = + getIdPIdByIssuer issuer >=> mapGetIdPResult + +-- | See 'getIdPIdByIssuerAllowOld' and 'mapGetIdPResult'. +getIdPConfigByIssuerAllowOld :: + (HasCallStack, Member IdPEffect.IdP r) => + SAML.Issuer -> + Maybe TeamId -> + Spar r (GetIdPResult IdP) +getIdPConfigByIssuerAllowOld issuer = do + getIdPIdByIssuerAllowOld issuer >=> mapGetIdPResult + +-- | Same as 'getIdPIdByIssuerAllowOld', but you are guaranteed that the 'TeamId' is passed. +getIdPIdByIssuer :: + (HasCallStack, Member IdPEffect.IdP r) => + SAML.Issuer -> + TeamId -> + Spar r (GetIdPResult SAML.IdPId) +getIdPIdByIssuer issuer = getIdPIdByIssuerAllowOld issuer . Just + +-- | (There are probably category theoretical models for what we're doing here, but it's more +-- straight-forward to just handle the one instance we need.) +mapGetIdPResult :: (HasCallStack, Member IdPEffect.IdP r) => GetIdPResult SAML.IdPId -> Spar r (GetIdPResult IdP) +mapGetIdPResult (GetIdPFound i) = liftSem (IdPEffect.getConfig i) <&> maybe (GetIdPDanglingId i) GetIdPFound +mapGetIdPResult GetIdPNotFound = pure GetIdPNotFound +mapGetIdPResult (GetIdPDanglingId i) = pure (GetIdPDanglingId i) +mapGetIdPResult (GetIdPNonUnique is) = pure (GetIdPNonUnique is) +mapGetIdPResult (GetIdPWrongTeam i) = pure (GetIdPWrongTeam i) + +-- | Delete all tokens belonging to a team. +deleteTeam :: + (HasCallStack, Members [SAMLUser, IdPEffect.IdP] r) => + TeamId -> + Spar r () +deleteTeam team = do + liftMonadClient $ Data.deleteTeamScimTokens team + -- Since IdPs are not shared between teams, we can look at the set of IdPs + -- used by the team, and remove everything related to those IdPs, too. + idps <- liftSem $ IdPEffect.getConfigsByTeam team + for_ idps $ \idp -> do + let idpid = idp ^. SAML.idpId + issuer = idp ^. SAML.idpMetadata . SAML.edIssuer + liftSem $ do + SAMLUser.deleteByIssuer issuer + IdPEffect.deleteConfig idpid issuer team diff --git a/services/spar/src/Spar/Data.hs b/services/spar/src/Spar/Data.hs index d523149563e..96c4403ba24 100644 --- a/services/spar/src/Spar/Data.hs +++ b/services/spar/src/Spar/Data.hs @@ -58,13 +58,10 @@ module Spar.Data clearReplacedBy, GetIdPResult (..), getIdPConfig, - getIdPConfigByIssuer, - getIdPConfigByIssuerAllowOld, - getIdPIdByIssuer, - getIdPIdByIssuerAllowOld, + getIdPIdByIssuerWithoutTeam, + getIdPIdByIssuerWithTeam, getIdPConfigsByTeam, deleteIdPConfig, - deleteTeam, storeIdPRawMetadata, getIdPRawMetadata, deleteIdPRawMetadata, @@ -110,6 +107,7 @@ import SAML2.Util (renderURI) import qualified SAML2.WebSSO as SAML import qualified SAML2.WebSSO.Types.Email as SAMLEmail import Spar.Data.Instances (VerdictFormatCon, VerdictFormatRow, fromVerdictFormat, toVerdictFormat) +import Spar.Sem.IdP (GetIdPResult (..), Replaced (..), Replacing (..)) import Text.RawString.QQ import URI.ByteString import qualified Web.Cookie as Cky @@ -465,10 +463,6 @@ storeIdPConfig idp = retry x5 . batch $ do byTeam :: PrepQuery W (SAML.IdPId, TeamId) () byTeam = "INSERT INTO team_idp (idp, team) VALUES (?, ?)" -newtype Replaced = Replaced SAML.IdPId - -newtype Replacing = Replacing SAML.IdPId - -- | See also: test case @"{set,clear}ReplacedBy"@ in integration tests ("Test.Spar.DataSpec"). setReplacedBy :: (HasCallStack, MonadClient m) => @@ -521,78 +515,6 @@ getIdPConfig idpid = sel :: PrepQuery R (Identity SAML.IdPId) IdPConfigRow sel = "SELECT idp, issuer, request_uri, public_key, extra_public_keys, team, api_version, old_issuers, replaced_by FROM idp WHERE idp = ?" -data GetIdPResult a - = GetIdPFound a - | GetIdPNotFound - | -- | IdPId has been found, but no IdPConfig matching that Id. (Database - -- inconsistency or race condition.) - GetIdPDanglingId SAML.IdPId - | -- | You were looking for an idp by just providing issuer, not teamid, and `issuer_idp_v2` - -- has more than one entry (for different teams). - GetIdPNonUnique [SAML.IdPId] - | -- | An IdP was found, but it lives in another team than the one you were looking for. - -- This should be handled similarly to NotFound in most cases. - GetIdPWrongTeam SAML.IdPId - deriving (Eq, Show) - --- | (There are probably category theoretical models for what we're doing here, but it's more --- straight-forward to just handle the one instance we need.) -mapGetIdPResult :: (HasCallStack, MonadClient m) => GetIdPResult SAML.IdPId -> m (GetIdPResult IdP) -mapGetIdPResult (GetIdPFound i) = getIdPConfig i <&> maybe (GetIdPDanglingId i) GetIdPFound -mapGetIdPResult GetIdPNotFound = pure GetIdPNotFound -mapGetIdPResult (GetIdPDanglingId i) = pure (GetIdPDanglingId i) -mapGetIdPResult (GetIdPNonUnique is) = pure (GetIdPNonUnique is) -mapGetIdPResult (GetIdPWrongTeam i) = pure (GetIdPWrongTeam i) - --- | See 'getIdPIdByIssuer'. -getIdPConfigByIssuer :: - (HasCallStack, MonadClient m) => - SAML.Issuer -> - TeamId -> - m (GetIdPResult IdP) -getIdPConfigByIssuer issuer = - getIdPIdByIssuer issuer >=> mapGetIdPResult - --- | See 'getIdPIdByIssuerAllowOld'. -getIdPConfigByIssuerAllowOld :: - (HasCallStack, MonadClient m) => - SAML.Issuer -> - Maybe TeamId -> - m (GetIdPResult IdP) -getIdPConfigByIssuerAllowOld issuer = do - getIdPIdByIssuerAllowOld issuer >=> mapGetIdPResult - --- | Lookup idp in table `issuer_idp_v2` (using both issuer entityID and teamid); if nothing --- is found there or if teamid is 'Nothing', lookup under issuer in `issuer_idp`. -getIdPIdByIssuer :: - (HasCallStack, MonadClient m) => - SAML.Issuer -> - TeamId -> - m (GetIdPResult SAML.IdPId) -getIdPIdByIssuer issuer = getIdPIdByIssuerAllowOld issuer . Just - --- | Like 'getIdPIdByIssuer', but do not require a 'TeamId'. If none is provided, see if a --- single solution can be found without. -getIdPIdByIssuerAllowOld :: - (HasCallStack, MonadClient m) => - SAML.Issuer -> - Maybe TeamId -> - m (GetIdPResult SAML.IdPId) -getIdPIdByIssuerAllowOld issuer mbteam = do - mbv2 <- maybe (pure Nothing) (getIdPIdByIssuerWithTeam issuer) mbteam - mbv1v2 <- maybe (getIdPIdByIssuerWithoutTeam issuer) (pure . GetIdPFound) mbv2 - case (mbv1v2, mbteam) of - (GetIdPFound idpid, Just team) -> do - getIdPConfig idpid >>= \case - Nothing -> do - pure $ GetIdPDanglingId idpid - Just idp -> - pure $ - if idp ^. SAML.idpExtraInfo . wiTeam /= team - then GetIdPWrongTeam idpid - else mbv1v2 - _ -> pure mbv1v2 - -- | Find 'IdPId' without team. Search both `issuer_idp_v2` and `issuer_idp`; in the former, -- make sure the result is unique (no two IdPs for two different teams). getIdPIdByIssuerWithoutTeam :: @@ -668,22 +590,6 @@ deleteIdPConfig idp issuer team = retry x5 . batch $ do delTeamIdp :: PrepQuery W (TeamId, SAML.IdPId) () delTeamIdp = "DELETE FROM team_idp WHERE team = ? and idp = ?" --- | Delete all tokens belonging to a team. -deleteTeam :: - (HasCallStack, MonadClient m) => - TeamId -> - m () -deleteTeam team = do - deleteTeamScimTokens team - -- Since IdPs are not shared between teams, we can look at the set of IdPs - -- used by the team, and remove everything related to those IdPs, too. - idps <- getIdPConfigsByTeam team - for_ idps $ \idp -> do - let idpid = idp ^. SAML.idpId - issuer = idp ^. SAML.idpMetadata . SAML.edIssuer - deleteSAMLUsersByIssuer issuer - deleteIdPConfig idpid issuer team - storeIdPRawMetadata :: (HasCallStack, MonadClient m) => SAML.IdPId -> diff --git a/services/spar/src/Spar/Scim.hs b/services/spar/src/Spar/Scim.hs index 48eb9f6be07..9042d605c1e 100644 --- a/services/spar/src/Spar/Scim.hs +++ b/services/spar/src/Spar/Scim.hs @@ -82,6 +82,7 @@ import Spar.Error ) import Spar.Scim.Auth import Spar.Scim.User +import qualified Spar.Sem.IdP as IdPEffect import Spar.Sem.SAMLUser (SAMLUser) import qualified Web.Scim.Capabilities.MetaSchema as Scim.Meta import qualified Web.Scim.Class.Auth as Scim.Auth @@ -100,7 +101,7 @@ import Wire.API.User.Scim configuration :: Scim.Meta.Configuration configuration = Scim.Meta.empty -apiScim :: Member SAMLUser r => ServerT APIScim (Spar r) +apiScim :: Members [IdPEffect.IdP, SAMLUser] r => ServerT APIScim (Spar r) apiScim = hoistScim (toServant (server configuration)) :<|> apiScimToken diff --git a/services/spar/src/Spar/Scim/Auth.hs b/services/spar/src/Spar/Scim/Auth.hs index cfb76293bf8..519beb0f3a9 100644 --- a/services/spar/src/Spar/Scim/Auth.hs +++ b/services/spar/src/Spar/Scim/Auth.hs @@ -41,14 +41,17 @@ import Data.String.Conversions (cs) import Data.Time (getCurrentTime) import Imports import OpenSSL.Random (randBytes) +-- FUTUREWORK: these imports are not very handy. split up Spar.Scim into +-- Spar.Scim.{Core,User,Group} to avoid at least some of the hscim name clashes? + +import Polysemy import qualified SAML2.WebSSO as SAML import Servant (NoContent (NoContent), ServerT, (:<|>) ((:<|>))) -import Spar.App (Spar, sparCtxOpts, wrapMonadClient) -import qualified Spar.Data as Data +import Spar.App (Spar, sparCtxOpts, wrapMonadClient, wrapMonadClientSem) +import qualified Spar.Data as Data hiding (clearReplacedBy, deleteIdPRawMetadata, getIdPConfig, getIdPConfigsByTeam, getIdPIdByIssuerWithTeam, getIdPIdByIssuerWithoutTeam, getIdPRawMetadata, setReplacedBy, storeIdPConfig, storeIdPRawMetadata) import qualified Spar.Error as E import qualified Spar.Intra.Brig as Intra.Brig --- FUTUREWORK: these imports are not very handy. split up Spar.Scim into --- Spar.Scim.{Core,User,Group} to avoid at least some of the hscim name clashes? +import qualified Spar.Sem.IdP as IdPEffect import qualified Web.Scim.Class.Auth as Scim.Class.Auth import qualified Web.Scim.Handler as Scim import qualified Web.Scim.Schema.Error as Scim @@ -73,7 +76,7 @@ instance Scim.Class.Auth.AuthDB SparTag (Spar r) where -- | API for manipulating SCIM tokens (protected by normal Wire authentication and available -- only to team owners). -apiScimToken :: ServerT APIScimToken (Spar r) +apiScimToken :: Member IdPEffect.IdP r => ServerT APIScimToken (Spar r) apiScimToken = createScimToken :<|> deleteScimToken @@ -83,6 +86,7 @@ apiScimToken = -- -- Create a token for user's team. createScimToken :: + Member IdPEffect.IdP r => -- | Who is trying to create a token Maybe UserId -> -- | Request body @@ -96,7 +100,7 @@ createScimToken zusr CreateScimToken {..} = do maxTokens <- asks (maxScimTokens . sparCtxOpts) unless (tokenNumber < maxTokens) $ E.throwSpar E.SparProvisioningTokenLimitReached - idps <- wrapMonadClient $ Data.getIdPConfigsByTeam teamid + idps <- wrapMonadClientSem $ IdPEffect.getConfigsByTeam teamid let caseOneOrNoIdP :: Maybe SAML.IdPId -> Spar r CreateScimTokenResponse caseOneOrNoIdP midpid = do diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 2acf2bf75d1..9096450690c 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -65,12 +65,14 @@ import Imports import Network.URI (URI, parseURI) import Polysemy import qualified SAML2.WebSSO as SAML -import Spar.App (GetUserResult (..), Spar, getUserIdByScimExternalId, getUserIdByUref, sparCtxOpts, validateEmailIfExists, wrapMonadClient) -import qualified Spar.Data as Data +import Spar.App (GetUserResult (..), Spar, getUserIdByScimExternalId, getUserIdByUref, liftMonadClient, liftSem, sparCtxOpts, validateEmailIfExists, wrapMonadClient, wrapMonadClientSem, wrapSpar) +import qualified Spar.Data as Data hiding (clearReplacedBy, deleteIdPRawMetadata, getIdPConfig, getIdPConfigsByTeam, getIdPIdByIssuerWithTeam, getIdPIdByIssuerWithoutTeam, getIdPRawMetadata, setReplacedBy, storeIdPConfig, storeIdPRawMetadata) import qualified Spar.Intra.Brig as Brig import Spar.Scim.Auth () import qualified Spar.Scim.Types as ST +import qualified Spar.Sem.IdP as IdPEffect import Spar.Sem.SAMLUser (SAMLUser) +import qualified Spar.Sem.SAMLUser as SAMLUser import qualified System.Logger.Class as Log import System.Logger.Message (Msg) import qualified URI.ByteString as URIBS @@ -96,7 +98,7 @@ import qualified Wire.API.User.Scim as ST ---------------------------------------------------------------------------- -- UserDB instance -instance Member SAMLUser r => Scim.UserDB ST.SparTag (Spar r) where +instance (Members [IdPEffect.IdP, SAMLUser] r) => Scim.UserDB ST.SparTag (Spar r) where getUsers :: ScimTokenInfo -> Maybe Scim.Filter -> @@ -110,7 +112,7 @@ instance Member SAMLUser r => Scim.UserDB ST.SparTag (Spar r) where . logFilter filter' ) $ do - mIdpConfig <- maybe (pure Nothing) (lift . wrapMonadClient . Data.getIdPConfig) stiIdP + mIdpConfig <- maybe (pure Nothing) (lift . wrapMonadClientSem . IdPEffect.getConfig) stiIdP case filter' of Scim.FilterAttrCompare (Scim.AttrPath schema attrName _subAttr) Scim.OpEq (Scim.ValString val) | Scim.isUserSchema schema -> do @@ -133,7 +135,7 @@ instance Member SAMLUser r => Scim.UserDB ST.SparTag (Spar r) where . logTokenInfo tokeninfo ) $ do - mIdpConfig <- maybe (pure Nothing) (lift . wrapMonadClient . Data.getIdPConfig) stiIdP + mIdpConfig <- maybe (pure Nothing) (lift . wrapMonadClientSem . IdPEffect.getConfig) stiIdP let notfound = Scim.notFound "User" (idToText uid) brigUser <- lift (Brig.getBrigUserAccount Brig.WithPendingInvitations uid) >>= maybe (throwError notfound) pure unless (userTeam (accountUser brigUser) == Just stiTeam) (throwError notfound) @@ -172,6 +174,7 @@ instance Member SAMLUser r => Scim.UserDB ST.SparTag (Spar r) where validateScimUser :: forall m r. (m ~ Scim.ScimHandler (Spar r)) => + Member IdPEffect.IdP r => -- | Used to decide what IdP to assign the user to ScimTokenInfo -> Scim.User ST.SparTag -> @@ -181,9 +184,9 @@ validateScimUser tokinfo user = do richInfoLimit <- lift $ asks (richInfoLimit . sparCtxOpts) validateScimUser' mIdpConfig richInfoLimit user -tokenInfoToIdP :: ScimTokenInfo -> Scim.ScimHandler (Spar r) (Maybe IdP) +tokenInfoToIdP :: Member IdPEffect.IdP r => ScimTokenInfo -> Scim.ScimHandler (Spar r) (Maybe IdP) tokenInfoToIdP ScimTokenInfo {stiIdP} = do - maybe (pure Nothing) (lift . wrapMonadClient . Data.getIdPConfig) stiIdP + maybe (pure Nothing) (lift . wrapMonadClientSem . IdPEffect.getConfig) stiIdP -- | Validate a handle (@userName@). validateHandle :: MonadError Scim.ScimError m => Text -> m Handle @@ -423,12 +426,12 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid lift $ Log.debug (Log.msg $ "createValidScimUser: spar says " <> show storedUser) -- {(arianvp): these two actions we probably want to make transactional.} - lift . wrapMonadClient $ do + lift . wrapSpar $ do -- Store scim timestamps, saml credentials, scim externalId locally in spar. - Data.writeScimUserTimes storedUser + liftMonadClient $ Data.writeScimUserTimes storedUser ST.runValidExternalId - (`Data.insertSAMLUser` buid) - (\email -> Data.insertScimExternalId stiTeam email buid) + (liftSem . (`SAMLUser.insert` buid)) + (\email -> liftMonadClient $ Data.insertScimExternalId stiTeam email buid) veid -- If applicable, trigger email validation procedure on brig. @@ -445,6 +448,7 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid -- TODO(arianvp): how do we get this safe w.r.t. race conditions / crashes? updateValidScimUser :: forall m r. + Member IdPEffect.IdP r => Member SAMLUser r => (m ~ Scim.ScimHandler (Spar r)) => ScimTokenInfo -> @@ -500,6 +504,7 @@ updateValidScimUser tokinfo@ScimTokenInfo {stiTeam} uid newValidScimUser = pure newScimStoredUser updateVsuUref :: + Member SAMLUser r => TeamId -> UserId -> ST.ValidExternalId -> @@ -511,9 +516,9 @@ updateVsuUref team uid old new = do (mo, mn@(Just newuref)) | mo /= mn -> validateEmailIfExists uid newuref _ -> pure () - wrapMonadClient $ do - old & ST.runValidExternalId (Data.deleteSAMLUser uid) (Data.deleteScimExternalId team) - new & ST.runValidExternalId (`Data.insertSAMLUser` uid) (\email -> Data.insertScimExternalId team email uid) + wrapSpar $ do + old & ST.runValidExternalId (liftSem . (SAMLUser.delete uid)) (liftMonadClient . Data.deleteScimExternalId team) + new & ST.runValidExternalId (liftSem . (`SAMLUser.insert` uid)) (\email -> liftMonadClient $ Data.insertScimExternalId team email uid) Brig.setBrigUserVeid uid new @@ -571,7 +576,7 @@ updScimStoredUser' now usr (Scim.WithMeta meta (Scim.WithId scimuid _)) = Scim.version = calculateVersion scimuid usr } -deleteScimUser :: ScimTokenInfo -> UserId -> Scim.ScimHandler (Spar r) () +deleteScimUser :: Members [SAMLUser, IdPEffect.IdP] r => ScimTokenInfo -> UserId -> Scim.ScimHandler (Spar r) () deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = logScim ( logFunction "Spar.Scim.User.deleteScimUser" @@ -593,15 +598,15 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = throwError $ Scim.notFound "user" (idToText uid) - mIdpConfig <- maybe (pure Nothing) (lift . wrapMonadClient . Data.getIdPConfig) stiIdP + mIdpConfig <- maybe (pure Nothing) (lift . wrapMonadClientSem . IdPEffect.getConfig) stiIdP case Brig.veidFromBrigUser brigUser ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) of Left _ -> pure () Right veid -> - lift . wrapMonadClient $ + lift . wrapSpar $ ST.runValidExternalId - (Data.deleteSAMLUser uid) - (Data.deleteScimExternalId stiTeam) + (liftSem . SAMLUser.delete uid) + (liftMonadClient . Data.deleteScimExternalId stiTeam) veid lift . wrapMonadClient $ Data.deleteScimUserTimes uid @@ -793,7 +798,7 @@ scimFindUserByHandle mIdpConfig stiTeam hndl = do -- -- Note the user won't get an entry in `spar.user`. That will only happen on their first -- successful authentication with their SAML credentials. -scimFindUserByEmail :: Maybe IdP -> TeamId -> Text -> MaybeT (Scim.ScimHandler (Spar r)) (Scim.StoredUser ST.SparTag) +scimFindUserByEmail :: forall r. Member SAMLUser r => Maybe IdP -> TeamId -> Text -> MaybeT (Scim.ScimHandler (Spar r)) (Scim.StoredUser ST.SparTag) scimFindUserByEmail mIdpConfig stiTeam email = do -- Azure has been observed to search for externalIds that are not emails, even if the -- mapping is set up like it should be. This is a problem: if there is no SAML IdP, 'mkValidExternalId' @@ -809,7 +814,7 @@ scimFindUserByEmail mIdpConfig stiTeam email = do where withUref :: SAML.UserRef -> Spar r (Maybe UserId) withUref uref = do - wrapMonadClient (Data.getSAMLUser uref) >>= \case + wrapMonadClientSem (SAMLUser.get uref) >>= \case Nothing -> maybe (pure Nothing) withEmailOnly $ Brig.urefToEmail uref Just uid -> pure (Just uid) diff --git a/services/spar/src/Spar/Sem/IdP.hs b/services/spar/src/Spar/Sem/IdP.hs new file mode 100644 index 00000000000..946561fe7a3 --- /dev/null +++ b/services/spar/src/Spar/Sem/IdP.hs @@ -0,0 +1,43 @@ +module Spar.Sem.IdP where + +import Data.Id +import Imports +import Polysemy +import qualified SAML2.WebSSO as SAML +import qualified Wire.API.User.IdentityProvider as IP + +data GetIdPResult a + = GetIdPFound a + | GetIdPNotFound + | -- | IdPId has been found, but no IdPConfig matching that Id. (Database + -- inconsistency or race condition.) + GetIdPDanglingId SAML.IdPId + | -- | You were looking for an idp by just providing issuer, not teamid, and `issuer_idp_v2` + -- has more than one entry (for different teams). + GetIdPNonUnique [SAML.IdPId] + | -- | An IdP was found, but it lives in another team than the one you were looking for. + -- This should be handled similarly to NotFound in most cases. + GetIdPWrongTeam SAML.IdPId + deriving (Eq, Show) + +newtype Replaced = Replaced SAML.IdPId + +newtype Replacing = Replacing SAML.IdPId + +data IdP m a where + StoreConfig :: IP.IdP -> IdP m () + GetConfig :: SAML.IdPId -> IdP m (Maybe IP.IdP) + GetIdByIssuerWithoutTeam :: SAML.Issuer -> IdP m (GetIdPResult SAML.IdPId) + GetIdByIssuerWithTeam :: SAML.Issuer -> TeamId -> IdP m (Maybe SAML.IdPId) + GetConfigsByTeam :: TeamId -> IdP m [IP.IdP] + DeleteConfig :: SAML.IdPId -> SAML.Issuer -> TeamId -> IdP m () + SetReplacedBy :: Replaced -> Replacing -> IdP m () + ClearReplacedBy :: Replaced -> IdP m () + -- TODO(sandy): maybe this wants to be a separate effect + -- data Metadata m a wher e + StoreRawMetadata :: SAML.IdPId -> Text -> IdP m () + GetRawMetadata :: SAML.IdPId -> IdP m (Maybe Text) + DeleteRawMetadata :: SAML.IdPId -> IdP m () + +-- TODO(sandy): Inline this definition --- no TH +makeSem ''IdP diff --git a/services/spar/src/Spar/Sem/IdP/Cassandra.hs b/services/spar/src/Spar/Sem/IdP/Cassandra.hs new file mode 100644 index 00000000000..286eb2301ee --- /dev/null +++ b/services/spar/src/Spar/Sem/IdP/Cassandra.hs @@ -0,0 +1,27 @@ +module Spar.Sem.IdP.Cassandra where + +import Cassandra +import Imports +import Polysemy +import qualified Spar.Data as Data +import Spar.Sem.IdP + +idPToCassandra :: + forall m r a. + (MonadClient m, Member (Embed m) r) => + Sem (IdP ': r) a -> + Sem r a +idPToCassandra = + interpret $ + embed @m . \case + StoreConfig iw -> Data.storeIdPConfig iw + GetConfig i -> Data.getIdPConfig i + GetIdByIssuerWithoutTeam i -> Data.getIdPIdByIssuerWithoutTeam i + GetIdByIssuerWithTeam i t -> Data.getIdPIdByIssuerWithTeam i t + GetConfigsByTeam itlt -> Data.getIdPConfigsByTeam itlt + DeleteConfig i i11 itlt -> Data.deleteIdPConfig i i11 itlt + SetReplacedBy r r11 -> Data.setReplacedBy r r11 + ClearReplacedBy r -> Data.clearReplacedBy r + StoreRawMetadata i t -> Data.storeIdPRawMetadata i t + GetRawMetadata i -> Data.getIdPRawMetadata i + DeleteRawMetadata i -> Data.deleteIdPRawMetadata i diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs index 0a26514b2a3..dad4316f3b6 100644 --- a/services/spar/test-integration/Test/Spar/APISpec.hs +++ b/services/spar/test-integration/Test/Spar/APISpec.hs @@ -70,8 +70,9 @@ import qualified SAML2.WebSSO as SAML import SAML2.WebSSO.Test.Lenses import SAML2.WebSSO.Test.MockResponse import SAML2.WebSSO.Test.Util -import qualified Spar.Data as Data +import Spar.App (liftSem) import qualified Spar.Intra.Brig as Intra +import qualified Spar.Sem.IdP as IdPEffect import Text.XML.DSig (SignPrivCreds, mkSignCredsWithCert) import qualified URI.ByteString as URI import URI.ByteString.QQ (uri) @@ -868,7 +869,7 @@ specCRUDIdentityProvider = do pure $ idpmeta1 & edIssuer .~ (idpmeta3 ^. edIssuer) do - midp <- runSparCass $ Data.getIdPConfig idpid1 + midp <- runSpar $ liftSem $ IdPEffect.getConfig idpid1 liftIO $ do (midp ^? _Just . idpMetadata . edIssuer) `shouldBe` Just (idpmeta1 ^. edIssuer) (midp ^? _Just . idpExtraInfo . wiOldIssuers) `shouldBe` Just [] @@ -881,7 +882,7 @@ specCRUDIdentityProvider = do resp <- call $ callIdpUpdate' (env ^. teSpar) (Just owner1) idpid1 (IdPMetadataValue (cs $ SAML.encode new) undefined) liftIO $ statusCode resp `shouldBe` 200 - midp <- runSparCass $ Data.getIdPConfig idpid1 + midp <- runSpar $ liftSem $ IdPEffect.getConfig idpid1 liftIO $ do (midp ^? _Just . idpMetadata . edIssuer) `shouldBe` Just (new ^. edIssuer) sort <$> (midp ^? _Just . idpExtraInfo . wiOldIssuers) `shouldBe` Just (sort $ olds <&> (^. edIssuer)) diff --git a/services/spar/test-integration/Test/Spar/AppSpec.hs b/services/spar/test-integration/Test/Spar/AppSpec.hs index a357d2b4091..8cee5f66520 100644 --- a/services/spar/test-integration/Test/Spar/AppSpec.hs +++ b/services/spar/test-integration/Test/Spar/AppSpec.hs @@ -33,9 +33,10 @@ import Imports import SAML2.WebSSO as SAML import qualified SAML2.WebSSO.Test.MockResponse as SAML import qualified Servant +import Spar.App (liftSem) import qualified Spar.App as Spar -import qualified Spar.Data as Data import Spar.Orphans () +import qualified Spar.Sem.SAMLUser as SAMLUser import qualified Text.XML as XML import qualified Text.XML.DSig as DSig import URI.ByteString as URI @@ -180,5 +181,5 @@ requestAccessVerdict idp isGranted mkAuthnReq = do $ outcome qry :: [(SBS, SBS)] qry = queryPairs $ uriQuery loc - muid <- runSparCass $ Data.getSAMLUser uref + muid <- runSpar $ liftSem $ SAMLUser.get uref pure (muid, outcome, loc, qry) diff --git a/services/spar/test-integration/Test/Spar/DataSpec.hs b/services/spar/test-integration/Test/Spar/DataSpec.hs index 0662956fc69..117e69fcb10 100644 --- a/services/spar/test-integration/Test/Spar/DataSpec.hs +++ b/services/spar/test-integration/Test/Spar/DataSpec.hs @@ -31,8 +31,11 @@ import Data.UUID as UUID import Data.UUID.V4 as UUID import Imports import SAML2.WebSSO as SAML +import Spar.App as App import Spar.Data as Data import Spar.Intra.Brig (veidFromUserSSOId) +import qualified Spar.Sem.IdP as IdPEffect +import qualified Spar.Sem.SAMLUser as SAMLUser import Type.Reflection (typeRep) import URI.ByteString.QQ (uri) import Util.Core @@ -108,34 +111,34 @@ spec = do context "user is new" $ do it "getUser returns Nothing" $ do uref <- nextUserRef - muid <- runSparCass $ Data.getSAMLUser uref + muid <- runSpar $ liftSem $ SAMLUser.get uref liftIO $ muid `shouldBe` Nothing it "inserts new user and responds with 201 / returns new user" $ do uref <- nextUserRef uid <- nextWireId - () <- runSparCass $ Data.insertSAMLUser uref uid - muid <- runSparCass $ Data.getSAMLUser uref + () <- runSpar $ liftSem $ SAMLUser.insert uref uid + muid <- runSpar $ liftSem $ SAMLUser.get uref liftIO $ muid `shouldBe` Just uid context "user already exists (idempotency)" $ do it "inserts new user and responds with 201 / returns new user" $ do uref <- nextUserRef uid <- nextWireId uid' <- nextWireId - () <- runSparCass $ Data.insertSAMLUser uref uid - () <- runSparCass $ Data.insertSAMLUser uref uid' - muid <- runSparCass $ Data.getSAMLUser uref + () <- runSpar $ liftSem $ SAMLUser.insert uref uid + () <- runSpar $ liftSem $ SAMLUser.insert uref uid' + muid <- runSpar $ liftSem $ SAMLUser.get uref liftIO $ muid `shouldBe` Just uid' describe "DELETE" $ do it "works" $ do uref <- nextUserRef uid <- nextWireId do - () <- runSparCass $ Data.insertSAMLUser uref uid - muid <- runSparCass (Data.getSAMLUser uref) + () <- runSpar $ liftSem $ SAMLUser.insert uref uid + muid <- runSpar $ liftSem (SAMLUser.get uref) liftIO $ muid `shouldBe` Just uid do - () <- runSparCass $ Data.deleteSAMLUser uid uref - muid <- runSparCass (Data.getSAMLUser uref) `aFewTimes` isNothing + () <- runSpar $ liftSem $ SAMLUser.delete uid uref + muid <- runSpar (liftSem $ SAMLUser.get uref) `aFewTimes` isNothing liftIO $ muid `shouldBe` Nothing describe "BindCookie" $ do let mkcky :: TestSpar SetBindCookie @@ -164,57 +167,57 @@ spec = do describe "IdPConfig" $ do it "storeIdPConfig, getIdPConfig are \"inverses\"" $ do idp <- makeTestIdP - () <- runSparCass $ Data.storeIdPConfig idp - midp <- runSparCass $ Data.getIdPConfig (idp ^. idpId) + () <- runSpar $ liftSem $ IdPEffect.storeConfig idp + midp <- runSpar $ liftSem $ IdPEffect.getConfig (idp ^. idpId) liftIO $ midp `shouldBe` Just idp it "getIdPConfigByIssuer works" $ do idp <- makeTestIdP - () <- runSparCass $ Data.storeIdPConfig idp - midp <- runSparCass $ Data.getIdPConfigByIssuer (idp ^. idpMetadata . edIssuer) (idp ^. SAML.idpExtraInfo . wiTeam) + () <- runSpar $ liftSem $ IdPEffect.storeConfig idp + midp <- runSpar $ App.getIdPConfigByIssuer (idp ^. idpMetadata . edIssuer) (idp ^. SAML.idpExtraInfo . wiTeam) liftIO $ midp `shouldBe` GetIdPFound idp it "getIdPIdByIssuer works" $ do idp <- makeTestIdP - () <- runSparCass $ Data.storeIdPConfig idp - midp <- runSparCass $ Data.getIdPIdByIssuer (idp ^. idpMetadata . edIssuer) (idp ^. SAML.idpExtraInfo . wiTeam) + () <- runSpar $ liftSem $ IdPEffect.storeConfig idp + midp <- runSpar $ App.getIdPIdByIssuer (idp ^. idpMetadata . edIssuer) (idp ^. SAML.idpExtraInfo . wiTeam) liftIO $ midp `shouldBe` GetIdPFound (idp ^. idpId) it "getIdPConfigsByTeam works" $ do skipIdPAPIVersions [WireIdPAPIV1] teamid <- nextWireId idp <- makeTestIdP <&> idpExtraInfo .~ (WireIdP teamid Nothing [] Nothing) - () <- runSparCass $ Data.storeIdPConfig idp - idps <- runSparCass $ Data.getIdPConfigsByTeam teamid + () <- runSpar $ liftSem $ IdPEffect.storeConfig idp + idps <- runSpar $ liftSem $ IdPEffect.getConfigsByTeam teamid liftIO $ idps `shouldBe` [idp] it "deleteIdPConfig works" $ do teamid <- nextWireId idpApiVersion <- asks (^. teWireIdPAPIVersion) idp <- makeTestIdP <&> idpExtraInfo .~ (WireIdP teamid (Just idpApiVersion) [] Nothing) - () <- runSparCass $ Data.storeIdPConfig idp + () <- runSpar $ liftSem $ IdPEffect.storeConfig idp do - midp <- runSparCass $ Data.getIdPConfig (idp ^. idpId) + midp <- runSpar $ liftSem $ IdPEffect.getConfig (idp ^. idpId) liftIO $ midp `shouldBe` Just idp - () <- runSparCass $ Data.deleteIdPConfig (idp ^. idpId) (idp ^. idpMetadata . edIssuer) teamid + () <- runSpar $ liftSem $ IdPEffect.deleteConfig (idp ^. idpId) (idp ^. idpMetadata . edIssuer) teamid do - midp <- runSparCass $ Data.getIdPConfig (idp ^. idpId) + midp <- runSpar $ liftSem $ IdPEffect.getConfig (idp ^. idpId) liftIO $ midp `shouldBe` Nothing do - midp <- runSparCass $ Data.getIdPConfigByIssuer (idp ^. idpMetadata . edIssuer) (idp ^. SAML.idpExtraInfo . wiTeam) + midp <- runSpar $ App.getIdPConfigByIssuer (idp ^. idpMetadata . edIssuer) (idp ^. SAML.idpExtraInfo . wiTeam) liftIO $ midp `shouldBe` GetIdPNotFound do - midp <- runSparCass $ Data.getIdPIdByIssuer (idp ^. idpMetadata . edIssuer) (idp ^. SAML.idpExtraInfo . wiTeam) + midp <- runSpar $ App.getIdPIdByIssuer (idp ^. idpMetadata . edIssuer) (idp ^. SAML.idpExtraInfo . wiTeam) liftIO $ midp `shouldBe` GetIdPNotFound do - idps <- runSparCass $ Data.getIdPConfigsByTeam teamid + idps <- runSpar $ liftSem $ IdPEffect.getConfigsByTeam teamid liftIO $ idps `shouldBe` [] describe "{set,clear}ReplacedBy" $ do it "handle non-existent idps gradefully" $ do pendingWith "this requires a cql{,-io} upgrade. https://gitlab.com/twittner/cql-io/-/issues/7" idp1 <- makeTestIdP idp2 <- makeTestIdP - runSparCass (Data.setReplacedBy (Data.Replaced (idp1 ^. idpId)) (Data.Replacing (idp2 ^. idpId))) - idp1' <- runSparCass (Data.getIdPConfig (idp1 ^. idpId)) + runSpar $ liftSem $ IdPEffect.setReplacedBy (Data.Replaced (idp1 ^. idpId)) (Data.Replacing (idp2 ^. idpId)) + idp1' <- runSpar $ liftSem (IdPEffect.getConfig (idp1 ^. idpId)) liftIO $ idp1' `shouldBe` Nothing - runSparCass (Data.clearReplacedBy (Data.Replaced (idp1 ^. idpId))) - idp2' <- runSparCass (Data.getIdPConfig (idp1 ^. idpId)) + runSpar $ liftSem $ IdPEffect.clearReplacedBy (Data.Replaced (idp1 ^. idpId)) + idp2' <- runSpar $ liftSem (IdPEffect.getConfig (idp1 ^. idpId)) liftIO $ idp2' `shouldBe` Nothing testSPStoreID :: @@ -265,7 +268,7 @@ testDeleteTeam = it "cleans up all the right tables after deletion" $ do ssoid1 <- getSsoidViaSelf (getUid storedUser1) ssoid2 <- getSsoidViaSelf (getUid storedUser2) -- Delete the team - runSparCass $ Data.deleteTeam tid + runSpar $ App.deleteTeam tid -- See that everything got cleaned up. -- -- The token from 'team_provisioning_by_token': @@ -280,33 +283,35 @@ testDeleteTeam = it "cleans up all the right tables after deletion" $ do do mbUser1 <- case veidFromUserSSOId ssoid1 of Right veid -> - runSparCass $ - runValidExternalId - Data.getSAMLUser - undefined -- could be @Data.lookupScimExternalId@, but we don't hit that path. - veid + runSpar $ + liftSem $ + runValidExternalId + SAMLUser.get + undefined -- could be @Data.lookupScimExternalId@, but we don't hit that path. + veid Left _email -> undefined -- runSparCass . Data.lookupScimExternalId . fromEmail $ _email liftIO $ mbUser1 `shouldBe` Nothing do mbUser2 <- case veidFromUserSSOId ssoid2 of Right veid -> - runSparCass $ - runValidExternalId - Data.getSAMLUser - undefined - veid + runSpar $ + liftSem $ + runValidExternalId + SAMLUser.get + undefined + veid Left _email -> undefined liftIO $ mbUser2 `shouldBe` Nothing -- The config from 'idp': do - mbIdp <- runSparCass $ Data.getIdPConfig (idp ^. SAML.idpId) + mbIdp <- runSpar $ liftSem $ IdPEffect.getConfig (idp ^. SAML.idpId) liftIO $ mbIdp `shouldBe` Nothing -- The config from 'issuer_idp': do let issuer = idp ^. SAML.idpMetadata . SAML.edIssuer - mbIdp <- runSparCass $ Data.getIdPIdByIssuer issuer (idp ^. SAML.idpExtraInfo . wiTeam) + mbIdp <- runSpar $ App.getIdPIdByIssuer issuer (idp ^. SAML.idpExtraInfo . wiTeam) liftIO $ mbIdp `shouldBe` GetIdPNotFound -- The config from 'team_idp': do - idps <- runSparCass $ Data.getIdPConfigsByTeam tid + idps <- runSpar $ liftSem $ IdPEffect.getConfigsByTeam tid liftIO $ idps `shouldBe` [] diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index 4ade02f3eb9..6a83fc540c9 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -60,11 +60,13 @@ import Imports import qualified Network.Wai.Utilities.Error as Wai import qualified SAML2.WebSSO as SAML import qualified SAML2.WebSSO.Test.MockResponse as SAML +import Spar.App (liftSem) import Spar.Data (lookupScimExternalId) import qualified Spar.Data as Data import qualified Spar.Intra.Brig as Intra import Spar.Scim import qualified Spar.Scim.User as SU +import qualified Spar.Sem.SAMLUser as SAMLUser import qualified Text.XML.DSig as SAML import qualified URI.ByteString as URI import Util @@ -1317,7 +1319,7 @@ testUpdateExternalId withidp = do lookupByValidExternalId :: ValidExternalId -> TestSpar (Maybe UserId) lookupByValidExternalId = runValidExternalId - (runSparCass . Data.getSAMLUser) + (runSpar . liftSem . SAMLUser.get) ( \email -> do let action = SU.scimFindUserByEmail midp tid $ fromEmail email result <- runSpar . runExceptT . runMaybeT $ action diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index 17526e05c25..4f5b2281c1c 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -175,13 +175,16 @@ import qualified SAML2.WebSSO.API.Example as SAML import SAML2.WebSSO.Test.Lenses (userRefL) import SAML2.WebSSO.Test.MockResponse import SAML2.WebSSO.Test.Util (SampleIdP (..), makeSampleIdPMetadata) -import Spar.App (toLevel) +import Spar.App (liftMonadClient, liftSem, toLevel) import qualified Spar.App as Spar import qualified Spar.Data as Data import qualified Spar.Intra.Brig as Intra import qualified Spar.Options import Spar.Run +import qualified Spar.Sem.IdP as IdPEffect +import Spar.Sem.IdP.Cassandra import Spar.Sem.SAMLUser (SAMLUser) +import qualified Spar.Sem.SAMLUser as SAMLUser import Spar.Sem.SAMLUser.Cassandra import qualified System.Logger.Extended as Log import System.Random (randomRIO) @@ -1206,10 +1209,10 @@ callDeleteDefaultSsoCode sparreq_ = do ssoToUidSpar :: (HasCallStack, MonadIO m, MonadReader TestEnv m) => TeamId -> Brig.UserSSOId -> m (Maybe UserId) ssoToUidSpar tid ssoid = do veid <- either (error . ("could not parse brig sso_id: " <>)) pure $ Intra.veidFromUserSSOId ssoid - runSparCass @Client $ + runSpar $ runValidExternalId - Data.getSAMLUser - (Data.lookupScimExternalId tid) + (liftSem . SAMLUser.get) + (liftMonadClient . Data.lookupScimExternalId tid) veid runSparCass :: @@ -1242,11 +1245,11 @@ runSimpleSP action = do result <- SAML.runSimpleSP ctx action either (throwIO . ErrorCall . show) pure result -runSpar :: (MonadReader TestEnv m, MonadIO m) => Spar.Spar '[SAMLUser, Embed Client, Embed IO, Final IO] a -> m a +runSpar :: (MonadReader TestEnv m, MonadIO m) => Spar.Spar '[IdPEffect.IdP, SAMLUser, Embed Client, Embed IO, Final IO] a -> m a runSpar (Spar.Spar action) = do env <- (^. teSparEnv) <$> ask liftIO $ do - result <- runFinal $ embedToFinal @IO $ interpretClientToIO (Spar.sparCtxCas env) $ samlUserToCassandra @Cas.Client $ runExceptT $ action `runReaderT` env + result <- runFinal $ embedToFinal @IO $ interpretClientToIO (Spar.sparCtxCas env) $ samlUserToCassandra @Cas.Client $ idPToCassandra @Cas.Client $ runExceptT $ action `runReaderT` env either (throwIO . ErrorCall . show) pure result getSsoidViaSelf :: HasCallStack => UserId -> TestSpar UserSSOId @@ -1267,7 +1270,7 @@ getUserIdViaRef uref = maybe (error "not found") pure =<< getUserIdViaRef' uref getUserIdViaRef' :: HasCallStack => UserRef -> TestSpar (Maybe UserId) getUserIdViaRef' uref = do - aFewTimes (runSparCass $ Data.getSAMLUser uref) isJust + aFewTimes (runSpar $ liftSem $ SAMLUser.get uref) isJust checkErr :: HasCallStack => Int -> Maybe TestErrorLabel -> Assertions () checkErr status mlabel = do From c713f3159cd36fbf02e73453ef385f73eda2ee75 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 21 Sep 2021 09:20:24 +0200 Subject: [PATCH 37/72] Servantify other member update (#1784) * Convert convMemberNotFound to ErrorDescription * Servantify updateOtherMember endpoint * Add qualified endpoint stub for updateOtherMember * Add other member update tests Add tests that notifications are sent correctly (to local users) after updates to conversation member roles, using both the legacy and the qualified endpoint. --- .../deprecate-other-member-update | 1 + .../qualified-other-member-update | 1 + .../servantify-other-member-update | 1 + .../src/Wire/API/Conversation/Member.hs | 31 +++++---- .../wire-api/src/Wire/API/ErrorDescription.hs | 2 + .../src/Wire/API/Routes/Public/Galley.hs | 40 +++++++++++ services/galley/src/Galley/API/Error.hs | 24 ++++++- services/galley/src/Galley/API/Public.hs | 23 +------ services/galley/src/Galley/API/Update.hs | 35 +++++++--- services/galley/src/Galley/API/Util.hs | 2 +- services/galley/test/integration/API.hs | 69 +++++++++++++++++++ services/galley/test/integration/API/Util.hs | 23 +++++++ 12 files changed, 202 insertions(+), 50 deletions(-) create mode 100644 changelog.d/1-api-changes/deprecate-other-member-update create mode 100644 changelog.d/1-api-changes/qualified-other-member-update create mode 100644 changelog.d/6-federation/servantify-other-member-update diff --git a/changelog.d/1-api-changes/deprecate-other-member-update b/changelog.d/1-api-changes/deprecate-other-member-update new file mode 100644 index 00000000000..52c6712c2e4 --- /dev/null +++ b/changelog.d/1-api-changes/deprecate-other-member-update @@ -0,0 +1 @@ +Deprecate `PUT /conversations/:cnv/members/:usr` endpoint diff --git a/changelog.d/1-api-changes/qualified-other-member-update b/changelog.d/1-api-changes/qualified-other-member-update new file mode 100644 index 00000000000..45185a56848 --- /dev/null +++ b/changelog.d/1-api-changes/qualified-other-member-update @@ -0,0 +1 @@ +Add qualified endpoint for updating conversation members diff --git a/changelog.d/6-federation/servantify-other-member-update b/changelog.d/6-federation/servantify-other-member-update new file mode 100644 index 00000000000..ce3f92bc3fa --- /dev/null +++ b/changelog.d/6-federation/servantify-other-member-update @@ -0,0 +1 @@ +Convert the `PUT /conversations/:cnv/members/:usr` endpoint to Servant diff --git a/libs/wire-api/src/Wire/API/Conversation/Member.hs b/libs/wire-api/src/Wire/API/Conversation/Member.hs index d2bcc02db7e..7b1a570ff08 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Member.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Member.hs @@ -45,7 +45,6 @@ import Control.Lens ((?~)) import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as A import Data.Id -import Data.Json.Util import Data.Qualified import Data.Schema import qualified Data.Swagger as S @@ -271,9 +270,7 @@ data OtherMemberUpdate = OtherMemberUpdate { omuConvRoleName :: Maybe RoleName } deriving stock (Eq, Show, Generic) - -instance Arbitrary OtherMemberUpdate where - arbitrary = OtherMemberUpdate . Just <$> arbitrary + deriving (FromJSON, ToJSON, S.ToSchema) via (Schema OtherMemberUpdate) modelOtherMemberUpdate :: Doc.Model modelOtherMemberUpdate = Doc.defineModel "otherMemberUpdate" $ do @@ -282,15 +279,19 @@ modelOtherMemberUpdate = Doc.defineModel "otherMemberUpdate" $ do Doc.description "Name of the conversation role updated to" Doc.optional -instance ToJSON OtherMemberUpdate where - toJSON m = - A.object $ - "conversation_role" A..= omuConvRoleName m - # [] +instance Arbitrary OtherMemberUpdate where + arbitrary = OtherMemberUpdate . Just <$> arbitrary + +instance ToSchema OtherMemberUpdate where + schema = + (`withParser` (either fail pure . validateOtherMemberUpdate)) + . objectWithDocModifier + "OtherMemberUpdate" + (description ?~ "Update user properties of other members relative to a conversation") + $ OtherMemberUpdate + <$> omuConvRoleName .= optField "conversation_role" Nothing schema -instance FromJSON OtherMemberUpdate where - parseJSON = A.withObject "other-member-update object" $ \m -> do - u <- OtherMemberUpdate <$> m A..:? "conversation_role" - unless (isJust (omuConvRoleName u)) $ - fail "One of { 'conversation_role'} required." - return u +validateOtherMemberUpdate :: OtherMemberUpdate -> Either String OtherMemberUpdate +validateOtherMemberUpdate u + | isJust (omuConvRoleName u) = pure u + | otherwise = Left "'conversation_role' is required" diff --git a/libs/wire-api/src/Wire/API/ErrorDescription.hs b/libs/wire-api/src/Wire/API/ErrorDescription.hs index a74daa75636..63328925d5e 100644 --- a/libs/wire-api/src/Wire/API/ErrorDescription.hs +++ b/libs/wire-api/src/Wire/API/ErrorDescription.hs @@ -206,6 +206,8 @@ type ConvNotFound = ErrorDescription 404 "no-conversation" "Conversation not fou convNotFound :: ConvNotFound convNotFound = mkErrorDescription +type ConvMemberNotFound = ErrorDescription 404 "no-conversation-member" "Conversation member not found" + type UnknownClient = ErrorDescription 403 "unknown-client" "Unknown Client" unknownClient :: UnknownClient 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 e8ad817c4de..cc5bf5ef378 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -277,6 +277,46 @@ data Api routes = Api RemoveFromConversationHTTPResponse RemoveFromConversationResponse, -- This endpoint can lead to the following events being sent: + -- - MemberStateUpdate event to members + updateOtherMemberUnqualified :: + routes + :- Summary "Update membership of the specified user (deprecated)" + :> Description "Use `PUT /conversations/:cnv_domain/:cnv/members/:usr_domain/:usr` instead" + :> ZUser + :> ZConn + :> CanThrow ConvNotFound + :> CanThrow ConvMemberNotFound + :> CanThrow (InvalidOp "Invalid operation") + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> "members" + :> Capture' '[Description "Target User ID"] "usr" UserId + :> ReqBody '[JSON] OtherMemberUpdate + :> MultiVerb + 'PUT + '[JSON] + '[RespondEmpty 200 "Membership updated"] + (), + updateOtherMember :: + routes + :- Summary "Update membership of the specified user" + :> Description "**Note**: at least one field has to be provided." + :> ZUser + :> ZConn + :> CanThrow ConvNotFound + :> CanThrow ConvMemberNotFound + :> CanThrow (InvalidOp "Invalid operation") + :> "conversations" + :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId + :> "members" + :> QualifiedCapture' '[Description "Target User ID"] "usr" UserId + :> ReqBody '[JSON] OtherMemberUpdate + :> MultiVerb + 'PUT + '[JSON] + '[RespondEmpty 200 "Membership updated"] + (), + -- This endpoint can lead to the following events being sent: -- - ConvRename event to members updateConversationNameDeprecated :: routes diff --git a/services/galley/src/Galley/API/Error.hs b/services/galley/src/Galley/API/Error.hs index 27572d52a8e..2ab72ddc11d 100644 --- a/services/galley/src/Galley/API/Error.hs +++ b/services/galley/src/Galley/API/Error.hs @@ -39,21 +39,39 @@ errorDescriptionToWai :: errorDescriptionToWai (ErrorDescription msg) = mkError (statusVal (Proxy @code)) (LT.pack (symbolVal (Proxy @lbl))) (LT.fromStrict msg) +errorDescriptionTypeToWai :: + forall e (code :: Nat) (lbl :: Symbol) (desc :: Symbol). + ( KnownStatus code, + KnownSymbol lbl, + KnownSymbol desc, + e ~ ErrorDescription code lbl desc + ) => + Error +errorDescriptionTypeToWai = errorDescriptionToWai (mkErrorDescription :: e) + throwErrorDescription :: (KnownStatus code, KnownSymbol lbl, MonadThrow m) => ErrorDescription code lbl desc -> m a throwErrorDescription = throwM . errorDescriptionToWai +throwErrorDescriptionType :: + forall e (code :: Nat) (lbl :: Symbol) (desc :: Symbol) m a. + ( KnownStatus code, + KnownSymbol lbl, + KnownSymbol desc, + MonadThrow m, + e ~ ErrorDescription code lbl desc + ) => + m a +throwErrorDescriptionType = throwErrorDescription (mkErrorDescription :: e) + internalError :: Error internalError = internalErrorWithDescription "internal error" internalErrorWithDescription :: LText -> Error internalErrorWithDescription = mkError status500 "internal-error" -convMemberNotFound :: Error -convMemberNotFound = mkError status404 "no-conversation-member" "conversation member not found" - invalidSelfOp :: Error invalidSelfOp = invalidOp "invalid operation for self conversation" diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index a4c1a29787e..6d7daa9b320 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -92,6 +92,8 @@ servantSitemap = GalleyAPI.addMembersToConversationV2 = Update.addMembers, GalleyAPI.removeMemberUnqualified = Update.removeMemberUnqualified, GalleyAPI.removeMember = Update.removeMemberQualified, + GalleyAPI.updateOtherMemberUnqualified = Update.updateOtherMemberUnqualified, + GalleyAPI.updateOtherMember = Update.updateOtherMember, GalleyAPI.updateConversationNameDeprecated = Update.updateLocalConversationName, GalleyAPI.updateConversationNameUnqualified = Update.updateLocalConversationName, GalleyAPI.updateConversationName = Update.updateConversationName, @@ -702,27 +704,6 @@ sitemap = do errorResponse (Error.errorDescriptionToWai Error.notConnected) errorResponse (Error.errorDescriptionToWai Error.convAccessDenied) - -- This endpoint can lead to the following events being sent: - -- - MemberStateUpdate event to members - put "/conversations/:cnv/members/:usr" (continue Update.updateOtherMemberH) $ - zauthUserId - .&. zauthConnId - .&. capture "cnv" - .&. capture "usr" - .&. jsonRequest @Public.OtherMemberUpdate - document "PUT" "updateOtherMember" $ do - summary "Update membership of the specified user" - notes "Even though all fields are optional, at least one needs to be given." - parameter Path "cnv" bytes' $ - description "Conversation ID" - parameter Path "usr" bytes' $ - description "Target User ID" - body (ref Public.modelOtherMemberUpdate) $ - description "JSON body" - errorResponse (Error.errorDescriptionToWai Error.convNotFound) - errorResponse Error.convMemberNotFound - errorResponse Error.invalidTargetUserOp - -- This endpoint can lead to the following events being sent: -- - Typing event to members post "/conversations/:cnv/typing" (continue Update.isTypingH) $ diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 04d7ef7f367..c9d378a485d 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -39,7 +39,8 @@ module Galley.API.Update addMembers, updateUnqualifiedSelfMember, updateSelfMember, - updateOtherMemberH, + updateOtherMember, + updateOtherMemberUnqualified, removeMember, removeMemberQualified, removeMemberUnqualified, @@ -114,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 - ( ConvNotFound, + ( ConvMemberNotFound, + ConvNotFound, codeNotFound, convNotFound, missingLegalholdConsent, @@ -583,18 +585,31 @@ updateRemoteSelfMember :: updateRemoteSelfMember zusr zcon rcid update = do statusMap <- Data.remoteConversationStatus zusr [rcid] case Map.lookup rcid statusMap of - Nothing -> throwM convMemberNotFound + Nothing -> throwErrorDescriptionType @ConvMemberNotFound Just _ -> void $ processUpdateMemberEvent zusr zcon (unTagged rcid) [zusr] zusr update -updateOtherMemberH :: UserId ::: ConnId ::: ConvId ::: UserId ::: JsonRequest Public.OtherMemberUpdate -> Galley Response -updateOtherMemberH (zusr ::: zcon ::: cid ::: victim ::: req) = do - update <- fromJsonBody req - updateOtherMember zusr zcon cid victim update - return empty +updateOtherMember :: + UserId -> + ConnId -> + Qualified ConvId -> + Qualified UserId -> + Public.OtherMemberUpdate -> + Galley () +updateOtherMember zusr zcon qcid qvictim update = do + localDomain <- viewFederationDomain + if qDomain qcid == localDomain && qDomain qvictim == localDomain + then updateOtherMemberUnqualified zusr zcon (qUnqualified qcid) (qUnqualified qvictim) update + else throwM federationNotImplemented -updateOtherMember :: UserId -> ConnId -> ConvId -> UserId -> Public.OtherMemberUpdate -> Galley () -updateOtherMember zusr zcon cid victim update = do +updateOtherMemberUnqualified :: + UserId -> + ConnId -> + ConvId -> + UserId -> + Public.OtherMemberUpdate -> + Galley () +updateOtherMemberUnqualified zusr zcon cid victim update = do localDomain <- viewFederationDomain when (zusr == victim) $ throwM invalidTargetUserOp diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index e7bbd6d43a4..59e98042b64 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -294,7 +294,7 @@ 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 +getOtherMember = getLocalMember (errorDescriptionTypeToWai @ConvMemberNotFound) getOtherMemberLegacy :: Foldable t => UserId -> t LocalMember -> Galley LocalMember getOtherMemberLegacy usr lmems = diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 289ee3c0b2d..3f8554b785f 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -183,6 +183,8 @@ tests s = test s "rename conversation" putConvRenameOk, test s "rename qualified conversation" putQualifiedConvRenameOk, test s "rename qualified conversation failure" putQualifiedConvRenameFailure, + test s "other member update role" putOtherMemberOk, + test s "qualified other member update role" putQualifiedOtherMemberOk, test s "member update (otr mute)" putMemberOtrMuteOk, test s "member update (otr archive)" putMemberOtrArchiveOk, test s "member update (hidden)" putMemberHiddenOk, @@ -2553,6 +2555,73 @@ putConvRenameOk = do evtFrom e @?= qbob evtData e @?= EdConvRename (ConversationRename "gossip++") +putQualifiedOtherMemberOk :: TestM () +putQualifiedOtherMemberOk = do + c <- view tsCannon + qalice <- randomQualifiedUser + qbob <- randomQualifiedUser + let bob = qUnqualified qbob + alice = qUnqualified qalice + connectUsers alice (singleton bob) + conv <- decodeConvId <$> postConv alice [bob] (Just "gossip") [] Nothing Nothing + let qconv = Qualified conv (qDomain qbob) + expectedMemberUpdateData = + MemberUpdateData + { misTarget = Just alice, + misOtrMutedStatus = Nothing, + misOtrMutedRef = Nothing, + misOtrArchived = Nothing, + misOtrArchivedRef = Nothing, + misHidden = Nothing, + misHiddenRef = Nothing, + misConvRoleName = Just roleNameWireMember + } + + WS.bracketR2 c alice bob $ \(wsA, wsB) -> do + -- demote qalice + putOtherMemberQualified bob qalice (OtherMemberUpdate (Just roleNameWireMember)) qconv + !!! const 200 === statusCode + void . liftIO . WS.assertMatchN (5 # Second) [wsA, wsB] $ \n -> do + let e = List1.head (WS.unpackPayload n) + ntfTransient n @?= False + evtConv e @?= qconv + evtType e @?= MemberStateUpdate + evtFrom e @?= qbob + evtData e @?= EdMemberUpdate expectedMemberUpdateData + +putOtherMemberOk :: TestM () +putOtherMemberOk = do + c <- view tsCannon + alice <- randomUser + qbob <- randomQualifiedUser + let bob = qUnqualified qbob + connectUsers alice (singleton bob) + conv <- decodeConvId <$> postConv alice [bob] (Just "gossip") [] Nothing Nothing + let qconv = Qualified conv (qDomain qbob) + expectedMemberUpdateData = + MemberUpdateData + { misTarget = Just alice, + misOtrMutedStatus = Nothing, + misOtrMutedRef = Nothing, + misOtrArchived = Nothing, + misOtrArchivedRef = Nothing, + misHidden = Nothing, + misHiddenRef = Nothing, + misConvRoleName = Just roleNameWireMember + } + + WS.bracketR2 c alice bob $ \(wsA, wsB) -> do + -- demote alice + putOtherMember bob alice (OtherMemberUpdate (Just roleNameWireMember)) conv + !!! const 200 === statusCode + void . liftIO . WS.assertMatchN (5 # Second) [wsA, wsB] $ \n -> do + let e = List1.head (WS.unpackPayload n) + ntfTransient n @?= False + evtConv e @?= qconv + evtType e @?= MemberStateUpdate + evtFrom e @?= qbob + evtData e @?= EdMemberUpdate expectedMemberUpdateData + putMemberOtrMuteOk :: TestM () putMemberOtrMuteOk = do putMemberOk (memberUpdate {mupOtrMuteStatus = Just 1, mupOtrMuteRef = Just "ref"}) diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 4c8ef7e9ad5..0286234ac6a 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -955,6 +955,29 @@ putMember u m (Qualified c dom) = do . zType "access" . json m +putOtherMemberQualified :: + UserId -> + Qualified UserId -> + OtherMemberUpdate -> + Qualified ConvId -> + TestM ResponseLBS +putOtherMemberQualified from to m c = do + g <- view tsGalley + put $ + g + . paths + [ "conversations", + toByteString' (qDomain c), + toByteString' (qUnqualified c), + "members", + toByteString' (qDomain to), + toByteString' (qUnqualified to) + ] + . zUser from + . zConn "conn" + . zType "access" + . json m + putOtherMember :: UserId -> UserId -> OtherMemberUpdate -> ConvId -> TestM ResponseLBS putOtherMember from to m c = do g <- view tsGalley From c5ae4a23a393d6b30c67cc618af4524c012ebcf8 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 21 Sep 2021 11:05:28 +0200 Subject: [PATCH 38/72] Federation: support conversation renames (#1767) This generalises the `on-conversation-memberships-changed` RPC to support notifications of conversation renames, by adding a new constructor to the corresponding "action" type. It also unifies and cleans up the handling of these events on the remote side of a conversation, and adds tests to make sure that we never send notifications to a usere when we are not sure they are part of the conversation. This is part of https://wearezeta.atlassian.net/browse/SQCORE-885 (federated conversation metadata updates). --- changelog.d/6-federation/fed-conv-rename | 1 + .../fed-conv-update-notifications | 1 + libs/tasty-cannon/src/Test/Tasty/Cannon.hs | 9 + libs/types-common/src/Data/Qualified.hs | 8 + .../src/Wire/API/Federation/API/Galley.hs | 46 ++- ...nMemberUpdate.hs => ConversationUpdate.hs} | 41 +-- .../Wire/API/Federation/Golden/GoldenSpec.hs | 6 +- ...on => testObject_ConversationUpdate1.json} | 4 +- ...on => testObject_ConversationUpdate2.json} | 4 +- .../wire-api-federation.cabal | 4 +- libs/wire-api/src/Wire/API/Conversation.hs | 15 + .../src/Wire/API/Conversation/Role.hs | 2 +- .../src/Wire/API/Event/Conversation.hs | 34 ++- services/galley/src/Galley/API/Federation.hs | 89 +++--- services/galley/src/Galley/API/Public.hs | 4 +- services/galley/src/Galley/API/Update.hs | 116 +++++--- services/galley/src/Galley/API/Util.hs | 20 +- services/galley/src/Galley/Data.hs | 14 +- services/galley/src/Galley/Data/Queries.hs | 7 +- services/galley/test/integration/API.hs | 125 ++++++--- .../galley/test/integration/API/Federation.hs | 262 +++++++++++------- services/galley/test/integration/API/Util.hs | 28 +- 22 files changed, 541 insertions(+), 299 deletions(-) create mode 100644 changelog.d/6-federation/fed-conv-rename create mode 100644 changelog.d/6-federation/fed-conv-update-notifications rename libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/{ConversationMemberUpdate.hs => ConversationUpdate.hs} (67%) rename libs/wire-api-federation/test/golden/{testObject_ConversationMemberUpdate1.json => testObject_ConversationUpdate1.json} (93%) rename libs/wire-api-federation/test/golden/{testObject_ConversationMemberUpdate2.json => testObject_ConversationUpdate2.json} (92%) diff --git a/changelog.d/6-federation/fed-conv-rename b/changelog.d/6-federation/fed-conv-rename new file mode 100644 index 00000000000..702e3c332c4 --- /dev/null +++ b/changelog.d/6-federation/fed-conv-rename @@ -0,0 +1 @@ +Notify remote users when a conversation is renamed diff --git a/changelog.d/6-federation/fed-conv-update-notifications b/changelog.d/6-federation/fed-conv-update-notifications new file mode 100644 index 00000000000..64d2525b1ce --- /dev/null +++ b/changelog.d/6-federation/fed-conv-update-notifications @@ -0,0 +1 @@ +Make sure that only users that are actually part of a conversation get notified about updates in the conversation metadata diff --git a/libs/tasty-cannon/src/Test/Tasty/Cannon.hs b/libs/tasty-cannon/src/Test/Tasty/Cannon.hs index 94c1f68da03..9838ed2ccf2 100644 --- a/libs/tasty-cannon/src/Test/Tasty/Cannon.hs +++ b/libs/tasty-cannon/src/Test/Tasty/Cannon.hs @@ -53,6 +53,7 @@ module Test.Tasty.Cannon assertMatch, assertMatch_, assertMatchN, + assertMatchN_, assertSuccess, assertNoEvent, @@ -357,6 +358,14 @@ assertMatchN :: m [Notification] assertMatchN t wss f = awaitMatchN t wss f >>= mapM assertSuccess +assertMatchN_ :: + (HasCallStack, MonadIO m, MonadThrow m) => + Timeout -> + [WebSocket] -> + (Notification -> Assertion) -> + m () +assertMatchN_ t wss f = void $ assertMatchN t wss f + assertSuccess :: (HasCallStack, MonadIO m, MonadThrow m) => Either MatchTimeout Notification -> m Notification assertSuccess = either throwM return diff --git a/libs/types-common/src/Data/Qualified.hs b/libs/types-common/src/Data/Qualified.hs index 779cae99080..38cd9010868 100644 --- a/libs/types-common/src/Data/Qualified.hs +++ b/libs/types-common/src/Data/Qualified.hs @@ -25,6 +25,8 @@ module Data.Qualified toRemote, Local, toLocal, + lUnqualified, + lDomain, renderQualifiedId, partitionRemoteOrLocalIds, partitionRemoteOrLocalIds', @@ -75,6 +77,12 @@ type Local a = Tagged "local" (Qualified a) toLocal :: Qualified a -> Local a toLocal = Tagged +lUnqualified :: Local a -> a +lUnqualified = qUnqualified . unTagged + +lDomain :: Local a -> Domain +lDomain = qDomain . unTagged + -- | FUTUREWORK: Maybe delete this, it is only used in printing federation not -- implemented errors renderQualified :: (a -> Text) -> Qualified a -> Text 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 d80a55a5e2d..5e4ba623761 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 @@ -21,7 +21,6 @@ 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) @@ -31,6 +30,14 @@ import Servant.API.Generic ((:-)) import Servant.Client.Generic (AsClientT, genericClient) import Wire.API.Arbitrary (Arbitrary, GenericUniform (..)) import Wire.API.Conversation + ( Access, + AccessRole, + ConvType, + ConversationAction (..), + ConversationMetadata, + ReceiptMode, + ) +import Wire.API.Conversation.Member (OtherMember) import Wire.API.Conversation.Role (RoleName) import Wire.API.Federation.Client (FederationClientFailure, FederatorClient) import Wire.API.Federation.Domain (OriginDomainHeader) @@ -62,14 +69,14 @@ data Api routes = Api :> OriginDomainHeader :> ReqBody '[JSON] GetConversationsRequest :> Post '[JSON] GetConversationsResponse, - -- used by backend that owns the conversation to inform the backend about - -- add/removal of its users to the conversation - onConversationMembershipsChanged :: + -- used by the backend that owns a conversation to inform this backend of + -- changes to the conversation + onConversationUpdated :: routes :- "federation" - :> "on-conversation-memberships-changed" + :> "on-conversation-updated" :> OriginDomainHeader - :> ReqBody '[JSON] ConversationMemberUpdate + :> ReqBody '[JSON] ConversationUpdate :> Post '[JSON] (), leaveConversation :: routes @@ -159,33 +166,24 @@ data NewRemoteConversation conv = NewRemoteConversation deriving stock (Eq, Show, Generic, Functor) deriving (ToJSON, FromJSON) via (CustomEncoded (NewRemoteConversation conv)) --- | 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, +data ConversationUpdate = ConversationUpdate + { cuTime :: UTCTime, + cuOrigUserId :: Qualified UserId, -- | The unqualified ID of the conversation where the update is happening. -- The ID is local to prevent putting arbitrary domain that is different -- than that of the backend making a conversation membership update request. - cmuConvId :: ConvId, + cuConvId :: ConvId, -- | A list of users from a remote backend that need to be sent -- notifications about this change. This is required as we do not expect a -- non-conversation owning backend to have an indexed mapping of -- conversation to users. - cmuAlreadyPresentUsers :: [UserId], - -- | Users that got either added to or removed from the conversation. - cmuAction :: ConversationMembersAction + cuAlreadyPresentUsers :: [UserId], + -- | Information on the specific action that caused the update. + cuAction :: ConversationAction } deriving stock (Eq, Show, Generic) - deriving (Arbitrary) via (GenericUniform ConversationMemberUpdate) - deriving (ToJSON, FromJSON) via (CustomEncoded ConversationMemberUpdate) + deriving (Arbitrary) via (GenericUniform ConversationUpdate) + deriving (ToJSON, FromJSON) via (CustomEncoded ConversationUpdate) data LeaveConversationRequest = LeaveConversationRequest { -- | The conversation is assumed to be owned by the target domain, which 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/ConversationUpdate.hs similarity index 67% rename from libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationMemberUpdate.hs rename to libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs index 513bb00fa95..e13b75cb0fe 100644 --- a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationMemberUpdate.hs +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs @@ -15,9 +15,9 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Test.Wire.API.Federation.Golden.ConversationMemberUpdate - ( testObject_ConversationMemberUpdate1, - testObject_ConversationMemberUpdate2, +module Test.Wire.API.Federation.Golden.ConversationUpdate + ( testObject_ConversationUpdate1, + testObject_ConversationUpdate2, ) where @@ -27,8 +27,9 @@ import Data.List.NonEmpty (NonEmpty (..)) import Data.Qualified (Qualified (Qualified)) import qualified Data.UUID as UUID import Imports +import Wire.API.Conversation (ConversationAction (..)) import Wire.API.Conversation.Role (roleNameWireAdmin, roleNameWireMember) -import Wire.API.Federation.API.Galley (ConversationMemberUpdate (..), ConversationMembersAction (..)) +import Wire.API.Federation.API.Galley (ConversationUpdate (..)) qAlice, qBob :: Qualified UserId qAlice = @@ -44,30 +45,30 @@ 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 = +testObject_ConversationUpdate1 :: ConversationUpdate +testObject_ConversationUpdate1 = + ConversationUpdate + { cuTime = read "1864-04-12 12:22:43.673 UTC", + cuOrigUserId = Qualified (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000007"))) (Domain "golden.example.com"), - cmuConvId = + cuConvId = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000006")), - cmuAlreadyPresentUsers = [], - cmuAction = ConversationMembersActionAdd ((qAlice, roleNameWireMember) :| [(qBob, roleNameWireAdmin)]) + cuAlreadyPresentUsers = [], + cuAction = ConversationActionAddMembers ((qAlice, roleNameWireMember) :| [(qBob, roleNameWireAdmin)]) } -testObject_ConversationMemberUpdate2 :: ConversationMemberUpdate -testObject_ConversationMemberUpdate2 = - ConversationMemberUpdate - { cmuTime = read "1864-04-12 12:22:43.673 UTC", - cmuOrigUserId = +testObject_ConversationUpdate2 :: ConversationUpdate +testObject_ConversationUpdate2 = + ConversationUpdate + { cuTime = read "1864-04-12 12:22:43.673 UTC", + cuOrigUserId = Qualified (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000007"))) (Domain "golden.example.com"), - cmuConvId = + cuConvId = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000006")), - cmuAlreadyPresentUsers = [chad, dee], - cmuAction = ConversationMembersActionRemove (qAlice :| [qBob]) + cuAlreadyPresentUsers = [chad, dee], + cuAction = ConversationActionRemoveMembers (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 29f607f319e..eb9fded3083 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,7 +19,7 @@ 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.ConversationUpdate as ConversationUpdate 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 @@ -37,8 +37,8 @@ spec = ] testObjects [(LeaveConversationRequest.testObject_LeaveConversationRequest1, "testObject_LeaveConversationRequest1.json")] testObjects - [ (ConversationMemberUpdate.testObject_ConversationMemberUpdate1, "testObject_ConversationMemberUpdate1.json"), - (ConversationMemberUpdate.testObject_ConversationMemberUpdate2, "testObject_ConversationMemberUpdate2.json") + [ (ConversationUpdate.testObject_ConversationUpdate1, "testObject_ConversationUpdate1.json"), + (ConversationUpdate.testObject_ConversationUpdate2, "testObject_ConversationUpdate2.json") ] testObjects [ (LeaveConversationResponse.testObject_LeaveConversationResponse1, "testObject_LeaveConversationResponse1.json"), diff --git a/libs/wire-api-federation/test/golden/testObject_ConversationMemberUpdate1.json b/libs/wire-api-federation/test/golden/testObject_ConversationUpdate1.json similarity index 93% rename from libs/wire-api-federation/test/golden/testObject_ConversationMemberUpdate1.json rename to libs/wire-api-federation/test/golden/testObject_ConversationUpdate1.json index 1a3c4aa08c1..a753b72004b 100644 --- a/libs/wire-api-federation/test/golden/testObject_ConversationMemberUpdate1.json +++ b/libs/wire-api-federation/test/golden/testObject_ConversationUpdate1.json @@ -6,7 +6,7 @@ "already_present_users": [], "time": "1864-04-12T12:22:43.673Z", "action": { - "tag": "ConversationMembersActionAdd", + "tag": "ConversationActionAddMembers", "contents": [ [ { @@ -25,4 +25,4 @@ ] }, "conv_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_ConversationUpdate2.json similarity index 92% rename from libs/wire-api-federation/test/golden/testObject_ConversationMemberUpdate2.json rename to libs/wire-api-federation/test/golden/testObject_ConversationUpdate2.json index a417c27f630..5b28f42cc45 100644 --- a/libs/wire-api-federation/test/golden/testObject_ConversationMemberUpdate2.json +++ b/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2.json @@ -9,7 +9,7 @@ ], "time": "1864-04-12T12:22:43.673Z", "action": { - "tag": "ConversationMembersActionRemove", + "tag": "ConversationActionRemoveMembers", "contents": [ { "domain": "golden.example.com", @@ -22,4 +22,4 @@ ] }, "conv_id": "00000000-0000-0000-0000-000100000006" -} +} \ 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 39c202fbc6c..5fada7cdf10 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: 51e5ed505621b80d7d0ea96cc1555dd231292948d5961f0eaccc4efb1b08e0d0 +-- hash: 8106f61fbca587df7a82a89effeec838bb9d9326c84bd7af8f615502cedc152f name: wire-api-federation version: 0.1.0 @@ -77,7 +77,7 @@ 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.ConversationUpdate Test.Wire.API.Federation.Golden.GoldenSpec Test.Wire.API.Federation.Golden.LeaveConversationRequest Test.Wire.API.Federation.Golden.LeaveConversationResponse diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index 735bd55f10d..f42e01b2940 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -67,6 +67,7 @@ module Wire.API.Conversation ConversationAccessUpdate (..), ConversationReceiptModeUpdate (..), ConversationMessageTimerUpdate (..), + ConversationAction (..), -- * re-exports module Wire.API.Conversation.Member, @@ -113,6 +114,7 @@ import qualified Test.QuickCheck as QC import Wire.API.Arbitrary (Arbitrary (arbitrary), GenericUniform (..)) import Wire.API.Conversation.Member import Wire.API.Conversation.Role (RoleName, roleNameWireAdmin) +import Wire.API.Util.Aeson (CustomEncoded (..)) -------------------------------------------------------------------------------- -- Conversation @@ -923,3 +925,16 @@ modelConversationMessageTimerUpdate = Doc.defineModel "ConversationMessageTimerU Doc.description "Contains conversation properties to update" Doc.property "message_timer" Doc.int64' $ Doc.description "Conversation message timer (in milliseconds); can be null" + +-------------------------------------------------------------------------------- +-- actions + +-- | An update to a conversation, including addition and removal of members. +-- Used to send notifications to users and to remote backends. +data ConversationAction + = ConversationActionAddMembers (NonEmpty (Qualified UserId, RoleName)) + | ConversationActionRemoveMembers (NonEmpty (Qualified UserId)) + | ConversationActionRename ConversationRename + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform ConversationAction) + deriving (ToJSON, FromJSON) via (CustomEncoded ConversationAction) diff --git a/libs/wire-api/src/Wire/API/Conversation/Role.hs b/libs/wire-api/src/Wire/API/Conversation/Role.hs index 2c4a40e6c08..836b2ee8d29 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Role.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Role.hs @@ -187,7 +187,7 @@ instance FromJSON ConversationRolesList where -- and cannot be created by externals. Therefore, never -- expose this constructor outside of this module. newtype RoleName = RoleName {fromRoleName :: Text} - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Ord, Show, Generic) deriving newtype (ToByteString, Hashable) deriving (FromJSON, ToJSON, S.ToSchema) via Schema RoleName diff --git a/libs/wire-api/src/Wire/API/Event/Conversation.hs b/libs/wire-api/src/Wire/API/Event/Conversation.hs index b83bf2d955d..30ef6eee78c 100644 --- a/libs/wire-api/src/Wire/API/Event/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Event/Conversation.hs @@ -24,6 +24,22 @@ module Wire.API.Event.Conversation EventType (..), EventData (..), + -- * Event lenses + _EdMembersJoin, + _EdMembersLeave, + _EdConnect, + _EdConvReceiptModeUpdate, + _EdConvRename, + _EdConvDelete, + _EdConvAccessUpdate, + _EdConvMessageTimerUpdate, + _EdConvCodeUpdate, + _EdConvCodeDelete, + _EdMemberUpdate, + _EdConversation, + _EdTyping, + _EdOtrMessage, + -- * Event data helpers SimpleMember (..), smId, @@ -31,6 +47,7 @@ module Wire.API.Event.Conversation Connect (..), MemberUpdateData (..), OtrMessage (..), + conversationActionToEvent, -- * re-exports ConversationReceiptModeUpdate (..), @@ -319,7 +336,7 @@ data SimpleMember = SimpleMember { smQualifiedId :: Qualified UserId, smConvRoleName :: RoleName } - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Ord, Show, Generic) deriving (Arbitrary) via (GenericUniform SimpleMember) deriving (FromJSON, ToJSON) via Schema SimpleMember @@ -544,3 +561,18 @@ instance ToJSON Event where instance S.ToSchema Event where declareNamedSchema = schemaToSwagger + +conversationActionToEvent :: + UTCTime -> + Qualified UserId -> + Qualified ConvId -> + ConversationAction -> + Event +conversationActionToEvent now quid qcnv (ConversationActionAddMembers newMembers) = + Event MemberJoin qcnv quid now $ + EdMembersJoin $ SimpleMembers (map (uncurry SimpleMember) . toList $ newMembers) +conversationActionToEvent now quid qcnv (ConversationActionRemoveMembers removedMembers) = + Event MemberLeave qcnv quid now $ + EdMembersLeave . QualifiedUserIdList . toList $ removedMembers +conversationActionToEvent now quid qcnv (ConversationActionRename rename) = + Event ConvRename qcnv quid now (EdConvRename rename) diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 414e36d4210..f5ef675ee1e 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -24,7 +24,7 @@ import Data.Containers.ListUtils (nubOrd) import Data.Domain import Data.Id (ConvId, UserId) import Data.Json.Util (Base64ByteString (..)) -import Data.List1 (list1) +import Data.List.NonEmpty (NonEmpty) import qualified Data.Map as Map import Data.Map.Lens (toMapOf) import Data.Qualified (Qualified (..), toRemote) @@ -49,7 +49,7 @@ import Wire.API.Conversation.Member (OtherMember (..)) import qualified Wire.API.Conversation.Role as Public import Wire.API.Event.Conversation import Wire.API.Federation.API.Galley - ( ConversationMemberUpdate (..), + ( ConversationUpdate (..), GetConversationsRequest (..), GetConversationsResponse (..), LeaveConversationRequest (..), @@ -69,7 +69,7 @@ federationSitemap = FederationAPIGalley.Api { FederationAPIGalley.onConversationCreated = onConversationCreated, FederationAPIGalley.getConversations = getConversations, - FederationAPIGalley.onConversationMembershipsChanged = onConversationMembershipsChanged, + FederationAPIGalley.onConversationUpdated = onConversationUpdated, FederationAPIGalley.leaveConversation = leaveConversation, FederationAPIGalley.onMessageSent = onMessageSent, FederationAPIGalley.sendMessage = sendMessage @@ -85,7 +85,7 @@ onConversationCreated domain rc = do $ rc localUserIds = fmap qUnqualified localUsers unless (null localUsers) $ do - Data.addLocalMembersToRemoteConv localUserIds (rcCnvId qrc) + Data.addLocalMembersToRemoteConv (rcCnvId qrc) localUserIds forM_ (fromNewRemoteConversation localDomain qrc) $ \(mem, c) -> do let event = Event @@ -105,46 +105,55 @@ getConversations domain (GetConversationsRequest uid cids) = do . map (Mapping.conversationToRemote localDomain ruid) <$> Data.conversations cids +getLocalUsers :: Domain -> NonEmpty (Qualified UserId) -> [UserId] +getLocalUsers localDomain = map qUnqualified . filter ((== localDomain) . qDomain) . toList + -- | Update the local database with information on conversation members joining -- or leaving. Finally, push out notifications to local users. -onConversationMembershipsChanged :: Domain -> ConversationMemberUpdate -> Galley () -onConversationMembershipsChanged requestingDomain cmu = do +onConversationUpdated :: Domain -> ConversationUpdate -> Galley () +onConversationUpdated requestingDomain cu = do localDomain <- viewFederationDomain - 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 - qconvId = Qualified (cmuConvId cmu) requestingDomain - event <- case cmuAction cmu of - FederationAPIGalley.ConversationMembersActionAdd toAdd -> do - unless (null localUsers) $ - Data.addLocalMembersToRemoteConv localUserIds qconvId - let mems = SimpleMembers (map (uncurry SimpleMember) . toList $ toAdd) - pure $ - Event - MemberJoin - qconvId - (cmuOrigUserId cmu) - (cmuTime cmu) - (EdMembersJoin mems) - FederationAPIGalley.ConversationMembersActionRemove toRemove -> do - case localUserIds of - [] -> pure () - (h : t) -> - Data.removeLocalMembersFromRemoteConv - qconvId - (list1 h t) - pure $ - Event - MemberLeave - qconvId - (cmuOrigUserId cmu) - (cmuTime cmu) - (EdMembersLeave . QualifiedUserIdList . toList $ toRemove) + let qconvId = Qualified (cuConvId cu) requestingDomain + + -- Note: we generally do not send notifications to users that are not part of + -- the conversation (from our point of view), to prevent spam from the remote + -- backend. See also the comment below. + (presentUsers, allUsersArePresent) <- Data.filterRemoteConvMembers (cuAlreadyPresentUsers cu) qconvId + + -- Perform action, and determine extra notification targets. + -- + -- When new users are being added to the conversation, we consider them as + -- notification targets. Once we start checking connections before letting + -- people being added, this will be safe against spam. However, if users that + -- are not in the conversations are being removed, we do **not** add them to the + -- list of targets, because we have no way to make sure that they are actually + -- supposed to receive that notification. + extraTargets <- case cuAction cu of + Public.ConversationActionAddMembers toAdd -> do + let localUsers = getLocalUsers localDomain (fmap fst toAdd) + Data.addLocalMembersToRemoteConv qconvId localUsers + pure localUsers + Public.ConversationActionRemoveMembers toRemove -> do + let localUsers = getLocalUsers localDomain toRemove + Data.removeLocalMembersFromRemoteConv qconvId localUsers + pure [] + Public.ConversationActionRename _ -> pure [] + + -- Send notifications + let event = conversationActionToEvent (cuTime cu) (cuOrigUserId cu) qconvId (cuAction cu) + targets = nubOrd $ presentUsers <> extraTargets + + unless allUsersArePresent $ + Log.warn $ + Log.field "conversation" (toByteString' (cuConvId cu)) + Log.~~ Log.field "domain" (toByteString' requestingDomain) + Log.~~ Log.msg + ( "Attempt to send notification about conversation update \ + \to users not in the conversation" :: + ByteString + ) + -- FUTUREWORK: support bots? - -- send notifications pushConversationEvent Nothing event targets [] leaveConversation :: diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index 6d7daa9b320..a191021c4c2 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -94,8 +94,8 @@ servantSitemap = GalleyAPI.removeMember = Update.removeMemberQualified, GalleyAPI.updateOtherMemberUnqualified = Update.updateOtherMemberUnqualified, GalleyAPI.updateOtherMember = Update.updateOtherMember, - GalleyAPI.updateConversationNameDeprecated = Update.updateLocalConversationName, - GalleyAPI.updateConversationNameUnqualified = Update.updateLocalConversationName, + GalleyAPI.updateConversationNameDeprecated = Update.updateUnqualifiedConversationName, + GalleyAPI.updateConversationNameUnqualified = Update.updateUnqualifiedConversationName, GalleyAPI.updateConversationName = Update.updateConversationName, GalleyAPI.updateConversationMessageTimerUnqualified = Update.updateLocalConversationMessageTimer, diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index c9d378a485d..bc4e389fc27 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -26,8 +26,7 @@ module Galley.API.Update addCodeH, rmCodeH, getCodeH, - updateConversationDeprecatedH, - updateLocalConversationName, + updateUnqualifiedConversationName, updateConversationName, updateConversationAccessH, updateConversationReceiptModeH, @@ -110,7 +109,11 @@ import Network.HTTP.Types import Network.Wai import Network.Wai.Predicate hiding (and, failure, setStatus, _1, _2) import Network.Wai.Utilities -import Wire.API.Conversation (InviteQualified (invQRoleName)) +import UnliftIO (pooledForConcurrentlyN) +import Wire.API.Conversation + ( ConversationAction (..), + InviteQualified (invQRoleName), + ) import qualified Wire.API.Conversation as Public import qualified Wire.API.Conversation.Code as Public import Wire.API.Conversation.Role (roleNameWireAdmin) @@ -714,7 +717,7 @@ removeMemberFromLocalConv remover@(Qualified removerUid removerDomain) zcon conv -- Notify remote backends let existingRemotes = rmId <$> Data.convRemoteMembers conv - let action = FederatedGalley.ConversationMembersActionRemove $ pure qvictim + let action = ConversationActionRemoveMembers $ pure qvictim lift $ notifyRemoteAboutConvUpdate remover convId (evtTime event) action existingRemotes pure event @@ -893,55 +896,100 @@ newMessage qusr con qcnv msg now (m, c, t) ~(toBots, toUsers) = . set pushTransient (newOtrTransient msg) in (toBots, p : toUsers) -updateConversationDeprecatedH :: UserId ::: ConnId ::: ConvId ::: JsonRequest Public.ConversationRename -> Galley Response -updateConversationDeprecatedH (zusr ::: zcon ::: cnv ::: req) = do - convRename <- fromJsonBody req - setStatus status200 . json <$> updateLocalConversationName zusr zcon cnv convRename - updateConversationName :: UserId -> ConnId -> Qualified ConvId -> Public.ConversationRename -> Galley (Maybe Public.Event) -updateConversationName usr zcon qcnv convRename = do - localDomain <- viewFederationDomain - if qDomain qcnv == localDomain - then updateLocalConversationName usr zcon (qUnqualified qcnv) convRename +updateConversationName zusr zcon qcnv convRename = do + lusr <- qualifyLocal zusr + if qDomain qcnv == lDomain lusr + then updateLocalConversationName lusr zcon (toLocal qcnv) convRename else throwM federationNotImplemented -updateLocalConversationName :: +updateUnqualifiedConversationName :: UserId -> ConnId -> ConvId -> Public.ConversationRename -> Galley (Maybe Public.Event) -updateLocalConversationName usr zcon cnv convRename = do - alive <- Data.isConvAlive cnv +updateUnqualifiedConversationName zusr zcon cnv rename = do + lusr <- qualifyLocal zusr + lcnv <- qualifyLocal cnv + updateLocalConversationName lusr zcon lcnv rename + +updateLocalConversationName :: + Local UserId -> + ConnId -> + Local ConvId -> + Public.ConversationRename -> + Galley (Maybe Public.Event) +updateLocalConversationName lusr zcon lcnv convRename = do + alive <- Data.isConvAlive (lUnqualified lcnv) if alive - then Just <$> updateLiveLocalConversationName usr zcon cnv convRename - else Nothing <$ Data.deleteConversation cnv + then Just <$> updateLiveLocalConversationName lusr zcon lcnv convRename + else Nothing <$ Data.deleteConversation (lUnqualified lcnv) updateLiveLocalConversationName :: - UserId -> + Local UserId -> ConnId -> - ConvId -> + Local ConvId -> Public.ConversationRename -> Galley Public.Event -updateLiveLocalConversationName usr zcon cnv convRename = do - localDomain <- viewFederationDomain - let qcnv = Qualified cnv localDomain - qusr = Qualified usr localDomain - (bots, users) <- localBotsAndUsers <$> Data.members cnv - ensureActionAllowedThrowing ModifyConversationName =<< getSelfMemberFromLocalsLegacy usr users - now <- liftIO getCurrentTime +updateLiveLocalConversationName lusr zcon lcnv convRename = do + -- get local members and bots + (bots, lusers) <- localBotsAndUsers <$> Data.members (lUnqualified lcnv) + + -- perform update + ensureActionAllowedThrowing ModifyConversationName + =<< getSelfMemberFromLocalsLegacy (lUnqualified lusr) lusers cn <- rangeChecked (cupName convRename) - Data.updateConversation cnv cn - let e = Event ConvRename qcnv qusr now (EdConvRename convRename) - for_ (newPushLocal ListComplete usr (ConvEvent e) (recipient <$> users)) $ \p -> - push1 $ p & pushConn ?~ zcon - void . forkIO $ void $ External.deliver (bots `zip` repeat e) - pure e + Data.updateConversation (lUnqualified lcnv) cn + + -- send notifications + rusers <- Data.lookupRemoteMembers (lUnqualified lcnv) + let targets = + NotificationTargets + { ntLocals = map lmId lusers, + ntRemotes = map rmId rusers, + ntBots = bots + } + now <- liftIO getCurrentTime + let action = ConversationActionRename convRename + notifyConversationMetadataUpdate now (unTagged lusr) (Just zcon) lcnv targets action + +data NotificationTargets = NotificationTargets + { ntLocals :: [UserId], + ntRemotes :: [Remote UserId], + ntBots :: [BotMember] + } + +notifyConversationMetadataUpdate :: + UTCTime -> + Qualified UserId -> + Maybe ConnId -> + Local ConvId -> + NotificationTargets -> + ConversationAction -> + Galley Event +notifyConversationMetadataUpdate now quid mcon (Tagged qcnv) targets action = do + localDomain <- viewFederationDomain + let e = Public.conversationActionToEvent now quid qcnv action + + -- notify remote participants + let rusersByDomain = partitionRemote (ntRemotes targets) + void . pooledForConcurrentlyN 8 rusersByDomain $ \(domain, uids) -> do + let req = FederatedGalley.ConversationUpdate now quid (qUnqualified qcnv) uids action + rpc = + FederatedGalley.onConversationUpdated + FederatedGalley.clientRoutes + localDomain + req + runFederatedGalley domain rpc + + -- notify local participants and bots + pushConversationEvent mcon e (ntLocals targets) (ntBots targets) $> e isTypingH :: UserId ::: ConnId ::: ConvId ::: JsonRequest Public.TypingData -> Galley Response isTypingH (zusr ::: zcon ::: cnv ::: req) = do @@ -1071,7 +1119,7 @@ addToConversation (bots, existingLocals) existingRemotes (usr, usrRole) conn new [] -> pure () (x : xs) -> do - let action = FederatedGalley.ConversationMembersActionAdd (x :| xs) + let action = ConversationActionAddMembers (x :| xs) qusr = Qualified usr localDomain notifyRemoteAboutConvUpdate qusr (convId c) now action (rmId <$> existingRemotes <> rmm) let localsToNotify = nubOrd . fmap lmId $ existingLocals <> lmm diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 59e98042b64..31355c00734 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -34,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, toRemote) +import Data.Qualified (Local, Qualified (..), Remote, partitionQualified, toLocal, toRemote) import qualified Data.Set as Set import Data.Tagged (Tagged (unTagged)) import qualified Data.Text.Lazy as LT @@ -59,6 +59,7 @@ import Network.Wai import Network.Wai.Predicate hiding (Error) import Network.Wai.Utilities import UnliftIO (concurrently) +import Wire.API.Conversation (ConversationAction (..)) import qualified Wire.API.Conversation as Public import Wire.API.ErrorDescription import qualified Wire.API.Federation.API.Brig as FederatedBrig @@ -391,7 +392,7 @@ canDeleteMember deleter deletee -- here, so we pick a reasonable default.) getRole mem = fromMaybe RoleMember $ permissionsRole $ mem ^. permissions --- | Notify local users and bots of being added to a conversation +-- | Send an event to local users and bots pushConversationEvent :: Maybe ConnId -> Event -> [UserId] -> [BotMember] -> Galley () pushConversationEvent conn e users bots = do localDomain <- viewFederationDomain @@ -427,6 +428,9 @@ ensureAccess conv access = viewFederationDomain :: MonadReader Env m => m Domain viewFederationDomain = view (options . optSettings . setFederationDomain) +qualifyLocal :: MonadReader Env m => a -> m (Local a) +qualifyLocal a = fmap (toLocal . Qualified a) viewFederationDomain + checkRemoteUsersExist :: [Remote UserId] -> Galley () checkRemoteUsersExist = -- FUTUREWORK: pooledForConcurrentlyN_ instead of sequential checks per domain @@ -592,13 +596,13 @@ notifyRemoteAboutConvUpdate :: -- | The current time UTCTime -> -- | Action being performed - ConversationMembersAction -> + ConversationAction -> -- | Remote members that need to be notified [Remote UserId] -> Galley () notifyRemoteAboutConvUpdate origUser convId time action remotesToNotify = do localDomain <- viewFederationDomain - let mkUpdate oth = ConversationMemberUpdate time origUser convId oth action + let mkUpdate oth = ConversationUpdate time origUser convId oth action traverse_ (uncurry (notificationRPC localDomain . mkUpdate) . swap) . Map.assocs . partitionQualified @@ -606,13 +610,13 @@ notifyRemoteAboutConvUpdate origUser convId time action remotesToNotify = do . map unTagged $ remotesToNotify where - notificationRPC :: Domain -> ConversationMemberUpdate -> Domain -> Galley () - notificationRPC sendingDomain cmu receivingDomain = do + notificationRPC :: Domain -> ConversationUpdate -> Domain -> Galley () + notificationRPC sendingDomain cu receivingDomain = do let rpc = - FederatedGalley.onConversationMembershipsChanged + FederatedGalley.onConversationUpdated FederatedGalley.clientRoutes sendingDomain - cmu + cu runFederated receivingDomain rpc -------------------------------------------------------------------------------- diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index 3592ab08e66..7478a9b8914 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -608,7 +608,7 @@ remoteConversationStatus uid = remoteConversationStatusOnDomain :: MonadClient m => UserId -> Domain -> [ConvId] -> m (Map (Remote ConvId) MemberStatus) remoteConversationStatusOnDomain uid domain convs = Map.fromList . map toPair - <$> query Cql.selectRemoteConvMembers (params Quorum (uid, domain, convs)) + <$> query Cql.selectRemoteConvMemberStatuses (params Quorum (uid, domain, convs)) where toPair (conv, omus, omur, oar, oarr, hid, hidr) = ( toRemote (Qualified conv domain), @@ -921,8 +921,9 @@ addMembersUncheckedWithRole localDomain t conv (orig, _origRole) lusrs rusrs = d -- | Set local users as belonging to a remote conversation. This is invoked by a -- remote galley when users from the current backend are added to conversations -- on the remote end. -addLocalMembersToRemoteConv :: MonadClient m => [UserId] -> Qualified ConvId -> m () -addLocalMembersToRemoteConv users qconv = do +addLocalMembersToRemoteConv :: MonadClient m => Qualified ConvId -> [UserId] -> m () +addLocalMembersToRemoteConv _ [] = pure () +addLocalMembersToRemoteConv qconv users = do -- FUTUREWORK: consider using pooledMapConcurrentlyN for_ (List.chunksOf 32 users) $ \chunk -> retry x5 . batch $ do @@ -1024,9 +1025,9 @@ filterRemoteConvMembers users (Qualified conv dom) = where filterMember :: MonadClient m => UserId -> m [UserId] filterMember user = - fmap (map (const user)) + fmap (map runIdentity) . retry x1 - $ query Cql.selectRemoteConvMembers (params Quorum (user, dom, [conv])) + $ query Cql.selectRemoteConvMembers (params Quorum (user, dom, conv)) removeLocalMembersFromLocalConv :: MonadClient m => @@ -1071,8 +1072,9 @@ removeLocalMembersFromRemoteConv :: -- | The conversation to remove members from Qualified ConvId -> -- | Members to remove local to this backend - List1 UserId -> + [UserId] -> m () +removeLocalMembersFromRemoteConv _ [] = pure () removeLocalMembersFromRemoteConv (Qualified conv convDomain) victims = retry x5 . batch $ do setType BatchLogged diff --git a/services/galley/src/Galley/Data/Queries.hs b/services/galley/src/Galley/Data/Queries.hs index a07facd611c..8ebdcddd5eb 100644 --- a/services/galley/src/Galley/Data/Queries.hs +++ b/services/galley/src/Galley/Data/Queries.hs @@ -303,8 +303,11 @@ insertUserRemoteConv = "insert into user_remote_conv (user, conv_remote_domain, selectUserRemoteConvs :: PrepQuery R (Identity UserId) (Domain, ConvId) selectUserRemoteConvs = "select conv_remote_domain, conv_remote_id from user_remote_conv where user = ?" -selectRemoteConvMembers :: PrepQuery R (UserId, Domain, [ConvId]) (ConvId, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text) -selectRemoteConvMembers = "select conv_remote_id, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref from user_remote_conv where user = ? and conv_remote_domain = ? and conv_remote_id in ?" +selectRemoteConvMemberStatuses :: PrepQuery R (UserId, Domain, [ConvId]) (ConvId, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text) +selectRemoteConvMemberStatuses = "select conv_remote_id, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref from user_remote_conv where user = ? and conv_remote_domain = ? and conv_remote_id in ?" + +selectRemoteConvMembers :: PrepQuery R (UserId, Domain, ConvId) (Identity UserId) +selectRemoteConvMembers = "select user from user_remote_conv where user = ? and conv_remote_domain = ? and conv_remote_id = ?" 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 3f8554b785f..e40ecf331be 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -182,6 +182,7 @@ tests s = test s "rename conversation (deprecated endpoint)" putConvDeprecatedRenameOk, test s "rename conversation" putConvRenameOk, test s "rename qualified conversation" putQualifiedConvRenameOk, + test s "rename qualified conversation with remote members" putQualifiedConvRenameWithRemotesOk, test s "rename qualified conversation failure" putQualifiedConvRenameFailure, test s "other member update role" putOtherMemberOk, test s "qualified other member update role" putQualifiedOtherMemberOk, @@ -238,7 +239,7 @@ emptyFederatedGalley = in FederatedGalley.Api { FederatedGalley.onConversationCreated = \_ _ -> e "onConversationCreated", FederatedGalley.getConversations = \_ _ -> e "getConversations", - FederatedGalley.onConversationMembershipsChanged = \_ _ -> e "onConversationMembershipsChanged", + FederatedGalley.onConversationUpdated = \_ _ -> e "onConversationUpdated", FederatedGalley.leaveConversation = \_ _ -> e "leaveConversation", FederatedGalley.onMessageSent = \_ _ -> e "onMessageSent", FederatedGalley.sendMessage = \_ _ -> e "sendMessage" @@ -1313,30 +1314,30 @@ paginateConvListIds = do qChad = Qualified remoteChad chadDomain replicateM_ 25 $ do conv <- randomId - let cmu = - FederatedGalley.ConversationMemberUpdate - { FederatedGalley.cmuTime = now, - FederatedGalley.cmuOrigUserId = qChad, - FederatedGalley.cmuConvId = conv, - FederatedGalley.cmuAlreadyPresentUsers = [], - FederatedGalley.cmuAction = FederatedGalley.ConversationMembersActionAdd $ pure (qAlice, roleNameWireMember) + let cu = + FederatedGalley.ConversationUpdate + { FederatedGalley.cuTime = now, + FederatedGalley.cuOrigUserId = qChad, + FederatedGalley.cuConvId = conv, + FederatedGalley.cuAlreadyPresentUsers = [], + FederatedGalley.cuAction = ConversationActionAddMembers $ pure (qAlice, roleNameWireMember) } - FederatedGalley.onConversationMembershipsChanged fedGalleyClient chadDomain cmu + FederatedGalley.onConversationUpdated fedGalleyClient chadDomain cu remoteDee <- randomId let deeDomain = Domain "dee.example.com" qDee = Qualified remoteDee deeDomain replicateM_ 31 $ do conv <- randomId - let cmu = - FederatedGalley.ConversationMemberUpdate - { FederatedGalley.cmuTime = now, - FederatedGalley.cmuOrigUserId = qDee, - FederatedGalley.cmuConvId = conv, - FederatedGalley.cmuAlreadyPresentUsers = [], - FederatedGalley.cmuAction = FederatedGalley.ConversationMembersActionAdd $ pure (qAlice, roleNameWireMember) + let cu = + FederatedGalley.ConversationUpdate + { FederatedGalley.cuTime = now, + FederatedGalley.cuOrigUserId = qDee, + FederatedGalley.cuConvId = conv, + FederatedGalley.cuAlreadyPresentUsers = [], + FederatedGalley.cuAction = ConversationActionAddMembers $ pure (qAlice, roleNameWireMember) } - FederatedGalley.onConversationMembershipsChanged fedGalleyClient deeDomain cmu + FederatedGalley.onConversationUpdated fedGalleyClient deeDomain cu -- 1 self conv + 2 convs with bob and eve + 197 local convs + 25 convs on -- chad.example.com + 31 on dee.example = 256 convs. Getting them 16 at a time @@ -1371,15 +1372,15 @@ paginateConvListIdsPageEndingAtLocalsAndDomain = do -- The 3rd page will end with this domain replicateM_ 16 $ do conv <- randomId - let cmu = - FederatedGalley.ConversationMemberUpdate - { FederatedGalley.cmuTime = now, - FederatedGalley.cmuOrigUserId = qChad, - FederatedGalley.cmuConvId = conv, - FederatedGalley.cmuAlreadyPresentUsers = [], - FederatedGalley.cmuAction = FederatedGalley.ConversationMembersActionAdd $ pure (qAlice, roleNameWireMember) + let cu = + FederatedGalley.ConversationUpdate + { FederatedGalley.cuTime = now, + FederatedGalley.cuOrigUserId = qChad, + FederatedGalley.cuConvId = conv, + FederatedGalley.cuAlreadyPresentUsers = [], + FederatedGalley.cuAction = ConversationActionAddMembers $ pure (qAlice, roleNameWireMember) } - FederatedGalley.onConversationMembershipsChanged fedGalleyClient chadDomain cmu + FederatedGalley.onConversationUpdated fedGalleyClient chadDomain cu remoteDee <- randomId let deeDomain = Domain "dee.example.com" @@ -1387,15 +1388,15 @@ paginateConvListIdsPageEndingAtLocalsAndDomain = do -- The 4th and last page will end with this domain replicateM_ 16 $ do conv <- randomId - let cmu = - FederatedGalley.ConversationMemberUpdate - { FederatedGalley.cmuTime = now, - FederatedGalley.cmuOrigUserId = qDee, - FederatedGalley.cmuConvId = conv, - FederatedGalley.cmuAlreadyPresentUsers = [], - FederatedGalley.cmuAction = FederatedGalley.ConversationMembersActionAdd $ pure (qAlice, roleNameWireMember) + let cu = + FederatedGalley.ConversationUpdate + { FederatedGalley.cuTime = now, + FederatedGalley.cuOrigUserId = qDee, + FederatedGalley.cuConvId = conv, + FederatedGalley.cuAlreadyPresentUsers = [], + FederatedGalley.cuAction = ConversationActionAddMembers $ pure (qAlice, roleNameWireMember) } - FederatedGalley.onConversationMembershipsChanged fedGalleyClient deeDomain cmu + FederatedGalley.onConversationUpdated fedGalleyClient deeDomain cu foldM_ (getChunkedConvs 16 0 alice) Nothing [4, 3, 2, 1, 0 :: Int] @@ -1839,7 +1840,7 @@ testAddRemoteMember = do map F.domain reqs @?= replicate 2 (domainText remoteDomain) map (fmap F.path . F.request) reqs @?= [ Just "/federation/get-users-by-ids", - Just "/federation/on-conversation-memberships-changed" + Just "/federation/on-conversation-updated" ] e <- responseJsonUnsafe <$> (pure resp randomId <*> pure remoteDomain + qbob <- randomQualifiedUser + let bob = qUnqualified qbob + + resp <- postConvWithRemoteUser remoteDomain (mkProfile qalice (Name "Alice")) bob [qalice] + let qconv = decodeQualifiedConvId resp + + opts <- view tsGConf + WS.bracketR c bob $ \wsB -> do + (_, requests) <- + withTempMockFederator opts remoteDomain (const ()) $ + putQualifiedConversationName bob qconv "gossip++" !!! const 200 === statusCode + + req <- assertOne requests + liftIO $ do + F.domain req @?= domainText remoteDomain + fmap F.component (F.request req) @?= Just F.Galley + fmap F.path (F.request req) @?= Just "/federation/on-conversation-updated" + Just (Right cu) <- pure $ fmap (eitherDecode . LBS.fromStrict . F.body) (F.request req) + FederatedGalley.cuConvId cu @?= qUnqualified qconv + FederatedGalley.cuAction cu @?= ConversationActionRename (ConversationRename "gossip++") + + void . liftIO . WS.assertMatch (5 # Second) wsB $ \n -> do + let e = List1.head (WS.unpackPayload n) + ntfTransient n @?= False + evtConv e @?= qconv + evtType e @?= ConvRename + evtFrom e @?= qbob + evtData e @?= EdConvRename (ConversationRename "gossip++") + +assertOne :: (HasCallStack, MonadIO m, Show a) => [a] -> m a +assertOne [a] = pure a +assertOne xs = liftIO . assertFailure $ "Expected exactly one element, found " <> show xs + putConvDeprecatedRenameOk :: TestM () putConvDeprecatedRenameOk = do c <- view tsCannon @@ -2745,16 +2784,16 @@ putRemoteConvMemberOk update = do qconv <- Qualified <$> randomId <*> pure remoteDomain fedGalleyClient <- view tsFedGalleyClient now <- liftIO getCurrentTime - let cmu = - FederatedGalley.ConversationMemberUpdate - { cmuTime = now, - cmuOrigUserId = qbob, - cmuConvId = qUnqualified qconv, - cmuAlreadyPresentUsers = [], - cmuAction = - FederatedGalley.ConversationMembersActionAdd (pure (qalice, roleNameWireMember)) + let cu = + FederatedGalley.ConversationUpdate + { cuTime = now, + cuOrigUserId = qbob, + cuConvId = qUnqualified qconv, + cuAlreadyPresentUsers = [], + cuAction = + ConversationActionAddMembers (pure (qalice, roleNameWireMember)) } - FederatedGalley.onConversationMembershipsChanged fedGalleyClient remoteDomain cmu + FederatedGalley.onConversationUpdated fedGalleyClient remoteDomain cu -- Expected member state let memberAlice = diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 0daa10e4c52..5aa13b88198 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -48,6 +48,7 @@ import qualified Test.Tasty.Cannon as WS import Test.Tasty.HUnit import TestHelpers import TestSetup +import Wire.API.Conversation (ConversationAction (..)) import Wire.API.Conversation.Member (Member (..)) import Wire.API.Conversation.Role import Wire.API.Federation.API.Galley (GetConversationsRequest (..), GetConversationsResponse (..), RemoteConvMembers (..), RemoteConversation (..)) @@ -63,10 +64,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/on-conversation-memberships-changed : Add local user to remote conversation" addLocalUser, - test s "POST /federation/on-conversation-memberships-changed : Remove a local user from a remote conversation" removeLocalUser, - test s "POST /federation/on-conversation-memberships-changed : Remove a remote user from a remote conversation" removeRemoteUser, - test s "POST /federation/on-conversation-memberships-changed : Notify local user about other members joining" notifyLocalUser, + test s "POST /federation/on-conversation-updated : Add local user to remote conversation" addLocalUser, + test s "POST /federation/on-conversation-updated : Notify local user about other members joining" addRemoteUser, + test s "POST /federation/on-conversation-updated : Remove a local user from a remote conversation" removeLocalUser, + test s "POST /federation/on-conversation-updated : Remove a remote user from a remote conversation" removeRemoteUser, + test s "POST /federation/on-conversation-updated : Notify local user about conversation rename" notifyConvRename, test s "POST /federation/leave-conversation : Success" leaveConversationSuccess, test s "POST /federation/on-message-sent : Receive a message from another backend" onMessageSent, test s "POST /federation/send-message : Post a message sent from another backend" sendMessage @@ -150,30 +152,32 @@ addLocalUser = do let remoteDomain = Domain "bobland.example.com" bob <- randomId let qbob = Qualified bob remoteDomain + charlie <- randomUser conv <- randomId let qconv = Qualified conv remoteDomain fedGalleyClient <- view tsFedGalleyClient now <- liftIO getCurrentTime - let cmu = - FedGalley.ConversationMemberUpdate - { FedGalley.cmuTime = now, - FedGalley.cmuOrigUserId = qbob, - FedGalley.cmuConvId = conv, - FedGalley.cmuAlreadyPresentUsers = [], - FedGalley.cmuAction = - FedGalley.ConversationMembersActionAdd (pure (qalice, roleNameWireMember)) + let cu = + FedGalley.ConversationUpdate + { FedGalley.cuTime = now, + FedGalley.cuOrigUserId = qbob, + FedGalley.cuConvId = conv, + FedGalley.cuAlreadyPresentUsers = [charlie], + FedGalley.cuAction = + ConversationActionAddMembers (pure (qalice, roleNameWireMember)) } - WS.bracketR c alice $ \ws -> do - FedGalley.onConversationMembershipsChanged fedGalleyClient remoteDomain cmu - void . liftIO $ - WS.assertMatch (5 # Second) ws $ + WS.bracketR2 c alice charlie $ \(wsA, wsC) -> do + FedGalley.onConversationUpdated fedGalleyClient remoteDomain cu + liftIO $ do + WS.assertMatch_ (5 # Second) wsA $ wsAssertMemberJoinWithRole qconv qbob [qalice] roleNameWireMember + WS.assertNoEvent (1 # Second) [wsC] convs <- listRemoteConvs remoteDomain alice liftIO $ convs @?= [Qualified conv remoteDomain] -- | This test invokes the federation endpoint: -- --- 'POST /federation/on-conversation-memberships-changed' +-- 'POST /federation/on-conversation-updated' -- -- 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 @@ -192,29 +196,29 @@ removeLocalUser = do let qconv = Qualified conv remoteDomain fedGalleyClient <- view tsFedGalleyClient now <- liftIO getCurrentTime - let cmuAdd = - FedGalley.ConversationMemberUpdate - { FedGalley.cmuTime = now, - FedGalley.cmuOrigUserId = qBob, - FedGalley.cmuConvId = conv, - FedGalley.cmuAlreadyPresentUsers = [], - FedGalley.cmuAction = - FedGalley.ConversationMembersActionAdd (pure (qAlice, roleNameWireMember)) + let cuAdd = + FedGalley.ConversationUpdate + { FedGalley.cuTime = now, + FedGalley.cuOrigUserId = qBob, + FedGalley.cuConvId = conv, + FedGalley.cuAlreadyPresentUsers = [], + FedGalley.cuAction = + ConversationActionAddMembers (pure (qAlice, roleNameWireMember)) } - cmuRemove = - FedGalley.ConversationMemberUpdate - { FedGalley.cmuTime = addUTCTime (secondsToNominalDiffTime 5) now, - FedGalley.cmuOrigUserId = qBob, - FedGalley.cmuConvId = conv, - FedGalley.cmuAlreadyPresentUsers = [alice], - FedGalley.cmuAction = - FedGalley.ConversationMembersActionRemove (pure qAlice) + cuRemove = + FedGalley.ConversationUpdate + { FedGalley.cuTime = addUTCTime (secondsToNominalDiffTime 5) now, + FedGalley.cuOrigUserId = qBob, + FedGalley.cuConvId = conv, + FedGalley.cuAlreadyPresentUsers = [alice], + FedGalley.cuAction = + ConversationActionRemoveMembers (pure qAlice) } WS.bracketR c alice $ \ws -> do - FedGalley.onConversationMembershipsChanged fedGalleyClient remoteDomain cmuAdd + FedGalley.onConversationUpdated fedGalleyClient remoteDomain cuAdd afterAddition <- listRemoteConvs remoteDomain alice - FedGalley.onConversationMembershipsChanged fedGalleyClient remoteDomain cmuRemove + FedGalley.onConversationUpdated fedGalleyClient remoteDomain cuRemove liftIO $ do void . WS.assertMatch (3 # Second) ws $ wsAssertMemberJoinWithRole qconv qBob [qAlice] roleNameWireMember @@ -225,91 +229,153 @@ removeLocalUser = do afterAddition @?= [qconv] afterRemoval @?= [] --- | This test invokes the federation endpoint: +-- characters: +-- +-- alice: present local user +-- +-- bob: present remote user -- --- 'POST /federation/on-conversation-memberships-changed' +-- charlie: not present local user -- --- 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. +-- dee: local user being removed +-- +-- eve: remote user being removed +-- +-- flo: not present local user being removed removeRemoteUser :: TestM () removeRemoteUser = do localDomain <- viewFederationDomain c <- view tsCannon alice <- randomUser [bob, eve] <- replicateM 2 randomId + charlie <- randomUser + qDee <- randomQualifiedUser + qFlo <- randomQualifiedUser let qAlice = Qualified alice localDomain remoteDomain = Domain "bobland.example.com" qBob = Qualified bob remoteDomain + dee = qUnqualified qDee qEve = Qualified eve remoteDomain + flo = qUnqualified qFlo + aliceAsOtherMember = OtherMember qAlice Nothing roleNameWireMember + deeAsOtherMember = OtherMember qDee Nothing roleNameWireMember + eveAsOtherMember = OtherMember qEve Nothing roleNameWireMember 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 = conv, - FedGalley.cmuAlreadyPresentUsers = [], - FedGalley.cmuAction = - FedGalley.ConversationMembersActionAdd - ((qAlice, roleNameWireMember) :| [(qEve, roleNameWireMember)]) - } - cmuRemove = - FedGalley.ConversationMemberUpdate - { FedGalley.cmuTime = addUTCTime (secondsToNominalDiffTime 5) now, - FedGalley.cmuOrigUserId = qBob, - FedGalley.cmuConvId = conv, - FedGalley.cmuAlreadyPresentUsers = [alice], - FedGalley.cmuAction = - FedGalley.ConversationMembersActionRemove (pure qEve) + + registerRemoteConv qconv qBob (Just "gossip") (Set.fromList [aliceAsOtherMember, deeAsOtherMember, eveAsOtherMember]) + let cuRemove = + FedGalley.ConversationUpdate + { FedGalley.cuTime = addUTCTime (secondsToNominalDiffTime 5) now, + FedGalley.cuOrigUserId = qBob, + FedGalley.cuConvId = conv, + FedGalley.cuAlreadyPresentUsers = [alice, charlie, dee], + FedGalley.cuAction = + ConversationActionRemoveMembers (qEve :| [qDee, qFlo]) } - WS.bracketR c alice $ \ws -> do - FedGalley.onConversationMembershipsChanged fedGalleyClient remoteDomain cmuAdd - afterAddition <- listRemoteConvs remoteDomain alice - void . liftIO . WS.assertMatch (3 # Second) ws $ - wsAssertMemberJoinWithRole qconv qBob [qAlice, qEve] roleNameWireMember - FedGalley.onConversationMembershipsChanged fedGalleyClient remoteDomain cmuRemove + WS.bracketRN c [alice, charlie, dee, flo] $ \[wsA, wsC, wsD, wsF] -> do + FedGalley.onConversationUpdated fedGalleyClient remoteDomain cuRemove afterRemoval <- listRemoteConvs remoteDomain alice - void . liftIO $ - WS.assertMatch (3 # Second) ws $ - wsAssertMembersLeave qconv qBob [qEve] liftIO $ do - afterAddition @?= [qconv] + WS.assertMatchN_ (3 # Second) [wsA, wsD] $ + wsAssertMembersLeave qconv qBob [qDee, qEve, qFlo] + WS.assertNoEvent (1 # Second) [wsC] + WS.assertNoEvent (1 # Second) [wsF] + liftIO $ do afterRemoval @?= [qconv] -notifyLocalUser :: TestM () -notifyLocalUser = do +notifyConvRename :: TestM () +notifyConvRename = do c <- view tsCannon - alice <- randomUser + qalice <- randomQualifiedUser + let alice = qUnqualified qalice bob <- randomId - charlie <- randomId + charlie <- randomUser conv <- randomId let bdom = Domain "bob.example.com" - cdom = Domain "charlie.example.com" qbob = Qualified bob bdom qconv = Qualified conv bdom - qcharlie = Qualified charlie cdom + aliceAsOtherMember = OtherMember qalice Nothing roleNameWireMember fedGalleyClient <- view tsFedGalleyClient + + registerRemoteConv qconv qbob (Just "gossip") (Set.singleton aliceAsOtherMember) + now <- liftIO getCurrentTime - let cmu = - FedGalley.ConversationMemberUpdate - { FedGalley.cmuTime = now, - FedGalley.cmuOrigUserId = qbob, - FedGalley.cmuConvId = conv, - FedGalley.cmuAlreadyPresentUsers = [alice], - FedGalley.cmuAction = - FedGalley.ConversationMembersActionAdd (pure (qcharlie, roleNameWireMember)) + let cu = + FedGalley.ConversationUpdate + { FedGalley.cuTime = now, + FedGalley.cuOrigUserId = qbob, + FedGalley.cuConvId = conv, + FedGalley.cuAlreadyPresentUsers = [alice, charlie], + FedGalley.cuAction = + ConversationActionRename (ConversationRename "gossip++") } - WS.bracketR c alice $ \ws -> do - FedGalley.onConversationMembershipsChanged fedGalleyClient bdom cmu - void . liftIO $ - WS.assertMatch (5 # Second) ws $ - wsAssertMemberJoinWithRole qconv qbob [qcharlie] roleNameWireMember + WS.bracketR2 c alice charlie $ \(wsA, wsC) -> do + FedGalley.onConversationUpdated fedGalleyClient bdom cu + liftIO $ do + WS.assertMatch_ (5 # Second) wsA $ \n -> do + let e = List1.head (WS.unpackPayload n) + ntfTransient n @?= False + evtConv e @?= qconv + evtType e @?= ConvRename + evtFrom e @?= qbob + evtData e @?= EdConvRename (ConversationRename "gossip++") + WS.assertNoEvent (1 # Second) [wsC] + +-- TODO: test adding non-existing users +-- TODO: test adding resulting in an empty notification + +-- characters: +-- +-- alice: present local user +-- +-- bob: present remote user +-- +-- charlie: not present local user +-- +-- dee: present local user being added +-- +-- eve: remote user being added +-- +-- flo: not present local user being added +addRemoteUser :: TestM () +addRemoteUser = do + c <- view tsCannon + let bdom = Domain "bob.example.com" + edom = Domain "eve.example.com" + qalice <- randomQualifiedUser + qbob <- randomQualifiedId bdom + qcharlie <- randomQualifiedUser + qdee <- randomQualifiedUser + qeve <- randomQualifiedId edom + qflo <- randomQualifiedUser + + qconv <- randomQualifiedId bdom + fedGalleyClient <- view tsFedGalleyClient + now <- liftIO getCurrentTime + + let asOtherMember quid = OtherMember quid Nothing roleNameWireMember + registerRemoteConv qconv qbob (Just "gossip") (Set.fromList (map asOtherMember [qalice, qdee, qeve])) + + -- The conversation owning + let cu = + FedGalley.ConversationUpdate + { FedGalley.cuTime = now, + FedGalley.cuOrigUserId = qbob, + FedGalley.cuConvId = qUnqualified qconv, + FedGalley.cuAlreadyPresentUsers = (map qUnqualified [qalice, qcharlie]), + FedGalley.cuAction = + ConversationActionAddMembers ((qdee, roleNameWireMember) :| [(qeve, roleNameWireMember), (qflo, roleNameWireMember)]) + } + WS.bracketRN c (map qUnqualified [qalice, qcharlie, qdee, qflo]) $ \[wsA, wsC, wsD, wsF] -> do + FedGalley.onConversationUpdated fedGalleyClient bdom cu + void . liftIO $ do + WS.assertMatchN_ (5 # Second) [wsA, wsD, wsF] $ + wsAssertMemberJoinWithRole qconv qbob [qeve, qdee, qflo] roleNameWireMember + WS.assertNoEvent (1 # Second) [wsC] leaveConversationSuccess :: TestM () leaveConversationSuccess = do @@ -390,16 +456,16 @@ onMessageSent = do fedGalleyClient <- view tsFedGalleyClient -- only add alice to the remote conversation - let cmu = - FedGalley.ConversationMemberUpdate - { FedGalley.cmuTime = now, - FedGalley.cmuOrigUserId = qbob, - FedGalley.cmuConvId = conv, - FedGalley.cmuAlreadyPresentUsers = [], - FedGalley.cmuAction = - FedGalley.ConversationMembersActionAdd (pure (qalice, roleNameWireMember)) + let cu = + FedGalley.ConversationUpdate + { FedGalley.cuTime = now, + FedGalley.cuOrigUserId = qbob, + FedGalley.cuConvId = conv, + FedGalley.cuAlreadyPresentUsers = [], + FedGalley.cuAction = + ConversationActionAddMembers (pure (qalice, roleNameWireMember)) } - FedGalley.onConversationMembershipsChanged fedGalleyClient bdom cmu + FedGalley.onConversationUpdated fedGalleyClient bdom cu let txt = "Hello from another backend" msg client = Map.fromList [(client, txt)] diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 0286234ac6a..f49bb5e9e85 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -107,6 +107,7 @@ import Util.Options import Web.Cookie import Wire.API.Conversation import qualified Wire.API.Conversation as Public +import Wire.API.Event.Conversation (_EdMembersJoin, _EdMembersLeave) import qualified Wire.API.Event.Team as TE import qualified Wire.API.Federation.API.Brig as FederatedBrig import qualified Wire.API.Federation.API.Galley as FederatedGalley @@ -989,9 +990,14 @@ putOtherMember from to m c = do . zType "access" . json m -putQualifiedConversationName :: UserId -> Qualified ConvId -> Text -> TestM ResponseLBS +putQualifiedConversationName :: + (HasCallStack, HasGalley m, MonadIO m, MonadHttp m, MonadMask m) => + UserId -> + Qualified ConvId -> + Text -> + m ResponseLBS putQualifiedConversationName u c n = do - g <- view tsGalley + g <- viewGalley let update = ConversationRename n put ( g @@ -1326,7 +1332,7 @@ wsAssertMemberJoinWithRole conv usr new role n = do evtConv e @?= conv evtType e @?= Conv.MemberJoin evtFrom e @?= usr - evtData e @?= EdMembersJoin (SimpleMembers (fmap (`SimpleMember` role) new)) + fmap (sort . mMembers) (evtData e ^? _EdMembersJoin) @?= Just (sort (fmap (`SimpleMember` role) new)) -- FUTUREWORK: See if this one can be implemented in terms of: -- @@ -1355,7 +1361,7 @@ assertLeaveEvent conv usr leaving e = do evtConv e @?= conv evtType e @?= Conv.MemberLeave evtFrom e @?= usr - evtData e @?= EdMembersLeave (QualifiedUserIdList leaving) + fmap (sort . qualifiedUserIdList) (evtData e ^? _EdMembersLeave) @?= Just (sort leaving) wsAssertMemberUpdateWithRole :: Qualified ConvId -> Qualified UserId -> UserId -> RoleName -> Notification -> IO () wsAssertMemberUpdateWithRole conv usr target role n = do @@ -1409,13 +1415,13 @@ assertNoMsg ws f = do 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/on-conversation-memberships-changed" + F.path req @?= "/federation/on-conversation-updated" F.originDomain req @?= (domainText . qDomain) qconvId - let Just cmu = decodeStrict (F.body req) - FederatedGalley.cmuOrigUserId cmu @?= remover - FederatedGalley.cmuConvId cmu @?= qUnqualified qconvId - sort (FederatedGalley.cmuAlreadyPresentUsers cmu) @?= sort alreadyPresentUsers - FederatedGalley.cmuAction cmu @?= FederatedGalley.ConversationMembersActionRemove (pure victim) + let Just cu = decodeStrict (F.body req) + FederatedGalley.cuOrigUserId cu @?= remover + FederatedGalley.cuConvId cu @?= qUnqualified qconvId + sort (FederatedGalley.cuAlreadyPresentUsers cu) @?= sort alreadyPresentUsers + FederatedGalley.cuAction cu @?= Public.ConversationActionRemoveMembers (pure victim) ------------------------------------------------------------------------------- -- Helpers @@ -1605,7 +1611,7 @@ randomQualifiedUser :: HasCallStack => TestM (Qualified UserId) randomQualifiedUser = randomUser' False True True randomQualifiedId :: MonadIO m => Domain -> m (Qualified (Id a)) -randomQualifiedId domain = flip Qualified domain <$> randomId +randomQualifiedId domain = Qualified <$> randomId <*> pure domain randomTeamCreator :: HasCallStack => TestM UserId randomTeamCreator = qUnqualified <$> randomUser' True True True From 18b90a8ed1bd5cb0c613b1bc746f5e0ac32b23c1 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 21 Sep 2021 11:57:45 +0200 Subject: [PATCH 39/72] Remove explicit instantiations of ErrorDescription values (#1794) * Remove explicit instantiation of ConvNotFound * Remove explicit instantiation of UnknownClient * Remove explicit instantiations of some brig errors * Remove explicit instantiation of notConnected * Implicit instantiation of connectionLimitReached * Remove explicit instantiation of invalidUser * Remove explicit instantiation of invalidTransition * Remove explicit instantiation of notATeamMember * Remove instantiation of convMemberRemovalDenied * Remove explicit instantiation of codeNotFound * Remove explicit instantiation of convAccessDenied * Remove explicit instantiation of userNotFound * Remove instantiation of connectionNotFound * Remove instantiation of handleNotFound * Remove explicit instantiation of tooManyClients * Remove explicit instantiation of missingAuthError * Remove explicit instantiation of deleteCodePending * Remove explicit instantiation of malformedPrekeys * Remove instantiation of missingLegalholdConsent * Remove more error description instantiations --- .../5-internal/remove-explicit-errdesc | 1 + .../wire-api/src/Wire/API/ErrorDescription.hs | 84 +---------------- services/brig/src/Brig/API/Connection.hs | 4 +- services/brig/src/Brig/API/Error.hs | 94 ++++++++++--------- services/brig/src/Brig/API/Internal.hs | 6 +- services/brig/src/Brig/API/Public.hs | 20 ++-- services/brig/src/Brig/Provider/API.hs | 30 +++--- services/brig/src/Brig/User/API/Auth.hs | 11 ++- services/galley/src/Galley/API/Create.hs | 4 +- services/galley/src/Galley/API/Internal.hs | 6 +- services/galley/src/Galley/API/Public.hs | 54 +++++------ services/galley/src/Galley/API/Query.hs | 8 +- services/galley/src/Galley/API/Teams.hs | 16 ++-- services/galley/src/Galley/API/Update.hs | 60 ++++++------ services/galley/src/Galley/API/Util.hs | 34 +++---- 15 files changed, 180 insertions(+), 252 deletions(-) create mode 100644 changelog.d/5-internal/remove-explicit-errdesc diff --git a/changelog.d/5-internal/remove-explicit-errdesc b/changelog.d/5-internal/remove-explicit-errdesc new file mode 100644 index 00000000000..1d73b72958e --- /dev/null +++ b/changelog.d/5-internal/remove-explicit-errdesc @@ -0,0 +1 @@ +Remove explicit instantiations of ErrorDescription diff --git a/libs/wire-api/src/Wire/API/ErrorDescription.hs b/libs/wire-api/src/Wire/API/ErrorDescription.hs index 63328925d5e..1772d9f55ab 100644 --- a/libs/wire-api/src/Wire/API/ErrorDescription.hs +++ b/libs/wire-api/src/Wire/API/ErrorDescription.hs @@ -203,50 +203,22 @@ mkErrorDescription = ErrorDescription $ Text.pack (symbolVal (Proxy @desc)) type ConvNotFound = ErrorDescription 404 "no-conversation" "Conversation not found" -convNotFound :: ConvNotFound -convNotFound = mkErrorDescription - type ConvMemberNotFound = ErrorDescription 404 "no-conversation-member" "Conversation member not found" type UnknownClient = ErrorDescription 403 "unknown-client" "Unknown Client" -unknownClient :: UnknownClient -unknownClient = ErrorDescription "Sending client not known" - type ClientNotFound = ErrorDescription 404 "client-not-found" "Client not found" -clientNotFound :: ClientNotFound -clientNotFound = mkErrorDescription - type NotConnected = ErrorDescription 403 "not-connected" "Users are not connected" -notConnected :: NotConnected -notConnected = mkErrorDescription - type ConnectionLimitReached = ErrorDescription 403 "connection-limit" "Too many sent/accepted connections." -connectionLimitReached :: ConnectionLimitReached -connectionLimitReached = mkErrorDescription - type InvalidUser = ErrorDescription 400 "invalid-user" "Invalid user." -invalidUser :: InvalidUser -invalidUser = mkErrorDescription - -type InvalidCode = - ErrorDescription - 403 - "invalid-code" - "Invalid verification code" - -invalidCode :: InvalidCode -invalidCode = mkErrorDescription +type InvalidCode = ErrorDescription 403 "invalid-code" "Invalid verification code" type InvalidTransition = ErrorDescription 403 "bad-conn-update" "Invalid status transition." -invalidTransition :: InvalidTransition -invalidTransition = mkErrorDescription - type NoIdentity = ErrorDescription 403 "no-identity" "The user has no verified identity (email or phone number)." noIdentity :: forall code lbl desc. (NoIdentity ~ ErrorDescription code lbl desc) => Int -> NoIdentity @@ -261,9 +233,6 @@ operationDenied p = type NotATeamMember = ErrorDescription 403 "no-team-member" "Requesting user is not a team member" -notATeamMember :: NotATeamMember -notATeamMember = mkErrorDescription - type ActionDenied = ErrorDescription 403 "action-denied" "Insufficient authorization" actionDenied :: Show a => a -> ActionDenied @@ -273,80 +242,44 @@ actionDenied 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 -codeNotFound = mkErrorDescription - type ConvAccessDenied = ErrorDescription 403 "access-denied" "Conversation access denied" -convAccessDenied :: ConvAccessDenied -convAccessDenied = mkErrorDescription - type UserNotFound = ErrorDescription 404 "not-found" "User not found" -userNotFound :: UserNotFound -userNotFound = mkErrorDescription - type ConnectionNotFound = ErrorDescription 404 "not-found" "Connection not found" -connectionNotFound :: ConnectionNotFound -connectionNotFound = mkErrorDescription - type HandleNotFound = ErrorDescription 404 "not-found" "Handle not found" -handleNotFound :: HandleNotFound -handleNotFound = mkErrorDescription - type TooManyClients = ErrorDescription 403 "too-many-clients" "Too many clients" -tooManyClients :: TooManyClients -tooManyClients = mkErrorDescription - type MissingAuth = ErrorDescription 403 "missing-auth" "Re-authentication via password required" -missingAuthError :: MissingAuth -missingAuthError = mkErrorDescription - type BadCredentials = ErrorDescription 403 "invalid-credentials" "Authentication failed." -badCredentials :: BadCredentials -badCredentials = mkErrorDescription - type DeleteCodePending = ErrorDescription 403 "pending-delete" "A verification code for account deletion is still pending." -deleteCodePending :: DeleteCodePending -deleteCodePending = mkErrorDescription - type OwnerDeletingSelf = ErrorDescription 403 "no-self-delete-for-team-owner" "Team owners are not allowed to delete themselves. Ask a fellow owner." -ownerDeletingSelf :: OwnerDeletingSelf -ownerDeletingSelf = mkErrorDescription - type MalformedPrekeys = ErrorDescription 400 "bad-request" "Malformed prekeys uploaded" -malformedPrekeys :: MalformedPrekeys -malformedPrekeys = mkErrorDescription - type MissingLegalholdConsent = ErrorDescription 403 @@ -354,18 +287,12 @@ type MissingLegalholdConsent = "Failed to connect to a user or to invite a user to a group because somebody \ \is under legalhold and somebody else has not granted consent." -missingLegalholdConsent :: MissingLegalholdConsent -missingLegalholdConsent = mkErrorDescription - type CustomRolesNotSupported = ErrorDescription 400 "bad-request" "Custom roles not supported" -customRolesNotSupported :: CustomRolesNotSupported -customRolesNotSupported = mkErrorDescription - type InvalidOp desc = ErrorDescription 403 @@ -377,15 +304,6 @@ 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/services/brig/src/Brig/API/Connection.hs b/services/brig/src/Brig/API/Connection.hs index be837b42f98..9ca00f5f8f1 100644 --- a/services/brig/src/Brig/API/Connection.hs +++ b/services/brig/src/Brig/API/Connection.hs @@ -34,7 +34,7 @@ module Brig.API.Connection ) where -import Brig.API.Error (errorDescriptionToWai) +import Brig.API.Error (errorDescriptionTypeToWai) import Brig.API.Types import Brig.API.User (getLegalHoldStatus) import Brig.App @@ -175,7 +175,7 @@ checkLegalholdPolicyConflict uid1 uid2 = do let catchProfileNotFound = -- Does not fit into 'ExceptT', so throw in 'AppIO'. Anyway at the time of writing -- this, users are guaranteed to exist when called from 'createConnectionToLocalUser'. - maybe (throwM (errorDescriptionToWai userNotFound)) return + maybe (throwM (errorDescriptionTypeToWai @UserNotFound)) return status1 <- lift (getLegalHoldStatus uid1) >>= catchProfileNotFound status2 <- lift (getLegalHoldStatus uid2) >>= catchProfileNotFound diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index 32e5b447d6c..edce3880082 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -37,21 +37,31 @@ import Network.HTTP.Types.Header import Network.HTTP.Types.Status import qualified Network.Wai.Utilities.Error as Wai import Servant.API.Status -import qualified Wire.API.ErrorDescription as ErrDesc +import Wire.API.ErrorDescription import Wire.API.Federation.Client (FederationError (..)) import Wire.API.Federation.Error errorDescriptionToWai :: forall (code :: Nat) (lbl :: Symbol) (desc :: Symbol). (KnownStatus code, KnownSymbol lbl) => - ErrDesc.ErrorDescription code lbl desc -> + ErrorDescription code lbl desc -> Wai.Error -errorDescriptionToWai (ErrDesc.ErrorDescription msg) = +errorDescriptionToWai (ErrorDescription msg) = Wai.mkError (statusVal (Proxy @code)) (LT.pack (symbolVal (Proxy @lbl))) (LT.fromStrict msg) +errorDescriptionTypeToWai :: + forall e (code :: Nat) (lbl :: Symbol) (desc :: Symbol). + ( KnownStatus code, + KnownSymbol lbl, + KnownSymbol desc, + e ~ ErrorDescription code lbl desc + ) => + Wai.Error +errorDescriptionTypeToWai = errorDescriptionToWai (mkErrorDescription :: e) + data Error where StdError :: !Wai.Error -> Error RichError :: ToJSON a => !Wai.Error -> !a -> [Header] -> Error @@ -72,10 +82,21 @@ throwRich e x h = throwError (RichError e x h) throwErrorDescription :: (KnownStatus code, KnownSymbol lbl, MonadError Error m) => - ErrDesc.ErrorDescription code lbl desc -> + ErrorDescription code lbl desc -> m a throwErrorDescription = throwStd . errorDescriptionToWai +throwErrorDescriptionType :: + forall e (code :: Nat) (lbl :: Symbol) (desc :: Symbol) m a. + ( KnownStatus code, + KnownSymbol lbl, + KnownSymbol desc, + MonadError Error m, + e ~ ErrorDescription code lbl desc + ) => + m a +throwErrorDescriptionType = throwErrorDescription (mkErrorDescription :: e) + instance ToJSON Error where toJSON (StdError e) = toJSON e toJSON (RichError e x _) = case (toJSON e, toJSON x) of @@ -85,16 +106,16 @@ instance ToJSON Error where -- Error Mapping ---------------------------------------------------------- connError :: ConnectionError -> Error -connError TooManyConnections {} = StdError (errorDescriptionToWai ErrDesc.connectionLimitReached) -connError InvalidTransition {} = StdError (errorDescriptionToWai ErrDesc.invalidTransition) -connError NotConnected {} = StdError (errorDescriptionToWai ErrDesc.notConnected) -connError InvalidUser {} = StdError (errorDescriptionToWai ErrDesc.invalidUser) -connError ConnectNoIdentity {} = StdError (errorDescriptionToWai (ErrDesc.noIdentity 0)) +connError TooManyConnections {} = StdError (errorDescriptionTypeToWai @ConnectionLimitReached) +connError InvalidTransition {} = StdError (errorDescriptionTypeToWai @InvalidTransition) +connError NotConnected {} = StdError (errorDescriptionTypeToWai @NotConnected) +connError InvalidUser {} = StdError (errorDescriptionTypeToWai @InvalidUser) +connError ConnectNoIdentity {} = StdError (errorDescriptionToWai (noIdentity 0)) connError (ConnectBlacklistedUserKey k) = StdError $ foldKey (const blacklistedEmail) (const blacklistedPhone) k connError (ConnectInvalidEmail _ _) = StdError invalidEmail connError ConnectInvalidPhone {} = StdError invalidPhone connError ConnectSameBindingTeamUsers = StdError sameBindingTeamUsers -connError ConnectMissingLegalholdConsent = StdError (errorDescriptionToWai ErrDesc.missingLegalholdConsent) +connError ConnectMissingLegalholdConsent = StdError (errorDescriptionTypeToWai @MissingLegalholdConsent) actError :: ActivationError -> Error actError (UserKeyExists _) = StdError userKeyExists @@ -147,12 +168,12 @@ changePhoneError (PhoneExists _) = StdError userKeyExists changePhoneError (BlacklistedNewPhone _) = StdError blacklistedPhone changePwError :: ChangePasswordError -> Error -changePwError InvalidCurrentPassword = StdError badCredentials -changePwError ChangePasswordNoIdentity = StdError (errorDescriptionToWai (ErrDesc.noIdentity 1)) +changePwError InvalidCurrentPassword = StdError (errorDescriptionTypeToWai @BadCredentials) +changePwError ChangePasswordNoIdentity = StdError (errorDescriptionToWai (noIdentity 1)) changePwError ChangePasswordMustDiffer = StdError changePasswordMustDiffer changeHandleError :: ChangeHandleError -> Error -changeHandleError ChangeHandleNoIdentity = StdError (errorDescriptionToWai (ErrDesc.noIdentity 2)) +changeHandleError ChangeHandleNoIdentity = StdError (errorDescriptionToWai (noIdentity 2)) changeHandleError ChangeHandleExists = StdError handleExists changeHandleError ChangeHandleInvalid = StdError invalidHandle changeHandleError ChangeHandleManagedByScim = StdError $ propertyManagedByScim "handle" @@ -164,7 +185,7 @@ legalHoldLoginError (LegalHoldLoginError e) = loginError e legalHoldLoginError (LegalHoldReAuthError e) = reauthError e loginError :: LoginError -> Error -loginError LoginFailed = StdError badCredentials +loginError LoginFailed = StdError (errorDescriptionTypeToWai @BadCredentials) loginError LoginSuspended = StdError accountSuspended loginError LoginEphemeral = StdError accountEphemeral loginError LoginPendingActivation = StdError accountPending @@ -180,14 +201,14 @@ loginError (LoginBlocked wait) = [("Retry-After", toByteString' (retryAfterSeconds wait))] authError :: AuthError -> Error -authError AuthInvalidUser = StdError badCredentials -authError AuthInvalidCredentials = StdError badCredentials +authError AuthInvalidUser = StdError (errorDescriptionTypeToWai @BadCredentials) +authError AuthInvalidCredentials = StdError (errorDescriptionTypeToWai @BadCredentials) authError AuthSuspended = StdError accountSuspended authError AuthEphemeral = StdError accountEphemeral authError AuthPendingInvitation = StdError accountPending reauthError :: ReAuthError -> Error -reauthError ReAuthMissingPassword = StdError (errorDescriptionToWai ErrDesc.missingAuthError) +reauthError ReAuthMissingPassword = StdError (errorDescriptionTypeToWai @MissingAuth) reauthError (ReAuthError e) = authError e zauthError :: ZAuth.Failure -> Error @@ -197,14 +218,14 @@ zauthError ZAuth.Invalid = StdError authTokenInvalid zauthError ZAuth.Unsupported = StdError authTokenUnsupported clientError :: ClientError -> Error -clientError ClientNotFound = StdError (errorDescriptionToWai ErrDesc.clientNotFound) +clientError ClientNotFound = StdError (errorDescriptionTypeToWai @ClientNotFound) clientError (ClientDataError e) = clientDataError e -clientError (ClientUserNotFound _) = StdError (errorDescriptionToWai ErrDesc.invalidUser) +clientError (ClientUserNotFound _) = StdError (errorDescriptionTypeToWai @InvalidUser) clientError ClientLegalHoldCannotBeRemoved = StdError can'tDeleteLegalHoldClient clientError ClientLegalHoldCannotBeAdded = StdError can'tAddLegalHoldClient clientError (ClientFederationError e) = fedError e clientError ClientCapabilitiesCannotBeRemoved = StdError clientCapabilitiesCannotBeRemoved -clientError ClientMissingLegalholdConsent = StdError (errorDescriptionToWai ErrDesc.missingLegalholdConsent) +clientError ClientMissingLegalholdConsent = StdError (errorDescriptionTypeToWai @MissingLegalholdConsent) fedError :: FederationError -> Error fedError = StdError . federationErrorToWai @@ -212,24 +233,24 @@ fedError = StdError . federationErrorToWai idtError :: RemoveIdentityError -> Error idtError LastIdentity = StdError lastIdentity idtError NoPassword = StdError noPassword -idtError NoIdentity = StdError (errorDescriptionToWai (ErrDesc.noIdentity 3)) +idtError NoIdentity = StdError (errorDescriptionToWai (noIdentity 3)) propDataError :: PropertiesDataError -> Error propDataError TooManyProperties = StdError tooManyProperties clientDataError :: ClientDataError -> Error -clientDataError TooManyClients = StdError (errorDescriptionToWai ErrDesc.tooManyClients) +clientDataError TooManyClients = StdError (errorDescriptionTypeToWai @TooManyClients) clientDataError (ClientReAuthError e) = reauthError e -clientDataError ClientMissingAuth = StdError (errorDescriptionToWai ErrDesc.missingAuthError) -clientDataError MalformedPrekeys = StdError (errorDescriptionToWai ErrDesc.malformedPrekeys) +clientDataError ClientMissingAuth = StdError (errorDescriptionTypeToWai @MissingAuth) +clientDataError MalformedPrekeys = StdError (errorDescriptionTypeToWai @MalformedPrekeys) deleteUserError :: DeleteUserError -> Error -deleteUserError DeleteUserInvalid = StdError (errorDescriptionToWai ErrDesc.invalidUser) -deleteUserError DeleteUserInvalidCode = StdError invalidCode -deleteUserError DeleteUserInvalidPassword = StdError badCredentials -deleteUserError DeleteUserMissingPassword = StdError (errorDescriptionToWai ErrDesc.missingAuthError) +deleteUserError DeleteUserInvalid = StdError (errorDescriptionTypeToWai @InvalidUser) +deleteUserError DeleteUserInvalidCode = StdError (errorDescriptionTypeToWai @InvalidCode) +deleteUserError DeleteUserInvalidPassword = StdError (errorDescriptionTypeToWai @BadCredentials) +deleteUserError DeleteUserMissingPassword = StdError (errorDescriptionTypeToWai @MissingAuth) deleteUserError (DeleteUserPendingCode t) = RichError deletionCodePending (DeletionCodeTimeout t) [] -deleteUserError DeleteUserOwnerDeletingSelf = StdError ownerDeletingSelf +deleteUserError DeleteUserOwnerDeletingSelf = StdError (errorDescriptionTypeToWai @OwnerDeletingSelf) accountStatusError :: AccountStatusError -> Error accountStatusError InvalidAccountStatus = StdError invalidAccountStatus @@ -241,7 +262,7 @@ phoneError (PhoneBudgetExhausted t) = RichError phoneBudgetExhausted (PhoneBudge updateProfileError :: UpdateProfileError -> Error updateProfileError DisplayNameManagedByScim = StdError (propertyManagedByScim "name") -updateProfileError (ProfileNotFound _) = StdError (errorDescriptionToWai ErrDesc.userNotFound) +updateProfileError (ProfileNotFound _) = StdError (errorDescriptionTypeToWai @UserNotFound) -- WAI Errors ----------------------------------------------------------------- @@ -326,18 +347,12 @@ accountSuspended = Wai.mkError status403 "suspended" "Account suspended." accountEphemeral :: Wai.Error accountEphemeral = Wai.mkError status403 "ephemeral" "Account is ephemeral." -badCredentials :: Wai.Error -badCredentials = Wai.mkError status403 "invalid-credentials" "Authentication failed." - newPasswordMustDiffer :: Wai.Error newPasswordMustDiffer = Wai.mkError status409 "password-must-differ" "For provider password change or reset, new and old password must be different." notFound :: LText -> Wai.Error notFound = Wai.mkError status404 "not-found" -invalidCode :: Wai.Error -invalidCode = Wai.mkError status403 "invalid-code" "Invalid verification code" - invalidAccountStatus :: Wai.Error invalidAccountStatus = Wai.mkError status400 "invalid-status" "The specified account status cannot be set." @@ -445,13 +460,6 @@ propertyManagedByScim prop = Wai.mkError status403 "managed-by-scim" $ "Updating sameBindingTeamUsers :: Wai.Error sameBindingTeamUsers = Wai.mkError status403 "same-binding-team-users" "Operation not allowed to binding team users." -ownerDeletingSelf :: Wai.Error -ownerDeletingSelf = - Wai.mkError - status403 - "no-self-delete-for-team-owner" - "Team owners are not allowed to delete themselves. Ask a fellow owner." - tooManyTeamInvitations :: Wai.Error tooManyTeamInvitations = Wai.mkError status403 "too-many-team-invitations" "Too many team invitations for this team." diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 8bf0022036a..28e5dd8807e 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -363,7 +363,7 @@ deleteUserNoVerify :: UserId -> Handler () deleteUserNoVerify uid = do void $ lift (API.lookupAccount uid) - >>= ifNothing (errorDescriptionToWai userNotFound) + >>= ifNothing (errorDescriptionTypeToWai @UserNotFound) lift $ API.deleteUserNoVerify uid changeSelfEmailMaybeSendH :: UserId ::: Bool ::: JsonRequest EmailUpdate -> Handler Response @@ -589,7 +589,7 @@ updateUserNameH (uid ::: _ ::: body) = empty <$ (updateUserName uid =<< parseJso updateUserName :: UserId -> NameUpdate -> Handler () updateUserName uid (NameUpdate nameUpd) = do - name <- either (const $ throwStd (errorDescriptionToWai invalidUser)) pure $ mkName nameUpd + name <- either (const $ throwStd (errorDescriptionTypeToWai @InvalidUser)) pure $ mkName nameUpd let uu = UserUpdate { uupName = Just name, @@ -599,7 +599,7 @@ updateUserName uid (NameUpdate nameUpd) = do } lift (Data.lookupUser WithPendingInvitations uid) >>= \case Just _ -> API.updateUser uid Nothing uu API.AllowSCIMUpdates !>> updateProfileError - Nothing -> throwStd (errorDescriptionToWai invalidUser) + Nothing -> throwStd (errorDescriptionTypeToWai @InvalidUser) checkHandleInternalH :: Text -> Handler Response checkHandleInternalH = diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 63d95bc657f..e84cbc785d1 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -93,7 +93,7 @@ import Servant.Swagger.UI import qualified System.Logger.Class as Log import Util.Logging (logFunction, logHandle, logTeam, logUser) import qualified Wire.API.Connection as Public -import Wire.API.ErrorDescription hiding (badCredentials, invalidCode) +import Wire.API.ErrorDescription import qualified Wire.API.Properties as Public import qualified Wire.API.Routes.Public.Brig as BrigAPI import qualified Wire.API.Routes.Public.Galley as GalleyAPI @@ -292,7 +292,7 @@ sitemap = do Doc.description "Handle to check" Doc.response 200 "Handle is taken" Doc.end Doc.errorResponse invalidHandle - Doc.errorResponse (errorDescriptionToWai handleNotFound) + Doc.errorResponse (errorDescriptionTypeToWai @HandleNotFound) -- some APIs moved to servant -- end User Handle API @@ -359,7 +359,7 @@ sitemap = do Doc.body (Doc.ref Public.modelChangePassword) $ Doc.description "JSON body" Doc.response 200 "Password changed." Doc.end - Doc.errorResponse badCredentials + Doc.errorResponse (errorDescriptionTypeToWai @BadCredentials) Doc.errorResponse (errorDescriptionToWai (noIdentity 4)) put "/self/locale" (continue changeLocaleH) $ @@ -426,7 +426,7 @@ sitemap = do Doc.body (Doc.ref Public.modelVerifyDelete) $ Doc.description "JSON body" Doc.response 200 "Deletion is initiated." Doc.end - Doc.errorResponse invalidCode + Doc.errorResponse (errorDescriptionTypeToWai @InvalidCode) -- Properties API ----------------------------------------------------- @@ -716,7 +716,7 @@ getMultiUserPrekeyBundleUnqualifiedH :: UserId -> Public.UserClients -> Handler getMultiUserPrekeyBundleUnqualifiedH zusr userClients = do maxSize <- fromIntegral . setMaxConvSize <$> view settings when (Map.size (Public.userClients userClients) > maxSize) $ - throwErrorDescription tooManyClients + throwErrorDescriptionType @TooManyClients API.claimLocalMultiPrekeyBundles (ProtectedUser zusr) userClients !>> clientError getMultiUserPrekeyBundleH :: UserId -> Public.QualifiedUserClients -> Handler Public.QualifiedUserClientPrekeyMap @@ -727,7 +727,7 @@ getMultiUserPrekeyBundleH zusr qualUserClients = do (\_ v -> Sum . Map.size $ v) (Public.qualifiedUserClients qualUserClients) when (size > maxSize) $ - throwErrorDescription tooManyClients + throwErrorDescriptionType @TooManyClients API.claimMultiPrekeyBundles (ProtectedUser zusr) qualUserClients !>> clientError addClient :: UserId -> ConnId -> Maybe IpAddr -> Public.NewClient -> Handler BrigAPI.NewClientResponse @@ -783,7 +783,7 @@ getUserClientQualified quid cid = do getClientCapabilities :: UserId -> ClientId -> Handler Public.ClientCapabilityList getClientCapabilities uid cid = do mclient <- lift (API.lookupLocalClient uid cid) - maybe (throwErrorDescription clientNotFound) (pure . Public.clientCapabilities) mclient + maybe (throwErrorDescriptionType @ClientNotFound) (pure . Public.clientCapabilities) mclient getRichInfoH :: UserId ::: UserId ::: JSON -> Handler Response getRichInfoH (self ::: user ::: _) = @@ -794,10 +794,10 @@ getRichInfo self user = do -- Check that both users exist and the requesting user is allowed to see rich info of the -- other user selfUser <- - ifNothing (errorDescriptionToWai userNotFound) + ifNothing (errorDescriptionTypeToWai @UserNotFound) =<< lift (Data.lookupUser NoPendingInvitations self) otherUser <- - ifNothing (errorDescriptionToWai userNotFound) + ifNothing (errorDescriptionTypeToWai @UserNotFound) =<< lift (Data.lookupUser NoPendingInvitations user) case (Public.userTeam selfUser, Public.userTeam otherUser) of (Just t1, Just t2) | t1 == t2 -> pure () @@ -886,7 +886,7 @@ createUser (Public.NewUserPublic new) = do getSelf :: UserId -> Handler Public.SelfProfile getSelf self = lift (API.lookupSelfProfile self) - >>= ifNothing (errorDescriptionToWai userNotFound) + >>= ifNothing (errorDescriptionTypeToWai @UserNotFound) getUserUnqualifiedH :: UserId -> UserId -> Handler (Maybe Public.UserProfile) getUserUnqualifiedH self uid = do diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index 326a4f41e43..8cebe4a4f6b 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -96,7 +96,7 @@ import qualified Ssl.Util as SSL import UnliftIO.Async (pooledMapConcurrentlyN_) import qualified Web.Cookie as Cookie import qualified Wire.API.Conversation.Bot as Public -import qualified Wire.API.ErrorDescription as ErrDesc +import Wire.API.ErrorDescription import qualified Wire.API.Event.Conversation as Public (Event) import qualified Wire.API.Provider as Public import qualified Wire.API.Provider.Bot as Public (BotUserView) @@ -361,7 +361,7 @@ activateAccountKey key val = do c <- Code.verify key Code.IdentityVerification val >>= maybeInvalidCode (pid, email) <- case (Code.codeAccount c, Code.codeForEmail c) of (Just p, Just e) -> return (Id p, e) - _ -> throwStd invalidCode + _ -> throwErrorDescriptionType @InvalidCode (name, memail, _url, _descr) <- DB.lookupAccountData pid >>= maybeInvalidCode case memail of Just email' | email == email' -> return Nothing @@ -410,7 +410,7 @@ approveAccountKey key val = do (name, _, _, _) <- DB.lookupAccountData (Id pid) >>= maybeInvalidCode activate (Id pid) Nothing email lift $ sendApprovalConfirmMail name email - _ -> throwStd invalidCode + _ -> throwErrorDescriptionType @InvalidCode loginH :: JsonRequest Public.ProviderLogin -> Handler Response loginH req = do @@ -422,7 +422,7 @@ login l = do pid <- DB.lookupKey (mkEmailKey (providerLoginEmail l)) >>= maybeBadCredentials pass <- DB.lookupPassword pid >>= maybeBadCredentials unless (verifyPassword (providerLoginPassword l) pass) $ - throwStd badCredentials + throwErrorDescriptionType @BadCredentials ZAuth.newProviderToken pid beginPasswordResetH :: JsonRequest Public.PasswordReset -> Handler Response @@ -518,7 +518,7 @@ updateAccountPassword :: ProviderId -> Public.PasswordChange -> Handler () updateAccountPassword pid upd = do pass <- DB.lookupPassword pid >>= maybeBadCredentials unless (verifyPassword (cpOldPassword upd) pass) $ - throwStd badCredentials + throwErrorDescriptionType @BadCredentials when (verifyPassword (cpNewPassword upd) pass) $ throwStd newPasswordMustDiffer DB.updateAccountPassword pid (cpNewPassword upd) @@ -586,7 +586,7 @@ updateServiceConn :: ProviderId -> ServiceId -> Public.UpdateServiceConn -> Hand updateServiceConn pid sid upd = do pass <- DB.lookupPassword pid >>= maybeBadCredentials unless (verifyPassword (updateServiceConnPassword upd) pass) $ - throwStd badCredentials + throwErrorDescriptionType @BadCredentials scon <- DB.lookupServiceConn pid sid >>= maybeServiceNotFound svc <- DB.lookupServiceProfile pid sid >>= maybeServiceNotFound let newBaseUrl = updateServiceConnUrl upd @@ -635,7 +635,7 @@ deleteService :: ProviderId -> ServiceId -> Public.DeleteService -> Handler () deleteService pid sid del = do pass <- DB.lookupPassword pid >>= maybeBadCredentials unless (verifyPassword (deleteServicePassword del) pass) $ - throwStd badCredentials + throwErrorDescriptionType @BadCredentials _ <- DB.lookupService pid sid >>= maybeServiceNotFound -- Disable the service DB.updateServiceConn pid sid Nothing Nothing Nothing (Just False) @@ -666,7 +666,7 @@ deleteAccount pid del = do prov <- DB.lookupAccount pid >>= maybeInvalidProvider pass <- DB.lookupPassword pid >>= maybeBadCredentials unless (verifyPassword (deleteProviderPassword del) pass) $ - throwStd badCredentials + throwErrorDescriptionType @BadCredentials svcs <- DB.listServices pid forM_ svcs $ \svc -> do let sid = serviceId svc @@ -907,11 +907,11 @@ botGetSelfH bot = json <$> botGetSelf bot botGetSelf :: BotId -> Handler Public.UserProfile botGetSelf bot = do p <- lift $ User.lookupUser NoPendingInvitations (botUserId bot) - maybe (throwErrorDescription ErrDesc.userNotFound) (return . (`Public.publicProfile` UserLegalHoldNoConsent)) p + maybe (throwErrorDescriptionType @UserNotFound) (return . (`Public.publicProfile` UserLegalHoldNoConsent)) p botGetClientH :: BotId -> Handler Response botGetClientH bot = do - maybe (throwErrorDescription ErrDesc.clientNotFound) (pure . json) =<< lift (botGetClient bot) + maybe (throwErrorDescriptionType @ClientNotFound) (pure . json) =<< lift (botGetClient bot) botGetClient :: BotId -> AppIO (Maybe Public.Client) botGetClient bot = do @@ -936,7 +936,7 @@ botUpdatePrekeys :: BotId -> Public.UpdateBotPrekeys -> Handler () botUpdatePrekeys bot upd = do clt <- lift $ listToMaybe <$> User.lookupClients (botUserId bot) case clt of - Nothing -> throwErrorDescription ErrDesc.clientNotFound + Nothing -> throwErrorDescriptionType @ClientNotFound Just c -> do let pks = updateBotPrekeyList upd User.updatePrekeys (botUserId bot) (clientId c) pks !>> clientDataError @@ -949,7 +949,7 @@ botClaimUsersPrekeys :: Public.UserClients -> Handler Public.UserClientPrekeyMap botClaimUsersPrekeys body = do maxSize <- fromIntegral . setMaxConvSize <$> view settings when (Map.size (Public.userClients body) > maxSize) $ - throwErrorDescription ErrDesc.tooManyClients + throwErrorDescriptionType @TooManyClients Client.claimLocalMultiPrekeyBundles UnprotectedBot body !>> clientError botListUserProfilesH :: List UserId -> Handler Response @@ -1065,7 +1065,7 @@ maybeInvalidProvider :: Maybe a -> Handler a maybeInvalidProvider = maybe (throwStd invalidProvider) return maybeInvalidCode :: Maybe a -> Handler a -maybeInvalidCode = maybe (throwStd invalidCode) return +maybeInvalidCode = maybe (throwErrorDescriptionType @InvalidCode) return maybeServiceNotFound :: Maybe a -> Handler a maybeServiceNotFound = maybe (throwStd (notFound "Service not found")) return @@ -1077,7 +1077,7 @@ maybeConvNotFound :: Maybe a -> Handler a maybeConvNotFound = maybe (throwStd (notFound "Conversation not found")) return maybeBadCredentials :: Maybe a -> Handler a -maybeBadCredentials = maybe (throwStd badCredentials) return +maybeBadCredentials = maybe (throwErrorDescriptionType @BadCredentials) return maybeInvalidServiceKey :: Maybe a -> Handler a maybeInvalidServiceKey = maybe (throwStd invalidServiceKey) return @@ -1086,7 +1086,7 @@ maybeInvalidBot :: Maybe a -> Handler a maybeInvalidBot = maybe (throwStd invalidBot) return maybeInvalidUser :: Maybe a -> Handler a -maybeInvalidUser = maybe (throwStd (errorDescriptionToWai ErrDesc.invalidUser)) return +maybeInvalidUser = maybe (throwStd (errorDescriptionTypeToWai @InvalidUser)) return rangeChecked :: Within a n m => a -> Handler (Range n m a) rangeChecked = either (throwStd . invalidRange . fromString) return . checkedEither diff --git a/services/brig/src/Brig/User/API/Auth.hs b/services/brig/src/Brig/User/API/Auth.hs index 3424c371382..3c21ab9c121 100644 --- a/services/brig/src/Brig/User/API/Auth.hs +++ b/services/brig/src/Brig/User/API/Auth.hs @@ -54,6 +54,7 @@ import Network.Wai.Utilities.Response (empty, json) import qualified Network.Wai.Utilities.Response as WaiResp import Network.Wai.Utilities.Swagger (document) import qualified Network.Wai.Utilities.Swagger as Doc +import Wire.API.ErrorDescription import qualified Wire.API.User as Public import Wire.API.User.Auth as Public import Wire.Swagger as Doc (pendingLoginError) @@ -80,7 +81,7 @@ routesPublic = do Doc.parameter Doc.Query "access_token" Doc.bytes' $ do Doc.description "The access-token as query parameter." Doc.optional - Doc.errorResponse badCredentials + Doc.errorResponse (errorDescriptionTypeToWai @BadCredentials) post "/login/send" (continue sendLoginCodeH) $ jsonRequest @Public.SendLoginCode @@ -112,7 +113,7 @@ routesPublic = do Doc.parameter Doc.Query "persist" (Doc.bool $ Doc.def False) $ do Doc.description "Request a persistent cookie instead of a session cookie." Doc.optional - Doc.errorResponse badCredentials + Doc.errorResponse (errorDescriptionTypeToWai @BadCredentials) Doc.errorResponse accountSuspended Doc.errorResponse accountPending Doc.errorResponse loginsTooFrequent @@ -133,7 +134,7 @@ routesPublic = do Doc.parameter Doc.Query "access_token" Doc.bytes' $ do Doc.description "The access-token as query parameter." Doc.optional - Doc.errorResponse badCredentials + Doc.errorResponse (errorDescriptionTypeToWai @BadCredentials) put "/access/self/email" (continue changeSelfEmailH) $ accept "application" "json" @@ -159,7 +160,7 @@ routesPublic = do Doc.errorResponse blacklistedPhone Doc.errorResponse missingAccessToken Doc.errorResponse invalidAccessToken - Doc.errorResponse badCredentials + Doc.errorResponse (errorDescriptionTypeToWai @BadCredentials) get "/cookies" (continue listCookiesH) $ header "Z-User" @@ -178,7 +179,7 @@ routesPublic = do document "POST" "rmCookies" $ do Doc.summary "Revoke stored cookies." Doc.body (Doc.ref Public.modelRemoveCookies) Doc.end - Doc.errorResponse badCredentials + Doc.errorResponse (errorDescriptionTypeToWai @BadCredentials) routesInternal :: Routes a Handler () routesInternal = do diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index 72f02735dac..12242fdfec9 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -49,7 +49,7 @@ import Network.Wai import Network.Wai.Predicate hiding (setStatus) import Network.Wai.Utilities import qualified Wire.API.Conversation as Public -import Wire.API.ErrorDescription (missingLegalholdConsent) +import Wire.API.ErrorDescription (MissingLegalholdConsent) import Wire.API.Routes.Public.Galley (ConversationResponse) import Wire.API.Routes.Public.Util import Wire.API.Team.LegalHold (LegalholdProtectee (LegalholdPlusFederationNotImplemented)) @@ -88,7 +88,7 @@ ensureNoLegalholdConflicts remotes locals = do let FutureWork _remotes = FutureWork @'LegalholdPlusFederationNotImplemented remotes whenM (anyLegalholdActivated locals) $ unlessM (allLegalholdConsentGiven locals) $ - throwErrorDescription missingLegalholdConsent + throwErrorDescriptionType @MissingLegalholdConsent -- | A helper for creating a regular (non-team) group conversation. createRegularGroupConv :: UserId -> ConnId -> NewConvUnmanaged -> Galley ConversationResponse diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 9711ee9cc82..6758b734286 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -38,7 +38,7 @@ import GHC.TypeLits (AppendSymbol) import qualified Galley.API.Clients as Clients import qualified Galley.API.Create as Create import qualified Galley.API.CustomBackend as CustomBackend -import Galley.API.Error (throwErrorDescription) +import Galley.API.Error (throwErrorDescriptionType) import Galley.API.LegalHold (getTeamLegalholdWhitelistedH, setTeamLegalholdWhitelistedH, unsetTeamLegalholdWhitelistedH) import Galley.API.LegalHold.Conflicts (guardLegalholdPolicyConflicts) import qualified Galley.API.Query as Query @@ -72,7 +72,7 @@ import Servant.API.Generic import Servant.Server import Servant.Server.Generic (genericServerT) import System.Logger.Class hiding (Path, name) -import Wire.API.ErrorDescription (missingLegalholdConsent) +import Wire.API.ErrorDescription (MissingLegalholdConsent) import Wire.API.Routes.MultiVerb (MultiVerb, RespondEmpty) import Wire.API.Routes.Public (ZOptConn, ZUser) import qualified Wire.API.Team.Feature as Public @@ -497,5 +497,5 @@ guardLegalholdPolicyConflictsH :: (JsonRequest GuardLegalholdPolicyConflicts ::: guardLegalholdPolicyConflictsH (req ::: _) = do glh <- fromJsonBody req guardLegalholdPolicyConflicts (glhProtectee glh) (glhUserClients glh) - >>= either (const (throwErrorDescription missingLegalholdConsent)) pure + >>= either (const (throwErrorDescriptionType @MissingLegalholdConsent)) pure pure $ Network.Wai.Utilities.setStatus status200 empty diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index a191021c4c2..41c320a6b44 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -183,7 +183,7 @@ sitemap = do body (ref Public.modelNewNonBindingTeam) $ description "JSON body" response 201 "Team ID as `Location` header value" end - errorResponse (Error.errorDescriptionToWai Error.notConnected) + errorResponse (Error.errorDescriptionTypeToWai @Error.NotConnected) put "/teams/:tid" (continue Teams.updateTeamH) $ zauthUserId @@ -197,7 +197,7 @@ sitemap = do description "Team ID" body (ref Public.modelUpdateData) $ description "JSON body" - errorResponse (Error.errorDescriptionToWai Error.notATeamMember) + errorResponse (Error.errorDescriptionTypeToWai @Error.NotATeamMember) errorResponse (Error.errorDescriptionToWai (Error.operationDenied Public.SetTeamData)) get "/teams" (continue Teams.getManyTeamsH) $ @@ -245,7 +245,7 @@ sitemap = do optional description "JSON body, required only for binding teams." response 202 "Team is scheduled for removal" end - errorResponse (Error.errorDescriptionToWai Error.notATeamMember) + errorResponse (Error.errorDescriptionTypeToWai @Error.NotATeamMember) errorResponse (Error.errorDescriptionToWai (Error.operationDenied Public.DeleteTeam)) errorResponse Error.deleteQueueFull errorResponse Error.reAuthFailed @@ -267,7 +267,7 @@ sitemap = do description "Maximum Results to be returned" returns (ref Public.modelTeamMemberList) response 200 "Team members" end - errorResponse (Error.errorDescriptionToWai Error.notATeamMember) + errorResponse (Error.errorDescriptionTypeToWai @Error.NotATeamMember) get "/teams/:tid/members/csv" (continue Teams.getTeamMembersCSVH) $ -- we could discriminate based on accept header only, but having two paths makes building @@ -303,7 +303,7 @@ sitemap = do description "JSON body" returns (ref Public.modelTeamMemberList) response 200 "Team members" end - errorResponse (Error.errorDescriptionToWai Error.notATeamMember) + errorResponse (Error.errorDescriptionTypeToWai @Error.NotATeamMember) errorResponse Error.bulkGetMemberLimitExceeded get "/teams/:tid/members/:uid" (continue Teams.getTeamMemberH) $ @@ -319,7 +319,7 @@ sitemap = do description "User ID" returns (ref Public.modelTeamMember) response 200 "Team member" end - errorResponse (Error.errorDescriptionToWai Error.notATeamMember) + errorResponse (Error.errorDescriptionTypeToWai @Error.NotATeamMember) errorResponse Error.teamMemberNotFound get "/teams/notifications" (continue Teams.getTeamNotificationsH) $ @@ -374,9 +374,9 @@ sitemap = do description "Team ID" body (ref Public.modelNewTeamMember) $ description "JSON body" - errorResponse (Error.errorDescriptionToWai Error.notATeamMember) + errorResponse (Error.errorDescriptionTypeToWai @Error.NotATeamMember) errorResponse (Error.errorDescriptionToWai (Error.operationDenied Public.AddTeamMember)) - errorResponse (Error.errorDescriptionToWai Error.notConnected) + errorResponse (Error.errorDescriptionTypeToWai @Error.NotConnected) errorResponse Error.invalidPermissions errorResponse Error.tooManyTeamMembers @@ -397,7 +397,7 @@ sitemap = do optional description "JSON body, required only for binding teams." response 202 "Team member scheduled for deletion" end - errorResponse (Error.errorDescriptionToWai Error.notATeamMember) + errorResponse (Error.errorDescriptionTypeToWai @Error.NotATeamMember) errorResponse (Error.errorDescriptionToWai (Error.operationDenied Public.RemoveTeamMember)) errorResponse Error.reAuthFailed @@ -413,7 +413,7 @@ sitemap = do description "Team ID" body (ref Public.modelNewTeamMember) $ description "JSON body" - errorResponse (Error.errorDescriptionToWai Error.notATeamMember) + errorResponse (Error.errorDescriptionTypeToWai @Error.NotATeamMember) errorResponse Error.teamMemberNotFound errorResponse (Error.errorDescriptionToWai (Error.operationDenied Public.SetMemberPermissions)) @@ -567,7 +567,7 @@ sitemap = do description "Conversation ID" returns (ref Public.modelEvent) response 200 "Conversation joined." end - errorResponse (Error.errorDescriptionToWai Error.convNotFound) + errorResponse (Error.errorDescriptionTypeToWai @Error.ConvNotFound) post "/conversations/code-check" (continue Update.checkReusableCodeH) $ jsonRequest @Public.ConversationCode @@ -576,7 +576,7 @@ sitemap = do response 200 "Valid" end body (ref Public.modelConversationCode) $ description "JSON body" - errorResponse (Error.errorDescriptionToWai Error.codeNotFound) + errorResponse (Error.errorDescriptionTypeToWai @Error.CodeNotFound) -- This endpoint can lead to the following events being sent: -- - MemberJoin event to members @@ -590,8 +590,8 @@ sitemap = do response 200 "Conversation joined." end body (ref Public.modelConversationCode) $ description "JSON body" - errorResponse (Error.errorDescriptionToWai Error.codeNotFound) - errorResponse (Error.errorDescriptionToWai Error.convNotFound) + errorResponse (Error.errorDescriptionTypeToWai @Error.CodeNotFound) + errorResponse (Error.errorDescriptionTypeToWai @Error.ConvNotFound) errorResponse Error.tooManyMembers -- This endpoint can lead to the following events being sent: @@ -608,7 +608,7 @@ sitemap = do returns (ref Public.modelConversationCode) response 201 "Conversation code created." (model Public.modelEvent) response 200 "Conversation code already exists." (model Public.modelConversationCode) - errorResponse (Error.errorDescriptionToWai Error.convNotFound) + errorResponse (Error.errorDescriptionTypeToWai @Error.ConvNotFound) errorResponse Error.invalidAccessOp -- This endpoint can lead to the following events being sent: @@ -623,7 +623,7 @@ sitemap = do description "Conversation ID" returns (ref Public.modelEvent) response 200 "Conversation code deleted." end - errorResponse (Error.errorDescriptionToWai Error.convNotFound) + errorResponse (Error.errorDescriptionTypeToWai @Error.ConvNotFound) errorResponse Error.invalidAccessOp get "/conversations/:cnv/code" (continue Update.getCodeH) $ @@ -635,7 +635,7 @@ sitemap = do description "Conversation ID" returns (ref Public.modelConversationCode) response 200 "Conversation Code" end - errorResponse (Error.errorDescriptionToWai Error.convNotFound) + errorResponse (Error.errorDescriptionTypeToWai @Error.ConvNotFound) errorResponse Error.invalidAccessOp -- This endpoint can lead to the following events being sent: @@ -655,8 +655,8 @@ sitemap = do response 204 "Conversation access unchanged." end body (ref Public.modelConversationAccessUpdate) $ description "JSON body" - errorResponse (Error.errorDescriptionToWai Error.convNotFound) - errorResponse (Error.errorDescriptionToWai Error.convAccessDenied) + errorResponse (Error.errorDescriptionTypeToWai @Error.ConvNotFound) + errorResponse (Error.errorDescriptionTypeToWai @Error.ConvAccessDenied) errorResponse Error.invalidTargetAccess errorResponse Error.invalidSelfOp errorResponse Error.invalidOne2OneOp @@ -679,8 +679,8 @@ sitemap = do response 204 "Conversation receipt mode unchanged." end body (ref Public.modelConversationReceiptModeUpdate) $ description "JSON body" - errorResponse (Error.errorDescriptionToWai Error.convNotFound) - errorResponse (Error.errorDescriptionToWai Error.convAccessDenied) + errorResponse (Error.errorDescriptionTypeToWai @Error.ConvNotFound) + errorResponse (Error.errorDescriptionTypeToWai @Error.ConvAccessDenied) -- This endpoint can lead to the following events being sent: -- - MemberJoin event to members @@ -699,10 +699,10 @@ sitemap = do response 200 "Members added" end response 204 "No change" end response 412 "The user(s) cannot be added to the conversation (eg., due to legalhold policy conflict)." end - errorResponse (Error.errorDescriptionToWai Error.convNotFound) + errorResponse (Error.errorDescriptionTypeToWai @Error.ConvNotFound) errorResponse (Error.invalidOp "Conversation type does not allow adding members") - errorResponse (Error.errorDescriptionToWai Error.notConnected) - errorResponse (Error.errorDescriptionToWai Error.convAccessDenied) + errorResponse (Error.errorDescriptionTypeToWai @Error.NotConnected) + errorResponse (Error.errorDescriptionTypeToWai @Error.ConvAccessDenied) -- This endpoint can lead to the following events being sent: -- - Typing event to members @@ -717,7 +717,7 @@ sitemap = do description "Conversation ID" body (ref Public.modelTyping) $ description "JSON body" - errorResponse (Error.errorDescriptionToWai Error.convNotFound) + errorResponse (Error.errorDescriptionTypeToWai @Error.ConvNotFound) -- This endpoint can lead to the following events being sent: -- - OtrMessageAdd event to recipients @@ -754,7 +754,7 @@ sitemap = do response 412 "Missing clients" end errorResponse Error.teamNotFound errorResponse Error.nonBindingTeam - errorResponse (Error.errorDescriptionToWai Error.unknownClient) + errorResponse (Error.errorDescriptionTypeToWai @Error.UnknownClient) errorResponse Error.broadcastLimitExceeded -- This endpoint can lead to the following events being sent: @@ -789,7 +789,7 @@ sitemap = do response 412 "Missing clients" end errorResponse Error.teamNotFound errorResponse Error.nonBindingTeam - errorResponse (Error.errorDescriptionToWai Error.unknownClient) + errorResponse (Error.errorDescriptionTypeToWai @Error.UnknownClient) errorResponse Error.broadcastLimitExceeded apiDocs :: Routes ApiBuilder Galley () diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index be37e81e6d2..efe77c9ea0d 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -68,7 +68,7 @@ import UnliftIO (pooledForConcurrentlyN) import Wire.API.Conversation (ConversationCoverView (..)) import qualified Wire.API.Conversation as Public import qualified Wire.API.Conversation.Role as Public -import Wire.API.ErrorDescription (convNotFound) +import Wire.API.ErrorDescription (ConvNotFound) import Wire.API.Federation.API.Galley (gcresConvs) import qualified Wire.API.Federation.API.Galley as FederatedGalley import Wire.API.Federation.Client (FederationError, executeFederated) @@ -81,7 +81,7 @@ getBotConversationH (zbot ::: zcnv ::: _) = do getBotConversation :: BotId -> ConvId -> Galley Public.BotConvView getBotConversation zbot zcnv = do - c <- getConversationAndCheckMembershipWithError (errorDescriptionToWai convNotFound) (botUserId zbot) zcnv + c <- getConversationAndCheckMembershipWithError (errorDescriptionTypeToWai @ConvNotFound) (botUserId zbot) zcnv domain <- viewFederationDomain let cmems = mapMaybe (mkMember domain) (toList (Data.convLocalMembers c)) pure $ Public.botConvView zcnv (Data.convName c) cmems @@ -109,7 +109,7 @@ getConversation zusr cnv = do getRemoteConversation remoteConvId = do conversations <- getRemoteConversations zusr [remoteConvId] case conversations of - [] -> throwErrorDescription convNotFound + [] -> throwErrorDescriptionType @ConvNotFound [conv] -> pure conv _convs -> throwM (federationUnexpectedBody "expected one conversation, got multiple") @@ -125,7 +125,7 @@ data FailedGetConversationReason | FailedGetConversationRemotely FederationError fgcrError :: FailedGetConversationReason -> Wai.Error -fgcrError FailedGetConversationLocally = errorDescriptionToWai convNotFound +fgcrError FailedGetConversationLocally = errorDescriptionTypeToWai @ConvNotFound fgcrError (FailedGetConversationRemotely e) = federationErrorToWai e data FailedGetConversation diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 49e6ee477be..c756c38ea41 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -115,7 +115,7 @@ import qualified SAML2.WebSSO as SAML import qualified System.Logger.Class as Log import UnliftIO (mapConcurrently) import qualified Wire.API.Conversation.Role as Public -import Wire.API.ErrorDescription (convNotFound, notATeamMember, operationDenied) +import Wire.API.ErrorDescription (ConvNotFound, NotATeamMember, operationDenied) import qualified Wire.API.Notification as Public import qualified Wire.API.Team as Public import qualified Wire.API.Team.Conversation as Public @@ -369,7 +369,7 @@ getTeamConversationRoles :: UserId -> TeamId -> Galley Public.ConversationRolesL getTeamConversationRoles zusr tid = do mem <- Data.teamMember tid zusr case mem of - Nothing -> throwErrorDescription notATeamMember + Nothing -> throwErrorDescriptionType @NotATeamMember Just _ -> do -- NOTE: If/when custom roles are added, these roles should -- be merged with the team roles (if they exist) @@ -383,7 +383,7 @@ getTeamMembersH (zusr ::: tid ::: maxResults ::: _) = do getTeamMembers :: UserId -> TeamId -> Range 1 Public.HardTruncationLimit Int32 -> Galley (Public.TeamMemberList, Public.TeamMember -> Bool) getTeamMembers zusr tid maxResults = do Data.teamMember tid zusr >>= \case - Nothing -> throwErrorDescription notATeamMember + Nothing -> throwErrorDescriptionType @NotATeamMember Just m -> do mems <- Data.teamMembersWithLimit tid maxResults let withPerms = (m `canSeePermsOf`) @@ -504,7 +504,7 @@ bulkGetTeamMembers zusr tid maxResults uids = do unless (length uids <= fromIntegral (fromRange maxResults)) $ throwM bulkGetMemberLimitExceeded Data.teamMember tid zusr >>= \case - Nothing -> throwErrorDescription notATeamMember + Nothing -> throwErrorDescriptionType @NotATeamMember Just m -> do mems <- Data.teamMembersLimited tid uids let withPerms = (m `canSeePermsOf`) @@ -520,7 +520,7 @@ getTeamMember :: UserId -> TeamId -> UserId -> Galley (Public.TeamMember, Public getTeamMember zusr tid uid = do zusrMembership <- Data.teamMember tid zusr case zusrMembership of - Nothing -> throwErrorDescription notATeamMember + Nothing -> throwErrorDescriptionType @NotATeamMember Just m -> do let withPerms = (m `canSeePermsOf`) Data.teamMember tid uid >>= \case @@ -750,17 +750,17 @@ uncheckedDeleteTeamMember zusr zcon tid remove mems = do getTeamConversations :: UserId -> TeamId -> Galley Public.TeamConversationList getTeamConversations zusr tid = do - tm <- Data.teamMember tid zusr >>= ifNothing (errorDescriptionToWai notATeamMember) + tm <- Data.teamMember tid zusr >>= ifNothing (errorDescriptionTypeToWai @NotATeamMember) unless (tm `hasPermission` GetTeamConversations) $ throwErrorDescription (operationDenied GetTeamConversations) Public.newTeamConversationList <$> Data.teamConversations tid getTeamConversation :: UserId -> TeamId -> ConvId -> Galley Public.TeamConversation getTeamConversation zusr tid cid = do - tm <- Data.teamMember tid zusr >>= ifNothing (errorDescriptionToWai notATeamMember) + tm <- Data.teamMember tid zusr >>= ifNothing (errorDescriptionTypeToWai @NotATeamMember) unless (tm `hasPermission` GetTeamConversations) $ throwErrorDescription (operationDenied GetTeamConversations) - Data.teamConversation tid cid >>= maybe (throwErrorDescription convNotFound) pure + Data.teamConversation tid cid >>= maybe (throwErrorDescriptionType @ConvNotFound) pure deleteTeamConversation :: UserId -> ConnId -> TeamId -> ConvId -> Galley () deleteTeamConversation zusr zcon tid cid = do diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index bc4e389fc27..66907a42e0f 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -118,12 +118,12 @@ 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 - ( ConvMemberNotFound, + ( CodeNotFound, + ConvMemberNotFound, ConvNotFound, - codeNotFound, - convNotFound, - missingLegalholdConsent, - unknownClient, + MissingLegalholdConsent, + UnknownClient, + mkErrorDescription, ) import qualified Wire.API.ErrorDescription as Public import qualified Wire.API.Event.Conversation as Public @@ -142,7 +142,7 @@ acceptConvH (usr ::: conn ::: cnv) = acceptConv :: UserId -> Maybe ConnId -> ConvId -> Galley Conversation acceptConv usr conn cnv = do - conv <- Data.conversation cnv >>= ifNothing (errorDescriptionToWai convNotFound) + conv <- Data.conversation cnv >>= ifNothing (errorDescriptionTypeToWai @ConvNotFound) conv' <- acceptOne2One usr conv conn conversationView usr conv' @@ -152,7 +152,7 @@ blockConvH (zusr ::: cnv) = blockConv :: UserId -> ConvId -> Galley () blockConv zusr cnv = do - conv <- Data.conversation cnv >>= ifNothing (errorDescriptionToWai convNotFound) + conv <- Data.conversation cnv >>= ifNothing (errorDescriptionTypeToWai @ConvNotFound) unless (Data.convType conv `elem` [ConnectConv, One2OneConv]) $ throwM $ invalidOp "block: invalid conversation type" @@ -165,7 +165,7 @@ unblockConvH (usr ::: conn ::: cnv) = unblockConv :: UserId -> Maybe ConnId -> ConvId -> Galley Conversation unblockConv usr conn cnv = do - conv <- Data.conversation cnv >>= ifNothing (errorDescriptionToWai convNotFound) + conv <- Data.conversation cnv >>= ifNothing (errorDescriptionTypeToWai @ConvNotFound) unless (Data.convType conv `elem` [ConnectConv, One2OneConv]) $ throwM $ invalidOp "unblock: invalid conversation type" @@ -196,7 +196,7 @@ updateConversationAccess usr zcon cnv update = do -- The user who initiated access change has to be a conversation member (bots, users) <- localBotsAndUsers <$> Data.members cnv ensureConvMember users usr - conv <- Data.conversation cnv >>= ifNothing (errorDescriptionToWai convNotFound) + conv <- Data.conversation cnv >>= ifNothing (errorDescriptionTypeToWai @ConvNotFound) -- The conversation has to be a group conversation ensureGroupConvThrowing conv self <- getSelfMemberFromLocalsLegacy usr users @@ -340,7 +340,7 @@ updateLocalConversationMessageTimer usr zcon cnv timerUpdate@(Public.Conversatio (bots, users) <- localBotsAndUsers <$> Data.members cnv ensureActionAllowedThrowing ModifyConversationMessageTimer =<< getSelfMemberFromLocalsLegacy usr users - conv <- Data.conversation cnv >>= ifNothing (errorDescriptionToWai convNotFound) + conv <- Data.conversation cnv >>= ifNothing (errorDescriptionTypeToWai @ConvNotFound) ensureGroupConvThrowing conv let currentTimer = Data.convMessageTimer conv if currentTimer == target @@ -370,7 +370,7 @@ addCode usr zcon cnv = do localDomain <- viewFederationDomain let qcnv = Qualified cnv localDomain qusr = Qualified usr localDomain - conv <- Data.conversation cnv >>= ifNothing (errorDescriptionToWai convNotFound) + conv <- Data.conversation cnv >>= ifNothing (errorDescriptionTypeToWai @ConvNotFound) ensureConvMember (Data.convLocalMembers conv) usr ensureAccess conv CodeAccess let (bots, users) = localBotsAndUsers $ Data.convLocalMembers conv @@ -403,7 +403,7 @@ rmCode usr zcon cnv = do localDomain <- viewFederationDomain let qcnv = Qualified cnv localDomain qusr = Qualified usr localDomain - conv <- Data.conversation cnv >>= ifNothing (errorDescriptionToWai convNotFound) + conv <- Data.conversation cnv >>= ifNothing (errorDescriptionTypeToWai @ConvNotFound) ensureConvMember (Data.convLocalMembers conv) usr ensureAccess conv CodeAccess let (bots, users) = localBotsAndUsers $ Data.convLocalMembers conv @@ -420,13 +420,13 @@ getCodeH (usr ::: cnv) = getCode :: UserId -> ConvId -> Galley Public.ConversationCode getCode usr cnv = do - conv <- Data.conversation cnv >>= ifNothing (errorDescriptionToWai convNotFound) + conv <- Data.conversation cnv >>= ifNothing (errorDescriptionTypeToWai @ConvNotFound) ensureAccess conv CodeAccess ensureConvMember (Data.convLocalMembers conv) usr key <- mkKey cnv c <- Data.lookupCode key ReusableCode - >>= ifNothing (errorDescriptionToWai codeNotFound) + >>= ifNothing (errorDescriptionTypeToWai @CodeNotFound) returnCode c returnCode :: Code -> Galley Public.ConversationCode @@ -484,7 +484,7 @@ addMembersH (zusr ::: zcon ::: cid ::: req) = do addMembers :: UserId -> ConnId -> ConvId -> Public.InviteQualified -> Galley (UpdateResult Event) addMembers zusr zcon convId invite = do - conv <- Data.conversation convId >>= ifNothing (errorDescriptionToWai convNotFound) + conv <- Data.conversation convId >>= ifNothing (errorDescriptionTypeToWai @ConvNotFound) let mems = localBotsAndUsers (Data.convLocalMembers conv) let rMems = Data.convRemoteMembers conv self <- getSelfMemberFromLocalsLegacy zusr (snd mems) @@ -529,11 +529,11 @@ addMembers zusr zcon convId invite = do whenM (anyLegalholdActivated (lmId <$> convUsers)) $ unless allNewUsersGaveConsent $ - throwErrorDescription missingLegalholdConsent + throwErrorDescriptionType @MissingLegalholdConsent whenM (anyLegalholdActivated newUsers) $ do unless allNewUsersGaveConsent $ - throwErrorDescription missingLegalholdConsent + throwErrorDescriptionType @MissingLegalholdConsent convUsersLHStatus <- do uidsStatus <- getLHStatusForUsers (lmId <$> convUsers) @@ -552,7 +552,7 @@ addMembers zusr zcon convId invite = do let qvictim = Qualified (lmId mem) localDomain in void $ removeMember (lmId mem `Qualified` localDomain) Nothing (Data.convId conv `Qualified` localDomain) qvictim - else throwErrorDescription missingLegalholdConsent + else throwErrorDescriptionType @MissingLegalholdConsent checkLHPolicyConflictsRemote :: FutureWork 'LegalholdPlusFederationNotImplemented [Remote UserId] -> Galley () checkLHPolicyConflictsRemote _remotes = pure () @@ -761,8 +761,8 @@ handleOtrResult :: OtrResult -> Galley Response handleOtrResult = \case OtrSent m -> pure $ json m & setStatus status201 OtrMissingRecipients m -> pure $ json m & setStatus status412 - OtrUnknownClient _ -> throwErrorDescription unknownClient - OtrConversationNotFound _ -> throwErrorDescription convNotFound + OtrUnknownClient _ -> throwErrorDescriptionType @UnknownClient + OtrConversationNotFound _ -> throwErrorDescriptionType @ConvNotFound postBotMessageH :: BotId ::: ConvId ::: Public.OtrFilterMissing ::: JsonRequest Public.NewOtrMessage ::: JSON -> Galley Response postBotMessageH (zbot ::: zcnv ::: val ::: req ::: _) = do @@ -1004,7 +1004,7 @@ isTyping zusr zcon cnv typingData = do qusr = Qualified zusr localDomain mm <- Data.members cnv unless (zusr `isMember` mm) $ - throwErrorDescription convNotFound + throwErrorDescriptionType @ConvNotFound now <- liftIO getCurrentTime let e = Event Typing qcnv qusr now (EdTyping typingData) for_ (newPushLocal ListComplete zusr (ConvEvent e) (recipient <$> mm)) $ \p -> @@ -1033,7 +1033,7 @@ addBot :: UserId -> ConnId -> AddBot -> Galley Event addBot zusr zcon b = do localDomain <- viewFederationDomain let qusr = Qualified zusr localDomain - c <- Data.conversation (b ^. addBotConv) >>= ifNothing (errorDescriptionToWai convNotFound) + c <- Data.conversation (b ^. addBotConv) >>= ifNothing (errorDescriptionTypeToWai @ConvNotFound) -- Check some preconditions on adding bots to a conversation for_ (Data.convTeam c) $ teamConvChecks (b ^. addBotConv) (bots, users) <- regularConvChecks c @@ -1048,7 +1048,7 @@ addBot zusr zcon b = do regularConvChecks c = do let (bots, users) = localBotsAndUsers (Data.convLocalMembers c) unless (zusr `isMember` users) $ - throwErrorDescription convNotFound + throwErrorDescriptionType @ConvNotFound ensureGroupConvThrowing c ensureActionAllowedThrowing AddConversationMember =<< getSelfMemberFromLocalsLegacy zusr users unless (any ((== b ^. addBotId) . botMemId) bots) $ @@ -1066,12 +1066,12 @@ rmBotH (zusr ::: zcon ::: req) = do rmBot :: UserId -> Maybe ConnId -> RemoveBot -> Galley (UpdateResult Event) rmBot zusr zcon b = do - c <- Data.conversation (b ^. rmBotConv) >>= ifNothing (errorDescriptionToWai convNotFound) + c <- Data.conversation (b ^. rmBotConv) >>= ifNothing (errorDescriptionTypeToWai @ConvNotFound) localDomain <- viewFederationDomain let qcnv = Qualified (Data.convId c) localDomain qusr = Qualified zusr localDomain unless (zusr `isMember` Data.convLocalMembers c) $ - throwErrorDescription convNotFound + throwErrorDescriptionType @ConvNotFound let (bots, users) = localBotsAndUsers (Data.convLocalMembers c) if not (any ((== b ^. rmBotId) . botMemId) bots) then pure Unchanged @@ -1161,7 +1161,7 @@ notIsMember' cc u = not $ isRemoteMember u (Data.convRemoteMembers cc) ensureConvMember :: [LocalMember] -> UserId -> Galley () ensureConvMember users usr = unless (usr `isMember` users) $ - throwErrorDescription convNotFound + throwErrorDescriptionType @ConvNotFound -- | Update a member of a conversation and propagate events. -- @@ -1272,7 +1272,7 @@ withValidOtrRecipients utype usr clt cnv rcps val now go = do if not alive then do Data.deleteConversation cnv - pure $ OtrConversationNotFound convNotFound + pure $ OtrConversationNotFound mkErrorDescription else do localMembers <- Data.members cnv let localMemberIds = lmId <$> localMembers @@ -1307,10 +1307,10 @@ handleOtrResponse utype usr clt rcps membs clts val now go = case checkOtrRecipi ValidOtrRecipients m r -> go r >> pure (OtrSent m) MissingOtrRecipients m -> do guardLegalholdPolicyConflicts (userToProtectee utype usr) (missingClients m) - >>= either (const (throwErrorDescription missingLegalholdConsent)) pure + >>= either (const (throwErrorDescriptionType @MissingLegalholdConsent)) pure pure (OtrMissingRecipients m) - InvalidOtrSenderUser -> pure $ OtrConversationNotFound convNotFound - InvalidOtrSenderClient -> pure $ OtrUnknownClient unknownClient + InvalidOtrSenderUser -> pure $ OtrConversationNotFound mkErrorDescription + InvalidOtrSenderClient -> pure $ OtrUnknownClient mkErrorDescription -- | Check OTR sender and recipients for validity and completeness -- against a given list of valid members and clients, optionally diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 31355c00734..999291076bd 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -73,14 +73,14 @@ type JSON = Media "application" "json" ensureAccessRole :: AccessRole -> [(UserId, Maybe TeamMember)] -> Galley () ensureAccessRole role users = case role of - PrivateAccessRole -> throwErrorDescription convAccessDenied + PrivateAccessRole -> throwErrorDescriptionType @ConvAccessDenied TeamAccessRole -> when (any (isNothing . snd) users) $ - throwErrorDescription notATeamMember + throwErrorDescriptionType @NotATeamMember ActivatedAccessRole -> do activated <- lookupActivatedUsers $ map fst users when (length activated /= length users) $ - throwErrorDescription convAccessDenied + throwErrorDescriptionType @ConvAccessDenied NonActivatedAccessRole -> return () -- | Check that the given user is either part of the same team(s) as the other @@ -117,7 +117,7 @@ ensureConnectedToLocals u uids = do getConnections [u] (Just uids) (Just Accepted) `concurrently` getConnections uids (Just [u]) (Just Accepted) unless (length connsFrom == length uids && length connsTo == length uids) $ - throwErrorDescription notConnected + throwErrorDescriptionType @NotConnected ensureReAuthorised :: UserId -> Maybe PlainTextPassword -> Galley () ensureReAuthorised u secret = do @@ -175,7 +175,7 @@ permissionCheck p = \case if m `hasPermission` p then pure m else throwErrorDescription (operationDenied p) - Nothing -> throwErrorDescription notATeamMember + Nothing -> throwErrorDescriptionType @NotATeamMember assertTeamExists :: TeamId -> Galley () assertTeamExists tid = do @@ -187,7 +187,7 @@ assertTeamExists tid = do assertOnTeam :: UserId -> TeamId -> Galley () assertOnTeam uid tid = do Data.teamMember tid uid >>= \case - Nothing -> throwErrorDescription notATeamMember + Nothing -> throwErrorDescriptionType @NotATeamMember Just _ -> return () -- | If the conversation is in a team, throw iff zusr is a team member and does not have named @@ -198,7 +198,7 @@ permissionCheckTeamConv zusr cnv perm = Just cnv' -> case Data.convTeam cnv' of Just tid -> void $ permissionCheck perm =<< Data.teamMember tid zusr Nothing -> pure () - Nothing -> throwErrorDescription convNotFound + Nothing -> throwErrorDescriptionType @ConvNotFound -- | Try to accept a 1-1 conversation, promoting connect conversations as appropriate. acceptOne2One :: UserId -> Data.Conversation -> Maybe ConnId -> Galley Data.Conversation @@ -214,7 +214,7 @@ acceptOne2One usr conv conn = do return $ conv {Data.convLocalMembers = mems <> toList mm} ConnectConv -> case mems of [_, _] | usr `isMember` mems -> promote - [_, _] -> throwErrorDescription convNotFound + [_, _] -> throwErrorDescriptionType @ConvNotFound _ -> do when (length mems > 2) $ throwM badConvState @@ -283,7 +283,7 @@ getSelfMemberFromLocals :: UserId -> t LocalMember -> ExceptT ConvNotFound m LocalMember -getSelfMemberFromLocals = getLocalMember convNotFound +getSelfMemberFromLocals = getLocalMember (mkErrorDescription :: ConvNotFound) -- | A legacy version of 'getSelfMemberFromLocals' that runs in the Galley monad. getSelfMemberFromLocalsLegacy :: @@ -322,7 +322,7 @@ getSelfMemberFromRemotes :: Remote UserId -> t RemoteMember -> ExceptT ConvNotFound m RemoteMember -getSelfMemberFromRemotes = getRemoteMember convNotFound +getSelfMemberFromRemotes = getRemoteMember (mkErrorDescription :: ConvNotFound) getSelfMemberFromRemotesLegacy :: Foldable t => Remote UserId -> t RemoteMember -> Galley RemoteMember getSelfMemberFromRemotesLegacy usr rmems = @@ -363,14 +363,14 @@ getMember p ex u = hoistEither . note ex . find ((u ==) . p) getConversationAndCheckMembership :: UserId -> ConvId -> Galley Data.Conversation getConversationAndCheckMembership = getConversationAndCheckMembershipWithError - (errorDescriptionToWai convAccessDenied) + (errorDescriptionTypeToWai @ConvAccessDenied) getConversationAndCheckMembershipWithError :: Error -> UserId -> ConvId -> Galley Data.Conversation getConversationAndCheckMembershipWithError ex zusr convId = do - c <- Data.conversation convId >>= ifNothing (errorDescriptionToWai convNotFound) + c <- Data.conversation convId >>= ifNothing (errorDescriptionTypeToWai @ConvNotFound) when (DataTypes.isConvDeleted c) $ do Data.deleteConversation convId - throwErrorDescription convNotFound + throwErrorDescriptionType @ConvNotFound unless (zusr `isMember` Data.convLocalMembers c) $ throwM ex return c @@ -404,14 +404,14 @@ verifyReusableCode :: ConversationCode -> Galley DataTypes.Code verifyReusableCode convCode = do c <- Data.lookupCode (conversationKey convCode) DataTypes.ReusableCode - >>= ifNothing (errorDescriptionToWai codeNotFound) + >>= ifNothing (errorDescriptionTypeToWai @CodeNotFound) unless (DataTypes.codeValue c == conversationCode convCode) $ - throwM (errorDescriptionToWai codeNotFound) + throwM (errorDescriptionTypeToWai @CodeNotFound) return c ensureConversationAccess :: UserId -> ConvId -> Access -> Galley Data.Conversation ensureConversationAccess zusr cnv access = do - conv <- Data.conversation cnv >>= ifNothing (errorDescriptionToWai convNotFound) + conv <- Data.conversation cnv >>= ifNothing (errorDescriptionTypeToWai @ConvNotFound) ensureAccess conv access zusrMembership <- maybe (pure Nothing) (`Data.teamMember` zusr) (Data.convTeam conv) ensureAccessRole (Data.convAccessRole conv) [(zusr, zusrMembership)] @@ -420,7 +420,7 @@ ensureConversationAccess zusr cnv access = do ensureAccess :: Data.Conversation -> Access -> Galley () ensureAccess conv access = unless (access `elem` Data.convAccess conv) $ - throwErrorDescription convAccessDenied + throwErrorDescriptionType @ConvAccessDenied -------------------------------------------------------------------------------- -- Federation From b4da76d52ee50535298dc44cc141069ae7d20e60 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 21 Sep 2021 13:25:29 +0200 Subject: [PATCH 40/72] Remove flaky search order test (#1798) --- changelog.d/5-internal/remove-flaky-test | 1 + services/brig/test/integration/API/Search.hs | 11 ++++++----- 2 files changed, 7 insertions(+), 5 deletions(-) create mode 100644 changelog.d/5-internal/remove-flaky-test diff --git a/changelog.d/5-internal/remove-flaky-test b/changelog.d/5-internal/remove-flaky-test new file mode 100644 index 00000000000..ac7e06b671f --- /dev/null +++ b/changelog.d/5-internal/remove-flaky-test @@ -0,0 +1 @@ +Remove one flaky integration test about ordering of search results diff --git a/services/brig/test/integration/API/Search.hs b/services/brig/test/integration/API/Search.hs index 084edb76bc7..b6e73b4bb1b 100644 --- a/services/brig/test/integration/API/Search.hs +++ b/services/brig/test/integration/API/Search.hs @@ -72,7 +72,6 @@ tests opts mgr galley brig = do test mgr "reindex" $ testReindex brig, testWithBothIndices opts mgr "no match" $ testSearchNoMatch brig, testWithBothIndices opts mgr "no extra results" $ testSearchNoExtraResults brig, - testWithBothIndices opts mgr "order-name (prefix match)" $ testOrderName brig, testWithBothIndices opts mgr "order-handle (prefix match)" $ testOrderHandle brig, testWithBothIndices opts mgr "by-first/middle/last name" $ testSearchByLastOrMiddleName brig, testWithBothIndices opts mgr "Non ascii names" $ testSearchNonAsciiNames brig, @@ -256,8 +255,11 @@ testReindex brig = do delayed = liftIO $ threadDelay 10000 mkRegularUser = randomUserWithHandle brig -testOrderName :: TestConstraints m => Brig -> m () -testOrderName brig = do +-- This test is currently disabled, because it fails sporadically, probably due +-- to imprecisions in ES exact match scoring. +-- FUTUREWORK: Find the reason for the failures and fix ES behaviour. +_testOrderName :: TestConstraints m => Brig -> m () +_testOrderName brig = do searcher <- userId <$> randomUser brig Name searchedWord <- randomNameWithMaxLen 122 nameMatch <- userQualifiedId <$> createUser' True searchedWord brig @@ -285,10 +287,9 @@ testOrderHandle brig = do results <- searchResults <$> executeSearch brig searcher searchedWord let resultUIds = map contactQualifiedId results let expectedOrder = [handleMatch, handlePrefixMatch] - let dbg = "results: " <> show results <> "\nsearchedWord: " <> cs searchedWord liftIO $ assertEqual - ("Expected order: handle match, handle prefix match.\n\nSince this test fails sporadically for unknown reasons here here is some debug info:\n" <> dbg) + "Expected order: handle match, handle prefix match." expectedOrder resultUIds From 520386b216d5dd470e52852b3107b219f97204fe Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 21 Sep 2021 13:47:16 +0200 Subject: [PATCH 41/72] Servantify receipt mode update (#1797) * Servantify updateConversationReceiptMode * Add stub for qualified receipt mode endpoint --- .../deprecate-receipt-mode-update | 1 + .../qualified-receipt-mode-update | 1 + .../5-internal/servantify-receipt-mode | 1 + .../src/Wire/API/Routes/Public/Galley.hs | 35 +++++++++++++++++++ services/galley/src/Galley/API/Public.hs | 23 ++---------- services/galley/src/Galley/API/Update.hs | 27 ++++++++++---- 6 files changed, 61 insertions(+), 27 deletions(-) create mode 100644 changelog.d/1-api-changes/deprecate-receipt-mode-update create mode 100644 changelog.d/1-api-changes/qualified-receipt-mode-update create mode 100644 changelog.d/5-internal/servantify-receipt-mode diff --git a/changelog.d/1-api-changes/deprecate-receipt-mode-update b/changelog.d/1-api-changes/deprecate-receipt-mode-update new file mode 100644 index 00000000000..76510907a57 --- /dev/null +++ b/changelog.d/1-api-changes/deprecate-receipt-mode-update @@ -0,0 +1 @@ +Deprecate `PUT /conversations/:cnv/receipt-mode` endpoint diff --git a/changelog.d/1-api-changes/qualified-receipt-mode-update b/changelog.d/1-api-changes/qualified-receipt-mode-update new file mode 100644 index 00000000000..9cd14f7fd9c --- /dev/null +++ b/changelog.d/1-api-changes/qualified-receipt-mode-update @@ -0,0 +1 @@ +Add qualified endpoint for updating receipt mode diff --git a/changelog.d/5-internal/servantify-receipt-mode b/changelog.d/5-internal/servantify-receipt-mode new file mode 100644 index 00000000000..03433eb286f --- /dev/null +++ b/changelog.d/5-internal/servantify-receipt-mode @@ -0,0 +1 @@ +Convert the `PUT /conversations/:cnv/receipt-mode` endpoint to Servant 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 cc5bf5ef378..6a513292754 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -404,6 +404,41 @@ data Api routes = Api '[JSON] (UpdateResponses "Message timer unchanged" "Message timer updated" Event) (UpdateResult Event), + -- This endpoint can lead to the following events being sent: + -- - ConvReceiptModeUpdate event to members + updateConversationReceiptModeUnqualified :: + routes + :- Summary "Update receipt mode for a conversation (deprecated)" + :> Description "Use `PUT /conversations/:domain/:cnv/receipt-mode` instead." + :> ZUser + :> ZConn + :> CanThrow ConvAccessDenied + :> CanThrow ConvNotFound + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> "receipt-mode" + :> ReqBody '[JSON] ConversationReceiptModeUpdate + :> MultiVerb + 'PUT + '[JSON] + (UpdateResponses "Receipt mode unchanged" "Receipt mode updated" Event) + (UpdateResult Event), + updateConversationReceiptMode :: + routes + :- Summary "Update receipt mode for a conversation" + :> ZUser + :> ZConn + :> CanThrow ConvAccessDenied + :> CanThrow ConvNotFound + :> "conversations" + :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId + :> "receipt-mode" + :> ReqBody '[JSON] ConversationReceiptModeUpdate + :> MultiVerb + 'PUT + '[JSON] + (UpdateResponses "Receipt mode unchanged" "Receipt mode updated" Event) + (UpdateResult Event), getConversationSelfUnqualified :: routes :- Summary "Get self membership properties (deprecated)" diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index 41c320a6b44..9ea4b37e644 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -100,6 +100,9 @@ servantSitemap = GalleyAPI.updateConversationMessageTimerUnqualified = Update.updateLocalConversationMessageTimer, GalleyAPI.updateConversationMessageTimer = Update.updateConversationMessageTimer, + GalleyAPI.updateConversationReceiptModeUnqualified = + Update.updateConversationReceiptModeUnqualified, + GalleyAPI.updateConversationReceiptMode = Update.updateConversationReceiptMode, GalleyAPI.getConversationSelfUnqualified = Query.getLocalSelf, GalleyAPI.updateConversationSelfUnqualified = Update.updateUnqualifiedSelfMember, GalleyAPI.updateConversationSelf = Update.updateSelfMember, @@ -662,26 +665,6 @@ sitemap = do errorResponse Error.invalidOne2OneOp errorResponse Error.invalidConnectOp - -- This endpoint can lead to the following events being sent: - -- - ConvReceiptModeUpdate event to members - put "/conversations/:cnv/receipt-mode" (continue Update.updateConversationReceiptModeH) $ - zauthUserId - .&. zauthConnId - .&. capture "cnv" - .&. jsonRequest @Public.ConversationReceiptModeUpdate - .&. accept "application" "json" - document "PUT" "updateConversationReceiptMode" $ do - summary "Update receipts mode for a conversation" - parameter Path "cnv" bytes' $ - description "Conversation ID" - returns (ref Public.modelEvent) - response 200 "Conversation receipt mode updated." end - response 204 "Conversation receipt mode unchanged." end - body (ref Public.modelConversationReceiptModeUpdate) $ - description "JSON body" - errorResponse (Error.errorDescriptionTypeToWai @Error.ConvNotFound) - errorResponse (Error.errorDescriptionTypeToWai @Error.ConvAccessDenied) - -- This endpoint can lead to the following events being sent: -- - MemberJoin event to members post "/conversations/:cnv/members" (continue Update.addMembersH) $ diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 66907a42e0f..e8bb722764b 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -29,7 +29,8 @@ module Galley.API.Update updateUnqualifiedConversationName, updateConversationName, updateConversationAccessH, - updateConversationReceiptModeH, + updateConversationReceiptModeUnqualified, + updateConversationReceiptMode, updateLocalConversationMessageTimer, updateConversationMessageTimer, @@ -299,13 +300,25 @@ uncheckedUpdateConversationAccess body usr zcon conv (currentAccess, targetAcces botsL :: Lens' ([LocalMember], [BotMember]) [BotMember] botsL = _2 -updateConversationReceiptModeH :: UserId ::: ConnId ::: ConvId ::: JsonRequest Public.ConversationReceiptModeUpdate ::: JSON -> Galley Response -updateConversationReceiptModeH (usr ::: zcon ::: cnv ::: req ::: _) = do - update <- fromJsonBody req - handleUpdateResult <$> updateConversationReceiptMode usr zcon cnv update +updateConversationReceiptMode :: + UserId -> + ConnId -> + Qualified ConvId -> + Public.ConversationReceiptModeUpdate -> + Galley (UpdateResult Event) +updateConversationReceiptMode usr zcon qcnv update = do + localDomain <- viewFederationDomain + if qDomain qcnv == localDomain + then updateConversationReceiptModeUnqualified usr zcon (qUnqualified qcnv) update + else throwM federationNotImplemented -updateConversationReceiptMode :: UserId -> ConnId -> ConvId -> Public.ConversationReceiptModeUpdate -> Galley (UpdateResult Event) -updateConversationReceiptMode usr zcon cnv receiptModeUpdate@(Public.ConversationReceiptModeUpdate target) = do +updateConversationReceiptModeUnqualified :: + UserId -> + ConnId -> + ConvId -> + Public.ConversationReceiptModeUpdate -> + Galley (UpdateResult Event) +updateConversationReceiptModeUnqualified usr zcon cnv receiptModeUpdate@(Public.ConversationReceiptModeUpdate target) = do localDomain <- viewFederationDomain let qcnv = Qualified cnv localDomain qusr = Qualified usr localDomain From ae5af5cb5a751bf51779e3fe0c8cc5c942fbc4cb Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 21 Sep 2021 15:42:14 +0200 Subject: [PATCH 42/72] Move servantification entry to internal section (#1796) --- .../{6-federation => 5-internal}/servantify-other-member-update | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename changelog.d/{6-federation => 5-internal}/servantify-other-member-update (100%) diff --git a/changelog.d/6-federation/servantify-other-member-update b/changelog.d/5-internal/servantify-other-member-update similarity index 100% rename from changelog.d/6-federation/servantify-other-member-update rename to changelog.d/5-internal/servantify-other-member-update From 828f39b151345feacdd4948b170d3241ef9ec7a8 Mon Sep 17 00:00:00 2001 From: fisx Date: Tue, 21 Sep 2021 17:21:46 +0200 Subject: [PATCH 43/72] Polysemy: pure (in-mem, state-based) interpreter for IdP effect (#1793) --- changelog.d/5-internal/idp-effect | 2 +- services/spar/spar.cabal | 3 +- services/spar/src/Spar/Sem/IdP/Mem.hs | 124 ++++++++++++++++++++++++++ 3 files changed, 127 insertions(+), 2 deletions(-) create mode 100644 services/spar/src/Spar/Sem/IdP/Mem.hs diff --git a/changelog.d/5-internal/idp-effect b/changelog.d/5-internal/idp-effect index 0a75abbd1b6..0c0f28c3123 100644 --- a/changelog.d/5-internal/idp-effect +++ b/changelog.d/5-internal/idp-effect @@ -1 +1 @@ -Spar: Extract IdP effect into Polysemy (#1787) +Spar: Extract IdP effect into Polysemy (#1787, #1793) diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index a53360f1e4f..4272dcb5931 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 5b06ec7a50a1803f0f0aefbe72aad10c986a9becf2aa984b53f253d6a8caf237 +-- hash: 920daea26e271c6f0d5688476b71beb67c388d49d00e6f57723aaf825eb3df0d name: spar version: 0.1 @@ -36,6 +36,7 @@ library Spar.Scim.User Spar.Sem.IdP Spar.Sem.IdP.Cassandra + Spar.Sem.IdP.Mem Spar.Sem.SAMLUser Spar.Sem.SAMLUser.Cassandra other-modules: diff --git a/services/spar/src/Spar/Sem/IdP/Mem.hs b/services/spar/src/Spar/Sem/IdP/Mem.hs new file mode 100644 index 00000000000..154bdda142d --- /dev/null +++ b/services/spar/src/Spar/Sem/IdP/Mem.hs @@ -0,0 +1,124 @@ +{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-} + +module Spar.Sem.IdP.Mem (idPToMem) where + +import Control.Exception (assert) +import Control.Lens ((%~), (.~), (^.), _1, _2) +import Data.Id (TeamId) +import qualified Data.Map as M +import Imports +import Polysemy +import Polysemy.State +import qualified SAML2.WebSSO.Types as SAML +import qualified Spar.Sem.IdP as Eff +import qualified Wire.API.User.IdentityProvider as IP + +type IS = (TypedState, RawState) + +type TypedState = Map SAML.IdPId IP.IdP + +type RawState = Map SAML.IdPId Text + +idPToMem :: + forall r a. + Sem (Eff.IdP ': r) a -> + Sem r a +idPToMem = evState . evEff + where + evState :: Sem (State IS : r) a -> Sem r a + evState = evalState mempty + + evEff :: Sem (Eff.IdP ': r) a -> Sem (State IS ': r) a + evEff = reinterpret @_ @(State IS) $ \case + Eff.StoreConfig iw -> + modify' (_1 %~ storeConfig iw) + Eff.GetConfig i -> + gets (getConfig i . (^. _1)) + Eff.GetIdByIssuerWithoutTeam iss -> + gets (getIdByIssuerWithoutTeam iss . (^. _1)) + Eff.GetIdByIssuerWithTeam iss team -> + gets (getIdByIssuerWithTeam iss team . (^. _1)) + Eff.GetConfigsByTeam team -> + gets (getConfigsByTeam team . (^. _1)) + Eff.DeleteConfig i iss team -> + modify' (_1 %~ deleteConfig i iss team) + Eff.SetReplacedBy (Eff.Replaced replaced) (Eff.Replacing replacing) -> + modify' (_1 %~ ((updateReplacedBy (Just replacing) replaced) <$>)) + Eff.ClearReplacedBy (Eff.Replaced replaced) -> + modify' (_1 %~ ((updateReplacedBy Nothing replaced) <$>)) + Eff.StoreRawMetadata i txt -> + modify (_2 %~ storeRawMetadata i txt) + Eff.GetRawMetadata i -> + gets (getRawMetadata i . (^. _2)) + Eff.DeleteRawMetadata i -> + modify (_2 %~ deleteRawMetadata i) + +storeConfig :: IP.IdP -> TypedState -> TypedState +storeConfig iw = + M.filter + ( \iw' -> + or + [ iw' ^. SAML.idpMetadata . SAML.edIssuer /= iw ^. SAML.idpMetadata . SAML.edIssuer, + iw' ^. SAML.idpExtraInfo . IP.wiTeam /= iw ^. SAML.idpExtraInfo . IP.wiTeam + ] + ) + . M.insert (iw ^. SAML.idpId) iw + +getConfig :: SAML.IdPId -> TypedState -> Maybe IP.IdP +getConfig = M.lookup + +getIdByIssuerWithoutTeam :: SAML.Issuer -> TypedState -> Eff.GetIdPResult SAML.IdPId +getIdByIssuerWithoutTeam iss mp = + case filter (\idp -> idp ^. SAML.idpMetadata . SAML.edIssuer == iss) $ M.elems mp of + [] -> Eff.GetIdPNotFound + [a] -> Eff.GetIdPFound (a ^. SAML.idpId) + as@(_ : _ : _) -> Eff.GetIdPNonUnique ((^. SAML.idpId) <$> as) + +getIdByIssuerWithTeam :: SAML.Issuer -> TeamId -> TypedState -> Maybe SAML.IdPId +getIdByIssuerWithTeam iss team mp = + case filter fl $ M.elems mp of + [] -> Nothing + [a] -> Just (a ^. SAML.idpId) + (_ : _ : _) -> + -- (Eff.StoreConfig doesn't let this happen) + error "Eff.GetIdByIssuerWithTeam: impossible" + where + fl :: IP.IdP -> Bool + fl idp = + idp ^. SAML.idpMetadata . SAML.edIssuer == iss + && idp ^. SAML.idpExtraInfo . IP.wiTeam == team + +getConfigsByTeam :: TeamId -> TypedState -> [IP.IdP] +getConfigsByTeam team = + filter fl . M.elems + where + fl :: IP.IdP -> Bool + fl idp = idp ^. SAML.idpExtraInfo . IP.wiTeam == team + +deleteConfig :: SAML.IdPId -> SAML.Issuer -> TeamId -> TypedState -> TypedState +deleteConfig i iss team = + M.filter fl + where + fl :: IP.IdP -> Bool + fl idp = + assert -- calling this function with inconsistent values will crash hard. + ( idp ^. SAML.idpMetadata . SAML.edIssuer == iss + && idp ^. SAML.idpExtraInfo . IP.wiTeam == team + ) + (idp ^. SAML.idpId /= i) + +updateReplacedBy :: Maybe SAML.IdPId -> SAML.IdPId -> IP.IdP -> IP.IdP +updateReplacedBy mbReplacing replaced idp = + idp + & if idp ^. SAML.idpId == replaced + then SAML.idpExtraInfo . IP.wiReplacedBy .~ mbReplacing + else id + +storeRawMetadata :: SAML.IdPId -> Text -> RawState -> RawState +storeRawMetadata = M.insert + +getRawMetadata :: SAML.IdPId -> RawState -> Maybe Text +getRawMetadata = M.lookup + +deleteRawMetadata :: SAML.IdPId -> RawState -> RawState +deleteRawMetadata idpid = M.filterWithKey (\idpid' _ -> idpid' /= idpid) From db5c85f8bf73a1efc1f90684c14f72f26c7060fe Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 21 Sep 2021 19:39:56 +0200 Subject: [PATCH 44/72] Abstract out multi-table-pagination (#1788) --- .../5-internal/abstract-multi-table-paging | 1 + libs/wire-api/src/Wire/API/Conversation.hs | 103 +++--------- .../src/Wire/API/Routes/MultiTablePaging.hs | 153 ++++++++++++++++++ .../Golden/Manual/ConversationPagingState.hs | 1 + .../Manual/GetPaginatedConversationIds.hs | 1 + libs/wire-api/wire-api.cabal | 3 +- services/galley/src/Galley/API/Query.hs | 31 ++-- services/galley/test/integration/API.hs | 13 +- services/galley/test/integration/API/Util.hs | 5 +- 9 files changed, 203 insertions(+), 108 deletions(-) create mode 100644 changelog.d/5-internal/abstract-multi-table-paging create mode 100644 libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs diff --git a/changelog.d/5-internal/abstract-multi-table-paging b/changelog.d/5-internal/abstract-multi-table-paging new file mode 100644 index 00000000000..74925882af6 --- /dev/null +++ b/changelog.d/5-internal/abstract-multi-table-paging @@ -0,0 +1 @@ +Abstract out multi-table-pagination used in list conversation-ids endpoint \ No newline at end of file diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index f42e01b2940..b783643c9a7 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -1,5 +1,4 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StrictData #-} -- This file is part of the Wire Server implementation. @@ -39,10 +38,12 @@ module Wire.API.Conversation ConversationList (..), ListConversations (..), ListConversationsV2 (..), - GetPaginatedConversationIds (..), - ConversationPagingState (..), - ConversationPagingTable (..), - ConvIdsPage (..), + GetPaginatedConversationIds, + pattern GetPaginatedConversationIds, + ConvIdsPage, + pattern ConvIdsPage, + ConversationPagingState, + pattern ConversationPagingState, ConversationsResponse (..), -- * Conversation properties @@ -93,16 +94,13 @@ import Control.Lens (at, (?~)) import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as A import qualified Data.Aeson.Types as A -import qualified Data.Attoparsec.ByteString as AB -import qualified Data.ByteString as BS import Data.Id -import Data.Json.Util (fromBase64Text, toBase64Text) import Data.List.NonEmpty (NonEmpty) import Data.List1 import Data.Misc import Data.Proxy (Proxy (Proxy)) import Data.Qualified (Qualified (qUnqualified), deprecatedSchema) -import Data.Range (Range, fromRange, rangedSchema, toRange) +import Data.Range (Range, fromRange, rangedSchema) import Data.Schema import qualified Data.Set as Set import Data.Singletons (sing) @@ -114,6 +112,7 @@ import qualified Test.QuickCheck as QC import Wire.API.Arbitrary (Arbitrary (arbitrary), GenericUniform (..)) import Wire.API.Conversation.Member import Wire.API.Conversation.Role (RoleName, roleNameWireAdmin) +import Wire.API.Routes.MultiTablePaging import Wire.API.Util.Aeson (CustomEncoded (..)) -------------------------------------------------------------------------------- @@ -343,84 +342,24 @@ instance FromJSON a => FromJSON (ConversationList a) where <$> o A..: "conversations" <*> o A..: "has_more" -data ConvIdsPage = ConvIdsPage - { pageConvIds :: [Qualified ConvId], - pageHasMore :: Bool, - pagePagingState :: ConversationPagingState - } - deriving (Show, Eq, Generic) - deriving (FromJSON, ToJSON, S.ToSchema) via Schema ConvIdsPage +type ConversationPagingName = "ConversationIds" -instance ToSchema ConvIdsPage where - schema = - object "ConvIdsPage" $ - ConvIdsPage - <$> pageConvIds .= field "qualified_conversations" (array schema) - <*> pageHasMore .= field "has_more" schema - <*> pagePagingState .= field "paging_state" schema - -data ConversationPagingState = ConversationPagingState - { cpsTable :: ConversationPagingTable, - cpsPagingState :: Maybe ByteString - } - deriving (Show, Eq) - deriving (FromJSON, ToJSON, S.ToSchema) via Schema ConversationPagingState +type ConvIdPagingKey = "qualified_conversations" -instance ToSchema ConversationPagingState where - schema = - (toBase64Text . encodeConversationPagingState) - .= parsedText "ConversationPagingState" (parseConvesationPagingState <=< fromBase64Text) +type ConversationPagingState = MultiTablePagingState ConversationPagingName LocalOrRemoteTable -parseConvesationPagingState :: ByteString -> Either String ConversationPagingState -parseConvesationPagingState = AB.parseOnly conversationPagingStateParser +pattern ConversationPagingState :: tables -> Maybe ByteString -> MultiTablePagingState name tables +pattern ConversationPagingState table state = MultiTablePagingState table state -conversationPagingStateParser :: AB.Parser ConversationPagingState -conversationPagingStateParser = do - cpsTable <- tableParser - cpsPagingState <- (AB.endOfInput $> Nothing) <|> (Just <$> AB.takeByteString <* AB.endOfInput) - pure ConversationPagingState {..} - where - tableParser :: AB.Parser ConversationPagingTable - tableParser = - (AB.word8 0 $> PagingLocals) - <|> (AB.word8 1 $> PagingRemotes) - -encodeConversationPagingState :: ConversationPagingState -> ByteString -encodeConversationPagingState ConversationPagingState {..} = - let table = encodeConversationPagingTable cpsTable - state = fromMaybe "" cpsPagingState - in BS.cons table state - -encodeConversationPagingTable :: ConversationPagingTable -> Word8 -encodeConversationPagingTable = \case - PagingLocals -> 0 - PagingRemotes -> 1 - -data ConversationPagingTable - = PagingLocals - | PagingRemotes - deriving (Show, Eq) - -data GetPaginatedConversationIds = GetPaginatedConversationIds - { gpciPagingState :: Maybe ConversationPagingState, - gpciSize :: Range 1 1000 Int32 - } - deriving stock (Eq, Show, Generic) - deriving (FromJSON, ToJSON, S.ToSchema) via Schema GetPaginatedConversationIds +type ConvIdsPage = MultiTablePage ConversationPagingName ConvIdPagingKey LocalOrRemoteTable (Qualified ConvId) -instance ToSchema GetPaginatedConversationIds where - schema = - let addPagingStateDoc = - description - ?~ "optional, when not specified first page of the conversation ids will be returned.\ - \Every returned page contains a paging_state, this should be supplied to retrieve the next page." - addSizeDoc = description ?~ "optional, must be <= 1000, defaults to 1000." - in objectWithDocModifier - "GetPaginatedConversationIds" - (description ?~ "A request to list some or all of a user's conversation ids, including remote ones") - $ GetPaginatedConversationIds - <$> gpciPagingState .= optFieldWithDocModifier "paging_state" Nothing addPagingStateDoc schema - <*> gpciSize .= (fieldWithDocModifier "size" addSizeDoc schema <|> pure (toRange (Proxy @1000))) +pattern ConvIdsPage :: [a] -> Bool -> MultiTablePagingState name tables -> MultiTablePage name resultsKey tables a +pattern ConvIdsPage ids hasMore state = MultiTablePage ids hasMore state + +type GetPaginatedConversationIds = GetMultiTablePageRequest ConversationPagingName LocalOrRemoteTable 1000 1000 + +pattern GetPaginatedConversationIds :: Maybe (MultiTablePagingState name tables) -> Range 1 max Int32 -> GetMultiTablePageRequest name tables max def +pattern GetPaginatedConversationIds state size = GetMultiTablePageRequest size state data ListConversations = ListConversations { lQualifiedIds :: Maybe (NonEmpty (Qualified ConvId)), diff --git a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs new file mode 100644 index 00000000000..5b330790a7f --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs @@ -0,0 +1,153 @@ +module Wire.API.Routes.MultiTablePaging where + +import Control.Lens ((?~)) +import Data.Aeson (FromJSON (..), ToJSON (..)) +import qualified Data.Attoparsec.ByteString as AB +import qualified Data.ByteString as BS +import Data.Json.Util (fromBase64Text, toBase64Text) +import Data.Kind +import Data.Proxy +import Data.Range +import Data.Schema +import qualified Data.Swagger as S +import qualified Data.Text as Text +import GHC.TypeLits +import Imports + +data GetMultiTablePageRequest (name :: Symbol) (tables :: Type) (max :: Nat) (def :: Nat) = GetMultiTablePageRequest + { gmtprSize :: Range 1 max Int32, + gmtprState :: Maybe (MultiTablePagingState name tables) + } + deriving stock (Show, Eq) + +-- We can't use deriving via due to this error: +-- .../wire-server/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs:24:12: error: +-- • Couldn't match type ‘Data.Singletons.Prelude.Ord.Case_6989586621679792881 +-- 1 max (CmpNat 1 max)’ +-- with ‘'True’ +-- arising from the 'deriving' clause of a data type declaration +-- • When deriving the instance for (ToJSON +-- (GetMultiTablePageRequest name tables max def)) +-- | +-- 24 | deriving ToJSON via Schema (GetMultiTablePageRequest name tables max def) +-- | ^^^^^^ + +type RequestSchemaConstraint name tables max def = (KnownNat max, KnownNat def, Within Int32 1 max, LTE 1 def, LTE def max, PagingTable tables, KnownSymbol name) + +deriving via + Schema (GetMultiTablePageRequest name tables max def) + instance + RequestSchemaConstraint name tables max def => ToJSON (GetMultiTablePageRequest name tables max def) + +deriving via + Schema (GetMultiTablePageRequest name tables max def) + instance + RequestSchemaConstraint name tables max def => FromJSON (GetMultiTablePageRequest name tables max def) + +deriving via + Schema (GetMultiTablePageRequest name tables max def) + instance + RequestSchemaConstraint name tables max def => S.ToSchema (GetMultiTablePageRequest name tables max def) + +instance RequestSchemaConstraint name tables max def => ToSchema (GetMultiTablePageRequest name tables max def) where + schema = + let addPagingStateDoc = + description + ?~ "optional, when not specified, the first page will be returned.\ + \Every returned page contains a paging_state, this should be supplied to retrieve the next page." + addSizeDoc = description ?~ ("optional, must be <= " <> textFromNat @max <> ", defaults to " <> textFromNat @def <> ".") + in objectWithDocModifier + ("GetPaginated_" <> textFromSymbol @name) + (description ?~ "A request to list some or all of a user's conversation ids, including remote ones") + $ GetMultiTablePageRequest + <$> gmtprSize .= (fieldWithDocModifier "size" addSizeDoc schema <|> pure (toRange (Proxy @def))) + <*> gmtprState .= optFieldWithDocModifier "paging_state" Nothing addPagingStateDoc schema + +textFromNat :: forall n. KnownNat n => Text +textFromNat = Text.pack . show . natVal $ Proxy @n + +textFromSymbol :: forall s. KnownSymbol s => Text +textFromSymbol = Text.pack . symbolVal $ Proxy @s + +data MultiTablePagingState (name :: Symbol) tables = MultiTablePagingState + { mtpsTable :: tables, + mtpsState :: Maybe ByteString + } + deriving stock (Show, Eq) + deriving (ToJSON, FromJSON, S.ToSchema) via Schema (MultiTablePagingState name tables) + +class PagingTable t where + -- Using 'Word8' because 256 tables ought to be enough. + encodePagingTable :: t -> Word8 + decodePagingTable :: MonadFail m => Word8 -> m t + +instance (PagingTable tables, KnownSymbol name) => ToSchema (MultiTablePagingState name tables) where + schema = + (toBase64Text . encodePagingState) + .= parsedText (textFromSymbol @name <> "_PagingState") (parseConvesationPagingState <=< fromBase64Text) + +encodePagingState :: PagingTable tables => MultiTablePagingState name tables -> ByteString +encodePagingState (MultiTablePagingState table state) = + let encodedTable = encodePagingTable table + encodedState = fromMaybe "" state + in BS.cons encodedTable encodedState + +parseConvesationPagingState :: PagingTable tables => ByteString -> Either String (MultiTablePagingState name tables) +parseConvesationPagingState = AB.parseOnly conversationPagingStateParser + +conversationPagingStateParser :: PagingTable tables => AB.Parser (MultiTablePagingState name tables) +conversationPagingStateParser = do + table <- AB.anyWord8 >>= decodePagingTable + state <- (AB.endOfInput $> Nothing) <|> (Just <$> AB.takeByteString <* AB.endOfInput) + pure $ MultiTablePagingState table state + +data MultiTablePage (name :: Symbol) (resultsKey :: Symbol) (tables :: Type) a = MultiTablePage + { mtpResults :: [a], + mtpHasMore :: Bool, + mtpPagingState :: MultiTablePagingState name tables + } + deriving stock (Eq, Show) + +type PageSchemaConstraints name resultsKey tables a = (KnownSymbol resultsKey, KnownSymbol name, ToSchema a, PagingTable tables) + +deriving via + (Schema (MultiTablePage name resultsKey tables a)) + instance + PageSchemaConstraints name resultsKey tables a => + ToJSON (MultiTablePage name resultsKey tables a) + +deriving via + (Schema (MultiTablePage name resultsKey tables a)) + instance + PageSchemaConstraints name resultsKey tables a => + FromJSON (MultiTablePage name resultsKey tables a) + +deriving via + (Schema (MultiTablePage name resultsKey tables a)) + instance + PageSchemaConstraints name resultsKey tables a => + S.ToSchema (MultiTablePage name resultsKey tables a) + +instance + (KnownSymbol resultsKey, KnownSymbol name, ToSchema a, PagingTable tables) => + ToSchema (MultiTablePage name resultsKey tables a) + where + schema = + object (textFromSymbol @name <> "_Page") $ + MultiTablePage + <$> mtpResults .= field (textFromSymbol @resultsKey) (array schema) + <*> mtpHasMore .= field "has_more" schema + <*> mtpPagingState .= field "paging_state" schema + +data LocalOrRemoteTable + = PagingLocals + | PagingRemotes + deriving stock (Show, Eq) + +instance PagingTable LocalOrRemoteTable where + encodePagingTable PagingLocals = 0 + encodePagingTable PagingRemotes = 1 + + decodePagingTable 0 = pure PagingLocals + decodePagingTable 1 = pure PagingRemotes + decodePagingTable x = fail $ "Expected 0 or 1 while parsing LocalOrRemoteTable, got: " <> show x diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationPagingState.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationPagingState.hs index bcf75ee423d..4e8c857e6c6 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationPagingState.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationPagingState.hs @@ -3,6 +3,7 @@ module Test.Wire.API.Golden.Manual.ConversationPagingState where import qualified Data.ByteString as BS import Imports import Wire.API.Conversation +import Wire.API.Routes.MultiTablePaging testObject_ConversationPagingState_1 :: ConversationPagingState testObject_ConversationPagingState_1 = ConversationPagingState PagingLocals Nothing diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/GetPaginatedConversationIds.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/GetPaginatedConversationIds.hs index 5848a8b0fb2..18459c57b3b 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/GetPaginatedConversationIds.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/GetPaginatedConversationIds.hs @@ -4,6 +4,7 @@ import Data.Proxy import Data.Range import Imports import Wire.API.Conversation +import Wire.API.Routes.MultiTablePaging testObject_GetPaginatedConversationIds_1 :: GetPaginatedConversationIds testObject_GetPaginatedConversationIds_1 = GetPaginatedConversationIds Nothing (toRange (Proxy @50)) diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 9077503f453..c16411e3fdc 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: b225ee25604ad590c2886cca427ff3612767c72e49039963f1fbafbb94a807bd +-- hash: 1b29447efcb495e0d025de9fc8e5c6c887ef9ef16d3b075cecd9deb42ad32fc6 name: wire-api version: 0.1.0 @@ -48,6 +48,7 @@ library Wire.API.Provider.Service.Tag Wire.API.Push.Token Wire.API.Push.V2.Token + Wire.API.Routes.MultiTablePaging Wire.API.Routes.MultiVerb Wire.API.Routes.Public Wire.API.Routes.Public.Brig diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index efe77c9ea0d..3e66d98f8ac 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -74,6 +74,7 @@ import qualified Wire.API.Federation.API.Galley as FederatedGalley import Wire.API.Federation.Client (FederationError, executeFederated) import Wire.API.Federation.Error import qualified Wire.API.Provider.Bot as Public +import qualified Wire.API.Routes.MultiTablePaging as Public getBotConversationH :: BotId ::: ConvId ::: JSON -> Galley Response getBotConversationH (zbot ::: zcnv ::: _) = do @@ -224,11 +225,11 @@ conversationIdsPageFromUnqualified zusr start msize = do -- - After local conversations, remote conversations are listed ordered -- - lexicographically by their domain and then by their id. conversationIdsPageFrom :: UserId -> Public.GetPaginatedConversationIds -> Galley Public.ConvIdsPage -conversationIdsPageFrom zusr Public.GetPaginatedConversationIds {..} = do +conversationIdsPageFrom zusr Public.GetMultiTablePageRequest {..} = do localDomain <- viewFederationDomain - case gpciPagingState of - Just (Public.ConversationPagingState Public.PagingRemotes stateBS) -> remotesOnly (mkState <$> stateBS) (fromRange gpciSize) - _ -> localsAndRemotes localDomain (fmap mkState . Public.cpsPagingState =<< gpciPagingState) gpciSize + case gmtprState of + Just (Public.ConversationPagingState Public.PagingRemotes stateBS) -> remotesOnly (mkState <$> stateBS) (fromRange gmtprSize) + _ -> localsAndRemotes localDomain (fmap mkState . Public.mtpsState =<< gmtprState) gmtprSize where mkState :: ByteString -> C.PagingState mkState = C.PagingState . LBS.fromStrict @@ -236,27 +237,23 @@ conversationIdsPageFrom zusr Public.GetPaginatedConversationIds {..} = do localsAndRemotes :: Domain -> Maybe C.PagingState -> Range 1 1000 Int32 -> Galley Public.ConvIdsPage localsAndRemotes localDomain pagingState size = do localPage <- pageToConvIdPage Public.PagingLocals . fmap (`Qualified` localDomain) <$> Data.localConversationIdsPageFrom zusr pagingState size - let remainingSize = fromRange size - fromIntegral (length (Public.pageConvIds localPage)) - if Public.pageHasMore localPage || remainingSize <= 0 - then pure localPage {Public.pageHasMore = True} -- We haven't check the remotes yet, so has_more must always be True here. + let remainingSize = fromRange size - fromIntegral (length (Public.mtpResults localPage)) + if Public.mtpHasMore localPage || remainingSize <= 0 + then pure localPage {Public.mtpHasMore = True} -- We haven't check the remotes yet, so has_more must always be True here. else do remotePage <- remotesOnly Nothing remainingSize - pure $ remotePage {Public.pageConvIds = Public.pageConvIds localPage <> Public.pageConvIds remotePage} + pure $ remotePage {Public.mtpResults = Public.mtpResults localPage <> Public.mtpResults remotePage} remotesOnly :: Maybe C.PagingState -> Int32 -> Galley Public.ConvIdsPage remotesOnly pagingState size = pageToConvIdPage Public.PagingRemotes <$> Data.remoteConversationIdsPageFrom zusr pagingState size - pageToConvIdPage :: Public.ConversationPagingTable -> Data.PageWithState (Qualified ConvId) -> Public.ConvIdsPage + pageToConvIdPage :: Public.LocalOrRemoteTable -> Data.PageWithState (Qualified ConvId) -> Public.ConvIdsPage pageToConvIdPage table page@Data.PageWithState {..} = - Public.ConvIdsPage - { pageConvIds = pwsResults, - pageHasMore = C.pwsHasMore page, - pagePagingState = - Public.ConversationPagingState - { cpsTable = table, - cpsPagingState = LBS.toStrict . C.unPagingState <$> pwsState - } + Public.MultiTablePage + { mtpResults = pwsResults, + mtpHasMore = C.pwsHasMore page, + mtpPagingState = Public.ConversationPagingState table (LBS.toStrict . C.unPagingState <$> pwsState) } getConversations :: UserId -> Maybe (Range 1 32 (CommaSeparatedList ConvId)) -> Maybe ConvId -> Maybe (Range 1 500 Int32) -> Galley (Public.ConversationList Public.Conversation) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index e40ecf331be..5fdef6f021c 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -89,6 +89,7 @@ import Wire.API.Federation.API.Galley import qualified Wire.API.Federation.API.Galley as FederatedGalley import qualified Wire.API.Federation.GRPC.Types as F import qualified Wire.API.Message as Message +import Wire.API.Routes.MultiTablePaging import Wire.API.User.Client ( QualifiedUserClients (..), UserClientPrekeyMap, @@ -1409,17 +1410,17 @@ getChunkedConvs :: HasCallStack => Int32 -> Int -> UserId -> Maybe ConversationP getChunkedConvs size lastSize alice pagingState n = do let paginationOpts = GetPaginatedConversationIds pagingState (unsafeRange size) resp <- listConvIds alice paginationOpts 0 - then assertEqual ("Number of convs should match the requested size, " <> show n <> " more chunks to go") (fromIntegral size) (length (pageConvIds c)) - else assertEqual "Number of convs should match the last size, no more chunks to go" lastSize (length (pageConvIds c)) + then assertEqual ("Number of convs should match the requested size, " <> show n <> " more chunks to go") (fromIntegral size) (length (mtpResults c)) + else assertEqual "Number of convs should match the last size, no more chunks to go" lastSize (length (mtpResults c)) if n > 0 - then assertEqual ("hasMore should be True, " <> show n <> " more chunk(s) to go") True (pageHasMore c) - else assertEqual "hasMore should be False, no more chunks to go" False (pageHasMore c) + then assertEqual ("hasMore should be True, " <> show n <> " more chunk(s) to go") True (mtpHasMore c) + else assertEqual "hasMore should be False, no more chunks to go" False (mtpHasMore c) - return . Just $ pagePagingState c + return . Just $ mtpPagingState c getConvsPagingOk :: TestM () getConvsPagingOk = do diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index f49bb5e9e85..d7de9f45f5f 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -117,6 +117,7 @@ import qualified Wire.API.Federation.GRPC.Types as F import qualified Wire.API.Federation.Mock as Mock import Wire.API.Message import qualified Wire.API.Message.Proto as Proto +import Wire.API.Routes.MultiTablePaging import Wire.API.User.Client (ClientCapability (..), UserClientsFull (UserClientsFull)) import qualified Wire.API.User.Client as Client @@ -860,7 +861,7 @@ listConvIds u paginationOpts = do 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 @@ -1463,7 +1464,7 @@ decodeConvIdList :: Response (Maybe Lazy.ByteString) -> [ConvId] decodeConvIdList = convList . responseJsonUnsafeWithMsg "conversation-ids" decodeQualifiedConvIdList :: Response (Maybe Lazy.ByteString) -> Either String [Qualified ConvId] -decodeQualifiedConvIdList = fmap pageConvIds . responseJsonEither +decodeQualifiedConvIdList = fmap mtpResults . responseJsonEither @ConvIdsPage zUser :: UserId -> Request -> Request zUser = header "Z-User" . toByteString' From 22d5ed56db0a5956c043e5fb2e5d949f70d624c4 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 22 Sep 2021 12:42:11 +0200 Subject: [PATCH 45/72] Federation: support message timer updates (#1783) * Notify remote members of message timer updates This also refactors the local message timer update handle to avoid some duplication and reuse some of the code for conversation renames. * Test federation behaviour of message timer updates --- .../6-federation/fed-conv-message-timer | 1 + libs/wire-api/src/Wire/API/Conversation.hs | 1 + .../src/Wire/API/Event/Conversation.hs | 2 + services/galley/src/Galley/API/Federation.hs | 1 + services/galley/src/Galley/API/Public.hs | 2 +- services/galley/src/Galley/API/Query.hs | 2 +- services/galley/src/Galley/API/Update.hs | 85 +++++++++++-------- services/galley/src/Galley/API/Util.hs | 40 ++++++--- services/galley/test/integration/API.hs | 4 - .../galley/test/integration/API/Federation.hs | 39 +++++++++ .../test/integration/API/MessageTimer.hs | 49 +++++++++++ services/galley/test/integration/API/Util.hs | 12 ++- 12 files changed, 186 insertions(+), 52 deletions(-) create mode 100644 changelog.d/6-federation/fed-conv-message-timer diff --git a/changelog.d/6-federation/fed-conv-message-timer b/changelog.d/6-federation/fed-conv-message-timer new file mode 100644 index 00000000000..db7879953b7 --- /dev/null +++ b/changelog.d/6-federation/fed-conv-message-timer @@ -0,0 +1 @@ +Notify remote users when a conversation message timer is updated diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index b783643c9a7..41b50a5896b 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -874,6 +874,7 @@ data ConversationAction = ConversationActionAddMembers (NonEmpty (Qualified UserId, RoleName)) | ConversationActionRemoveMembers (NonEmpty (Qualified UserId)) | ConversationActionRename ConversationRename + | ConversationActionMessageTimerUpdate ConversationMessageTimerUpdate deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform ConversationAction) deriving (ToJSON, FromJSON) via (CustomEncoded ConversationAction) diff --git a/libs/wire-api/src/Wire/API/Event/Conversation.hs b/libs/wire-api/src/Wire/API/Event/Conversation.hs index 30ef6eee78c..3c8782cef0b 100644 --- a/libs/wire-api/src/Wire/API/Event/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Event/Conversation.hs @@ -576,3 +576,5 @@ conversationActionToEvent now quid qcnv (ConversationActionRemoveMembers removed EdMembersLeave . QualifiedUserIdList . toList $ removedMembers conversationActionToEvent now quid qcnv (ConversationActionRename rename) = Event ConvRename qcnv quid now (EdConvRename rename) +conversationActionToEvent now quid qcnv (ConversationActionMessageTimerUpdate update) = + Event ConvMessageTimerUpdate qcnv quid now (EdConvMessageTimerUpdate update) diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index f5ef675ee1e..8789f220da2 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -138,6 +138,7 @@ onConversationUpdated requestingDomain cu = do Data.removeLocalMembersFromRemoteConv qconvId localUsers pure [] Public.ConversationActionRename _ -> pure [] + Public.ConversationActionMessageTimerUpdate _ -> pure [] -- Send notifications let event = conversationActionToEvent (cuTime cu) (cuOrigUserId cu) qconvId (cuAction cu) diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index 9ea4b37e644..f3cd9630246 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -98,7 +98,7 @@ servantSitemap = GalleyAPI.updateConversationNameUnqualified = Update.updateUnqualifiedConversationName, GalleyAPI.updateConversationName = Update.updateConversationName, GalleyAPI.updateConversationMessageTimerUnqualified = - Update.updateLocalConversationMessageTimer, + Update.updateConversationMessageTimerUnqualified, GalleyAPI.updateConversationMessageTimer = Update.updateConversationMessageTimer, GalleyAPI.updateConversationReceiptModeUnqualified = Update.updateConversationReceiptModeUnqualified, diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 3e66d98f8ac..0310c967b96 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -82,7 +82,7 @@ getBotConversationH (zbot ::: zcnv ::: _) = do getBotConversation :: BotId -> ConvId -> Galley Public.BotConvView getBotConversation zbot zcnv = do - c <- getConversationAndCheckMembershipWithError (errorDescriptionTypeToWai @ConvNotFound) (botUserId zbot) zcnv + (c, _) <- getConversationAndMemberWithError (errorDescriptionTypeToWai @ConvNotFound) (botUserId zbot) zcnv domain <- viewFederationDomain let cmems = mapMaybe (mkMember domain) (toList (Data.convLocalMembers c)) pure $ Public.botConvView zcnv (Data.convName c) cmems diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index e8bb722764b..f8c14b6e188 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -32,6 +32,7 @@ module Galley.API.Update updateConversationReceiptModeUnqualified, updateConversationReceiptMode, updateLocalConversationMessageTimer, + updateConversationMessageTimerUnqualified, updateConversationMessageTimer, -- * Managing Members @@ -337,36 +338,59 @@ updateConversationReceiptModeUnqualified usr zcon cnv receiptModeUpdate@(Public. pushConversationEvent (Just zcon) receiptEvent (map lmId users) bots pure receiptEvent -updateConversationMessageTimer :: UserId -> ConnId -> Qualified ConvId -> Public.ConversationMessageTimerUpdate -> Galley (UpdateResult Event) +updateConversationMessageTimerUnqualified :: + UserId -> + ConnId -> + ConvId -> + Public.ConversationMessageTimerUpdate -> + Galley (UpdateResult Event) +updateConversationMessageTimerUnqualified usr zcon cnv update = do + lusr <- qualifyLocal usr + lcnv <- qualifyLocal cnv + updateLocalConversationMessageTimer lusr zcon lcnv update + +updateConversationMessageTimer :: + UserId -> + ConnId -> + Qualified ConvId -> + Public.ConversationMessageTimerUpdate -> + Galley (UpdateResult Event) updateConversationMessageTimer usr zcon qcnv update = do localDomain <- viewFederationDomain + lusr <- qualifyLocal usr if qDomain qcnv == localDomain - then updateLocalConversationMessageTimer usr zcon (qUnqualified qcnv) update + then updateLocalConversationMessageTimer lusr zcon (toLocal qcnv) update else throwM federationNotImplemented -updateLocalConversationMessageTimer :: UserId -> ConnId -> ConvId -> Public.ConversationMessageTimerUpdate -> Galley (UpdateResult Event) -updateLocalConversationMessageTimer usr zcon cnv timerUpdate@(Public.ConversationMessageTimerUpdate target) = do - localDomain <- viewFederationDomain - let qcnv = Qualified cnv localDomain - qusr = Qualified usr localDomain - -- checks and balances - (bots, users) <- localBotsAndUsers <$> Data.members cnv - ensureActionAllowedThrowing ModifyConversationMessageTimer - =<< getSelfMemberFromLocalsLegacy usr users - conv <- Data.conversation cnv >>= ifNothing (errorDescriptionTypeToWai @ConvNotFound) +updateLocalConversationMessageTimer :: + Local UserId -> + ConnId -> + Local ConvId -> + Public.ConversationMessageTimerUpdate -> + Galley (UpdateResult Event) +updateLocalConversationMessageTimer lusr zcon lcnv update = do + (conv, self) <- + getConversationAndMemberWithError + (errorDescriptionTypeToWai @ConvNotFound) + (lUnqualified lusr) + (lUnqualified lcnv) + + -- perform checks + ensureActionAllowedThrowing ModifyConversationMessageTimer self ensureGroupConvThrowing conv + let currentTimer = Data.convMessageTimer conv - if currentTimer == target + if currentTimer == cupMessageTimer update then pure Unchanged - else Updated <$> update qcnv qusr users bots - where - update qcnv qusr users bots = do - -- update cassandra & send event - now <- liftIO getCurrentTime - let timerEvent = Event ConvMessageTimerUpdate qcnv qusr now (EdConvMessageTimerUpdate timerUpdate) - Data.updateConversationMessageTimer cnv target - pushConversationEvent (Just zcon) timerEvent (map lmId users) bots - pure timerEvent + else + Updated <$> do + -- perform update + Data.updateConversationMessageTimer (lUnqualified lcnv) (cupMessageTimer update) + + -- send notifications + let action = ConversationActionMessageTimerUpdate update + let targets = convTargets conv + notifyConversationMetadataUpdate (unTagged lusr) zcon lcnv targets action addCodeH :: UserId ::: ConnId ::: ConvId -> Galley Response addCodeH (usr ::: zcon ::: cnv) = @@ -968,26 +992,19 @@ updateLiveLocalConversationName lusr zcon lcnv convRename = do ntRemotes = map rmId rusers, ntBots = bots } - now <- liftIO getCurrentTime let action = ConversationActionRename convRename - notifyConversationMetadataUpdate now (unTagged lusr) (Just zcon) lcnv targets action - -data NotificationTargets = NotificationTargets - { ntLocals :: [UserId], - ntRemotes :: [Remote UserId], - ntBots :: [BotMember] - } + notifyConversationMetadataUpdate (unTagged lusr) zcon lcnv targets action notifyConversationMetadataUpdate :: - UTCTime -> Qualified UserId -> - Maybe ConnId -> + ConnId -> Local ConvId -> NotificationTargets -> ConversationAction -> Galley Event -notifyConversationMetadataUpdate now quid mcon (Tagged qcnv) targets action = do +notifyConversationMetadataUpdate quid con (Tagged qcnv) targets action = do localDomain <- viewFederationDomain + now <- liftIO getCurrentTime let e = Public.conversationActionToEvent now quid qcnv action -- notify remote participants @@ -1002,7 +1019,7 @@ notifyConversationMetadataUpdate now quid mcon (Tagged qcnv) targets action = do runFederatedGalley domain rpc -- notify local participants and bots - pushConversationEvent mcon e (ntLocals targets) (ntBots targets) $> e + pushConversationEvent (Just con) e (ntLocals targets) (ntBots targets) $> e isTypingH :: UserId ::: ConnId ::: ConvId ::: JsonRequest Public.TypingData -> Galley Response isTypingH (zusr ::: zcon ::: cnv ::: req) = do diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 999291076bd..40437077ee2 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -246,6 +246,21 @@ isMember u = isJust . find ((u ==) . lmId) isRemoteMember :: Foldable m => Remote UserId -> m RemoteMember -> Bool isRemoteMember u = isJust . find ((u ==) . rmId) +data NotificationTargets = NotificationTargets + { ntLocals :: [UserId], + ntRemotes :: [Remote UserId], + ntBots :: [BotMember] + } + +convTargets :: Data.Conversation -> NotificationTargets +convTargets conv = case localBotsAndUsers (Data.convLocalMembers conv) of + (bots, lusers) -> + NotificationTargets + { ntLocals = map lmId lusers, + ntRemotes = map rmId (Data.convRemoteMembers conv), + ntBots = bots + } + localBotsAndUsers :: Foldable f => f LocalMember -> ([BotMember], [LocalMember]) localBotsAndUsers = foldMap botOrUser where @@ -292,7 +307,7 @@ getSelfMemberFromLocalsLegacy :: t LocalMember -> Galley LocalMember getSelfMemberFromLocalsLegacy usr lmems = - eitherM (throwM . errorDescriptionToWai) pure . runExceptT $ getSelfMemberFromLocals usr lmems + eitherM throwErrorDescription pure . runExceptT $ getSelfMemberFromLocals usr lmems getOtherMember :: (Foldable t, Monad m) => UserId -> t LocalMember -> ExceptT Error m LocalMember getOtherMember = getLocalMember (errorDescriptionTypeToWai @ConvMemberNotFound) @@ -326,7 +341,7 @@ getSelfMemberFromRemotes = getRemoteMember (mkErrorDescription :: ConvNotFound) getSelfMemberFromRemotesLegacy :: Foldable t => Remote UserId -> t RemoteMember -> Galley RemoteMember getSelfMemberFromRemotesLegacy usr rmems = - eitherM (throwM . errorDescriptionToWai) pure . runExceptT $ + eitherM throwErrorDescription pure . runExceptT $ getSelfMemberFromRemotes usr rmems -- | Since we search by local user ID, we know that the member must be local. @@ -361,19 +376,24 @@ getMember :: getMember p ex u = hoistEither . note ex . find ((u ==) . p) getConversationAndCheckMembership :: UserId -> ConvId -> Galley Data.Conversation -getConversationAndCheckMembership = - getConversationAndCheckMembershipWithError - (errorDescriptionTypeToWai @ConvAccessDenied) +getConversationAndCheckMembership uid = + fmap fst + . getConversationAndMemberWithError (errorDescriptionTypeToWai @ConvAccessDenied) uid -getConversationAndCheckMembershipWithError :: Error -> UserId -> ConvId -> Galley Data.Conversation -getConversationAndCheckMembershipWithError ex zusr convId = do +getConversationAndMemberWithError :: + Error -> + UserId -> + ConvId -> + Galley (Data.Conversation, LocalMember) +getConversationAndMemberWithError ex zusr convId = do c <- Data.conversation convId >>= ifNothing (errorDescriptionTypeToWai @ConvNotFound) when (DataTypes.isConvDeleted c) $ do Data.deleteConversation convId throwErrorDescriptionType @ConvNotFound - unless (zusr `isMember` Data.convLocalMembers c) $ - throwM ex - return c + member <- + eitherM throwM pure . runExceptT $ + getLocalMember ex zusr (Data.convLocalMembers c) + pure (c, member) -- | Deletion requires a permission check, but also a 'Role' comparison: -- Owners can only be deleted by another owner (and not themselves). diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 5fdef6f021c..f1433ab53b3 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -2542,10 +2542,6 @@ putQualifiedConvRenameWithRemotesOk = do evtFrom e @?= qbob evtData e @?= EdConvRename (ConversationRename "gossip++") -assertOne :: (HasCallStack, MonadIO m, Show a) => [a] -> m a -assertOne [a] = pure a -assertOne xs = liftIO . assertFailure $ "Expected exactly one element, found " <> show xs - putConvDeprecatedRenameOk :: TestM () putConvDeprecatedRenameOk = do c <- view tsCannon diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 5aa13b88198..f750c427791 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -69,6 +69,7 @@ tests s = test s "POST /federation/on-conversation-updated : Remove a local user from a remote conversation" removeLocalUser, test s "POST /federation/on-conversation-updated : Remove a remote user from a remote conversation" removeRemoteUser, test s "POST /federation/on-conversation-updated : Notify local user about conversation rename" notifyConvRename, + test s "POST /federation/on-conversation-updated : Notify local user about message timer update" notifyMessageTimer, test s "POST /federation/leave-conversation : Success" leaveConversationSuccess, test s "POST /federation/on-message-sent : Receive a message from another backend" onMessageSent, test s "POST /federation/send-message : Post a message sent from another backend" sendMessage @@ -325,6 +326,44 @@ notifyConvRename = do evtData e @?= EdConvRename (ConversationRename "gossip++") WS.assertNoEvent (1 # Second) [wsC] +notifyMessageTimer :: TestM () +notifyMessageTimer = do + c <- view tsCannon + qalice <- randomQualifiedUser + let alice = qUnqualified qalice + bob <- randomId + charlie <- randomUser + conv <- randomId + let bdom = Domain "bob.example.com" + qbob = Qualified bob bdom + qconv = Qualified conv bdom + aliceAsOtherMember = OtherMember qalice Nothing roleNameWireMember + fedGalleyClient <- view tsFedGalleyClient + + registerRemoteConv qconv qbob (Just "gossip") (Set.singleton aliceAsOtherMember) + + now <- liftIO getCurrentTime + let cu = + FedGalley.ConversationUpdate + { FedGalley.cuTime = now, + FedGalley.cuOrigUserId = qbob, + FedGalley.cuConvId = conv, + FedGalley.cuAlreadyPresentUsers = [alice, charlie], + FedGalley.cuAction = + ConversationActionMessageTimerUpdate (ConversationMessageTimerUpdate (Just 5000)) + } + WS.bracketR2 c alice charlie $ \(wsA, wsC) -> do + FedGalley.onConversationUpdated fedGalleyClient bdom cu + liftIO $ do + WS.assertMatch_ (5 # Second) wsA $ \n -> do + let e = List1.head (WS.unpackPayload n) + ntfTransient n @?= False + evtConv e @?= qconv + evtType e @?= ConvMessageTimerUpdate + evtFrom e @?= qbob + evtData e @?= EdConvMessageTimerUpdate (ConversationMessageTimerUpdate (Just 5000)) + WS.assertNoEvent (1 # Second) [wsC] + -- TODO: test adding non-existing users -- TODO: test adding resulting in an empty notification diff --git a/services/galley/test/integration/API/MessageTimer.hs b/services/galley/test/integration/API/MessageTimer.hs index d8f77579dc4..e795e823972 100644 --- a/services/galley/test/integration/API/MessageTimer.hs +++ b/services/galley/test/integration/API/MessageTimer.hs @@ -24,21 +24,32 @@ import API.Util import Bilge hiding (timeout) import Bilge.Assert import Control.Lens (view) +import Data.Aeson (eitherDecode) +import qualified Data.ByteString.Lazy as LBS +import Data.Domain +import Data.Id import qualified Data.LegalHold as LH import Data.List1 +import qualified Data.List1 as List1 import Data.Misc import Data.Qualified import Galley.Types import Galley.Types.Conversations.Roles import qualified Galley.Types.Teams as Teams +import Gundeck.Types.Notification (Notification (..)) import Imports hiding (head) import Network.Wai.Utilities.Error import Test.Tasty import Test.Tasty.Cannon (TimeoutUnit (..), (#)) import qualified Test.Tasty.Cannon as WS +import Test.Tasty.HUnit import TestHelpers import TestSetup +import Wire.API.Conversation +import qualified Wire.API.Federation.API.Galley as F +import qualified Wire.API.Federation.GRPC.Types as F import qualified Wire.API.Team.Member as Member +import Wire.API.User.Profile (Name (..)) tests :: IO TestSetup -> TestTree tests s = @@ -51,6 +62,7 @@ tests s = ], test s "timer can be changed" messageTimerChange, test s "timer can be changed with the qualified endpoint" messageTimerChangeQualified, + test s "timer changes are propagated to remote users" messageTimerChangeWithRemotes, test s "timer can't be set by conv member without allowed action" messageTimerChangeWithoutAllowedAction, test s "timer can't be set in 1:1 conversations" messageTimerChangeO2O, test s "setting the timer generates an event" messageTimerEvent @@ -130,6 +142,43 @@ messageTimerChangeQualified = do getConv jane cid !!! const timer1year === (cnvMessageTimer <=< responseJsonUnsafe) +messageTimerChangeWithRemotes :: TestM () +messageTimerChangeWithRemotes = do + c <- view tsCannon + let remoteDomain = Domain "alice.example.com" + qalice <- Qualified <$> randomId <*> pure remoteDomain + qbob <- randomQualifiedUser + let bob = qUnqualified qbob + + resp <- postConvWithRemoteUser remoteDomain (mkProfile qalice (Name "Alice")) bob [qalice] + let qconv = decodeQualifiedConvId resp + + opts <- view tsGConf + WS.bracketR c bob $ \wsB -> do + (_, requests) <- + withTempMockFederator opts remoteDomain (const ()) $ + putMessageTimerUpdateQualified bob qconv (ConversationMessageTimerUpdate timer1sec) + !!! const 200 === statusCode + + req <- assertOne requests + liftIO $ do + F.domain req @?= domainText remoteDomain + fmap F.component (F.request req) @?= Just F.Galley + fmap F.path (F.request req) @?= Just "/federation/on-conversation-updated" + Just (Right cu) <- pure $ fmap (eitherDecode . LBS.fromStrict . F.body) (F.request req) + F.cuConvId cu @?= qUnqualified qconv + F.cuAction cu + @?= ConversationActionMessageTimerUpdate + (ConversationMessageTimerUpdate timer1sec) + + void . liftIO . WS.assertMatch (5 # Second) wsB $ \n -> do + let e = List1.head (WS.unpackPayload n) + ntfTransient n @?= False + evtConv e @?= qconv + evtType e @?= ConvMessageTimerUpdate + evtFrom e @?= qbob + evtData e @?= EdConvMessageTimerUpdate (ConversationMessageTimerUpdate timer1sec) + messageTimerChangeWithoutAllowedAction :: TestM () messageTimerChangeWithoutAllowedAction = do -- Create a team and a guest user diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index d7de9f45f5f..c08e7a9ee53 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -1083,9 +1083,13 @@ putAccessUpdate u c acc = do . json acc putMessageTimerUpdateQualified :: - UserId -> Qualified ConvId -> ConversationMessageTimerUpdate -> TestM ResponseLBS + (HasGalley m, MonadIO m, MonadHttp m) => + UserId -> + Qualified ConvId -> + ConversationMessageTimerUpdate -> + m ResponseLBS putMessageTimerUpdateQualified u c acc = do - g <- view tsGalley + g <- viewGalley put $ g . paths @@ -2326,3 +2330,7 @@ fedRequestsForDomain domain component = F.domain req == domainText domain && fmap F.component (F.request req) == Just component ) + +assertOne :: (HasCallStack, MonadIO m, Show a) => [a] -> m a +assertOne [a] = pure a +assertOne xs = liftIO . assertFailure $ "Expected exactly one element, found " <> show xs From 06020a9dbda2510099d9b7eac12d5f9f2c777cff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Wed, 22 Sep 2021 12:46:31 +0200 Subject: [PATCH 46/72] Fix a typo in a function name (#1800) --- libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs index 5b330790a7f..adb8a928467 100644 --- a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs +++ b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs @@ -84,7 +84,7 @@ class PagingTable t where instance (PagingTable tables, KnownSymbol name) => ToSchema (MultiTablePagingState name tables) where schema = (toBase64Text . encodePagingState) - .= parsedText (textFromSymbol @name <> "_PagingState") (parseConvesationPagingState <=< fromBase64Text) + .= parsedText (textFromSymbol @name <> "_PagingState") (parseConversationPagingState <=< fromBase64Text) encodePagingState :: PagingTable tables => MultiTablePagingState name tables -> ByteString encodePagingState (MultiTablePagingState table state) = @@ -92,8 +92,8 @@ encodePagingState (MultiTablePagingState table state) = encodedState = fromMaybe "" state in BS.cons encodedTable encodedState -parseConvesationPagingState :: PagingTable tables => ByteString -> Either String (MultiTablePagingState name tables) -parseConvesationPagingState = AB.parseOnly conversationPagingStateParser +parseConversationPagingState :: PagingTable tables => ByteString -> Either String (MultiTablePagingState name tables) +parseConversationPagingState = AB.parseOnly conversationPagingStateParser conversationPagingStateParser :: PagingTable tables => AB.Parser (MultiTablePagingState name tables) conversationPagingStateParser = do From aba373426b9346c7873eb8cf80ae59f958afcc12 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 22 Sep 2021 15:37:00 +0200 Subject: [PATCH 47/72] Federation: support other member updates (#1785) * Add foldQualified utility function * Federation behaviour for other member updates * Local admins can now update the role of remote members * Remote members get notified of any member update * Add CHANGELOG entries * Test remote notifications for member updates * Make MemberUpdateData target qualified Also make it required, addressing a FUTUREWORK comment. * Add fromJSON test for MemberUpdateData * Add role update tests with remote members --- .../6-federation/fed-conv-member-update | 1 + .../6-federation/fed-update-remote-members | 1 + libs/api-bot/src/Network/Wire/Bot/Monad.hs | 16 +- libs/types-common/src/Data/Qualified.hs | 8 + .../src/Wire/API/Federation/API/Galley.hs | 2 +- .../Federation/Golden/ConversationUpdate.hs | 2 +- libs/wire-api/src/Wire/API/Conversation.hs | 16 -- .../src/Wire/API/Conversation/Action.hs | 65 ++++++++ .../src/Wire/API/Event/Conversation.hs | 29 +--- .../testObject_MemberUpdateData_user_1.json | 12 ++ .../test/golden/testObject_Event_user_5.json | 7 +- .../testObject_MemberUpdateData_user_1.json | 5 +- .../testObject_MemberUpdateData_user_2.json | 9 +- .../unit/Test/Wire/API/Golden/FromJSON.hs | 5 + .../Wire/API/Golden/Generated/Event_user.hs | 5 +- .../Golden/Generated/MemberUpdateData_user.hs | 28 ++-- libs/wire-api/wire-api.cabal | 3 +- services/galley/src/Galley/API/Federation.hs | 16 +- services/galley/src/Galley/API/Update.hs | 105 +++++++------ services/galley/src/Galley/API/Util.hs | 41 +++-- services/galley/src/Galley/Data.hs | 91 ++++++----- services/galley/src/Galley/Data/Queries.hs | 3 + services/galley/test/integration/API.hs | 10 +- .../galley/test/integration/API/Federation.hs | 88 +++++------ .../test/integration/API/MessageTimer.hs | 2 +- services/galley/test/integration/API/Roles.hs | 141 ++++++++++++++++++ services/galley/test/integration/API/Util.hs | 18 ++- .../src/Network/Wire/Simulations/SmokeTest.hs | 5 +- 28 files changed, 520 insertions(+), 214 deletions(-) create mode 100644 changelog.d/6-federation/fed-conv-member-update create mode 100644 changelog.d/6-federation/fed-update-remote-members create mode 100644 libs/wire-api/src/Wire/API/Conversation/Action.hs create mode 100644 libs/wire-api/test/golden/fromJSON/testObject_MemberUpdateData_user_1.json diff --git a/changelog.d/6-federation/fed-conv-member-update b/changelog.d/6-federation/fed-conv-member-update new file mode 100644 index 00000000000..b3e0b3156a0 --- /dev/null +++ b/changelog.d/6-federation/fed-conv-member-update @@ -0,0 +1 @@ +Notify remote users when a conversation member role is updated diff --git a/changelog.d/6-federation/fed-update-remote-members b/changelog.d/6-federation/fed-update-remote-members new file mode 100644 index 00000000000..afbf8e98ff4 --- /dev/null +++ b/changelog.d/6-federation/fed-update-remote-members @@ -0,0 +1 @@ +Implement updates to remote members diff --git a/libs/api-bot/src/Network/Wire/Bot/Monad.hs b/libs/api-bot/src/Network/Wire/Bot/Monad.hs index d1a984452c5..5c78e8b8518 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Monad.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Monad.hs @@ -57,6 +57,9 @@ module Network.Wire.Bot.Monad withNewBot, withCachedBot, + -- * Federation + viewFederationDomain, + -- * BotClient BotClient (..), getBotClients, @@ -95,6 +98,7 @@ import Control.Concurrent.STM (retry) import Control.Monad.Base import Control.Monad.Catch hiding (try) import Control.Monad.Trans.Control +import Data.Domain import qualified Data.HashMap.Strict as HashMap import Data.Id import Data.Metrics (Metrics) @@ -143,7 +147,8 @@ data BotNetEnv = BotNetEnv botNetSettings :: BotSettings, botNetMetrics :: Metrics, botNetReportDir :: Maybe FilePath, - botNetMailboxFolders :: [String] + botNetMailboxFolders :: [String], + botNetDomain :: Domain } newBotNetEnv :: Manager -> Logger -> BotNetSettings -> IO BotNetEnv @@ -174,7 +179,8 @@ newBotNetEnv manager logger o = do botNetSettings = setBotNetBotSettings o, botNetMetrics = met, botNetReportDir = setBotNetReportDir o, - botNetMailboxFolders = setBotNetMailboxFolders o + botNetMailboxFolders = setBotNetMailboxFolders o, + botNetDomain = domain } -- Note: Initializing metrics to avoid race conditions on first access and thus @@ -513,6 +519,12 @@ withCachedBot t f = do b <- liftBotNet $ mkBot t (tagged t u) p f b `finally` killBot b `finally` Cache.put c x +------------------------------------------------------------------------------- +-- Federation + +viewFederationDomain :: MonadBotNet m => m Domain +viewFederationDomain = liftBotNet . BotNet $ asks botNetDomain + ------------------------------------------------------------------------------- -- Assertions diff --git a/libs/types-common/src/Data/Qualified.hs b/libs/types-common/src/Data/Qualified.hs index 38cd9010868..4e47a40534c 100644 --- a/libs/types-common/src/Data/Qualified.hs +++ b/libs/types-common/src/Data/Qualified.hs @@ -27,6 +27,7 @@ module Data.Qualified toLocal, lUnqualified, lDomain, + foldQualified, renderQualifiedId, partitionRemoteOrLocalIds, partitionRemoteOrLocalIds', @@ -83,6 +84,13 @@ lUnqualified = qUnqualified . unTagged lDomain :: Local a -> Domain lDomain = qDomain . unTagged +foldQualified :: Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b +foldQualified loc f g q + | lDomain loc == qDomain q = + f (toLocal q) + | otherwise = + g (toRemote q) + -- | FUTUREWORK: Maybe delete this, it is only used in printing federation not -- implemented errors renderQualified :: (a -> Text) -> Qualified a -> Text 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 5e4ba623761..f3524abfb87 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 @@ -33,10 +33,10 @@ import Wire.API.Conversation ( Access, AccessRole, ConvType, - ConversationAction (..), ConversationMetadata, ReceiptMode, ) +import Wire.API.Conversation.Action import Wire.API.Conversation.Member (OtherMember) import Wire.API.Conversation.Role (RoleName) import Wire.API.Federation.Client (FederationClientFailure, FederatorClient) diff --git a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs index e13b75cb0fe..bf9dcfb1a9e 100644 --- a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs @@ -27,7 +27,7 @@ import Data.List.NonEmpty (NonEmpty (..)) import Data.Qualified (Qualified (Qualified)) import qualified Data.UUID as UUID import Imports -import Wire.API.Conversation (ConversationAction (..)) +import Wire.API.Conversation.Action import Wire.API.Conversation.Role (roleNameWireAdmin, roleNameWireMember) import Wire.API.Federation.API.Galley (ConversationUpdate (..)) diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index 41b50a5896b..d774cf46828 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -68,7 +68,6 @@ module Wire.API.Conversation ConversationAccessUpdate (..), ConversationReceiptModeUpdate (..), ConversationMessageTimerUpdate (..), - ConversationAction (..), -- * re-exports module Wire.API.Conversation.Member, @@ -113,7 +112,6 @@ import Wire.API.Arbitrary (Arbitrary (arbitrary), GenericUniform (..)) import Wire.API.Conversation.Member import Wire.API.Conversation.Role (RoleName, roleNameWireAdmin) import Wire.API.Routes.MultiTablePaging -import Wire.API.Util.Aeson (CustomEncoded (..)) -------------------------------------------------------------------------------- -- Conversation @@ -864,17 +862,3 @@ modelConversationMessageTimerUpdate = Doc.defineModel "ConversationMessageTimerU Doc.description "Contains conversation properties to update" Doc.property "message_timer" Doc.int64' $ Doc.description "Conversation message timer (in milliseconds); can be null" - --------------------------------------------------------------------------------- --- actions - --- | An update to a conversation, including addition and removal of members. --- Used to send notifications to users and to remote backends. -data ConversationAction - = ConversationActionAddMembers (NonEmpty (Qualified UserId, RoleName)) - | ConversationActionRemoveMembers (NonEmpty (Qualified UserId)) - | ConversationActionRename ConversationRename - | ConversationActionMessageTimerUpdate ConversationMessageTimerUpdate - deriving stock (Eq, Show, Generic) - deriving (Arbitrary) via (GenericUniform ConversationAction) - deriving (ToJSON, FromJSON) via (CustomEncoded ConversationAction) diff --git a/libs/wire-api/src/Wire/API/Conversation/Action.hs b/libs/wire-api/src/Wire/API/Conversation/Action.hs new file mode 100644 index 00000000000..27358e01b88 --- /dev/null +++ b/libs/wire-api/src/Wire/API/Conversation/Action.hs @@ -0,0 +1,65 @@ +-- 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 Wire.API.Conversation.Action + ( ConversationAction (..), + conversationActionToEvent, + ) +where + +import Data.Aeson (FromJSON (..), ToJSON (..)) +import Data.Id +import Data.List.NonEmpty (NonEmpty) +import Data.Qualified +import Data.Time.Clock +import Imports +import Wire.API.Arbitrary (Arbitrary, GenericUniform (..)) +import Wire.API.Conversation +import Wire.API.Conversation.Role +import Wire.API.Event.Conversation +import Wire.API.Util.Aeson (CustomEncoded (..)) + +-- | An update to a conversation, including addition and removal of members. +-- Used to send notifications to users and to remote backends. +data ConversationAction + = ConversationActionAddMembers (NonEmpty (Qualified UserId, RoleName)) + | ConversationActionRemoveMembers (NonEmpty (Qualified UserId)) + | ConversationActionRename ConversationRename + | ConversationActionMessageTimerUpdate ConversationMessageTimerUpdate + | ConversationActionMemberUpdate MemberUpdateData + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform ConversationAction) + deriving (ToJSON, FromJSON) via (CustomEncoded ConversationAction) + +conversationActionToEvent :: + UTCTime -> + Qualified UserId -> + Qualified ConvId -> + ConversationAction -> + Event +conversationActionToEvent now quid qcnv (ConversationActionAddMembers newMembers) = + Event MemberJoin qcnv quid now $ + EdMembersJoin $ SimpleMembers (map (uncurry SimpleMember) . toList $ newMembers) +conversationActionToEvent now quid qcnv (ConversationActionRemoveMembers removedMembers) = + Event MemberLeave qcnv quid now $ + EdMembersLeave . QualifiedUserIdList . toList $ removedMembers +conversationActionToEvent now quid qcnv (ConversationActionRename rename) = + Event ConvRename qcnv quid now (EdConvRename rename) +conversationActionToEvent now quid qcnv (ConversationActionMessageTimerUpdate update) = + Event ConvMessageTimerUpdate qcnv quid now (EdConvMessageTimerUpdate update) +conversationActionToEvent now quid qcnv (ConversationActionMemberUpdate update) = + Event MemberStateUpdate qcnv quid now (EdMemberUpdate update) diff --git a/libs/wire-api/src/Wire/API/Event/Conversation.hs b/libs/wire-api/src/Wire/API/Event/Conversation.hs index 3c8782cef0b..7ec2aef4d8c 100644 --- a/libs/wire-api/src/Wire/API/Event/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Event/Conversation.hs @@ -47,7 +47,6 @@ module Wire.API.Event.Conversation Connect (..), MemberUpdateData (..), OtrMessage (..), - conversationActionToEvent, -- * re-exports ConversationReceiptModeUpdate (..), @@ -395,12 +394,8 @@ modelConnect = Doc.defineModel "Connect" $ do -- Used for events (sent over the websocket, etc.). See also -- 'MemberUpdate' and 'OtherMemberUpdate'. data MemberUpdateData = MemberUpdateData - { -- | Target user of this action, should not be optional anymore. - -- - -- FUTUREWORK: make it mandatory to guarantee that no events - -- out there do not contain an ID. - -- - misTarget :: Maybe UserId, + { -- | Target user of this action + misTarget :: Qualified UserId, misOtrMutedStatus :: Maybe MutedStatus, misOtrMutedRef :: Maybe Text, misOtrArchived :: Maybe Bool, @@ -419,7 +414,8 @@ instance ToSchema MemberUpdateData where memberUpdateDataObjectSchema :: ObjectSchema SwaggerDoc MemberUpdateData memberUpdateDataObjectSchema = MemberUpdateData - <$> misTarget .= opt (field "target" schema) + <$> misTarget .= field "qualified_target" schema + <* (Just . qUnqualified . misTarget) .= optField "target" Nothing schema <*> misOtrMutedStatus .= opt (field "otr_muted_status" schema) <*> misOtrMutedRef .= opt (field "otr_muted_ref" schema) <*> misOtrArchived .= opt (field "otr_archived" schema) @@ -561,20 +557,3 @@ instance ToJSON Event where instance S.ToSchema Event where declareNamedSchema = schemaToSwagger - -conversationActionToEvent :: - UTCTime -> - Qualified UserId -> - Qualified ConvId -> - ConversationAction -> - Event -conversationActionToEvent now quid qcnv (ConversationActionAddMembers newMembers) = - Event MemberJoin qcnv quid now $ - EdMembersJoin $ SimpleMembers (map (uncurry SimpleMember) . toList $ newMembers) -conversationActionToEvent now quid qcnv (ConversationActionRemoveMembers removedMembers) = - Event MemberLeave qcnv quid now $ - EdMembersLeave . QualifiedUserIdList . toList $ removedMembers -conversationActionToEvent now quid qcnv (ConversationActionRename rename) = - Event ConvRename qcnv quid now (EdConvRename rename) -conversationActionToEvent now quid qcnv (ConversationActionMessageTimerUpdate update) = - Event ConvMessageTimerUpdate qcnv quid now (EdConvMessageTimerUpdate update) diff --git a/libs/wire-api/test/golden/fromJSON/testObject_MemberUpdateData_user_1.json b/libs/wire-api/test/golden/fromJSON/testObject_MemberUpdateData_user_1.json new file mode 100644 index 00000000000..1f9ce1ae770 --- /dev/null +++ b/libs/wire-api/test/golden/fromJSON/testObject_MemberUpdateData_user_1.json @@ -0,0 +1,12 @@ +{ + "hidden": true, + "hidden_ref": "1", + "otr_archived": false, + "otr_archived_ref": "a", + "otr_muted_ref": "#M𗗐", + "otr_muted_status": -1, + "qualified_target": { + "domain": "target.example.com", + "id": "00000000-0000-0002-0000-000100000001" + } +} diff --git a/libs/wire-api/test/golden/testObject_Event_user_5.json b/libs/wire-api/test/golden/testObject_Event_user_5.json index 87eb24b6b8b..c39d23e7625 100644 --- a/libs/wire-api/test/golden/testObject_Event_user_5.json +++ b/libs/wire-api/test/golden/testObject_Event_user_5.json @@ -5,7 +5,12 @@ "hidden_ref": "\u0008\t\u0018", "otr_archived": false, "otr_archived_ref": "\u0001J", - "otr_muted_ref": "𗋭" + "otr_muted_ref": "𗋭", + "qualified_target": { + "domain": "target.example.com", + "id": "afb0e5b1-c554-4ce4-98f5-3e1671f22485" + }, + "target": "afb0e5b1-c554-4ce4-98f5-3e1671f22485" }, "from": "00002a12-0000-73e1-0000-71f700002ec9", "qualified_conversation": { diff --git a/libs/wire-api/test/golden/testObject_MemberUpdateData_user_1.json b/libs/wire-api/test/golden/testObject_MemberUpdateData_user_1.json index 6b538b2fc02..2d759ceb0f6 100644 --- a/libs/wire-api/test/golden/testObject_MemberUpdateData_user_1.json +++ b/libs/wire-api/test/golden/testObject_MemberUpdateData_user_1.json @@ -1,10 +1,13 @@ { - "conversation_role": "3fwjaofhryb7nd1hp3nwukjiyxxhgimw8ddzx5s_8ek5nnctkzkic6w51hqugeh6l50hg87dez8pw974dbuywd83njuytv0euf9619s", "hidden": true, "hidden_ref": "1", "otr_archived": false, "otr_archived_ref": "a", "otr_muted_ref": "#M𗗐", "otr_muted_status": -1, + "qualified_target": { + "domain": "target.example.com", + "id": "00000000-0000-0002-0000-000100000001" + }, "target": "00000000-0000-0002-0000-000100000001" } diff --git a/libs/wire-api/test/golden/testObject_MemberUpdateData_user_2.json b/libs/wire-api/test/golden/testObject_MemberUpdateData_user_2.json index 0967ef424bc..02d81ea3d6d 100644 --- a/libs/wire-api/test/golden/testObject_MemberUpdateData_user_2.json +++ b/libs/wire-api/test/golden/testObject_MemberUpdateData_user_2.json @@ -1 +1,8 @@ -{} +{ + "conversation_role": "3fwjaofhryb7nd1hp3nwukjiyxxhgimw8ddzx5s_8ek5nnctkzkic6w51hqugeh6l50hg87dez8pw974dbuywd83njuytv0euf9619s", + "qualified_target": { + "domain": "target.example.com", + "id": "00000000-0000-0002-0000-000100000001" + }, + "target": "00000000-0000-0002-0000-000100000001" +} diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/FromJSON.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/FromJSON.hs index d69d1b9cddf..f0bdbc03201 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/FromJSON.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/FromJSON.hs @@ -21,6 +21,7 @@ import Imports import Test.Tasty import Test.Tasty.HUnit import Test.Wire.API.Golden.Generated.Invite_user (testObject_Invite_user_2) +import Test.Wire.API.Golden.Generated.MemberUpdateData_user import Test.Wire.API.Golden.Generated.NewConvUnmanaged_user import Test.Wire.API.Golden.Generated.NewOtrMessage_user import Test.Wire.API.Golden.Generated.RmClient_user @@ -78,6 +79,10 @@ tests = \'hidden', 'hidden_ref', 'conversation_role'} required." ) "testObject_MemberUpdate_user_3.json", + testCase "MemberUpdateData" $ + testFromJSONObject + testObject_MemberUpdateData_user_1 + "testObject_MemberUpdateData_user_1.json", testCase "OtherMemberUpdate" $ testFromJSONFailure @OtherMemberUpdate "testObject_OtherMemberUpdate_user_2.json", testGroup "NewUser: failure" $ 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 cdd9a029b20..bd5cbfacae7 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 @@ -96,7 +96,10 @@ testObject_Event_user_5 = (read "1864-04-12 03:04:00.298 UTC") ( EdMemberUpdate ( MemberUpdateData - { misTarget = Nothing, + { misTarget = + Qualified + (Id (fromJust (UUID.fromString "afb0e5b1-c554-4ce4-98f5-3e1671f22485"))) + (Domain "target.example.com"), misOtrMutedStatus = Nothing, misOtrMutedRef = Just "\94957", misOtrArchived = Just False, diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/MemberUpdateData_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/MemberUpdateData_user.hs index 22180ec29c2..3d7d8181b99 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/MemberUpdateData_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/MemberUpdateData_user.hs @@ -16,7 +16,9 @@ -- with this program. If not, see . module Test.Wire.API.Golden.Generated.MemberUpdateData_user where +import Data.Domain import Data.Id (Id (Id)) +import Data.Qualified import qualified Data.UUID as UUID (fromString) import Imports (Bool (False, True), Maybe (Just, Nothing), fromJust) import Wire.API.Conversation (MutedStatus (MutedStatus, fromMutedStatus)) @@ -26,31 +28,37 @@ import Wire.API.Event.Conversation (MemberUpdateData (..)) testObject_MemberUpdateData_user_1 :: MemberUpdateData testObject_MemberUpdateData_user_1 = MemberUpdateData - { misTarget = Just (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000100000001"))), + { misTarget = + Qualified + (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000100000001"))) + (Domain "target.example.com"), misOtrMutedStatus = Just (MutedStatus {fromMutedStatus = -1}), misOtrMutedRef = Just "#M\95696", misOtrArchived = Just False, misOtrArchivedRef = Just "a", misHidden = Just True, misHiddenRef = Just "1", - misConvRoleName = - Just - ( fromJust - ( parseRoleName - "3fwjaofhryb7nd1hp3nwukjiyxxhgimw8ddzx5s_8ek5nnctkzkic6w51hqugeh6l50hg87dez8pw974dbuywd83njuytv0euf9619s" - ) - ) + misConvRoleName = Nothing } testObject_MemberUpdateData_user_2 :: MemberUpdateData testObject_MemberUpdateData_user_2 = MemberUpdateData - { misTarget = Nothing, + { misTarget = + Qualified + (Id (fromJust (UUID.fromString "00000000-0000-0002-0000-000100000001"))) + (Domain "target.example.com"), misOtrMutedStatus = Nothing, misOtrMutedRef = Nothing, misOtrArchived = Nothing, misOtrArchivedRef = Nothing, misHidden = Nothing, misHiddenRef = Nothing, - misConvRoleName = Nothing + misConvRoleName = + Just + ( fromJust + ( parseRoleName + "3fwjaofhryb7nd1hp3nwukjiyxxhgimw8ddzx5s_8ek5nnctkzkic6w51hqugeh6l50hg87dez8pw974dbuywd83njuytv0euf9619s" + ) + ) } diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index c16411e3fdc..b5ab6d34421 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: 1b29447efcb495e0d025de9fc8e5c6c887ef9ef16d3b075cecd9deb42ad32fc6 +-- hash: 1dce25e4dabf58eac09c8e4f384829306931a35d0c9b902d22d4f29b7a592aae name: wire-api version: 0.1.0 @@ -26,6 +26,7 @@ library Wire.API.Call.Config Wire.API.Connection Wire.API.Conversation + Wire.API.Conversation.Action Wire.API.Conversation.Bot Wire.API.Conversation.Code Wire.API.Conversation.Member diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 8789f220da2..047a74834c8 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -45,6 +45,7 @@ import Servant.API.Generic (ToServantApi) import Servant.Server.Generic (genericServerT) import qualified System.Logger.Class as Log import qualified Wire.API.Conversation as Public +import Wire.API.Conversation.Action import Wire.API.Conversation.Member (OtherMember (..)) import qualified Wire.API.Conversation.Role as Public import Wire.API.Event.Conversation @@ -125,20 +126,21 @@ onConversationUpdated requestingDomain cu = do -- When new users are being added to the conversation, we consider them as -- notification targets. Once we start checking connections before letting -- people being added, this will be safe against spam. However, if users that - -- are not in the conversations are being removed, we do **not** add them to the - -- list of targets, because we have no way to make sure that they are actually - -- supposed to receive that notification. + -- are not in the conversations are being removed or have their membership state + -- updated, we do **not** add them to the list of targets, because we have no + -- way to make sure that they are actually supposed to receive that notification. extraTargets <- case cuAction cu of - Public.ConversationActionAddMembers toAdd -> do + ConversationActionAddMembers toAdd -> do let localUsers = getLocalUsers localDomain (fmap fst toAdd) Data.addLocalMembersToRemoteConv qconvId localUsers pure localUsers - Public.ConversationActionRemoveMembers toRemove -> do + ConversationActionRemoveMembers toRemove -> do let localUsers = getLocalUsers localDomain toRemove Data.removeLocalMembersFromRemoteConv qconvId localUsers pure [] - Public.ConversationActionRename _ -> pure [] - Public.ConversationActionMessageTimerUpdate _ -> pure [] + ConversationActionRename _ -> pure [] + ConversationActionMessageTimerUpdate _ -> pure [] + ConversationActionMemberUpdate _ -> pure [] -- Send notifications let event = conversationActionToEvent (cuTime cu) (cuOrigUserId cu) qconvId (cuAction cu) diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index f8c14b6e188..4c537c5eba3 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -112,11 +112,9 @@ import Network.Wai import Network.Wai.Predicate hiding (and, failure, setStatus, _1, _2) import Network.Wai.Utilities import UnliftIO (pooledForConcurrentlyN) -import Wire.API.Conversation - ( ConversationAction (..), - InviteQualified (invQRoleName), - ) +import Wire.API.Conversation (InviteQualified (invQRoleName)) import qualified Wire.API.Conversation as Public +import Wire.API.Conversation.Action (ConversationAction (..), conversationActionToEvent) import qualified Wire.API.Conversation.Code as Public import Wire.API.Conversation.Role (roleNameWireAdmin) import Wire.API.ErrorDescription @@ -614,7 +612,9 @@ updateLocalSelfMember zusr zcon (Tagged qcid) update = do -- only one is really needed (local members). conv <- getConversationAndCheckMembership zusr (qUnqualified qcid) m <- getSelfMemberFromLocalsLegacy zusr (Data.convLocalMembers conv) - void $ processUpdateMemberEvent zusr zcon qcid [lmId m] (lmId m) update + luid <- qualifyLocal zusr + let targets = NotificationTargets [lmId m] [] [] + processUpdateMemberEvent luid zcon qcid targets luid update updateRemoteSelfMember :: UserId -> @@ -626,8 +626,10 @@ updateRemoteSelfMember zusr zcon rcid update = do statusMap <- Data.remoteConversationStatus zusr [rcid] case Map.lookup rcid statusMap of Nothing -> throwErrorDescriptionType @ConvMemberNotFound - Just _ -> - void $ processUpdateMemberEvent zusr zcon (unTagged rcid) [zusr] zusr update + Just _ -> do + luid <- qualifyLocal zusr + let targets = NotificationTargets [zusr] [] [] + processUpdateMemberEvent luid zcon (unTagged rcid) targets luid update updateOtherMember :: UserId -> @@ -637,10 +639,12 @@ updateOtherMember :: Public.OtherMemberUpdate -> Galley () updateOtherMember zusr zcon qcid qvictim update = do - localDomain <- viewFederationDomain - if qDomain qcid == localDomain && qDomain qvictim == localDomain - then updateOtherMemberUnqualified zusr zcon (qUnqualified qcid) (qUnqualified qvictim) update - else throwM federationNotImplemented + lusr <- qualifyLocal zusr + foldQualified + lusr + (\lcid -> updateOtherMemberLocalConv lusr zcon lcid qvictim update) + (\_ -> throwM federationNotImplemented) + qcid updateOtherMemberUnqualified :: UserId -> @@ -649,17 +653,30 @@ updateOtherMemberUnqualified :: UserId -> Public.OtherMemberUpdate -> Galley () -updateOtherMemberUnqualified zusr zcon cid victim update = do - localDomain <- viewFederationDomain - when (zusr == victim) $ +updateOtherMemberUnqualified zusr zcon cnv victim update = do + lusr <- qualifyLocal zusr + lcnv <- qualifyLocal cnv + lvictim <- qualifyLocal victim + updateOtherMemberLocalConv lusr zcon lcnv (unTagged lvictim) update + +updateOtherMemberLocalConv :: + Local UserId -> + ConnId -> + Local ConvId -> + Qualified UserId -> + Public.OtherMemberUpdate -> + Galley () +updateOtherMemberLocalConv luid zcon lcid qvictim update = do + when (unTagged luid == qvictim) $ throwM invalidTargetUserOp - conv <- getConversationAndCheckMembership zusr cid - let (bots, users) = localBotsAndUsers (Data.convLocalMembers conv) - ensureActionAllowedThrowing ModifyOtherConversationMember =<< getSelfMemberFromLocalsLegacy zusr users - -- this has the side effect of checking that the victim is indeed part of the conversation - memTarget <- getOtherMemberLegacy victim users - e <- processUpdateMemberEvent zusr zcon (Qualified cid localDomain) (map lmId users) (lmId memTarget) update - void . forkIO $ void $ External.deliver (bots `zip` repeat e) + (conv, self) <- + getConversationAndMemberWithError + (errorDescriptionTypeToWai @ConvNotFound) + (lUnqualified luid) + (lUnqualified lcid) + ensureActionAllowedThrowing ModifyOtherConversationMember self + void $ ensureOtherMember luid qvictim (Data.convLocalMembers conv) (Data.convRemoteMembers conv) + processUpdateMemberEvent luid zcon (unTagged lcid) (convTargets conv) qvictim update -- | 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 @@ -1005,7 +1022,7 @@ notifyConversationMetadataUpdate :: notifyConversationMetadataUpdate quid con (Tagged qcnv) targets action = do localDomain <- viewFederationDomain now <- liftIO getCurrentTime - let e = Public.conversationActionToEvent now quid qcnv action + let e = conversationActionToEvent now quid qcnv action -- notify remote participants let rusersByDomain = partitionRemote (ntRemotes targets) @@ -1195,38 +1212,40 @@ ensureConvMember users usr = -- | Update a member of a conversation and propagate events. -- --- Note: the target is assumed to be a member of the conversation. +-- Note: the victim is assumed to be a member of the conversation. processUpdateMemberEvent :: - Data.IsMemberUpdate mu => + ( IsNotificationTarget uid, + Data.IsMemberUpdate mu uid + ) => -- | Originating user - UserId -> + Local UserId -> -- | Connection ID for the originating user ConnId -> -- | Conversation whose members are being updated Qualified ConvId -> -- | Recipients of the notification - [UserId] -> + NotificationTargets -> -- | User being updated - UserId -> + uid -> -- | Update structure mu -> - Galley Event -processUpdateMemberEvent zusr zcon qcid users target update = do - localDomain <- viewFederationDomain - let qusr = Qualified zusr localDomain + Galley () +processUpdateMemberEvent lusr zcon qcid targets victim update = do up <- - if localDomain == qDomain qcid - then Data.updateMember (qUnqualified qcid) target update - else Data.updateMemberRemoteConv (toRemote qcid) target update - now <- liftIO getCurrentTime - let e = Event MemberStateUpdate qcid qusr now (EdMemberUpdate up) - let recipients = fmap userRecipient (target : filter (/= target) users) - for_ (newPushLocal ListComplete zusr (ConvEvent e) recipients) $ \p -> - push1 $ - p - & pushConn ?~ zcon - & pushRoute .~ RouteDirect - return e + foldQualified + lusr + Data.updateMember + Data.updateMemberRemoteConv + qcid + victim + update + void $ + notifyConversationMetadataUpdate + (unTagged lusr) + zcon + (toLocal qcid) + (ntAdd lusr victim targets) + (ConversationActionMemberUpdate up) ------------------------------------------------------------------------------- -- OtrRecipients Validation diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 40437077ee2..86d1799f4c8 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -34,9 +34,9 @@ import Data.LegalHold (UserLegalHoldStatus (..), defUserLegalHoldStatus) import Data.List.Extra (chunksOf, nubOrd) import qualified Data.Map as Map import Data.Misc (PlainTextPassword (..)) -import Data.Qualified (Local, Qualified (..), Remote, partitionQualified, toLocal, toRemote) +import Data.Qualified import qualified Data.Set as Set -import Data.Tagged (Tagged (unTagged)) +import Data.Tagged import qualified Data.Text.Lazy as LT import Data.Time import Galley.API.Error @@ -59,8 +59,8 @@ import Network.Wai import Network.Wai.Predicate hiding (Error) import Network.Wai.Utilities import UnliftIO (concurrently) -import Wire.API.Conversation (ConversationAction (..)) import qualified Wire.API.Conversation as Public +import Wire.API.Conversation.Action (ConversationAction (..)) import Wire.API.ErrorDescription import qualified Wire.API.Federation.API.Brig as FederatedBrig import Wire.API.Federation.API.Galley as FederatedGalley @@ -246,12 +246,29 @@ isMember u = isJust . find ((u ==) . lmId) isRemoteMember :: Foldable m => Remote UserId -> m RemoteMember -> Bool isRemoteMember u = isJust . find ((u ==) . rmId) +-- | This is an ad-hoc class to update notification targets based on the type +-- of the user id. Local user IDs get added to the local targets, remote user IDs +-- to remote targets, and qualified user IDs get added to the appropriate list +-- according to whether they are local or remote, by making a runtime check. +class IsNotificationTarget uid where + ntAdd :: Local x -> uid -> NotificationTargets -> NotificationTargets + data NotificationTargets = NotificationTargets { ntLocals :: [UserId], ntRemotes :: [Remote UserId], ntBots :: [BotMember] } +instance IsNotificationTarget (Local UserId) where + ntAdd _ (Tagged (Qualified uid _)) nt = + nt {ntLocals = uid : filter (/= uid) (ntLocals nt)} + +instance IsNotificationTarget (Remote UserId) where + ntAdd _ ruid nt = nt {ntRemotes = ruid : filter (/= ruid) (ntRemotes nt)} + +instance IsNotificationTarget (Qualified UserId) where + ntAdd loc = foldQualified loc (ntAdd loc) (ntAdd loc) + convTargets :: Data.Conversation -> NotificationTargets convTargets conv = case localBotsAndUsers (Data.convLocalMembers conv) of (bots, lusers) -> @@ -309,12 +326,18 @@ getSelfMemberFromLocalsLegacy :: getSelfMemberFromLocalsLegacy usr lmems = eitherM throwErrorDescription pure . runExceptT $ getSelfMemberFromLocals usr lmems -getOtherMember :: (Foldable t, Monad m) => UserId -> t LocalMember -> ExceptT Error m LocalMember -getOtherMember = getLocalMember (errorDescriptionTypeToWai @ConvMemberNotFound) - -getOtherMemberLegacy :: Foldable t => UserId -> t LocalMember -> Galley LocalMember -getOtherMemberLegacy usr lmems = - eitherM throwM pure . runExceptT $ getOtherMember usr lmems +-- | Throw 'ConvMemberNotFound' if the given user is not part of a +-- conversation (either locally or remotely). +ensureOtherMember :: + Local a -> + Qualified UserId -> + [LocalMember] -> + [RemoteMember] -> + Galley (Either LocalMember RemoteMember) +ensureOtherMember loc quid locals remotes = + maybe (throwErrorDescriptionType @ConvMemberNotFound) pure $ + (Left <$> find ((== quid) . (`Qualified` lDomain loc) . lmId) locals) + <|> (Right <$> find ((== quid) . unTagged . rmId) remotes) -- | Note that we use 2 nearly identical functions but slightly different -- semantics; when using `getSelfMemberQualified`, if that user is _not_ part of diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index 7478a9b8914..379d6a0f533 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -934,14 +934,14 @@ addLocalMembersToRemoteConv qconv users = do Cql.insertUserRemoteConv (u, qDomain qconv, qUnqualified qconv) -class IsMemberUpdate mu where - updateMember :: MonadClient m => ConvId -> UserId -> mu -> m MemberUpdateData - updateMemberRemoteConv :: MonadClient m => Remote ConvId -> UserId -> mu -> m MemberUpdateData +class IsMemberUpdate mu uid where + updateMember :: MonadClient m => Local ConvId -> uid -> mu -> m MemberUpdateData + updateMemberRemoteConv :: MonadClient m => Remote ConvId -> uid -> mu -> m MemberUpdateData -memberUpdateToData :: UserId -> MemberUpdate -> MemberUpdateData -memberUpdateToData uid mup = +memberUpdateToData :: Qualified UserId -> MemberUpdate -> MemberUpdateData +memberUpdateToData quid mup = MemberUpdateData - { misTarget = Just uid, + { misTarget = quid, misOtrMutedStatus = mupOtrMuteStatus mup, misOtrMutedRef = mupOtrMuteRef mup, misOtrArchived = mupOtrArchive mup, @@ -951,60 +951,75 @@ memberUpdateToData uid mup = misConvRoleName = Nothing } -instance IsMemberUpdate MemberUpdate where - updateMember cid uid mup = do +instance IsMemberUpdate MemberUpdate (Local UserId) where + updateMember lcid luid mup = do retry x5 . batch $ do setType BatchUnLogged setConsistency Quorum for_ (mupOtrMuteStatus mup) $ \ms -> - addPrepQuery Cql.updateOtrMemberMutedStatus (ms, mupOtrMuteRef mup, cid, uid) + addPrepQuery + Cql.updateOtrMemberMutedStatus + (ms, mupOtrMuteRef mup, lUnqualified lcid, lUnqualified luid) for_ (mupOtrArchive mup) $ \a -> - addPrepQuery Cql.updateOtrMemberArchived (a, mupOtrArchiveRef mup, cid, uid) + addPrepQuery + Cql.updateOtrMemberArchived + (a, mupOtrArchiveRef mup, lUnqualified lcid, lUnqualified luid) for_ (mupHidden mup) $ \h -> - addPrepQuery Cql.updateMemberHidden (h, mupHiddenRef mup, cid, uid) - pure (memberUpdateToData uid mup) - updateMemberRemoteConv (Tagged (Qualified cid domain)) uid mup = do + addPrepQuery + Cql.updateMemberHidden + (h, mupHiddenRef mup, lUnqualified lcid, lUnqualified luid) + pure (memberUpdateToData (unTagged luid) mup) + updateMemberRemoteConv (Tagged (Qualified cid domain)) luid mup = do retry x5 . batch $ do setType BatchUnLogged setConsistency Quorum for_ (mupOtrMuteStatus mup) $ \ms -> addPrepQuery Cql.updateRemoteOtrMemberMutedStatus - (ms, mupOtrMuteRef mup, domain, cid, uid) + (ms, mupOtrMuteRef mup, domain, cid, lUnqualified luid) for_ (mupOtrArchive mup) $ \a -> addPrepQuery Cql.updateRemoteOtrMemberArchived - (a, mupOtrArchiveRef mup, domain, cid, uid) + (a, mupOtrArchiveRef mup, domain, cid, lUnqualified luid) for_ (mupHidden mup) $ \h -> addPrepQuery Cql.updateRemoteMemberHidden - (h, mupHiddenRef mup, domain, cid, uid) - pure (memberUpdateToData uid mup) - -instance IsMemberUpdate OtherMemberUpdate where - updateMember cid uid omu = do - retry x5 . batch $ do - setType BatchUnLogged - setConsistency Quorum - for_ (omuConvRoleName omu) $ \r -> - addPrepQuery Cql.updateMemberConvRoleName (r, cid, uid) - pure - MemberUpdateData - { misTarget = Just uid, - misOtrMutedStatus = Nothing, - misOtrMutedRef = Nothing, - misOtrArchived = Nothing, - misOtrArchivedRef = Nothing, - misHidden = Nothing, - misHiddenRef = Nothing, - misConvRoleName = omuConvRoleName omu - } + (h, mupHiddenRef mup, domain, cid, lUnqualified luid) + pure (memberUpdateToData (unTagged luid) mup) + +instance IsMemberUpdate OtherMemberUpdate (Qualified UserId) where + updateMember lcid quid omu = + do + let addQuery r + | lDomain lcid == qDomain quid = + addPrepQuery + Cql.updateMemberConvRoleName + (r, lUnqualified lcid, qUnqualified quid) + | otherwise = + addPrepQuery + Cql.updateRemoteMemberConvRoleName + (r, lUnqualified lcid, qDomain quid, qUnqualified quid) + retry x5 . batch $ do + setType BatchUnLogged + setConsistency Quorum + traverse_ addQuery (omuConvRoleName omu) + pure + MemberUpdateData + { misTarget = quid, + misOtrMutedStatus = Nothing, + misOtrMutedRef = Nothing, + misOtrArchived = Nothing, + misOtrArchivedRef = Nothing, + misHidden = Nothing, + misHiddenRef = Nothing, + misConvRoleName = omuConvRoleName omu + } -- FUTUREWORK: https://wearezeta.atlassian.net/browse/SQCORE-887 - updateMemberRemoteConv _ _ _ = + updateMemberRemoteConv _ quid _ = pure MemberUpdateData - { misTarget = Nothing, + { misTarget = quid, misOtrMutedStatus = Nothing, misOtrMutedRef = Nothing, misOtrArchived = Nothing, diff --git a/services/galley/src/Galley/Data/Queries.hs b/services/galley/src/Galley/Data/Queries.hs index 8ebdcddd5eb..a562b792f13 100644 --- a/services/galley/src/Galley/Data/Queries.hs +++ b/services/galley/src/Galley/Data/Queries.hs @@ -295,6 +295,9 @@ removeRemoteMember = "delete from member_remote_user where conv = ? and user_rem selectRemoteMembers :: PrepQuery R (Identity [ConvId]) (ConvId, Domain, UserId, RoleName) selectRemoteMembers = "select conv, user_remote_domain, user_remote_id, conversation_role from member_remote_user where conv in ?" +updateRemoteMemberConvRoleName :: PrepQuery W (RoleName, ConvId, Domain, UserId) () +updateRemoteMemberConvRoleName = "update member_remote_user set conversation_role = ? where conv = ? and user_remote_domain = ? and user_remote_id = ?" + -- local user with remote conversations insertUserRemoteConv :: PrepQuery W (UserId, Domain, ConvId) () diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index f1433ab53b3..c94f987dbb5 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -80,6 +80,7 @@ import TestHelpers import TestSetup import Util.Options (Endpoint (Endpoint)) import Wire.API.Conversation +import Wire.API.Conversation.Action import qualified Wire.API.Federation.API.Brig as FederatedBrig import Wire.API.Federation.API.Galley ( GetConversationsResponse (..), @@ -2603,7 +2604,7 @@ putQualifiedOtherMemberOk = do let qconv = Qualified conv (qDomain qbob) expectedMemberUpdateData = MemberUpdateData - { misTarget = Just alice, + { misTarget = qalice, misOtrMutedStatus = Nothing, misOtrMutedRef = Nothing, misOtrArchived = Nothing, @@ -2628,15 +2629,16 @@ putQualifiedOtherMemberOk = do putOtherMemberOk :: TestM () putOtherMemberOk = do c <- view tsCannon - alice <- randomUser + qalice <- randomQualifiedUser qbob <- randomQualifiedUser - let bob = qUnqualified qbob + let alice = qUnqualified qalice + bob = qUnqualified qbob connectUsers alice (singleton bob) conv <- decodeConvId <$> postConv alice [bob] (Just "gossip") [] Nothing Nothing let qconv = Qualified conv (qDomain qbob) expectedMemberUpdateData = MemberUpdateData - { misTarget = Just alice, + { misTarget = qalice, misOtrMutedStatus = Nothing, misOtrMutedRef = Nothing, misOtrArchived = Nothing, diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index f750c427791..e1b4065db23 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -27,7 +27,7 @@ import qualified Data.Aeson as A import Data.ByteString.Conversion (toByteString') import qualified Data.ByteString.Lazy as LBS import Data.Domain -import Data.Id (ConvId, Id (..), newClientId, randomId) +import Data.Id (ConvId, Id (..), UserId, newClientId, randomId) import Data.Json.Util (Base64ByteString (..), toBase64Text) import Data.List.NonEmpty (NonEmpty (..)) import Data.List1 @@ -48,7 +48,7 @@ import qualified Test.Tasty.Cannon as WS import Test.Tasty.HUnit import TestHelpers import TestSetup -import Wire.API.Conversation (ConversationAction (..)) +import Wire.API.Conversation.Action (ConversationAction (..)) import Wire.API.Conversation.Member (Member (..)) import Wire.API.Conversation.Role import Wire.API.Federation.API.Galley (GetConversationsRequest (..), GetConversationsResponse (..), RemoteConvMembers (..), RemoteConversation (..)) @@ -70,6 +70,7 @@ tests s = test s "POST /federation/on-conversation-updated : Remove a remote user from a remote conversation" removeRemoteUser, test s "POST /federation/on-conversation-updated : Notify local user about conversation rename" notifyConvRename, test s "POST /federation/on-conversation-updated : Notify local user about message timer update" notifyMessageTimer, + test s "POST /federation/on-conversation-updated : Notify local user about member update" notifyMemberUpdate, test s "POST /federation/leave-conversation : Success" leaveConversationSuccess, test s "POST /federation/on-message-sent : Receive a message from another backend" onMessageSent, test s "POST /federation/send-message : Post a message sent from another backend" sendMessage @@ -288,8 +289,8 @@ removeRemoteUser = do liftIO $ do afterRemoval @?= [qconv] -notifyConvRename :: TestM () -notifyConvRename = do +notifyUpdate :: [Qualified UserId] -> ConversationAction -> EventType -> EventData -> TestM () +notifyUpdate extras action etype edata = do c <- view tsCannon qalice <- randomQualifiedUser let alice = qUnqualified qalice @@ -299,10 +300,14 @@ notifyConvRename = do let bdom = Domain "bob.example.com" qbob = Qualified bob bdom qconv = Qualified conv bdom - aliceAsOtherMember = OtherMember qalice Nothing roleNameWireMember + mkMember quid = OtherMember quid Nothing roleNameWireMember fedGalleyClient <- view tsFedGalleyClient - registerRemoteConv qconv qbob (Just "gossip") (Set.singleton aliceAsOtherMember) + registerRemoteConv + qconv + qbob + (Just "gossip") + (Set.fromList (map mkMember (qalice : extras))) now <- liftIO getCurrentTime let cu = @@ -311,8 +316,7 @@ notifyConvRename = do FedGalley.cuOrigUserId = qbob, FedGalley.cuConvId = conv, FedGalley.cuAlreadyPresentUsers = [alice, charlie], - FedGalley.cuAction = - ConversationActionRename (ConversationRename "gossip++") + FedGalley.cuAction = action } WS.bracketR2 c alice charlie $ \(wsA, wsC) -> do FedGalley.onConversationUpdated fedGalleyClient bdom cu @@ -321,48 +325,44 @@ notifyConvRename = do let e = List1.head (WS.unpackPayload n) ntfTransient n @?= False evtConv e @?= qconv - evtType e @?= ConvRename + evtType e @?= etype evtFrom e @?= qbob - evtData e @?= EdConvRename (ConversationRename "gossip++") + evtData e @?= edata WS.assertNoEvent (1 # Second) [wsC] +notifyConvRename :: TestM () +notifyConvRename = do + let d = ConversationRename "gossip++" + notifyUpdate [] (ConversationActionRename d) ConvRename (EdConvRename d) + notifyMessageTimer :: TestM () notifyMessageTimer = do - c <- view tsCannon - qalice <- randomQualifiedUser - let alice = qUnqualified qalice - bob <- randomId - charlie <- randomUser - conv <- randomId - let bdom = Domain "bob.example.com" - qbob = Qualified bob bdom - qconv = Qualified conv bdom - aliceAsOtherMember = OtherMember qalice Nothing roleNameWireMember - fedGalleyClient <- view tsFedGalleyClient - - registerRemoteConv qconv qbob (Just "gossip") (Set.singleton aliceAsOtherMember) - - now <- liftIO getCurrentTime - let cu = - FedGalley.ConversationUpdate - { FedGalley.cuTime = now, - FedGalley.cuOrigUserId = qbob, - FedGalley.cuConvId = conv, - FedGalley.cuAlreadyPresentUsers = [alice, charlie], - FedGalley.cuAction = - ConversationActionMessageTimerUpdate (ConversationMessageTimerUpdate (Just 5000)) + let d = ConversationMessageTimerUpdate (Just 5000) + notifyUpdate + [] + (ConversationActionMessageTimerUpdate d) + ConvMessageTimerUpdate + (EdConvMessageTimerUpdate d) + +notifyMemberUpdate :: TestM () +notifyMemberUpdate = do + qdee <- randomQualifiedUser + let d = + MemberUpdateData + { misTarget = qdee, + misOtrMutedStatus = Nothing, + misOtrMutedRef = Nothing, + misOtrArchived = Nothing, + misOtrArchivedRef = Nothing, + misHidden = Nothing, + misHiddenRef = Nothing, + misConvRoleName = Just roleNameWireAdmin } - WS.bracketR2 c alice charlie $ \(wsA, wsC) -> do - FedGalley.onConversationUpdated fedGalleyClient bdom cu - liftIO $ do - WS.assertMatch_ (5 # Second) wsA $ \n -> do - let e = List1.head (WS.unpackPayload n) - ntfTransient n @?= False - evtConv e @?= qconv - evtType e @?= ConvMessageTimerUpdate - evtFrom e @?= qbob - evtData e @?= EdConvMessageTimerUpdate (ConversationMessageTimerUpdate (Just 5000)) - WS.assertNoEvent (1 # Second) [wsC] + notifyUpdate + [qdee] + (ConversationActionMemberUpdate d) + MemberStateUpdate + (EdMemberUpdate d) -- TODO: test adding non-existing users -- TODO: test adding resulting in an empty notification diff --git a/services/galley/test/integration/API/MessageTimer.hs b/services/galley/test/integration/API/MessageTimer.hs index e795e823972..276c597742b 100644 --- a/services/galley/test/integration/API/MessageTimer.hs +++ b/services/galley/test/integration/API/MessageTimer.hs @@ -45,7 +45,7 @@ import qualified Test.Tasty.Cannon as WS import Test.Tasty.HUnit import TestHelpers import TestSetup -import Wire.API.Conversation +import Wire.API.Conversation.Action import qualified Wire.API.Federation.API.Galley as F import qualified Wire.API.Federation.GRPC.Types as F import qualified Wire.API.Team.Member as Member diff --git a/services/galley/test/integration/API/Roles.hs b/services/galley/test/integration/API/Roles.hs index ae5d11d529d..7072998e57d 100644 --- a/services/galley/test/integration/API/Roles.hs +++ b/services/galley/test/integration/API/Roles.hs @@ -21,19 +21,29 @@ import API.Util import Bilge hiding (timeout) import Bilge.Assert import Control.Lens (view) +import Data.Aeson (eitherDecode) import Data.ByteString.Conversion (toByteString') +import qualified Data.ByteString.Lazy as LBS +import Data.Domain import Data.Id import Data.List1 +import qualified Data.List1 as List1 import Data.Qualified import Galley.Types import Galley.Types.Conversations.Roles +import Gundeck.Types.Notification (Notification (..)) import Imports import Network.Wai.Utilities.Error import Test.Tasty import Test.Tasty.Cannon (TimeoutUnit (..), (#)) import qualified Test.Tasty.Cannon as WS +import Test.Tasty.HUnit import TestHelpers import TestSetup +import Wire.API.Conversation.Action +import qualified Wire.API.Federation.API.Galley as F +import qualified Wire.API.Federation.GRPC.Types as F +import Wire.API.User tests :: IO TestSetup -> TestTree tests s = @@ -41,6 +51,8 @@ tests s = "Conversation roles" [ test s "conversation roles admin (and downgrade)" handleConversationRoleAdmin, test s "conversation roles member (and upgrade)" handleConversationRoleMember, + test s "conversation role update with remote users present" roleUpdateWithRemotes, + test s "conversation role update of remote member" roleUpdateRemoteMember, test s "get all conversation roles" testAllConversationRoles ] @@ -144,6 +156,135 @@ handleConversationRoleMember = do wsAssertMemberUpdateWithRole qcid qalice bob roleNameWireAdmin wireAdminChecks cid bob alice chuck +roleUpdateRemoteMember :: TestM () +roleUpdateRemoteMember = do + c <- view tsCannon + let remoteDomain = Domain "alice.example.com" + qalice <- Qualified <$> randomId <*> pure remoteDomain + qbob <- randomQualifiedUser + qcharlie <- Qualified <$> randomId <*> pure remoteDomain + let bob = qUnqualified qbob + + resp <- + postConvWithRemoteUsers + remoteDomain + [mkProfile qalice (Name "Alice"), mkProfile qcharlie (Name "Charlie")] + bob + [qalice, qcharlie] + let qconv = decodeQualifiedConvId resp + + opts <- view tsGConf + WS.bracketR c bob $ \wsB -> do + (_, requests) <- + withTempMockFederator opts remoteDomain (const ()) $ + putOtherMemberQualified + bob + qcharlie + (OtherMemberUpdate (Just roleNameWireMember)) + qconv + !!! const 200 === statusCode + + req <- assertOne requests + let mu = + MemberUpdateData + { misTarget = qcharlie, + misOtrMutedStatus = Nothing, + misOtrMutedRef = Nothing, + misOtrArchived = Nothing, + misOtrArchivedRef = Nothing, + misHidden = Nothing, + misHiddenRef = Nothing, + misConvRoleName = Just roleNameWireMember + } + liftIO $ do + F.domain req @?= domainText remoteDomain + fmap F.component (F.request req) @?= Just F.Galley + fmap F.path (F.request req) @?= Just "/federation/on-conversation-updated" + Just (Right cu) <- pure $ fmap (eitherDecode . LBS.fromStrict . F.body) (F.request req) + F.cuConvId cu @?= qUnqualified qconv + F.cuAction cu + @?= ConversationActionMemberUpdate mu + sort (F.cuAlreadyPresentUsers cu) @?= sort [qUnqualified qalice, qUnqualified qcharlie] + + liftIO . WS.assertMatch_ (5 # Second) wsB $ \n -> do + let e = List1.head (WS.unpackPayload n) + ntfTransient n @?= False + evtConv e @?= qconv + evtType e @?= MemberStateUpdate + evtFrom e @?= qbob + evtData e @?= EdMemberUpdate mu + + conv <- responseJsonError =<< getConvQualified bob qconv omQualifiedId m == qcharlie) (cmOthers (cnvMembers conv)) + liftIO $ + charlieAsMember + @=? Just + OtherMember + { omQualifiedId = qcharlie, + omService = Nothing, + omConvRoleName = roleNameWireMember + } + +roleUpdateWithRemotes :: TestM () +roleUpdateWithRemotes = do + c <- view tsCannon + let remoteDomain = Domain "alice.example.com" + qalice <- Qualified <$> randomId <*> pure remoteDomain + qbob <- randomQualifiedUser + qcharlie <- randomQualifiedUser + let bob = qUnqualified qbob + charlie = qUnqualified qcharlie + + connectUsers bob (singleton charlie) + resp <- + postConvWithRemoteUser + remoteDomain + (mkProfile qalice (Name "Alice")) + bob + [qalice, qcharlie] + let qconv = decodeQualifiedConvId resp + + opts <- view tsGConf + WS.bracketR2 c bob charlie $ \(wsB, wsC) -> do + (_, requests) <- + withTempMockFederator opts remoteDomain (const ()) $ + putOtherMemberQualified + bob + qcharlie + (OtherMemberUpdate (Just roleNameWireAdmin)) + qconv + !!! const 200 === statusCode + + req <- assertOne requests + let mu = + MemberUpdateData + { misTarget = qcharlie, + misOtrMutedStatus = Nothing, + misOtrMutedRef = Nothing, + misOtrArchived = Nothing, + misOtrArchivedRef = Nothing, + misHidden = Nothing, + misHiddenRef = Nothing, + misConvRoleName = Just roleNameWireAdmin + } + liftIO $ do + F.domain req @?= domainText remoteDomain + fmap F.component (F.request req) @?= Just F.Galley + fmap F.path (F.request req) @?= Just "/federation/on-conversation-updated" + Just (Right cu) <- pure $ fmap (eitherDecode . LBS.fromStrict . F.body) (F.request req) + F.cuConvId cu @?= qUnqualified qconv + F.cuAction cu + @?= ConversationActionMemberUpdate mu + F.cuAlreadyPresentUsers cu @?= [qUnqualified qalice] + + liftIO . WS.assertMatchN_ (5 # Second) [wsB, wsC] $ \n -> do + let e = List1.head (WS.unpackPayload n) + ntfTransient n @?= False + evtConv e @?= qconv + evtType e @?= MemberStateUpdate + evtFrom e @?= qbob + evtData e @?= EdMemberUpdate mu + -- | Given an admin, another admin and a member run all -- the necessary checks targeting the admin wireAdminChecks :: diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index c08e7a9ee53..2a279694b6f 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -107,6 +107,7 @@ import Util.Options import Web.Cookie import Wire.API.Conversation import qualified Wire.API.Conversation as Public +import Wire.API.Conversation.Action import Wire.API.Event.Conversation (_EdMembersJoin, _EdMembersLeave) import qualified Wire.API.Event.Team as TE import qualified Wire.API.Federation.API.Brig as FederatedBrig @@ -557,7 +558,11 @@ postConvQualified :: (HasGalley m, MonadIO m, MonadMask m, MonadHttp m) => UserI postConvQualified u us name a r mtimer = postConvWithRoleQualified us u [] name a r mtimer roleNameWireAdmin postConvWithRemoteUser :: Domain -> UserProfile -> UserId -> [Qualified UserId] -> TestM (Response (Maybe LByteString)) -postConvWithRemoteUser remoteDomain user creatorUnqualified members = do +postConvWithRemoteUser remoteDomain user creatorUnqualified members = + postConvWithRemoteUsers remoteDomain [user] creatorUnqualified members + +postConvWithRemoteUsers :: Domain -> [UserProfile] -> UserId -> [Qualified UserId] -> TestM (Response (Maybe LByteString)) +postConvWithRemoteUsers remoteDomain users creatorUnqualified members = do opts <- view tsGConf fmap fst $ withTempMockFederator @@ -570,7 +575,7 @@ postConvWithRemoteUser remoteDomain user creatorUnqualified members = do respond :: F.FederatedRequest -> Value respond req | fmap F.component (F.request req) == Just F.Brig = - toJSON [user] + toJSON users | otherwise = toJSON () postTeamConv :: TeamId -> UserId -> [UserId] -> Maybe Text -> [Access] -> Maybe AccessRole -> Maybe Milliseconds -> TestM ResponseLBS @@ -958,13 +963,14 @@ putMember u m (Qualified c dom) = do . json m putOtherMemberQualified :: + (HasGalley m, MonadIO m, MonadHttp m) => UserId -> Qualified UserId -> OtherMemberUpdate -> Qualified ConvId -> - TestM ResponseLBS + m ResponseLBS putOtherMemberQualified from to m c = do - g <- view tsGalley + g <- viewGalley put $ g . paths @@ -1377,7 +1383,7 @@ wsAssertMemberUpdateWithRole conv usr target role n = do evtFrom e @?= usr case evtData e of Conv.EdMemberUpdate mis -> do - assertEqual "target" (Just target) (misTarget mis) + assertEqual "target" (Qualified target (qDomain conv)) (misTarget mis) assertEqual "conversation_role" (Just role) (misConvRoleName mis) x -> assertFailure $ "Unexpected event data: " ++ show x @@ -1426,7 +1432,7 @@ assertRemoveUpdate req qconvId remover alreadyPresentUsers victim = liftIO $ do FederatedGalley.cuOrigUserId cu @?= remover FederatedGalley.cuConvId cu @?= qUnqualified qconvId sort (FederatedGalley.cuAlreadyPresentUsers cu) @?= sort alreadyPresentUsers - FederatedGalley.cuAction cu @?= Public.ConversationActionRemoveMembers (pure victim) + FederatedGalley.cuAction cu @?= ConversationActionRemoveMembers (pure victim) ------------------------------------------------------------------------------- -- Helpers diff --git a/tools/api-simulations/smoketest/src/Network/Wire/Simulations/SmokeTest.hs b/tools/api-simulations/smoketest/src/Network/Wire/Simulations/SmokeTest.hs index 56ed6bf0ddf..e3787eb3e5f 100644 --- a/tools/api-simulations/smoketest/src/Network/Wire/Simulations/SmokeTest.hs +++ b/tools/api-simulations/smoketest/src/Network/Wire/Simulations/SmokeTest.hs @@ -28,7 +28,7 @@ import qualified Codec.MIME.Type as MIME import qualified Data.ByteString.Lazy as LBS import Data.Id (ConvId) import Data.List1 -import Data.Qualified (qUnqualified) +import Data.Qualified (Qualified (..), qUnqualified) import Data.Range import Imports import Network.Wire.Bot @@ -92,10 +92,11 @@ mainBotNet n = do assertConvCreated conv ally others return conv info $ msg "Bill updates his member state" + localDomain <- viewFederationDomain runBotSession bill $ do let update = MemberUpdateData - { misTarget = Just $ botId bill, + { misTarget = Qualified (botId bill) localDomain, misOtrMutedStatus = Nothing, misOtrMutedRef = Nothing, misOtrArchived = Just True, From 0ba7f2cf7cfac5224175c822fcd02888b0a9139b Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 23 Sep 2021 08:23:35 +0200 Subject: [PATCH 48/72] Make sure that unnamed schemas are referenced (#1802) This changes the Swagger implementation of `unnamed` in schema-profunctor to drop the name, but still declare the corresponding named schema. Now even unnamed schemas that are not actually referenced anywhere will appear in the list of schemas in Swagger. Also changed the name of the schema for `SimpleMember` to make it reflect the Haskell type name. Thanks @atomrc for reporting this issue. --- changelog.d/4-docs/reference-schemas | 1 + libs/schema-profunctor/src/Data/Schema.hs | 4 +++- libs/wire-api/src/Wire/API/Event/Conversation.hs | 2 +- 3 files changed, 5 insertions(+), 2 deletions(-) create mode 100644 changelog.d/4-docs/reference-schemas diff --git a/changelog.d/4-docs/reference-schemas b/changelog.d/4-docs/reference-schemas new file mode 100644 index 00000000000..825bdb78edf --- /dev/null +++ b/changelog.d/4-docs/reference-schemas @@ -0,0 +1 @@ +All named Swagger schemas are now displayed in the Swagger UI diff --git a/libs/schema-profunctor/src/Data/Schema.hs b/libs/schema-profunctor/src/Data/Schema.hs index 634334e9a3f..9369ed4f79f 100644 --- a/libs/schema-profunctor/src/Data/Schema.hs +++ b/libs/schema-profunctor/src/Data/Schema.hs @@ -708,7 +708,9 @@ instance HasSchemaRef doc => HasField doc SwaggerDoc where instance HasObject SwaggerDoc NamedSwaggerDoc where mkObject name decl = S.NamedSchema (Just name) <$> decl - unmkObject = fmap S._namedSchemaSchema + unmkObject (WithDeclare d (S.NamedSchema Nothing s)) = WithDeclare d s + unmkObject (WithDeclare d (S.NamedSchema (Just n) s)) = + WithDeclare (d *> S.declare [(n, s)]) s instance HasSchemaRef ndoc => HasArray ndoc SwaggerDoc where mkArray = fmap f . schemaRef diff --git a/libs/wire-api/src/Wire/API/Event/Conversation.hs b/libs/wire-api/src/Wire/API/Event/Conversation.hs index 7ec2aef4d8c..bc65f7ccead 100644 --- a/libs/wire-api/src/Wire/API/Event/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Event/Conversation.hs @@ -313,7 +313,7 @@ newtype SimpleMembers = SimpleMembers instance ToSchema SimpleMembers where schema = - object "Members" $ + object "SimpleMembers" $ SimpleMembers <$> mMembers .= field "users" (array schema) <* (fmap smId . mMembers) From f442d0b47ed9f246e91111f2241f5c030f12b81c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Thu, 23 Sep 2021 14:03:47 +0200 Subject: [PATCH 49/72] [Federation] When Deleting a User, Remove Them From Remote Conversations (#1790) * This renames local conversation-specific functions to prepare ground for equivalents for remote conversations * Leave remote conversations for a deleted user * Paginate through local and remote conversations in a unified way * A futurework note is slightly misinformed; it is that this user is in a local or remote conversation, and not that a remote member is considered with respect to a local or remote conversation. * Include a remote conversation in the 'removeUser' integration test Co-authored-by: Paolo Capriotti --- .../remote-conversations-when-deleting-user | 1 + services/galley/src/Galley/API/Federation.hs | 2 +- services/galley/src/Galley/API/Internal.hs | 51 ++++++++++---- services/galley/src/Galley/API/Query.hs | 6 +- services/galley/src/Galley/Data.hs | 14 ++-- services/galley/test/integration/API.hs | 67 +++++++++++++++---- services/galley/test/integration/API/Util.hs | 6 +- 7 files changed, 106 insertions(+), 41 deletions(-) create mode 100644 changelog.d/6-federation/remote-conversations-when-deleting-user diff --git a/changelog.d/6-federation/remote-conversations-when-deleting-user b/changelog.d/6-federation/remote-conversations-when-deleting-user new file mode 100644 index 00000000000..fa4d5416572 --- /dev/null +++ b/changelog.d/6-federation/remote-conversations-when-deleting-user @@ -0,0 +1 @@ +Remove a user from remote conversations upon deleting their account diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 047a74834c8..9d9d0c20d7f 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -104,7 +104,7 @@ getConversations domain (GetConversationsRequest uid cids) = do GetConversationsResponse . catMaybes . map (Mapping.conversationToRemote localDomain ruid) - <$> Data.conversations cids + <$> Data.localConversations cids getLocalUsers :: Domain -> NonEmpty (Qualified UserId) -> [UserId] getLocalUsers localDomain = map qUnqualified . filter ((== localDomain) . qDomain) . toList diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 6758b734286..39b39dd8a51 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -29,9 +29,10 @@ import qualified Cassandra as Cql import Control.Exception.Safe (catchAny) import Control.Lens hiding ((.=)) import Control.Monad.Catch (MonadCatch) +import Data.Data (Proxy (Proxy)) import Data.Id as Id import Data.List1 (maybeList1) -import Data.Qualified (Qualified (Qualified)) +import Data.Qualified (Local, Qualified (..), Remote, lUnqualified, partitionRemoteOrLocalIds') import Data.Range import Data.String.Conversions (cs) import GHC.TypeLits (AppendSymbol) @@ -47,7 +48,7 @@ import qualified Galley.API.Teams as Teams import Galley.API.Teams.Features (DoAuth (..)) import qualified Galley.API.Teams.Features as Features import qualified Galley.API.Update as Update -import Galley.API.Util (JSON, isMember, viewFederationDomain) +import Galley.API.Util (JSON, isMember, qualifyLocal, viewFederationDomain) import Galley.App import qualified Galley.Data as Data import qualified Galley.Intra.Push as Intra @@ -72,7 +73,9 @@ import Servant.API.Generic import Servant.Server import Servant.Server.Generic (genericServerT) import System.Logger.Class hiding (Path, name) +import Wire.API.Conversation (ConvIdsPage, pattern GetPaginatedConversationIds) import Wire.API.ErrorDescription (MissingLegalholdConsent) +import Wire.API.Routes.MultiTablePaging (mtpHasMore, mtpPagingState, mtpResults) import Wire.API.Routes.MultiVerb (MultiVerb, RespondEmpty) import Wire.API.Routes.Public (ZOptConn, ZUser) import qualified Wire.API.Team.Feature as Public @@ -438,29 +441,49 @@ sitemap = do rmUser :: UserId -> Maybe ConnId -> Galley () rmUser user conn = do - let n = unsafeRange 100 :: Range 1 100 Int32 - tids <- Data.teamIdsForPagination user Nothing (rcast n) + let n = toRange (Proxy @100) :: Range 1 100 Int32 + nRange1000 = rcast n :: Range 1 1000 Int32 + tids <- Data.teamIdsForPagination user Nothing n leaveTeams tids - cids <- Data.conversationIdRowsForPagination user Nothing (rcast n) - leaveConversations user cids + allConvIds <- Query.conversationIdsPageFrom user (GetPaginatedConversationIds Nothing nRange1000) + lusr <- qualifyLocal user + goConvPages lusr nRange1000 allConvIds Data.eraseClients user where + goConvPages :: Local UserId -> Range 1 1000 Int32 -> ConvIdsPage -> Galley () + goConvPages lusr range page = do + localDomain <- viewFederationDomain + let (remoteConvs, localConvs) = partitionRemoteOrLocalIds' localDomain . mtpResults $ page + leaveLocalConversations localConvs + leaveRemoteConversations lusr remoteConvs + when (mtpHasMore page) $ do + let nextState = mtpPagingState page + usr = lUnqualified lusr + nextQuery = GetPaginatedConversationIds (Just nextState) range + newCids <- Query.conversationIdsPageFrom usr nextQuery + goConvPages lusr range newCids + 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 :: UserId -> Cql.Page ConvId -> Galley () - leaveConversations u ids = do + + leaveLocalConversations :: [ConvId] -> Galley () + leaveLocalConversations ids = do localDomain <- viewFederationDomain - cc <- Data.conversations (Cql.result ids) + cc <- Data.localConversations ids pp <- for cc $ \c -> case Data.convType c of SelfConv -> return Nothing One2OneConv -> Data.removeMember user (Data.convId c) >> return Nothing ConnectConv -> Data.removeMember user (Data.convId c) >> return Nothing RegularConv | user `isMember` Data.convLocalMembers c -> do - -- FUTUREWORK: deal with remote members, too, see removeMembers - e <- Data.removeLocalMembersFromLocalConv localDomain c (Qualified user localDomain) (pure u) + e <- + Data.removeLocalMembersFromLocalConv + localDomain + c + (Qualified user localDomain) + (pure user) return $ Intra.newPushLocal ListComplete user (Intra.ConvEvent e) (Intra.recipient <$> Data.convLocalMembers c) <&> set Intra.pushConn conn @@ -469,8 +492,10 @@ rmUser user conn = do for_ (maybeList1 (catMaybes pp)) Intra.push - unless (null $ Cql.result ids) $ - leaveConversations u =<< Cql.liftClient (Cql.nextPage ids) + + leaveRemoteConversations :: Foldable t => Local UserId -> t (Remote ConvId) -> Galley () + leaveRemoteConversations (unTagged -> qusr) cids = + for_ cids $ \(Tagged cid) -> Update.removeMember qusr Nothing cid qusr deleteLoop :: Galley () deleteLoop = do diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 0310c967b96..cd7a495ff5a 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -266,7 +266,7 @@ getConversationsInternal user mids mstart msize = do (more, ids) <- getIds mids let localConvIds = ids cs <- - Data.conversations localConvIds + Data.localConversations localConvIds >>= filterM removeDeleted >>= filterM (pure . isMember user . Data.convLocalMembers) pure $ Public.ConversationList cs more @@ -305,7 +305,7 @@ listConversations user (Public.ListConversations mIds qstart msize) = do pure (localMore, localConvIds, remoteConvIds) localInternalConversations <- - Data.conversations localConvIds + Data.localConversations localConvIds >>= filterM removeDeleted >>= filterM (pure . isMember user . Data.convLocalMembers) localConversations <- mapM (Mapping.conversationView user) localInternalConversations @@ -342,7 +342,7 @@ listConversationsV2 user (Public.ListConversationsV2 ids) = do (foundLocalIds, notFoundLocalIds) <- foundsAndNotFounds (Data.localConversationIdsOf user) localIds localInternalConversations <- - Data.conversations foundLocalIds + Data.localConversations foundLocalIds >>= filterM removeDeleted >>= filterM (pure . isMember user . Data.convLocalMembers) localConversations <- mapM (Mapping.conversationView user) localInternalConversations diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index 379d6a0f533..d2e97f046ee 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -62,8 +62,8 @@ module Galley.Data localConversationIdsOf, remoteConversationStatus, localConversationIdsPageFrom, - conversationIdRowsForPagination, - conversations, + localConversationIdRowsForPagination, + localConversations, conversationMeta, conversationsRemote, createConnectConversation, @@ -503,12 +503,12 @@ conversationGC conv = case join (convDeleted <$> conv) of return Nothing _ -> return conv -conversations :: +localConversations :: (MonadLogger m, MonadUnliftIO m, MonadClient m) => [ConvId] -> m [Conversation] -conversations [] = return [] -conversations ids = do +localConversations [] = return [] +localConversations ids = do convs <- async fetchConvs mems <- async $ memberLists ids remoteMems <- async $ remoteMemberLists ids @@ -580,8 +580,8 @@ remoteConversationIdsPageFrom :: (MonadClient m) => UserId -> Maybe PagingState remoteConversationIdsPageFrom usr pagingState max = uncurry (flip Qualified) <$$> paginateWithState Cql.selectUserRemoteConvs (paramsPagingState Quorum (Identity usr) max pagingState) -conversationIdRowsForPagination :: MonadClient m => UserId -> Maybe ConvId -> Range 1 1000 Int32 -> m (Page ConvId) -conversationIdRowsForPagination usr start (fromRange -> max) = +localConversationIdRowsForPagination :: MonadClient m => UserId -> Maybe ConvId -> Range 1 1000 Int32 -> m (Page ConvId) +localConversationIdRowsForPagination usr start (fromRange -> max) = runIdentity <$$> case start of Just c -> paginate Cql.selectUserConvsFrom (paramsP Quorum (usr, c) max) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index c94f987dbb5..e670cd4ed22 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -2932,19 +2932,50 @@ postTypingIndicators = do removeUser :: TestM () removeUser = do c <- view tsCannon - alice <- randomUser - bob <- randomQualifiedUser - carl <- randomQualifiedUser - let carl' = qUnqualified carl - let bob' = qUnqualified bob - connectUsers alice (list1 bob' [carl']) - conv1 <- decodeConvId <$> postConv alice [bob'] (Just "gossip") [] Nothing Nothing - conv2 <- decodeConvId <$> postConv alice [bob', carl'] (Just "gossip2") [] Nothing Nothing - conv3 <- decodeConvId <$> postConv alice [carl'] (Just "gossip3") [] Nothing Nothing + let remoteDomain = Domain "far-away.example.com" + [alice, bob, carl] <- replicateM 3 randomQualifiedUser + dee <- (`Qualified` remoteDomain) <$> randomId + let [alice', bob', carl'] = qUnqualified <$> [alice, bob, carl] + connectUsers alice' (list1 bob' [carl']) + conv1 <- decodeConvId <$> postConv alice' [bob'] (Just "gossip") [] Nothing Nothing + conv2 <- decodeConvId <$> postConv alice' [bob', carl'] (Just "gossip2") [] Nothing Nothing + conv3 <- decodeConvId <$> postConv alice' [carl'] (Just "gossip3") [] Nothing Nothing + conv4 <- randomId -- a remote conversation at 'remoteDomain' that Alice, Bob and Dee will be in let qconv1 = Qualified conv1 (qDomain bob) qconv2 = Qualified conv2 (qDomain bob) - WS.bracketR3 c alice bob' carl' $ \(wsA, wsB, wsC) -> do - deleteUser bob' + + now <- liftIO getCurrentTime + fedGalleyClient <- view tsFedGalleyClient + let nc = + FederatedGalley.NewRemoteConversation + { FederatedGalley.rcTime = now, + FederatedGalley.rcOrigUserId = dee, + FederatedGalley.rcCnvId = conv4, + FederatedGalley.rcCnvType = RegularConv, + FederatedGalley.rcCnvAccess = [], + FederatedGalley.rcCnvAccessRole = PrivateAccessRole, + FederatedGalley.rcCnvName = Just "gossip4", + FederatedGalley.rcMembers = Set.fromList $ createOtherMember <$> [dee, alice, bob], + FederatedGalley.rcMessageTimer = Nothing, + FederatedGalley.rcReceiptMode = Nothing + } + FederatedGalley.onConversationCreated fedGalleyClient remoteDomain nc + + WS.bracketR3 c alice' bob' carl' $ \(wsA, wsB, wsC) -> do + opts <- view tsGConf + (_, fedRequests) <- + withTempMockFederator opts remoteDomain (const (FederatedGalley.LeaveConversationResponse (Right ()))) $ + deleteUser bob' !!! const 200 === statusCode + + req <- assertOne fedRequests + liftIO $ do + F.domain req @?= domainText remoteDomain + fmap F.component (F.request req) @?= Just F.Galley + fmap F.path (F.request req) @?= Just "/federation/leave-conversation" + Just (Right lc) <- pure $ fmap (eitherDecode . LBS.fromStrict . F.body) (F.request req) + FederatedGalley.lcConvId lc @?= conv4 + FederatedGalley.lcLeaver lc @?= qUnqualified bob + void . liftIO $ WS.assertMatchN (5 # Second) [wsA, wsB] $ wsAssertMembersLeave qconv1 bob [bob] @@ -2952,9 +2983,9 @@ removeUser = do WS.assertMatchN (5 # Second) [wsA, wsB, wsC] $ wsAssertMembersLeave qconv2 bob [bob] -- Check memberships - mems1 <- fmap cnvMembers . responseJsonUnsafe <$> getConv alice conv1 - mems2 <- fmap cnvMembers . responseJsonUnsafe <$> getConv alice conv2 - mems3 <- fmap cnvMembers . responseJsonUnsafe <$> getConv alice conv3 + mems1 <- fmap cnvMembers . responseJsonUnsafe <$> getConv alice' conv1 + mems2 <- fmap cnvMembers . responseJsonUnsafe <$> getConv alice' conv2 + mems3 <- fmap cnvMembers . responseJsonUnsafe <$> getConv alice' conv3 let other u = find ((== u) . omQualifiedId) . cmOthers liftIO $ do (mems1 >>= other bob) @?= Nothing @@ -2962,3 +2993,11 @@ removeUser = do (mems2 >>= other carl) @?= Just (OtherMember carl Nothing roleNameWireAdmin) (mems3 >>= other bob) @?= Nothing (mems3 >>= other carl) @?= Just (OtherMember carl Nothing roleNameWireAdmin) + where + createOtherMember :: Qualified UserId -> OtherMember + createOtherMember quid = + OtherMember + { omQualifiedId = quid, + omService = Nothing, + omConvRoleName = roleNameWireAdmin + } diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 2a279694b6f..3edbef5d300 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -1168,10 +1168,10 @@ deleteClientInternal u c = do . zConn "conn" . paths ["i", "clients", toByteString' c] -deleteUser :: HasCallStack => UserId -> TestM () +deleteUser :: (MonadIO m, MonadCatch m, MonadHttp m, HasGalley m, HasCallStack) => UserId -> m ResponseLBS deleteUser u = do - g <- view tsGalley - delete (g . path "/i/user" . zUser u) !!! const 200 === statusCode + g <- viewGalley + delete (g . path "/i/user" . zUser u) getTeamQueue :: HasCallStack => UserId -> Maybe NotificationId -> Maybe (Int, Bool) -> Bool -> TestM [(NotificationId, UserId)] getTeamQueue zusr msince msize onlyLast = From c4a6c294c08d2e8cd0b9dc93861e338776bb995b Mon Sep 17 00:00:00 2001 From: jschaul Date: Thu, 23 Sep 2021 20:02:57 +0200 Subject: [PATCH 50/72] Federation: endpoints for remote connection handling; qualified connections (#1773) * Introduce 4 endpoints for create/update/get/list connections including remote ones: all endpoints allow for remote connections in structure but are only implemented for local connections in practice. Actual remote functionality to be done in follow-up PRs * `list-connections` has been added to nginz config: requires nginz deployment * Qualify connections (for the remote user) in the return type. Partially implements https://wearezeta.atlassian.net/browse/SQCORE-720 (arguably events also need to be updated for that task to be done; or a new task has to be created) * Introduce a `LocalConnection` data type to separate the cassandra concerns from the outer json layer concerns (before the same object was used). --- changelog.d/0-release-notes/pr-1773 | 1 + .../1-api-changes/create-connection.md | 1 + changelog.d/1-api-changes/get-connection.md | 1 + changelog.d/1-api-changes/list-connections.md | 1 + .../1-api-changes/update-connection.md | 1 + changelog.d/6-federation/pr-1773 | 1 + .../6-federation/qualified-connections.md | 1 + charts/nginz/values.yaml | 3 + libs/api-bot/src/Network/Wire/Bot/Assert.hs | 4 +- libs/brig-types/src/Brig/Types/Connection.hs | 6 + libs/brig-types/src/Brig/Types/User/Event.hs | 11 +- libs/wire-api/src/Wire/API/Connection.hs | 40 ++- .../src/Wire/API/Routes/MultiTablePaging.hs | 2 +- .../src/Wire/API/Routes/Public/Brig.hs | 66 +++- .../src/Wire/API/Routes/Public/Util.hs | 2 + .../testObject_UserConnectionList_user_1.json | 12 + .../testObject_UserConnection_user_1.json | 4 + .../testObject_UserConnection_user_2.json | 8 + .../Generated/UserConnectionList_user.hs | 10 +- .../Golden/Generated/UserConnection_user.hs | 10 +- services/brig/src/Brig/API/Connection.hs | 198 +++++----- services/brig/src/Brig/API/Public.hs | 79 +++- services/brig/src/Brig/Data/Connection.hs | 101 ++++-- services/brig/src/Brig/IO/Intra.hs | 4 +- .../test/integration/API/User/Connection.hs | 337 +++++++++++++++++- .../brig/test/integration/API/User/Util.hs | 34 +- services/brig/test/integration/Util.hs | 31 +- .../test/integration/API/Teams/LegalHold.hs | 6 +- services/galley/test/integration/API/Util.hs | 2 +- .../lib/src/Network/Wire/Simulations.hs | 2 +- .../src/Network/Wire/Simulations/SmokeTest.hs | 2 +- tools/stern/src/Stern/Intra.hs | 5 +- 32 files changed, 817 insertions(+), 169 deletions(-) create mode 100644 changelog.d/0-release-notes/pr-1773 create mode 100644 changelog.d/1-api-changes/create-connection.md create mode 100644 changelog.d/1-api-changes/get-connection.md create mode 100644 changelog.d/1-api-changes/list-connections.md create mode 100644 changelog.d/1-api-changes/update-connection.md create mode 100644 changelog.d/6-federation/pr-1773 create mode 100644 changelog.d/6-federation/qualified-connections.md diff --git a/changelog.d/0-release-notes/pr-1773 b/changelog.d/0-release-notes/pr-1773 new file mode 100644 index 00000000000..e7fc3d3137f --- /dev/null +++ b/changelog.d/0-release-notes/pr-1773 @@ -0,0 +1 @@ +For Wire.com Cloud operators: Reminder to also deploy nginz. (No special action needed for on-premise operators) diff --git a/changelog.d/1-api-changes/create-connection.md b/changelog.d/1-api-changes/create-connection.md new file mode 100644 index 00000000000..1d0e494731c --- /dev/null +++ b/changelog.d/1-api-changes/create-connection.md @@ -0,0 +1 @@ +Add endpoint `POST /connections/:domain/:userId` to create a connection diff --git a/changelog.d/1-api-changes/get-connection.md b/changelog.d/1-api-changes/get-connection.md new file mode 100644 index 00000000000..40c8876aa96 --- /dev/null +++ b/changelog.d/1-api-changes/get-connection.md @@ -0,0 +1 @@ +Add endpoint `GET /connections/:domain/:userId` to get a single connection diff --git a/changelog.d/1-api-changes/list-connections.md b/changelog.d/1-api-changes/list-connections.md new file mode 100644 index 00000000000..d0943540ee8 --- /dev/null +++ b/changelog.d/1-api-changes/list-connections.md @@ -0,0 +1 @@ +Add `POST /list-connections` endpoint to get connections diff --git a/changelog.d/1-api-changes/update-connection.md b/changelog.d/1-api-changes/update-connection.md new file mode 100644 index 00000000000..1d90098bf4f --- /dev/null +++ b/changelog.d/1-api-changes/update-connection.md @@ -0,0 +1 @@ +Add endpoint `PUT /connections/:domain/:userId` to update a connection diff --git a/changelog.d/6-federation/pr-1773 b/changelog.d/6-federation/pr-1773 new file mode 100644 index 00000000000..649ed3508c5 --- /dev/null +++ b/changelog.d/6-federation/pr-1773 @@ -0,0 +1 @@ +4 endpoints for create/update/get/list connections designed for remote users in mind. So far, the implementation only works for local users (actual implementation will come as a follow-up) diff --git a/changelog.d/6-federation/qualified-connections.md b/changelog.d/6-federation/qualified-connections.md new file mode 100644 index 00000000000..a128f7f4d70 --- /dev/null +++ b/changelog.d/6-federation/qualified-connections.md @@ -0,0 +1 @@ +The returned `connection` object now has a `qualified_to` field with the domain of the (potentially remote) user. diff --git a/charts/nginz/values.yaml b/charts/nginz/values.yaml index 9a597b3ee29..3773dd2aed2 100644 --- a/charts/nginz/values.yaml +++ b/charts/nginz/values.yaml @@ -97,6 +97,9 @@ nginx_conf: - path: /connections envs: - all + - path: ~* ^/list-connections$ + envs: + - all - path: /invitations envs: - all diff --git a/libs/api-bot/src/Network/Wire/Bot/Assert.hs b/libs/api-bot/src/Network/Wire/Bot/Assert.hs index 039c923eee4..4140b3ff33a 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Assert.hs +++ b/libs/api-bot/src/Network/Wire/Bot/Assert.hs @@ -123,13 +123,13 @@ connStatus :: UserId -> UserId -> Relation -> Event -> Bool connStatus from to rel = \case EConnection c _ -> ucFrom c == from - && ucTo c == to + && qUnqualified (ucTo c) == to && ucStatus c == rel _ -> False memberJoined :: UserId -> UserId -> Event -> Bool memberJoined from other = \case EMemberJoin m -> - null (toList (fmap smId $ mMembers (convEvtData m)) \\ [other, from]) + null (toList (smId <$> mMembers (convEvtData m)) \\ [other, from]) && convEvtFrom m == from _ -> False diff --git a/libs/brig-types/src/Brig/Types/Connection.hs b/libs/brig-types/src/Brig/Types/Connection.hs index a606894f767..dc80c88c750 100644 --- a/libs/brig-types/src/Brig/Types/Connection.hs +++ b/libs/brig-types/src/Brig/Types/Connection.hs @@ -58,6 +58,12 @@ data ConnectionsStatusRequest = ConnectionsStatusRequest } deriving (Eq, Show, Generic) +-- FUTUREWORK: This needs to get Qualified IDs when implementing +-- Legalhold + Federation, as it's used in the internal +-- putConnectionInternal / galley->Brig "/i/users/connections-status" +-- endpoint. +-- Internal RPCs need to be updated accordingly. +-- See https://wearezeta.atlassian.net/browse/SQCORE-973 data UpdateConnectionsInternal = BlockForMissingLHConsent UserId [UserId] | RemoveLHBlocksInvolving UserId diff --git a/libs/brig-types/src/Brig/Types/User/Event.hs b/libs/brig-types/src/Brig/Types/User/Event.hs index 180b6f765a3..efe7c991f88 100644 --- a/libs/brig-types/src/Brig/Types/User/Event.hs +++ b/libs/brig-types/src/Brig/Types/User/Event.hs @@ -23,6 +23,7 @@ import Brig.Types import Data.ByteString.Conversion import Data.Handle (Handle) import Data.Id +import Data.Qualified (Qualified (Qualified)) import Imports import System.Logger.Class @@ -179,8 +180,14 @@ propEventUserId (PropertySet u _ _) = u propEventUserId (PropertyDeleted u _) = u propEventUserId (PropertiesCleared u) = u -logConnection :: UserId -> UserId -> Msg -> Msg -logConnection from to = +logConnection :: UserId -> Qualified UserId -> Msg -> Msg +logConnection from (Qualified toUser toDomain) = + "connection.from" .= toByteString from + ~~ "connection.to" .= toByteString toUser + ~~ "connection.to_domain" .= toByteString toDomain + +logLocalConnection :: UserId -> UserId -> Msg -> Msg +logLocalConnection from to = "connection.from" .= toByteString from ~~ "connection.to" .= toByteString to diff --git a/libs/wire-api/src/Wire/API/Connection.hs b/libs/wire-api/src/Wire/API/Connection.hs index 7b217f31e85..73e60c50288 100644 --- a/libs/wire-api/src/Wire/API/Connection.hs +++ b/libs/wire-api/src/Wire/API/Connection.hs @@ -25,6 +25,9 @@ module Wire.API.Connection ( -- * UserConnection UserConnection (..), UserConnectionList (..), + ConnectionsPage, + ConnectionPagingState, + pattern ConnectionPagingState, Relation (..), RelationWithHistory (..), relationDropHistory, @@ -32,6 +35,7 @@ module Wire.API.Connection -- * Requests ConnectionRequest (..), ConnectionUpdate (..), + ListConnectionsRequestPaginated, -- * Swagger modelConnectionList, @@ -40,12 +44,14 @@ module Wire.API.Connection ) where +import Control.Applicative (optional) import Control.Lens ((?~)) import Data.Aeson as Aeson import Data.Attoparsec.ByteString (takeByteString) import Data.ByteString.Conversion import Data.Id import Data.Json.Util (UTCTimeMillis) +import Data.Qualified (Qualified (qUnqualified), deprecatedSchema) import Data.Range import qualified Data.Schema as P import qualified Data.Swagger.Build.Api as Doc @@ -53,10 +59,24 @@ import Data.Swagger.Schema as S import Data.Text as Text import Imports import Wire.API.Arbitrary (Arbitrary (..), GenericUniform (..)) +import Wire.API.Routes.MultiTablePaging -------------------------------------------------------------------------------- -- UserConnectionList +-- | Request to get a paginated list of connection +type ListConnectionsRequestPaginated = GetMultiTablePageRequest "Connections" LocalOrRemoteTable 500 100 + +-- | A page in response to 'ListConnectionsRequestPaginated' +type ConnectionsPage = MultiTablePage "Connections" "connections" LocalOrRemoteTable UserConnection + +type ConnectionPagingName = "ConnectionIds" + +type ConnectionPagingState = MultiTablePagingState ConnectionPagingName LocalOrRemoteTable + +pattern ConnectionPagingState :: tables -> Maybe ByteString -> MultiTablePagingState name tables +pattern ConnectionPagingState table state = MultiTablePagingState table state + -- | Response type for endpoints returning lists of connections. data UserConnectionList = UserConnectionList { clConnections :: [UserConnection], @@ -91,11 +111,11 @@ modelConnectionList = Doc.defineModel "UserConnectionList" $ do -- create connections (A, B, Sent) and (B, A, Pending). data UserConnection = UserConnection { ucFrom :: UserId, - ucTo :: UserId, + ucTo :: Qualified UserId, ucStatus :: Relation, -- | When 'ucStatus' was last changed ucLastUpdate :: UTCTimeMillis, - ucConvId :: Maybe ConvId + ucConvId :: Maybe (Qualified ConvId) } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform UserConnection) @@ -106,10 +126,14 @@ instance P.ToSchema UserConnection where P.object "UserConnection" $ UserConnection <$> ucFrom P..= P.field "from" P.schema - <*> ucTo P..= P.field "to" P.schema + <*> ucTo P..= P.field "qualified_to" P.schema + <* (qUnqualified . ucTo) + P..= optional (P.field "to" (deprecatedSchema "qualified_to" P.schema)) <*> ucStatus P..= P.field "status" P.schema <*> ucLastUpdate P..= P.field "last_update" P.schema - <*> ucConvId P..= P.optField "conversation" Nothing P.schema + <*> ucConvId P..= P.optField "qualified_conversation" Nothing P.schema + <* (fmap qUnqualified . ucConvId) + P..= P.optField "conversation" Nothing (deprecatedSchema "qualified_conversation" P.schema) modelConnection :: Doc.Model modelConnection = Doc.defineModel "Connection" $ do @@ -238,8 +262,12 @@ instance ToByteString Relation where data ConnectionRequest = ConnectionRequest { -- | Connection recipient crUser :: UserId, - -- | Name of the conversation to be created - -- FUTUREWORK investigate: shouldn't this name be optional? Do we use this name actually anywhere? + -- | Name of the conversation to be created. This is not used in any + -- meaningful way anymore. The clients just write the name of the target + -- user here and it is ignored later. + -- + -- (In the past, this was used; but due to spam, clients started ignoring + -- it) crName :: Range 1 256 Text } deriving stock (Eq, Show, Generic) diff --git a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs index adb8a928467..91f958a6c47 100644 --- a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs +++ b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs @@ -58,7 +58,7 @@ instance RequestSchemaConstraint name tables max def => ToSchema (GetMultiTableP addSizeDoc = description ?~ ("optional, must be <= " <> textFromNat @max <> ", defaults to " <> textFromNat @def <> ".") in objectWithDocModifier ("GetPaginated_" <> textFromSymbol @name) - (description ?~ "A request to list some or all of a user's conversation ids, including remote ones") + (description ?~ "A request to list some or all of a user's " <> textFromSymbol @name <> ", including remote ones") $ GetMultiTablePageRequest <$> gmtprSize .= (fieldWithDocModifier "size" addSizeDoc schema <|> pure (toRange (Proxy @def))) <*> gmtprState .= optFieldWithDocModifier "paging_state" Nothing addPagingStateDoc schema diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs index 4cb4d0078ff..d275ad368c9 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs @@ -379,13 +379,39 @@ data Api routes = Api '[JSON] (ResponsesForExistedCreated "Connection existed" "Connection was created" UserConnection) (ResponseForExistedCreated UserConnection), - listConnections :: - routes :- Summary "List the connections to other users." + createConnection :: + routes :- Summary "Create a connection to another user" + :> CanThrow MissingLegalholdConsent + :> CanThrow InvalidUser + :> CanThrow ConnectionLimitReached + :> CanThrow NoIdentity + -- Config value 'setUserMaxConnections' value in production/by default + -- is currently 1000 and has not changed in the last few years. + -- While it would be more correct to use the config value here, that + -- might not be time well spent. + :> Description "You can have no more than 1000 connections in accepted or sent state" + :> ZUser + :> ZConn + :> "connections" + :> QualifiedCaptureUserId "uid" + :> MultiVerb + 'POST + '[JSON] + (ResponsesForExistedCreated "Connection existed" "Connection was created" UserConnection) + (ResponseForExistedCreated UserConnection), + listLocalConnections :: + routes :- Summary "List the local connections to other users. (deprecated)" :> ZUser :> "connections" :> QueryParam' '[Optional, Strict, Description "User ID to start from when paginating"] "start" UserId :> QueryParam' '[Optional, Strict, Description "Number of results to return (default 100, max 500)"] "size" (Range 1 500 Int32) :> Get '[JSON] UserConnectionList, + listConnections :: + routes :- Summary "List the connections to other users, including remote users." + :> ZUser + :> "list-connections" + :> ReqBody '[JSON] ListConnectionsRequestPaginated + :> Post '[JSON] ConnectionsPage, getConnectionUnqualified :: routes :- Summary "Get an existing connection to another user. (deprecated)" :> ZUser @@ -398,6 +424,18 @@ data Api routes = Api Respond 200 "Connection found" UserConnection ] (Maybe UserConnection), + getConnection :: + routes :- Summary "Get an existing connection to another user (local or remote)." + :> ZUser + :> "connections" + :> QualifiedCaptureUserId "uid" + :> MultiVerb + 'GET + '[JSON] + '[ EmptyErrorForLegacyReasons 404 "Connection not found", + Respond 200 "Connection found" UserConnection + ] + (Maybe UserConnection), -- This endpoint can lead to the following events being sent: -- - ConnectionUpdated event to self and other, if their connection states change -- @@ -422,6 +460,30 @@ data Api routes = Api '[JSON] ConnectionUpdateResponses (UpdateResult UserConnection), + -- This endpoint can lead to the following events being sent: + -- - ConnectionUpdated event to self and other, if their connection states change + -- + -- When changing the connection state to Sent or Accepted, this can cause events to be sent + -- when joining the connect conversation: + -- - MemberJoin event to self and other (via galley) + updateConnection :: + routes :- Summary "Update a connection to another user. (deprecated)" + :> CanThrow MissingLegalholdConsent + :> CanThrow InvalidUser + :> CanThrow ConnectionLimitReached + :> CanThrow NotConnected + :> CanThrow InvalidTransition + :> CanThrow NoIdentity + :> ZUser + :> ZConn + :> "connections" + :> QualifiedCaptureUserId "uid" + :> ReqBody '[JSON] ConnectionUpdate + :> MultiVerb + 'PUT + '[JSON] + ConnectionUpdateResponses + (UpdateResult UserConnection), searchContacts :: routes :- Summary "Search for users" :> ZUser diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Util.hs b/libs/wire-api/src/Wire/API/Routes/Public/Util.hs index fc54cdf9ad5..a2479de2afd 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Util.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Util.hs @@ -21,6 +21,7 @@ module Wire.API.Routes.Public.Util where import Data.SOP (I (..), NS (..)) +import Imports import Servant import Servant.Swagger.Internal.Orphans () import Wire.API.Routes.MultiVerb @@ -42,6 +43,7 @@ instance data ResponseForExistedCreated a = Existed !a | Created !a + deriving (Functor) type ResponsesForExistedCreated eDesc cDesc a = '[ Respond 200 eDesc a, diff --git a/libs/wire-api/test/golden/testObject_UserConnectionList_user_1.json b/libs/wire-api/test/golden/testObject_UserConnectionList_user_1.json index 4d3bf2d37c8..b1bdee5739e 100644 --- a/libs/wire-api/test/golden/testObject_UserConnectionList_user_1.json +++ b/libs/wire-api/test/golden/testObject_UserConnectionList_user_1.json @@ -3,6 +3,10 @@ { "from": "00000000-0000-0000-0000-000000000000", "last_update": "1864-05-09T06:44:37.367Z", + "qualified_to": { + "domain": "faraway.golden.example.com", + "id": "00000000-0000-0001-0000-000100000000" + }, "status": "pending", "to": "00000000-0000-0001-0000-000100000000" }, @@ -10,6 +14,14 @@ "conversation": "00000000-0000-0000-0000-000100000000", "from": "00000001-0000-0001-0000-000000000000", "last_update": "1864-05-09T00:43:52.049Z", + "qualified_conversation": { + "domain": "faraway.folden.example.com", + "id": "00000000-0000-0000-0000-000100000000" + }, + "qualified_to": { + "domain": "faraway.golden.example.com", + "id": "00000000-0000-0000-0000-000000000000" + }, "status": "accepted", "to": "00000000-0000-0000-0000-000000000000" } diff --git a/libs/wire-api/test/golden/testObject_UserConnection_user_1.json b/libs/wire-api/test/golden/testObject_UserConnection_user_1.json index cac93922d7c..702d2b197de 100644 --- a/libs/wire-api/test/golden/testObject_UserConnection_user_1.json +++ b/libs/wire-api/test/golden/testObject_UserConnection_user_1.json @@ -1,6 +1,10 @@ { "from": "00000000-0000-0004-0000-000100000001", "last_update": "1864-05-07T21:52:21.955Z", + "qualified_to": { + "domain": "farway.golden.example.com", + "id": "00000001-0000-0001-0000-000300000002" + }, "status": "pending", "to": "00000001-0000-0001-0000-000300000002" } diff --git a/libs/wire-api/test/golden/testObject_UserConnection_user_2.json b/libs/wire-api/test/golden/testObject_UserConnection_user_2.json index 12e04ea4de2..5b61e107205 100644 --- a/libs/wire-api/test/golden/testObject_UserConnection_user_2.json +++ b/libs/wire-api/test/golden/testObject_UserConnection_user_2.json @@ -2,6 +2,14 @@ "conversation": "00000002-0000-0001-0000-000000000004", "from": "00000004-0000-0002-0000-000000000004", "last_update": "1864-05-11T10:43:38.227Z", + "qualified_conversation": { + "domain": "nice-and-close-to-home.golden.example.com", + "id": "00000002-0000-0001-0000-000000000004" + }, + "qualified_to": { + "domain": "faraway.golden.example.com", + "id": "00000001-0000-0003-0000-000100000000" + }, "status": "cancelled", "to": "00000001-0000-0003-0000-000100000000" } diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/UserConnectionList_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/UserConnectionList_user.hs index 82d7d9fbce4..f28c6ab012b 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/UserConnectionList_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/UserConnectionList_user.hs @@ -18,10 +18,12 @@ -- with this program. If not, see . module Test.Wire.API.Golden.Generated.UserConnectionList_user where +import Data.Domain (Domain (..)) import Data.Id (Id (Id)) import Data.Json.Util (readUTCTimeMillis) +import Data.Qualified (Qualified (..)) import qualified Data.UUID as UUID (fromString) -import Imports (Bool (..), Maybe (..), fromJust) +import Imports import Wire.API.Connection ( Relation (..), UserConnection (..), @@ -34,17 +36,17 @@ testObject_UserConnectionList_user_1 = { clConnections = [ UserConnection { ucFrom = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000000")), - ucTo = Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000100000000")), + ucTo = Qualified (Id (fromJust (UUID.fromString "00000000-0000-0001-0000-000100000000"))) (Domain "faraway.golden.example.com"), ucStatus = Pending, ucLastUpdate = fromJust (readUTCTimeMillis "1864-05-09T06:44:37.367Z"), ucConvId = Nothing }, UserConnection { ucFrom = Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000000000000")), - ucTo = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000000")), + ucTo = Qualified (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000000000000"))) (Domain "faraway.golden.example.com"), ucStatus = Accepted, ucLastUpdate = fromJust (readUTCTimeMillis "1864-05-09T00:43:52.049Z"), - ucConvId = Just (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000000"))) + ucConvId = Just $ Qualified (Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000000"))) (Domain "faraway.folden.example.com") } ], clHasMore = False diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/UserConnection_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/UserConnection_user.hs index 4d441e6b62c..f78185c0864 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/UserConnection_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/UserConnection_user.hs @@ -16,10 +16,12 @@ -- with this program. If not, see . module Test.Wire.API.Golden.Generated.UserConnection_user where +import Data.Domain (Domain (..)) import Data.Id (Id (Id)) import Data.Json.Util (readUTCTimeMillis) +import Data.Qualified (Qualified (..)) import qualified Data.UUID as UUID (fromString) -import Imports (Maybe (Just, Nothing), fromJust) +import Imports import Wire.API.Connection ( Relation (..), UserConnection (..), @@ -29,7 +31,7 @@ testObject_UserConnection_user_1 :: UserConnection testObject_UserConnection_user_1 = UserConnection { ucFrom = Id (fromJust (UUID.fromString "00000000-0000-0004-0000-000100000001")), - ucTo = Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000300000002")), + ucTo = Qualified (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000300000002"))) (Domain "farway.golden.example.com"), ucStatus = Pending, ucLastUpdate = fromJust (readUTCTimeMillis "1864-05-07T21:52:21.955Z"), ucConvId = Nothing @@ -39,8 +41,8 @@ testObject_UserConnection_user_2 :: UserConnection testObject_UserConnection_user_2 = UserConnection { ucFrom = Id (fromJust (UUID.fromString "00000004-0000-0002-0000-000000000004")), - ucTo = Id (fromJust (UUID.fromString "00000001-0000-0003-0000-000100000000")), + ucTo = Qualified (Id (fromJust (UUID.fromString "00000001-0000-0003-0000-000100000000"))) (Domain "faraway.golden.example.com"), ucStatus = Cancelled, ucLastUpdate = fromJust (readUTCTimeMillis "1864-05-11T10:43:38.227Z"), - ucConvId = Just (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000000000004"))) + ucConvId = Just $ Qualified (Id (fromJust (UUID.fromString "00000002-0000-0001-0000-000000000004"))) (Domain "nice-and-close-to-home.golden.example.com") } diff --git a/services/brig/src/Brig/API/Connection.hs b/services/brig/src/Brig/API/Connection.hs index 9ca00f5f8f1..78c7e047ab5 100644 --- a/services/brig/src/Brig/API/Connection.hs +++ b/services/brig/src/Brig/API/Connection.hs @@ -26,8 +26,8 @@ module Brig.API.Connection updateConnection, UpdateConnectionsInternal (..), updateConnectionInternal, + lookupLocalConnection, lookupConnections, - Data.lookupConnection, Data.lookupConnectionStatus, Data.lookupConnectionStatus', Data.lookupContactList, @@ -38,6 +38,7 @@ import Brig.API.Error (errorDescriptionTypeToWai) import Brig.API.Types import Brig.API.User (getLegalHoldStatus) import Brig.App +import Brig.Data.Connection (LocalConnection (..), localToUserConn) import qualified Brig.Data.Connection as Data import Brig.Data.Types (resultHasMore, resultList) import qualified Brig.Data.User as Data @@ -51,6 +52,7 @@ import Control.Monad.Catch (throwM) import Data.Id as Id import qualified Data.LegalHold as LH import Data.Proxy (Proxy (Proxy)) +import Data.Qualified (Qualified (Qualified)) import Data.Range import Galley.Types (ConvType (..), cnvType) import Imports @@ -61,6 +63,11 @@ import qualified Wire.API.Conversation as Conv import Wire.API.ErrorDescription import Wire.API.Routes.Public.Util (ResponseForExistedCreated (..)) +lookupLocalConnection :: UserId -> UserId -> AppIO (Maybe UserConnection) +lookupLocalConnection uid1 uid2 = do + localDomain <- viewFederationDomain + Data.localToUserConn localDomain <$$> Data.lookupLocalConnection uid1 uid2 + createConnection :: UserId -> ConnectionRequest -> @@ -92,29 +99,31 @@ createConnectionToLocalUser self crUser ConnectionRequest {crName} conn = do sameTeam <- lift belongSameTeam when sameTeam $ throwE ConnectSameBindingTeamUsers - s2o <- lift $ Data.lookupConnection self crUser - o2s <- lift $ Data.lookupConnection crUser self + s2o <- lift $ Data.lookupLocalConnection self crUser + o2s <- lift $ Data.lookupLocalConnection crUser self + localDomain <- viewFederationDomain case update <$> s2o <*> o2s of - Just rs -> rs + Just rs -> localToUserConn localDomain <$$> rs Nothing -> do checkLimit self - Created <$> insert Nothing Nothing + Created . localToUserConn localDomain <$> insert Nothing Nothing where - insert :: Maybe UserConnection -> Maybe UserConnection -> ExceptT ConnectionError AppIO UserConnection + insert :: Maybe LocalConnection -> Maybe LocalConnection -> ExceptT ConnectionError AppIO LocalConnection insert s2o o2s = lift $ do + localDomain <- viewFederationDomain Log.info $ - logConnection self crUser + logConnection self (Qualified crUser localDomain) . msg (val "Creating connection") cnv <- Intra.createConnectConv self crUser (Just (fromRange crName)) (Just conn) - s2o' <- Data.insertConnection self crUser SentWithHistory cnv - o2s' <- Data.insertConnection crUser self PendingWithHistory cnv - e2o <- ConnectionUpdated o2s' (ucStatus <$> o2s) <$> Data.lookupName self - let e2s = ConnectionUpdated s2o' (ucStatus <$> s2o) Nothing + s2o' <- Data.insertLocalConnection self crUser SentWithHistory cnv + o2s' <- Data.insertLocalConnection crUser self PendingWithHistory cnv + e2o <- ConnectionUpdated (localToUserConn localDomain o2s') (lcStatus <$> o2s) <$> Data.lookupName self + let e2s = ConnectionUpdated (localToUserConn localDomain s2o') (lcStatus <$> s2o) Nothing mapM_ (Intra.onConnectionEvent self (Just conn)) [e2o, e2s] return s2o' - update :: UserConnection -> UserConnection -> ExceptT ConnectionError AppIO (ResponseForExistedCreated UserConnection) - update s2o o2s = case (ucStatus s2o, ucStatus o2s) of + update :: LocalConnection -> LocalConnection -> ExceptT ConnectionError AppIO (ResponseForExistedCreated LocalConnection) + update s2o o2s = case (lcStatus s2o, lcStatus o2s) of (MissingLegalholdConsent, _) -> throwE $ InvalidTransition self Sent (_, MissingLegalholdConsent) -> throwE $ InvalidTransition self Sent (Accepted, Accepted) -> return $ Existed s2o @@ -128,37 +137,38 @@ createConnectionToLocalUser self crUser ConnectionRequest {crName} conn = do (_, Pending) -> resend s2o o2s (_, Cancelled) -> resend s2o o2s - accept :: UserConnection -> UserConnection -> ExceptT ConnectionError AppIO (ResponseForExistedCreated UserConnection) + accept :: LocalConnection -> LocalConnection -> ExceptT ConnectionError AppIO (ResponseForExistedCreated LocalConnection) accept s2o o2s = do - when (ucStatus s2o `notElem` [Sent, Accepted]) $ + localDomain <- viewFederationDomain + when (lcStatus s2o `notElem` [Sent, Accepted]) $ checkLimit self Log.info $ - logConnection self (ucTo s2o) + logLocalConnection self (lcTo s2o) . msg (val "Accepting connection") - cnv <- lift $ for (ucConvId s2o) $ Intra.acceptConnectConv self (Just conn) - s2o' <- lift $ Data.updateConnection s2o AcceptedWithHistory + cnv <- lift $ for (lcConv s2o) $ Intra.acceptConnectConv self (Just conn) + s2o' <- lift $ Data.updateLocalConnection s2o AcceptedWithHistory o2s' <- lift $ if (cnvType <$> cnv) == Just ConnectConv - then Data.updateConnection o2s BlockedWithHistory - else Data.updateConnection o2s AcceptedWithHistory - e2o <- lift $ ConnectionUpdated o2s' (Just $ ucStatus o2s) <$> Data.lookupName self - let e2s = ConnectionUpdated s2o' (Just $ ucStatus s2o) Nothing + then Data.updateLocalConnection o2s BlockedWithHistory + else Data.updateLocalConnection o2s AcceptedWithHistory + e2o <- lift $ ConnectionUpdated (localToUserConn localDomain o2s') (Just $ lcStatus o2s) <$> Data.lookupName self + let e2s = ConnectionUpdated (localToUserConn localDomain s2o') (Just $ lcStatus s2o) Nothing lift $ mapM_ (Intra.onConnectionEvent self (Just conn)) [e2o, e2s] return $ Existed s2o' - resend :: UserConnection -> UserConnection -> ExceptT ConnectionError AppIO (ResponseForExistedCreated UserConnection) + resend :: LocalConnection -> LocalConnection -> ExceptT ConnectionError AppIO (ResponseForExistedCreated LocalConnection) resend s2o o2s = do - when (ucStatus s2o `notElem` [Sent, Accepted]) $ + when (lcStatus s2o `notElem` [Sent, Accepted]) $ checkLimit self Log.info $ - logConnection self (ucTo s2o) + logLocalConnection self (lcTo s2o) . msg (val "Resending connection request") s2o' <- insert (Just s2o) (Just o2s) return $ Existed s2o' - change :: UserConnection -> RelationWithHistory -> ExceptT ConnectionError AppIO (ResponseForExistedCreated UserConnection) - change c s = Existed <$> lift (Data.updateConnection c s) + change :: LocalConnection -> RelationWithHistory -> ExceptT ConnectionError AppIO (ResponseForExistedCreated LocalConnection) + change c s = Existed <$> lift (Data.updateLocalConnection c s) belongSameTeam :: AppIO Bool belongSameTeam = do @@ -208,9 +218,9 @@ updateConnection :: Maybe ConnId -> ExceptT ConnectionError AppIO (Maybe UserConnection) updateConnection self other newStatus conn = do - s2o <- connection self other - o2s <- connection other self - s2o' <- case (ucStatus s2o, ucStatus o2s, newStatus) of + s2o <- localConnection self other + o2s <- localConnection other self + s2o' <- case (lcStatus s2o, lcStatus o2s, newStatus) of -- missing legalhold consent: call 'updateConectionInternal' instead. (MissingLegalholdConsent, _, _) -> throwE $ InvalidTransition self newStatus (_, MissingLegalholdConsent, _) -> throwE $ InvalidTransition self newStatus @@ -251,76 +261,83 @@ updateConnection self other newStatus conn = do (old, _, new) | old == new -> return Nothing -- invalid _ -> throwE $ InvalidTransition self newStatus - lift . for_ s2o' $ \c -> - let e2s = ConnectionUpdated c (Just $ ucStatus s2o) Nothing + localDomain <- viewFederationDomain + let s2oUserConn = Data.localToUserConn localDomain <$> s2o' + lift . for_ s2oUserConn $ \c -> + let e2s = ConnectionUpdated c (Just $ lcStatus s2o) Nothing in Intra.onConnectionEvent self conn e2s - return s2o' + return s2oUserConn where - accept :: UserConnection -> UserConnection -> ExceptT ConnectionError AppIO (Maybe UserConnection) + accept :: LocalConnection -> LocalConnection -> ExceptT ConnectionError AppIO (Maybe LocalConnection) accept s2o o2s = do + localDomain <- viewFederationDomain checkLimit self Log.info $ - logConnection self (ucTo s2o) + logLocalConnection self (lcTo s2o) . msg (val "Accepting connection") - cnv <- lift . for (ucConvId s2o) $ Intra.acceptConnectConv self conn + cnv <- lift . for (lcConv s2o) $ Intra.acceptConnectConv self conn -- Note: The check for @Pending@ accounts for situations in which both -- sides are pending, which can occur due to rare race conditions -- when sending mutual connection requests, combined with untimely -- crashes. - when (ucStatus o2s `elem` [Sent, Pending]) . lift $ do + when (lcStatus o2s `elem` [Sent, Pending]) . lift $ do o2s' <- if (cnvType <$> cnv) /= Just ConnectConv - then Data.updateConnection o2s AcceptedWithHistory - else Data.updateConnection o2s BlockedWithHistory - e2o <- ConnectionUpdated o2s' (Just $ ucStatus o2s) <$> Data.lookupName self + then Data.updateLocalConnection o2s AcceptedWithHistory + else Data.updateLocalConnection o2s BlockedWithHistory + e2o <- ConnectionUpdated (localToUserConn localDomain o2s') (Just $ lcStatus o2s) <$> Data.lookupName self Intra.onConnectionEvent self conn e2o - lift $ Just <$> Data.updateConnection s2o AcceptedWithHistory + lift $ Just <$> Data.updateLocalConnection s2o AcceptedWithHistory - block :: UserConnection -> ExceptT ConnectionError AppIO (Maybe UserConnection) + block :: LocalConnection -> ExceptT ConnectionError AppIO (Maybe LocalConnection) block s2o = lift $ do Log.info $ - logConnection self (ucTo s2o) + logLocalConnection self (lcTo s2o) . msg (val "Blocking connection") - for_ (ucConvId s2o) $ Intra.blockConv (ucFrom s2o) conn - Just <$> Data.updateConnection s2o BlockedWithHistory + for_ (lcConv s2o) $ Intra.blockConv (lcFrom s2o) conn + Just <$> Data.updateLocalConnection s2o BlockedWithHistory - unblock :: UserConnection -> UserConnection -> Relation -> ExceptT ConnectionError AppIO (Maybe UserConnection) + unblock :: LocalConnection -> LocalConnection -> Relation -> ExceptT ConnectionError AppIO (Maybe LocalConnection) unblock s2o o2s new = do + localDomain <- viewFederationDomain -- FUTUREWORK: new is always in [Sent, Accepted]. Refactor to total function. when (new `elem` [Sent, Accepted]) $ checkLimit self Log.info $ - logConnection self (ucTo s2o) + logLocalConnection self (lcTo s2o) . msg (val "Unblocking connection") - cnv :: Maybe Conv.Conversation <- lift . for (ucConvId s2o) $ Intra.unblockConv (ucFrom s2o) conn - when (ucStatus o2s == Sent && new == Accepted) . lift $ do - o2s' :: UserConnection <- + cnv :: Maybe Conv.Conversation <- lift . for (lcConv s2o) $ Intra.unblockConv (lcFrom s2o) conn + when (lcStatus o2s == Sent && new == Accepted) . lift $ do + o2s' <- if (cnvType <$> cnv) /= Just ConnectConv - then Data.updateConnection o2s AcceptedWithHistory - else Data.updateConnection o2s BlockedWithHistory - e2o :: ConnectionEvent <- ConnectionUpdated o2s' (Just $ ucStatus o2s) <$> Data.lookupName self + then Data.updateLocalConnection o2s AcceptedWithHistory + else Data.updateLocalConnection o2s BlockedWithHistory + e2o :: ConnectionEvent <- ConnectionUpdated (localToUserConn localDomain o2s') (Just $ lcStatus o2s) <$> Data.lookupName self -- TODO: is this correct? shouldnt o2s be sent to other? Intra.onConnectionEvent self conn e2o - lift $ Just <$> Data.updateConnection s2o (mkRelationWithHistory (error "impossible") new) + lift $ Just <$> Data.updateLocalConnection s2o (mkRelationWithHistory (error "impossible") new) - cancel :: UserConnection -> UserConnection -> ExceptT ConnectionError AppIO (Maybe UserConnection) + cancel :: LocalConnection -> LocalConnection -> ExceptT ConnectionError AppIO (Maybe LocalConnection) cancel s2o o2s = do + localDomain <- viewFederationDomain Log.info $ - logConnection self (ucTo s2o) + logLocalConnection self (lcTo s2o) . msg (val "Cancelling connection") - lift . for_ (ucConvId s2o) $ Intra.blockConv (ucFrom s2o) conn - o2s' <- lift $ Data.updateConnection o2s CancelledWithHistory - let e2o = ConnectionUpdated o2s' (Just $ ucStatus o2s) Nothing + lift . for_ (lcConv s2o) $ Intra.blockConv (lcFrom s2o) conn + o2s' <- lift $ Data.updateLocalConnection o2s CancelledWithHistory + let e2o = ConnectionUpdated (localToUserConn localDomain o2s') (Just $ lcStatus o2s) Nothing lift $ Intra.onConnectionEvent self conn e2o change s2o Cancelled - change :: UserConnection -> Relation -> ExceptT ConnectionError AppIO (Maybe UserConnection) + change :: LocalConnection -> Relation -> ExceptT ConnectionError AppIO (Maybe LocalConnection) change c s = do -- FUTUREWORK: refactor to total function. Gets only called with either Ignored, Accepted, Cancelled - lift $ Just <$> Data.updateConnection c (mkRelationWithHistory (error "impossible") s) + lift $ Just <$> Data.updateLocalConnection c (mkRelationWithHistory (error "impossible") s) -connection :: UserId -> UserId -> ExceptT ConnectionError AppIO UserConnection -connection a b = lift (Data.lookupConnection a b) >>= tryJust (NotConnected a b) +localConnection :: UserId -> UserId -> ExceptT ConnectionError AppIO LocalConnection +localConnection a b = do + lift (Data.lookupLocalConnection a b) + >>= tryJust (NotConnected a b) mkRelationWithHistory :: HasCallStack => Relation -> Relation -> RelationWithHistory mkRelationWithHistory oldRel = \case @@ -350,53 +367,63 @@ updateConnectionInternal = \case -- inspired by @block@ in 'updateConnection'. blockForMissingLegalholdConsent :: UserId -> [UserId] -> ExceptT ConnectionError AppIO () blockForMissingLegalholdConsent self others = do + localDomain <- viewFederationDomain for_ others $ \other -> do Log.info $ - logConnection self other + logConnection self (Qualified other localDomain) . msg (val "Blocking connection (legalhold device present, but missing consent)") - s2o <- connection self other - o2s <- connection other self - for_ [s2o, o2s] $ \(uconn :: UserConnection) -> lift $ do - Intra.blockConv (ucFrom uconn) Nothing `mapM_` ucConvId uconn - uconn' <- Data.updateConnection uconn (mkRelationWithHistory (ucStatus uconn) MissingLegalholdConsent) - let ev = ConnectionUpdated uconn' (Just $ ucStatus uconn) Nothing + s2o <- localConnection self other + o2s <- localConnection other self + for_ [s2o, o2s] $ \(uconn :: LocalConnection) -> lift $ do + Intra.blockConv (lcFrom uconn) Nothing `mapM_` lcConv uconn + uconn' <- Data.updateLocalConnection uconn (mkRelationWithHistory (lcStatus uconn) MissingLegalholdConsent) + let ev = ConnectionUpdated (Data.localToUserConn localDomain uconn') (Just $ lcStatus uconn) Nothing Intra.onConnectionEvent self Nothing ev removeLHBlocksInvolving :: UserId -> ExceptT ConnectionError AppIO () removeLHBlocksInvolving self = iterateConnections self (toRange (Proxy @500)) $ \conns -> do + localDomain <- viewFederationDomain for_ conns $ \s2o -> - when (ucStatus s2o == MissingLegalholdConsent) $ do + when (Data.lcStatus s2o == MissingLegalholdConsent) $ do -- (this implies @ucStatus o2s == MissingLegalholdConsent@) - o2s <- connection (ucTo s2o) (ucFrom s2o) + let other = Data.lcTo s2o + o2s <- localConnection other self Log.info $ - logConnection (ucFrom s2o) (ucTo s2o) + logConnection (Data.lcFrom s2o) (Qualified (Data.lcTo s2o) localDomain) . msg (val "Unblocking connection (legalhold device removed or consent given)") unblockDirected s2o o2s unblockDirected o2s s2o where - iterateConnections :: UserId -> Range 1 500 Int32 -> ([UserConnection] -> ExceptT ConnectionError AppIO ()) -> ExceptT ConnectionError AppIO () + iterateConnections :: UserId -> Range 1 500 Int32 -> ([Data.LocalConnection] -> ExceptT ConnectionError AppIO ()) -> ExceptT ConnectionError AppIO () iterateConnections user pageSize handleConns = go Nothing where + go :: Maybe UserId -> ExceptT ConnectionError (AppT IO) () go mbStart = do - page <- lift $ Data.lookupConnections user mbStart pageSize + page <- lift $ Data.lookupLocalConnections user mbStart pageSize handleConns (resultList page) case resultList page of (conn : rest) -> if resultHasMore page - then go (Just (maximum (ucTo <$> (conn : rest)))) + then go (Just (maximum (Data.lcTo <$> (conn : rest)))) else pure () [] -> pure () - unblockDirected :: UserConnection -> UserConnection -> ExceptT ConnectionError AppIO () + unblockDirected :: Data.LocalConnection -> Data.LocalConnection -> ExceptT ConnectionError AppIO () unblockDirected uconn uconnRev = do - void . lift . for (ucConvId uconn) $ Intra.unblockConv (ucFrom uconn) Nothing - uconnRevRel :: RelationWithHistory <- relationWithHistory (ucFrom uconnRev) (ucTo uconnRev) - uconnRev' <- lift $ Data.updateConnection uconnRev (undoRelationHistory uconnRevRel) - connEvent :: ConnectionEvent <- lift $ ConnectionUpdated uconnRev' (Just $ ucStatus uconnRev) <$> Data.lookupName (ucFrom uconn) - lift $ Intra.onConnectionEvent (ucFrom uconn) Nothing connEvent - + void . lift . for (Data.lcConv uconn) $ Intra.unblockConv (Data.lcFrom uconn) Nothing + uconnRevRel :: RelationWithHistory <- relationWithHistory (Data.lcFrom uconnRev) (Data.lcTo uconnRev) + uconnRev' <- lift $ Data.updateLocalConnection uconnRev (undoRelationHistory uconnRevRel) + localDomain <- viewFederationDomain + connName <- lift $ Data.lookupName (Data.lcFrom uconn) + let connEvent = + ConnectionUpdated + { ucConn = Data.localToUserConn localDomain uconnRev', + ucPrev = Just $ Data.lcStatus uconnRev, + ucName = connName + } + lift $ Intra.onConnectionEvent (Data.lcFrom uconn) Nothing connEvent relationWithHistory :: UserId -> UserId -> ExceptT ConnectionError AppIO RelationWithHistory relationWithHistory a b = lift (Data.lookupRelationWithHistory a b) >>= tryJust (NotConnected a b) @@ -419,8 +446,9 @@ updateConnectionInternal = \case lookupConnections :: UserId -> Maybe UserId -> Range 1 500 Int32 -> AppIO UserConnectionList lookupConnections from start size = do - rs <- Data.lookupConnections from start size - return $! UserConnectionList (Data.resultList rs) (Data.resultHasMore rs) + rs <- Data.lookupLocalConnections from start size + localDomain <- viewFederationDomain + return $! UserConnectionList (Data.localToUserConn localDomain <$> Data.resultList rs) (Data.resultHasMore rs) -- Helpers diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index e84cbc785d1..c3f5b129e22 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -38,6 +38,7 @@ import Brig.API.Util import qualified Brig.API.Util as API import Brig.App import qualified Brig.Calling.API as Calling +import qualified Brig.Data.Connection as Data import qualified Brig.Data.User as Data import Brig.Options hiding (internalEvents, sesQueue) import qualified Brig.Provider.API as Provider @@ -52,12 +53,15 @@ import qualified Brig.User.API.Search as Search import qualified Brig.User.Auth.Cookie as Auth import Brig.User.Email import Brig.User.Phone +import qualified Cassandra as C +import qualified Cassandra as Data import Control.Error hiding (bool) import Control.Lens (view, (%~), (.~), (?~), (^.)) import Control.Monad.Catch (throwM) import Data.Aeson hiding (json) import Data.ByteString.Conversion import qualified Data.ByteString.Lazy as Lazy +import qualified Data.ByteString.Lazy.Char8 as LBS import qualified Data.Code as Code import Data.CommaSeparatedList (CommaSeparatedList (fromCommaSeparatedList)) import Data.Containers.ListUtils (nubOrd) @@ -94,7 +98,10 @@ import qualified System.Logger.Class as Log import Util.Logging (logFunction, logHandle, logTeam, logUser) import qualified Wire.API.Connection as Public import Wire.API.ErrorDescription +import Wire.API.Federation.Error (federationNotImplemented) import qualified Wire.API.Properties as Public +import qualified Wire.API.Routes.MultiTablePaging as Public +import Wire.API.Routes.Public.Brig (Api (updateConnectionUnqualified)) import qualified Wire.API.Routes.Public.Brig as BrigAPI import qualified Wire.API.Routes.Public.Galley as GalleyAPI import qualified Wire.API.Routes.Public.LegalHold as LegalHoldAPI @@ -254,10 +261,14 @@ servantSitemap = BrigAPI.getClient = getClient, BrigAPI.getClientCapabilities = getClientCapabilities, BrigAPI.getClientPrekeys = getClientPrekeys, - BrigAPI.createConnectionUnqualified = createConnection, + BrigAPI.createConnectionUnqualified = createLocalConnection, + BrigAPI.createConnection = createConnection, + BrigAPI.listLocalConnections = listLocalConnections, BrigAPI.listConnections = listConnections, - BrigAPI.getConnectionUnqualified = getConnection, - BrigAPI.updateConnectionUnqualified = updateConnection, + BrigAPI.getConnectionUnqualified = getLocalConnection, + BrigAPI.getConnection = getConnection, + BrigAPI.updateConnectionUnqualified = updateLocalConnection, + BrigAPI.updateConnection = updateConnection, BrigAPI.searchContacts = Search.search } @@ -1074,23 +1085,69 @@ customerExtensionCheckBlockedDomains email = do when (domain `elem` blockedDomains) $ throwM $ customerExtensionBlockedDomain domain -createConnection :: UserId -> ConnId -> Public.ConnectionRequest -> Handler (Public.ResponseForExistedCreated Public.UserConnection) -createConnection self conn cr = do +createLocalConnection :: UserId -> ConnId -> Public.ConnectionRequest -> Handler (Public.ResponseForExistedCreated Public.UserConnection) +createLocalConnection self conn cr = do API.createConnection self cr conn !>> connError -updateConnection :: UserId -> ConnId -> UserId -> Public.ConnectionUpdate -> Handler (Public.UpdateResult Public.UserConnection) -updateConnection self conn other update = do +-- | FUTUREWORK: also create remote connections: https://wearezeta.atlassian.net/browse/SQCORE-958 +createConnection :: UserId -> ConnId -> Qualified UserId -> Handler (Public.ResponseForExistedCreated Public.UserConnection) +createConnection self conn (Qualified otherUser otherDomain) = do + localDomain <- viewFederationDomain + if localDomain == otherDomain + then createLocalConnection self conn (Public.ConnectionRequest otherUser (unsafeRange "_")) + else throwM federationNotImplemented + +updateLocalConnection :: UserId -> ConnId -> UserId -> Public.ConnectionUpdate -> Handler (Public.UpdateResult Public.UserConnection) +updateLocalConnection self conn other update = do let newStatus = Public.cuStatus update mc <- API.updateConnection self other newStatus (Just conn) !>> connError return $ maybe Public.Unchanged Public.Updated mc -listConnections :: UserId -> Maybe UserId -> Maybe (Range 1 500 Int32) -> Handler Public.UserConnectionList -listConnections uid start msize = do +-- | FUTUREWORK: also update remote connections: https://wearezeta.atlassian.net/browse/SQCORE-959 +updateConnection :: UserId -> ConnId -> Qualified UserId -> Public.ConnectionUpdate -> Handler (Public.UpdateResult Public.UserConnection) +updateConnection self conn (Qualified otherUid otherDomain) update = do + localDomain <- viewFederationDomain + if localDomain == otherDomain + then updateLocalConnection self conn otherUid update + else throwM federationNotImplemented + +listLocalConnections :: UserId -> Maybe UserId -> Maybe (Range 1 500 Int32) -> Handler Public.UserConnectionList +listLocalConnections uid start msize = do let defaultSize = toRange (Proxy @100) lift $ API.lookupConnections uid start (fromMaybe defaultSize msize) -getConnection :: UserId -> UserId -> Handler (Maybe Public.UserConnection) -getConnection uid uid' = lift $ API.lookupConnection uid uid' +-- | FUTUREWORK: also list remote connections: https://wearezeta.atlassian.net/browse/SQCORE-963 +listConnections :: UserId -> Public.ListConnectionsRequestPaginated -> Handler Public.ConnectionsPage +listConnections uid req = do + localDomain <- viewFederationDomain + let size = Public.gmtprSize req + res :: C.PageWithState Data.LocalConnection <- Data.lookupLocalConnectionsPage uid convertedState (rcast size) + return (pageToConnectionsPage localDomain Public.PagingLocals res) + where + pageToConnectionsPage :: Domain -> Public.LocalOrRemoteTable -> Data.PageWithState Data.LocalConnection -> Public.ConnectionsPage + pageToConnectionsPage localDomain table page@Data.PageWithState {..} = + Public.MultiTablePage + { mtpResults = Data.localToUserConn localDomain <$> pwsResults, + mtpHasMore = C.pwsHasMore page, + -- FUTUREWORK confusingly, using 'ConversationPagingState' instead of 'ConnectionPagingState' doesn't fail any tests. + -- Is this type actually useless? Or the tests not good enough? + mtpPagingState = Public.ConnectionPagingState table (LBS.toStrict . C.unPagingState <$> pwsState) + } + mkState :: ByteString -> C.PagingState + mkState = C.PagingState . LBS.fromStrict + + convertedState :: Maybe C.PagingState + convertedState = fmap mkState . Public.mtpsState =<< Public.gmtprState req + +getLocalConnection :: UserId -> UserId -> Handler (Maybe Public.UserConnection) +getLocalConnection self other = lift $ API.lookupLocalConnection self other + +getConnection :: UserId -> Qualified UserId -> Handler (Maybe Public.UserConnection) +getConnection self (Qualified otherUser otherDomain) = do + localDomain <- viewFederationDomain + if localDomain == otherDomain + then getLocalConnection self otherUser + else throwM federationNotImplemented deleteUser :: UserId -> diff --git a/services/brig/src/Brig/Data/Connection.hs b/services/brig/src/Brig/Data/Connection.hs index e3d83d5d154..4acaac8c8f4 100644 --- a/services/brig/src/Brig/Data/Connection.hs +++ b/services/brig/src/Brig/Data/Connection.hs @@ -18,18 +18,27 @@ -- with this program. If not, see . module Brig.Data.Connection - ( module T, - insertConnection, - updateConnection, - lookupConnection, + ( -- * DB Types + LocalConnection (..), + RemoteConnection (..), + localToUserConn, + + -- * DB Operations + insertLocalConnection, + updateLocalConnection, + lookupLocalConnection, + lookupLocalConnectionsPage, lookupRelationWithHistory, - lookupConnections, + lookupLocalConnections, lookupConnectionStatus, lookupConnectionStatus', lookupContactList, lookupContactListWithRelation, countConnections, deleteConnections, + + -- * Re-exports + module T, ) where @@ -41,47 +50,74 @@ import Brig.Types.Intra import Cassandra import Data.Conduit (runConduit, (.|)) import qualified Data.Conduit.List as C +import Data.Domain (Domain) import Data.Id import Data.Json.Util (UTCTimeMillis, toUTCTimeMillis) +import Data.Qualified import Data.Range import Data.Time (getCurrentTime) import Imports import UnliftIO.Async (pooledMapConcurrentlyN_) import Wire.API.Connection -insertConnection :: +data LocalConnection = LocalConnection + { lcFrom :: UserId, + lcTo :: UserId, + lcStatus :: Relation, + -- | Why is this a Maybe? Are there actually any users who have this as null in DB? + lcConv :: Maybe ConvId, + lcLastUpdated :: UTCTimeMillis + } + +localToUserConn :: Domain -> LocalConnection -> UserConnection +localToUserConn localDomain lc = + UserConnection + { ucFrom = lcFrom lc, + ucTo = Qualified (lcTo lc) localDomain, + ucStatus = lcStatus lc, + ucLastUpdate = lcLastUpdated lc, + ucConvId = flip Qualified localDomain <$> lcConv lc + } + +data RemoteConnection = RemoteConnection + { rcFrom :: UserId, + rcTo :: Qualified UserId, + rcRelationWithHistory :: Relation, + rcConv :: Qualified ConvId + } + +insertLocalConnection :: -- | From UserId -> -- | To UserId -> RelationWithHistory -> ConvId -> - AppIO UserConnection -insertConnection from to status cid = do + AppIO LocalConnection +insertLocalConnection from to status cid = do now <- toUTCTimeMillis <$> liftIO getCurrentTime retry x5 . write connectionInsert $ params Quorum (from, to, status, now, cid) - return $ toUserConnection (from, to, status, now, Just cid) + return $ toLocalUserConnection (from, to, status, now, Just cid) -updateConnection :: UserConnection -> RelationWithHistory -> AppIO UserConnection -updateConnection c@UserConnection {..} status = do +updateLocalConnection :: LocalConnection -> RelationWithHistory -> AppIO LocalConnection +updateLocalConnection c@LocalConnection {..} status = do now <- toUTCTimeMillis <$> liftIO getCurrentTime - retry x5 . write connectionUpdate $ params Quorum (status, now, ucFrom, ucTo) + retry x5 . write connectionUpdate $ params Quorum (status, now, lcFrom, lcTo) return $ c - { ucStatus = relationDropHistory status, - ucLastUpdate = now + { lcStatus = relationDropHistory status, + lcLastUpdated = now } -- | Lookup the connection from a user 'A' to a user 'B' (A -> B). -lookupConnection :: +lookupLocalConnection :: -- | User 'A' UserId -> -- | User 'B' UserId -> - AppIO (Maybe UserConnection) -lookupConnection from to = - liftM toUserConnection - <$> retry x1 (query1 connectionSelect (params Quorum (from, to))) + AppIO (Maybe LocalConnection) +lookupLocalConnection from to = + toLocalUserConnection <$$> retry x1 (query1 connectionSelect (params Quorum (from, to))) -- | 'lookupConnection' with more 'Relation' info. lookupRelationWithHistory :: @@ -91,19 +127,30 @@ lookupRelationWithHistory :: UserId -> AppIO (Maybe RelationWithHistory) lookupRelationWithHistory from to = - liftM runIdentity - <$> retry x1 (query1 relationSelect (params Quorum (from, to))) + runIdentity + <$$> retry x1 (query1 relationSelect (params Quorum (from, to))) --- | For a given user 'A', lookup his outgoing connections (A -> X) to other users. -lookupConnections :: UserId -> Maybe UserId -> Range 1 500 Int32 -> AppIO (ResultPage UserConnection) -lookupConnections from start (fromRange -> size) = +-- | For a given user 'A', lookup their outgoing connections (A -> X) to other users. +lookupLocalConnections :: UserId -> Maybe UserId -> Range 1 500 Int32 -> AppIO (ResultPage LocalConnection) +lookupLocalConnections from start (fromRange -> size) = toResult <$> case start of Just u -> retry x1 $ paginate connectionsSelectFrom (paramsP Quorum (from, u) (size + 1)) Nothing -> retry x1 $ paginate connectionsSelect (paramsP Quorum (Identity from) (size + 1)) where - toResult = cassandraResultPage . fmap toUserConnection . trim + toResult = cassandraResultPage . fmap toLocalUserConnection . trim trim p = p {result = take (fromIntegral size) (result p)} +-- | For a given user 'A', lookup their outgoing connections (A -> X) to other users. +-- Similar to lookupLocalConnections +lookupLocalConnectionsPage :: + (MonadClient m) => + UserId -> + Maybe PagingState -> + Range 1 1000 Int32 -> + m (PageWithState LocalConnection) +lookupLocalConnectionsPage usr pagingState (fromRange -> size) = + fmap toLocalUserConnection <$> paginateWithState connectionsSelect (paramsPagingState Quorum (Identity usr) size pagingState) + -- | Lookup all relations between two sets of users (cartesian product). lookupConnectionStatus :: [UserId] -> [UserId] -> AppIO [ConnectionStatus] lookupConnectionStatus from to = @@ -187,8 +234,8 @@ connectionClear = "DELETE FROM connection WHERE left = ?" -- Conversions -toUserConnection :: (UserId, UserId, RelationWithHistory, UTCTimeMillis, Maybe ConvId) -> UserConnection -toUserConnection (l, r, relationDropHistory -> rel, time, cid) = UserConnection l r rel time cid +toLocalUserConnection :: (UserId, UserId, RelationWithHistory, UTCTimeMillis, Maybe ConvId) -> LocalConnection +toLocalUserConnection (l, r, relationDropHistory -> rel, time, cid) = LocalConnection l r rel cid time toConnectionStatus :: (UserId, UserId, RelationWithHistory) -> ConnectionStatus toConnectionStatus (l, r, relationDropHistory -> rel) = ConnectionStatus l r rel diff --git a/services/brig/src/Brig/IO/Intra.hs b/services/brig/src/Brig/IO/Intra.hs index 951c65c582c..1b2d71880e3 100644 --- a/services/brig/src/Brig/IO/Intra.hs +++ b/services/brig/src/Brig/IO/Intra.hs @@ -89,6 +89,7 @@ import Data.Id import Data.Json.Util (UTCTimeMillis, (#)) import Data.List.Split (chunksOf) import Data.List1 (List1, list1, singleton) +import Data.Qualified import Data.Range import qualified Data.Set as Set import Galley.Types (Connect (..), Conversation) @@ -534,8 +535,9 @@ createSelfConv u = do -- | Calls 'Galley.API.createConnectConversationH'. createConnectConv :: UserId -> UserId -> Maybe Text -> Maybe ConnId -> AppIO ConvId createConnectConv from to cname conn = do + localDomain <- viewFederationDomain debug $ - logConnection from to + logConnection from (Qualified to localDomain) . remote "galley" . msg (val "Creating connect conversation") r <- galleyRequest POST req diff --git a/services/brig/test/integration/API/User/Connection.hs b/services/brig/test/integration/API/User/Connection.hs index b9f5c768316..fbd9509b118 100644 --- a/services/brig/test/integration/API/User/Connection.hs +++ b/services/brig/test/integration/API/User/Connection.hs @@ -31,6 +31,7 @@ import Brig.Types.Intra import Control.Arrow ((&&&)) import Data.ByteString.Conversion import Data.Id hiding (client) +import Data.Qualified import qualified Data.UUID.V4 as UUID import Galley.Types import Imports @@ -38,26 +39,43 @@ import qualified Network.Wai.Utilities.Error as Error import Test.Tasty hiding (Timeout) import Test.Tasty.HUnit import Util +import Wire.API.Connection +import Wire.API.Routes.MultiTablePaging tests :: ConnectionLimit -> Opt.Timeout -> Opt.Opts -> Manager -> Brig -> Cannon -> Galley -> TestTree tests cl _at _conf p b _c g = testGroup "connection" [ test p "post /connections" $ testCreateManualConnections b, + test p "post /connections/:domain/:uid" $ testCreateManualConnectionsQualified b, test p "post /connections mutual" $ testCreateMutualConnections b g, + test p "post /connections/:domain/:uid mutual" $ testCreateMutualConnectionsQualified b g, test p "post /connections (bad user)" $ testCreateConnectionInvalidUser b, + test p "post /connections/:domain/:uid (bad user)" $ testCreateConnectionInvalidUserQualified b, test p "put /connections/:id accept" $ testAcceptConnection b, + test p "put /connections/:domain/:id accept" $ testAcceptConnectionQualified b, test p "put /connections/:id ignore" $ testIgnoreConnection b, + test p "put /connections/:domain/:id ignore" $ testIgnoreConnectionQualified b, test p "put /connections/:id cancel" $ testCancelConnection b, - test p "put /connections/:id cancel" $ testCancelConnection2 b g, + test p "put /connections/:domain/:id cancel" $ testCancelConnectionQualified b, + test p "put /connections/:id cancel 2" $ testCancelConnection2 b g, + test p "put /connections/:domain/:id cancel 2" $ testCancelConnectionQualified2 b g, test p "put /connections/:id block" $ testBlockConnection b, + test p "put /connections/:domain/:id block" $ testBlockConnectionQualified b, test p "put /connections/:id block-resend" $ testBlockAndResendConnection b g, + test p "put /connections/:domain/:id block-resend" $ testBlockAndResendConnectionQualified b g, test p "put /connections/:id unblock pending" $ testUnblockPendingConnection b, + test p "put /connections/:domain/:id unblock pending" $ testUnblockPendingConnectionQualified b, test p "put /connections/:id accept blocked" $ testAcceptWhileBlocked b, + test p "put /connections/:domain/:id accept blocked" $ testAcceptWhileBlockedQualified b, test p "put /connections/:id bad update" $ testBadUpdateConnection b, + test p "put /connections/:domain/:id bad update" $ testBadUpdateConnectionQualified 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 + test p "put /connections/:domain/:id noop" $ testUpdateConnectionNoopQualified b, + test p "get /connections - 200 (paging)" $ testLocalConnectionsPaging b, + test p "post /list-connections - 200 (paging)" $ testAllConnectionsPaging b, + test p "post /connections - 400 (max conns)" $ testConnectionLimit b cl, + test p "post /connections/:domain/:id - 400 (max conns)" $ testConnectionLimitQualified b cl ] testCreateConnectionInvalidUser :: Brig -> Http () @@ -73,6 +91,22 @@ testCreateConnectionInvalidUser brig = do const 400 === statusCode const (Just "invalid-user") === fmap Error.label . responseJsonMaybe +testCreateConnectionInvalidUserQualified :: Brig -> Http () +testCreateConnectionInvalidUserQualified brig = do + quid1 <- userQualifiedId <$> randomUser brig + let uid1 = qUnqualified quid1 + domain = qDomain quid1 + -- user does not exist + uid2 <- Id <$> liftIO UUID.nextRandom + let quid2 = Qualified uid2 domain + postConnectionQualified brig uid1 quid2 !!! do + const 400 === statusCode + const (Just "invalid-user") === fmap Error.label . responseJsonMaybe + -- cannot create a connection with yourself + postConnectionQualified brig uid1 quid1 !!! do + const 400 === statusCode + const (Just "invalid-user") === fmap Error.label . responseJsonMaybe + testCreateManualConnections :: Brig -> Http () testCreateManualConnections brig = do uid1 <- userId <$> randomUser brig @@ -86,6 +120,19 @@ testCreateManualConnections brig = do postConnection brig uid1 uid3 !!! const 400 === statusCode postConnection brig uid3 uid1 !!! const 403 === statusCode +testCreateManualConnectionsQualified :: Brig -> Http () +testCreateManualConnectionsQualified brig = do + (quid1, uid1, quid2, uid2) <- twoRandomUsers brig + postConnectionQualified brig uid1 quid2 !!! const 201 === statusCode + assertConnectionQualified brig uid1 quid2 Sent + assertConnectionQualified brig uid2 quid1 Pending + -- Test that no connections to anonymous users can be created, + -- as well as that anonymous users cannot create connections. + quid3 <- userQualifiedId <$> createAnonUser "foo3" brig + let uid3 = qUnqualified quid3 + postConnectionQualified brig uid1 quid3 !!! const 400 === statusCode + postConnectionQualified brig uid3 quid1 !!! const 403 === statusCode + testCreateMutualConnections :: Brig -> Galley -> Http () testCreateMutualConnections brig galley = do uid1 <- userId <$> randomUser brig @@ -98,7 +145,7 @@ testCreateMutualConnections brig galley = do assertConnections brig uid2 [ConnectionStatus uid2 uid1 Accepted] case responseJsonMaybe rsp >>= ucConvId of Nothing -> liftIO $ assertFailure "incomplete connection" - Just cnv -> do + Just (Qualified cnv _) -> do getConversation galley uid1 cnv !!! do const 200 === statusCode const (Just One2OneConv) === fmap cnvType . responseJsonMaybe @@ -106,6 +153,28 @@ testCreateMutualConnections brig galley = do const 200 === statusCode const (Just One2OneConv) === fmap cnvType . responseJsonMaybe +testCreateMutualConnectionsQualified :: Brig -> Galley -> Http () +testCreateMutualConnectionsQualified brig galley = do + (quid1, uid1, quid2, uid2) <- twoRandomUsers brig + + postConnectionQualified brig uid1 quid2 !!! const 201 === statusCode + assertConnectionQualified brig uid1 quid2 Sent + assertConnectionQualified brig uid2 quid1 Pending + + rsp <- postConnectionQualified brig uid2 quid1 >= ucConvId of + Nothing -> liftIO $ assertFailure "incomplete connection" + Just cnv -> do + getConversationQualified galley uid1 cnv !!! do + const 200 === statusCode + const (Just One2OneConv) === fmap cnvType . responseJsonMaybe + getConversationQualified galley uid2 cnv !!! do + const 200 === statusCode + const (Just One2OneConv) === fmap cnvType . responseJsonMaybe + testAcceptConnection :: Brig -> Http () testAcceptConnection brig = do uid1 <- userId <$> randomUser brig @@ -123,6 +192,17 @@ testAcceptConnection brig = do assertConnections brig uid1 [ConnectionStatus uid1 uid3 Accepted] assertConnections brig uid3 [ConnectionStatus uid3 uid1 Accepted] +testAcceptConnectionQualified :: Brig -> Http () +testAcceptConnectionQualified brig = do + (quid1, uid1, quid2, uid2) <- twoRandomUsers brig + -- Initiate a new connection (A -> B) + postConnectionQualified brig uid1 quid2 !!! const 201 === statusCode + -- B accepts + putConnectionQualified brig uid2 quid1 Accepted !!! const 200 === statusCode + + assertConnectionQualified brig uid1 quid2 Accepted + assertConnectionQualified brig uid2 quid1 Accepted + testIgnoreConnection :: Brig -> Http () testIgnoreConnection brig = do uid1 <- userId <$> randomUser brig @@ -138,6 +218,20 @@ testIgnoreConnection brig = do assertConnections brig uid1 [ConnectionStatus uid1 uid2 Accepted] assertConnections brig uid2 [ConnectionStatus uid2 uid1 Accepted] +testIgnoreConnectionQualified :: Brig -> Http () +testIgnoreConnectionQualified brig = do + (quid1, uid1, quid2, uid2) <- twoRandomUsers brig + -- Initiate a new connection (A -> B) + postConnectionQualified brig uid1 quid2 !!! const 201 === statusCode + -- B ignores A + putConnectionQualified brig uid2 quid1 Ignored !!! const 200 === statusCode + assertConnectionQualified brig uid1 quid2 Sent + assertConnectionQualified brig uid2 quid1 Ignored + -- B accepts after all + putConnectionQualified brig uid2 quid1 Accepted !!! const 200 === statusCode + assertConnectionQualified brig uid1 quid2 Accepted + assertConnectionQualified brig uid2 quid1 Accepted + testCancelConnection :: Brig -> Http () testCancelConnection brig = do uid1 <- userId <$> randomUser brig @@ -148,11 +242,25 @@ testCancelConnection brig = do putConnection brig uid1 uid2 Cancelled !!! const 200 === statusCode assertConnections brig uid1 [ConnectionStatus uid1 uid2 Cancelled] assertConnections brig uid2 [ConnectionStatus uid2 uid1 Cancelled] - -- A changes his mind again + -- A changes their mind again postConnection brig uid1 uid2 !!! const 200 === statusCode assertConnections brig uid1 [ConnectionStatus uid1 uid2 Sent] assertConnections brig uid2 [ConnectionStatus uid2 uid1 Pending] +testCancelConnectionQualified :: Brig -> Http () +testCancelConnectionQualified brig = do + (quid1, uid1, quid2, uid2) <- twoRandomUsers brig + -- Initiate a new connection (A -> B) + postConnectionQualified brig uid1 quid2 !!! const 201 === statusCode + -- A cancels the request + putConnectionQualified brig uid1 quid2 Cancelled !!! const 200 === statusCode + assertConnectionQualified brig uid1 quid2 Cancelled + assertConnectionQualified brig uid2 quid1 Cancelled + -- A changes their mind again + postConnectionQualified brig uid1 quid2 !!! const 200 === statusCode + assertConnectionQualified brig uid1 quid2 Sent + assertConnectionQualified brig uid2 quid1 Pending + testCancelConnection2 :: Brig -> Galley -> Http () testCancelConnection2 brig galley = do uid1 <- userId <$> randomUser brig @@ -163,7 +271,7 @@ testCancelConnection2 brig galley = do rsp <- putConnection brig uid1 uid2 Cancelled Galley -> Http () +testCancelConnectionQualified2 brig galley = do + (quid1, uid1, quid2, uid2) <- twoRandomUsers brig + -- Initiate a new connection (A -> B) + postConnectionQualified brig uid1 quid2 !!! const 201 === statusCode + -- A cancels the request + rsp <- putConnectionQualified brig uid1 quid2 Cancelled do + conv <- responseJsonMaybe rs + Just (cnvType conv) + -- A is a past member, cannot see the conversation + getConversationQualified galley uid1 cnv !!! do + const 403 === statusCode + -- A finally accepts + putConnectionQualified brig uid1 quid2 Accepted !!! const 200 === statusCode + assertConnectionQualified brig uid2 quid1 Accepted + assertConnectionQualified brig uid1 quid2 Accepted + getConversationQualified galley uid1 cnv !!! do + const 200 === statusCode + getConversationQualified galley uid2 cnv !!! do + const 200 === statusCode + testBlockConnection :: Brig -> Http () testBlockConnection brig = do u1 <- randomUser brig @@ -236,6 +381,53 @@ testBlockConnection brig = do assertConnections brig uid1 [ConnectionStatus uid1 uid2 Accepted] assertEmailVisibility brig u2 u1 False +testBlockConnectionQualified :: Brig -> Http () +testBlockConnectionQualified brig = do + u1 <- randomUser brig + u2 <- randomUser brig + let uid1 = userId u1 + uid2 = userId u2 + quid1 = userQualifiedId u1 + quid2 = userQualifiedId u2 + -- Initiate a new connection (A -> B) + postConnectionQualified brig uid1 quid2 !!! const 201 === statusCode + -- Even connected users cannot see each other's email + -- (or phone number for that matter). + assertEmailVisibility brig u2 u1 False + assertEmailVisibility brig u1 u2 False + -- B blocks A + putConnectionQualified brig uid2 quid1 Blocked !!! const 200 === statusCode + -- A does not notice that he got blocked + postConnectionQualified brig uid1 quid2 !!! do + const 200 === statusCode + const (Just Sent) === fmap ucStatus . responseJsonMaybe + assertConnectionQualified brig uid2 quid1 Blocked + -- B accepts after all + putConnectionQualified brig uid2 quid1 Accepted !!! const 200 === statusCode + assertConnectionQualified brig uid1 quid2 Accepted + assertConnectionQualified brig uid2 quid1 Accepted + assertEmailVisibility brig u1 u2 False + -- B blocks A again + putConnectionQualified brig uid2 quid1 Blocked !!! const 200 === statusCode + assertConnectionQualified brig uid2 quid1 Blocked + assertConnectionQualified brig uid1 quid2 Accepted + assertEmailVisibility brig u1 u2 False + -- B accepts again + putConnectionQualified brig uid2 quid1 Accepted !!! const 200 === statusCode + assertConnectionQualified brig uid1 quid2 Accepted + assertConnectionQualified brig uid2 quid1 Accepted + assertEmailVisibility brig u1 u2 False + -- A blocks B + putConnectionQualified brig uid1 quid2 Blocked !!! const 200 === statusCode + assertConnectionQualified brig uid1 quid2 Blocked + assertConnectionQualified brig uid2 quid1 Accepted + assertEmailVisibility brig u2 u1 False + -- A accepts B again + putConnectionQualified brig uid1 quid2 Accepted !!! const 200 === statusCode + assertConnectionQualified brig uid1 quid2 Accepted + assertConnectionQualified brig uid2 quid1 Accepted + assertEmailVisibility brig u2 u1 False + testBlockAndResendConnection :: Brig -> Galley -> Http () testBlockAndResendConnection brig galley = do u1 <- randomUser brig @@ -258,12 +450,37 @@ testBlockAndResendConnection brig galley = do assertConnections brig uid1 [ConnectionStatus uid1 uid2 Accepted] assertConnections brig uid2 [ConnectionStatus uid2 uid1 Blocked] -- B never accepted and thus does not see the conversation - let Just cnv = ucConvId =<< responseJsonMaybe rsp + let Just (Qualified cnv _) = ucConvId =<< responseJsonMaybe rsp getConversation galley uid2 cnv !!! const 403 === statusCode -- A can see the conversation and is a current member getConversation galley uid1 cnv !!! do const 200 === statusCode +testBlockAndResendConnectionQualified :: Brig -> Galley -> Http () +testBlockAndResendConnectionQualified brig galley = do + (quid1, uid1, quid2, uid2) <- twoRandomUsers brig + -- Initiate a new connection (A -> B) + postConnectionQualified brig uid1 quid2 !!! const 201 === statusCode + -- B blocks A + putConnectionQualified brig uid2 quid1 Blocked !!! const 200 === statusCode + -- A blocks B + putConnectionQualified brig uid1 quid2 Blocked !!! const 200 === statusCode + -- Cannot resend while blocked, need to unblock first + postConnectionQualified brig uid1 quid2 !!! const 403 === statusCode + -- Unblock + putConnectionQualified brig uid1 quid2 Accepted !!! const 200 === statusCode + -- Try to resend the connection request + -- B is not actually notified, since he blocked. + rsp <- postConnectionQualified brig uid1 quid2 Http () testUnblockPendingConnection brig = do u1 <- userId <$> randomUser brig @@ -276,6 +493,17 @@ testUnblockPendingConnection brig = do assertConnections brig u1 [ConnectionStatus u1 u2 Sent] assertConnections brig u2 [ConnectionStatus u2 u1 Pending] +testUnblockPendingConnectionQualified :: Brig -> Http () +testUnblockPendingConnectionQualified brig = do + (quid1, uid1, quid2, uid2) <- twoRandomUsers brig + postConnectionQualified brig uid1 quid2 !!! const 201 === statusCode + putConnectionQualified brig uid1 quid2 Blocked !!! const 200 === statusCode + assertConnectionQualified brig uid1 quid2 Blocked + assertConnectionQualified brig uid2 quid1 Pending + putConnectionQualified brig uid1 quid2 Accepted !!! const 200 === statusCode + assertConnectionQualified brig uid1 quid2 Sent + assertConnectionQualified brig uid2 quid1 Pending + testAcceptWhileBlocked :: Brig -> Http () testAcceptWhileBlocked brig = do u1 <- userId <$> randomUser brig @@ -288,16 +516,31 @@ testAcceptWhileBlocked brig = do assertConnections brig u1 [ConnectionStatus u1 u2 Blocked] assertConnections brig u2 [ConnectionStatus u2 u1 Accepted] +testAcceptWhileBlockedQualified :: Brig -> Http () +testAcceptWhileBlockedQualified brig = do + (quid1, uid1, quid2, uid2) <- twoRandomUsers brig + postConnectionQualified brig uid1 quid2 !!! const 201 === statusCode + putConnectionQualified brig uid1 quid2 Blocked !!! const 200 === statusCode + assertConnectionQualified brig uid1 quid2 Blocked + assertConnectionQualified brig uid2 quid1 Pending + putConnectionQualified brig uid2 quid1 Accepted !!! const 200 === statusCode + assertConnectionQualified brig uid1 quid2 Blocked + assertConnectionQualified brig uid2 quid1 Accepted + testUpdateConnectionNoop :: Brig -> Http () testUpdateConnectionNoop brig = do - u1 <- randomUser brig - u2 <- randomUser brig - let uid1 = userId u1 - let uid2 = userId u2 + (_, uid1, _, uid2) <- twoRandomUsers brig postConnection brig uid1 uid2 !!! const 201 === statusCode putConnection brig uid2 uid1 Accepted !!! const 200 === statusCode putConnection brig uid2 uid1 Accepted !!! const 204 === statusCode +testUpdateConnectionNoopQualified :: Brig -> Http () +testUpdateConnectionNoopQualified brig = do + (quid1, uid1, quid2, uid2) <- twoRandomUsers brig + postConnectionQualified brig uid1 quid2 !!! const 201 === statusCode + putConnectionQualified brig uid2 quid1 Accepted !!! const 200 === statusCode + putConnectionQualified brig uid2 quid1 Accepted !!! const 204 === statusCode + testBadUpdateConnection :: Brig -> Http () testBadUpdateConnection brig = do uid1 <- userId <$> randomUser brig @@ -313,8 +556,23 @@ testBadUpdateConnection brig = do const 403 === statusCode const (Just "bad-conn-update") === fmap Error.label . responseJsonMaybe -testConnectionPaging :: Brig -> Http () -testConnectionPaging b = do +testBadUpdateConnectionQualified :: Brig -> Http () +testBadUpdateConnectionQualified brig = do + (quid1, uid1, quid2, uid2) <- twoRandomUsers brig + postConnectionQualified brig uid1 quid2 !!! const 201 === statusCode + assertBadUpdate uid1 quid2 Pending + assertBadUpdate uid1 quid2 Ignored + assertBadUpdate uid1 quid2 Accepted + assertBadUpdate uid2 quid1 Sent + where + assertBadUpdate :: UserId -> Qualified UserId -> Relation -> Http () + assertBadUpdate uid1 quid2 s = + putConnectionQualified brig uid1 quid2 s !!! do + const 403 === statusCode + const (Just "bad-conn-update") === fmap Error.label . responseJsonMaybe + +testLocalConnectionsPaging :: Brig -> Http () +testLocalConnectionsPaging b = do u <- userId <$> randomUser b replicateM_ total $ do u2 <- userId <$> randomUser b @@ -323,6 +581,7 @@ testConnectionPaging b = do foldM_ (next u total) (0, Nothing) [total, 0] where total = 5 + next :: UserId -> Int -> (Int, Maybe UserId) -> Int -> HttpT IO (Int, Maybe UserId) next u step (count, start) n = do let count' = count + step let range = queryRange (toByteString' <$> start) (Just step) @@ -332,7 +591,32 @@ testConnectionPaging b = do let (conns, more) = (fmap clConnections &&& fmap clHasMore) $ responseJsonMaybe r liftIO $ assertEqual "page size" (Just n) (length <$> conns) liftIO $ assertEqual "has more" (Just (count' < total)) more - return . (count',) $ (conns >>= fmap ucTo . listToMaybe . reverse) + return . (count',) $ (conns >>= fmap (qUnqualified . ucTo) . listToMaybe . reverse) + +testAllConnectionsPaging :: Brig -> Http () +testAllConnectionsPaging b = do + quid <- userQualifiedId <$> randomUser b + let uid = qUnqualified quid + replicateM_ total $ do + qOther <- userQualifiedId <$> randomUser b + postConnectionQualified b uid qOther !!! const 201 === statusCode + + -- get all connections at once + resAll :: ConnectionsPage <- responseJsonError =<< listAllConnections b uid Nothing Nothing + liftIO $ assertEqual "all: size" total (length . mtpResults $ resAll) + liftIO $ assertEqual "all: has_more" False (mtpHasMore resAll) + + -- paginate by passing the pagingState + resFirst :: ConnectionsPage <- responseJsonError =<< listAllConnections b uid (Just size) Nothing + liftIO $ assertEqual "first: size" size (length . mtpResults $ resFirst) + liftIO $ assertEqual "first: has_more" True (mtpHasMore resFirst) + + resNext :: ConnectionsPage <- responseJsonError =<< listAllConnections b uid Nothing (Just $ mtpPagingState resFirst) + liftIO $ assertEqual "next: size" (total - size) (length . mtpResults $ resNext) + liftIO $ assertEqual "next: has_more" False (mtpHasMore resNext) + where + size = 2 + total = 5 testConnectionLimit :: Brig -> ConnectionLimit -> Http () testConnectionLimit brig (ConnectionLimit l) = do @@ -356,3 +640,28 @@ testConnectionLimit brig (ConnectionLimit l) = do assertLimited = do const 403 === statusCode const (Just "connection-limit") === fmap Error.label . responseJsonMaybe + +testConnectionLimitQualified :: Brig -> ConnectionLimit -> Http () +testConnectionLimitQualified brig (ConnectionLimit l) = do + quid1 <- userQualifiedId <$> randomUser brig + let uid1 = qUnqualified quid1 + (quid2 : _) <- replicateM (fromIntegral l) (newConn uid1) + quidX <- userQualifiedId <$> randomUser brig + postConnectionQualified brig uid1 quidX !!! assertLimited + -- blocked connections do not count towards the limit + putConnectionQualified brig uid1 quid2 Blocked !!! const 200 === statusCode + postConnectionQualified brig uid1 quidX !!! const 201 === statusCode + -- the next send/accept hits the limit again + quidY <- userQualifiedId <$> randomUser brig + postConnectionQualified brig uid1 quidY !!! assertLimited + -- (re-)sending an already accepted connection does not affect the limit + postConnectionQualified brig uid1 quidX !!! const 200 === statusCode + where + newConn :: UserId -> Http (Qualified UserId) + newConn from = do + to <- userQualifiedId <$> randomUser brig + postConnectionQualified brig from to !!! const 201 === statusCode + return to + assertLimited = do + const 403 === statusCode + const (Just "connection-limit") === fmap Error.label . responseJsonMaybe diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index fd09bb6c81c..155a5c7e832 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -41,12 +41,14 @@ import Data.Domain (Domain) import Data.Handle (Handle (Handle)) import Data.Id hiding (client) import Data.Misc (PlainTextPassword (..)) +import Data.Qualified import Data.Range (unsafeRange) import qualified Data.Text.Ascii as Ascii import qualified Data.Vector as Vec import Imports import Test.Tasty.HUnit import Util +import Wire.API.Routes.MultiTablePaging (LocalOrRemoteTable, MultiTablePagingState) newtype ConnectionLimit = ConnectionLimit Int64 @@ -245,6 +247,30 @@ listConnections brig u = . path "connections" . zUser u +listAllConnections :: (MonadIO m, MonadHttp m, HasCallStack) => Brig -> UserId -> Maybe Int -> Maybe (MultiTablePagingState "Connections" LocalOrRemoteTable) -> m ResponseLBS +listAllConnections brig u size state = + post $ + brig + . path "list-connections" + . zUser u + . expect2xx + . contentJson + . body + ( RequestBodyLBS $ + encode $ + object + [ "size" .= size, + "paging_state" .= state + ] + ) + +getConnectionQualified :: (MonadIO m, MonadHttp m) => Brig -> UserId -> Qualified UserId -> m ResponseLBS +getConnectionQualified brig from (Qualified toUser toDomain) = + get $ + brig + . paths ["connections", toByteString' toDomain, toByteString' toUser] + . zUser from + setProperty :: Brig -> UserId -> ByteString -> Value -> (MonadIO m, MonadHttp m) => m ResponseLBS setProperty brig u k v = put $ @@ -290,7 +316,13 @@ assertConnections brig u cs = const (Just True) === fmap (check . map status . clConnections) . responseJsonMaybe where check xs = all (`elem` xs) cs - status c = ConnectionStatus (ucFrom c) (ucTo c) (ucStatus c) + status c = ConnectionStatus (ucFrom c) (qUnqualified $ ucTo c) (ucStatus c) + +assertConnectionQualified :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> UserId -> Qualified UserId -> Relation -> m () +assertConnectionQualified brig u1 qu2 rel = + getConnectionQualified brig u1 qu2 !!! do + const 200 === statusCode + const (Right rel) === fmap ucStatus . responseJsonEither assertEmailVisibility :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> User -> User -> Bool -> m () assertEmailVisibility brig a b visible = diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index d33c4d61c3c..cb6c5ffc717 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 (qDomain, qUnqualified)) +import Data.Qualified import Data.Range import qualified Data.Text as Text import qualified Data.Text.Ascii as Ascii @@ -123,6 +123,14 @@ test m n h = testCase n (void $ runHttpT m h) test' :: AWS.Env -> Manager -> TestName -> Http a -> TestTree test' e m n h = testCase n $ void $ runHttpT m (liftIO (purgeJournalQueue e) >> h) +twoRandomUsers :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> m (Qualified UserId, UserId, Qualified UserId, UserId) +twoRandomUsers brig = do + quid1 <- userQualifiedId <$> randomUser brig + quid2 <- userQualifiedId <$> randomUser brig + let uid1 = qUnqualified quid1 + uid2 = qUnqualified quid2 + pure (quid1, uid1, quid2, uid2) + randomUser :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => Brig -> @@ -409,6 +417,15 @@ postConnection brig from to = RequestBodyLBS . encode $ ConnectionRequest to (unsafeRange "some conv name") +postConnectionQualified :: (MonadIO m, MonadHttp m) => Brig -> UserId -> Qualified UserId -> m ResponseLBS +postConnectionQualified brig from (Qualified toUser toDomain) = + post $ + brig + . paths ["/connections", toByteString' toDomain, toByteString' toUser] + . contentJson + . zUser from + . zConn "conn" + putConnection :: Brig -> UserId -> UserId -> Relation -> (MonadIO m, MonadHttp m) => m ResponseLBS putConnection brig from to r = put $ @@ -421,6 +438,18 @@ putConnection brig from to r = where payload = RequestBodyLBS . encode $ object ["status" .= r] +putConnectionQualified :: Brig -> UserId -> Qualified UserId -> Relation -> (MonadIO m, MonadHttp m) => m ResponseLBS +putConnectionQualified brig from (Qualified to toDomain) r = + put $ + brig + . paths ["/connections", toByteString' toDomain, toByteString' to] + . contentJson + . body payload + . zUser from + . zConn "conn" + where + payload = RequestBodyLBS . encode $ object ["status" .= r] + connectUsers :: Brig -> UserId -> List1 UserId -> (MonadIO m, MonadHttp m) => m () connectUsers b u = mapM_ connectTo where diff --git a/services/galley/test/integration/API/Teams/LegalHold.hs b/services/galley/test/integration/API/Teams/LegalHold.hs index 9038df8cba8..d5b1b2cbb6f 100644 --- a/services/galley/test/integration/API/Teams/LegalHold.hs +++ b/services/galley/test/integration/API/Teams/LegalHold.hs @@ -58,7 +58,7 @@ import qualified Data.List1 as List1 import qualified Data.Map.Strict as Map import Data.Misc (PlainTextPassword) import Data.PEM -import Data.Qualified (Qualified (Qualified)) +import Data.Qualified (Qualified (..)) import Data.Range import qualified Data.Set as Set import Data.String.Conversions (LBS, cs) @@ -888,7 +888,7 @@ testNoConsentBlockOne2OneConv connectFirst teamPeer approveLH testPendingConnect id peer peerClient - convId + (qUnqualified convId) [ (legalholder, legalholderLHDevice, "cipher") ] !!! do @@ -921,7 +921,7 @@ testNoConsentBlockOne2OneConv connectFirst teamPeer approveLH testPendingConnect id peer peerClient - convId + (qUnqualified convId) [ (legalholder, legalholderLHDevice, "cipher") ] !!! do diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 3edbef5d300..ec9fbf53e89 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -1609,7 +1609,7 @@ assertConnections u cstat = do unless (all (`elem` cstat') cstat) $ error $ "connection check failed: " <> show cstat <> " is not a subset of " <> show cstat' where - status c = ConnectionStatus (ucFrom c) (ucTo c) (ucStatus c) + status c = ConnectionStatus (ucFrom c) (qUnqualified $ ucTo c) (ucStatus c) listConnections brig usr = get $ brig . path "connections" . zUser usr randomUsers :: Int -> TestM [UserId] diff --git a/tools/api-simulations/lib/src/Network/Wire/Simulations.hs b/tools/api-simulations/lib/src/Network/Wire/Simulations.hs index eaa80350402..f0f383a491b 100644 --- a/tools/api-simulations/lib/src/Network/Wire/Simulations.hs +++ b/tools/api-simulations/lib/src/Network/Wire/Simulations.hs @@ -74,7 +74,7 @@ prepareConv [_] = error "prepareConv: at least two bots required" prepareConv [a, b] = do connectIfNeeded a b conv <- (>>= ucConvId) <$> runBotSession a (getConnection (botId b)) - requireMaybe conv $ + requireMaybe (qUnqualified <$> conv) $ "Missing 1-1 conversation between: " <> Text.concat (Text.pack . show . botId <$> [a, b]) prepareConv (a : bs) = do diff --git a/tools/api-simulations/smoketest/src/Network/Wire/Simulations/SmokeTest.hs b/tools/api-simulations/smoketest/src/Network/Wire/Simulations/SmokeTest.hs index e3787eb3e5f..529cdf29486 100644 --- a/tools/api-simulations/smoketest/src/Network/Wire/Simulations/SmokeTest.hs +++ b/tools/api-simulations/smoketest/src/Network/Wire/Simulations/SmokeTest.hs @@ -68,7 +68,7 @@ mainBotNet n = do crName = unsafeRange $ fromMaybe "" (botEmail ally) } assertConnectRequested ally user - requireMaybe (ucConvId conn) "conv_id not set after connection request" + requireMaybe (qUnqualified <$> ucConvId conn) "conv_id not set after connection request" info $ msg "Setting up connections between Ally and the rest of the gang" (a2b, a2c, a2goons) <- runBotSession ally $ do a2b <- allyConnectTo bill diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index cd59a002da7..a1fa618edd5 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -139,11 +139,12 @@ getUserConnections uid = do info $ msg "Getting user connections" fetchAll [] Nothing where + fetchAll :: [UserConnection] -> Maybe UserId -> Handler [UserConnection] fetchAll xs start = do userConnectionList <- fetchBatch start let batch = clConnections userConnectionList - if (not . null) batch && (clHasMore userConnectionList) - then fetchAll (batch ++ xs) (Just . ucTo $ last batch) + if (not . null) batch && clHasMore userConnectionList + then fetchAll (batch ++ xs) (Just . qUnqualified . ucTo $ last batch) else return (batch ++ xs) fetchBatch :: Maybe UserId -> Handler UserConnectionList fetchBatch start = do From 34e693b90d0689a196dbc68d29828c3322d15abb Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Thu, 23 Sep 2021 14:06:58 -0700 Subject: [PATCH 51/72] Polysemy: Separate more Cassandra effects from Spar (#1792) * Make sure to actually wrap the action in 'wrapMonadClientSem' * Implement wrapMonadClient in terms of wrapMonadClientSem * Pull out IdP effect * Push Member IdP constraints throughout * Pull application logic out of Data and into App * Use application-level functions instead * Remove deleteTeam from Data too * Get rid of wrapMonadClientWithEnvSem * Implement wrapSpar * Undo accidental formatting * Update cabal * make format * Update changelog * Get rid of the untouchable variable in liftSem * Be very careful about wrapping in the same places * Resort exports * Changelog * DefaultSsoCode effect * ScimTokenStore effect * wip BindCookie effect * Forgot some callsites * Get tests compiling again * Get everything compiling * remove runSparCassSem * Change the tests to use IdP * Finish all SAMLUser and IdP effects refs in tests * Excise all references to IdP and SAMLUser effects * make format * make format * Remove all references to new effects * make format * Add ScimUserTimesStore effect * ScimExternalIdStore effect * make format * Implement scimExternalIdStoreToCassandra * Use Members when appropriate * make format * Fixes. * Remove unwritten BindCookie effect modules * SAMLUser -> SAMLUserStore * Don't do extraneous lifting * Changelog.d --- changelog.d/5-internal/misc-effects | 1 + services/spar/spar.cabal | 14 ++- services/spar/src/Spar/API.hs | 52 ++++++----- services/spar/src/Spar/App.hs | 90 ++++++++++++------- services/spar/src/Spar/Scim.hs | 9 +- services/spar/src/Spar/Scim/Auth.hs | 24 ++--- services/spar/src/Spar/Scim/User.hs | 76 +++++++++------- services/spar/src/Spar/Sem/DefaultSsoCode.hs | 12 +++ .../src/Spar/Sem/DefaultSsoCode/Cassandra.hs | 21 +++++ services/spar/src/Spar/Sem/SAMLUser.hs | 17 ---- services/spar/src/Spar/Sem/SAMLUserStore.hs | 17 ++++ .../{SAMLUser => SAMLUserStore}/Cassandra.hs | 10 +-- .../spar/src/Spar/Sem/ScimExternalIdStore.hs | 13 +++ .../Spar/Sem/ScimExternalIdStore/Cassandra.hs | 19 ++++ services/spar/src/Spar/Sem/ScimTokenStore.hs | 15 ++++ .../src/Spar/Sem/ScimTokenStore/Cassandra.hs | 23 +++++ .../spar/src/Spar/Sem/ScimUserTimesStore.hs | 15 ++++ .../Spar/Sem/ScimUserTimesStore/Cassandra.hs | 15 ++++ .../test-integration/Test/Spar/AppSpec.hs | 4 +- .../test-integration/Test/Spar/DataSpec.hs | 31 +++---- .../Test/Spar/Scim/UserSpec.hs | 14 ++- services/spar/test-integration/Util/Core.hs | 38 ++++++-- services/spar/test-integration/Util/Scim.hs | 26 +++--- 23 files changed, 383 insertions(+), 173 deletions(-) create mode 100644 changelog.d/5-internal/misc-effects create mode 100644 services/spar/src/Spar/Sem/DefaultSsoCode.hs create mode 100644 services/spar/src/Spar/Sem/DefaultSsoCode/Cassandra.hs delete mode 100644 services/spar/src/Spar/Sem/SAMLUser.hs create mode 100644 services/spar/src/Spar/Sem/SAMLUserStore.hs rename services/spar/src/Spar/Sem/{SAMLUser => SAMLUserStore}/Cassandra.hs (81%) create mode 100644 services/spar/src/Spar/Sem/ScimExternalIdStore.hs create mode 100644 services/spar/src/Spar/Sem/ScimExternalIdStore/Cassandra.hs create mode 100644 services/spar/src/Spar/Sem/ScimTokenStore.hs create mode 100644 services/spar/src/Spar/Sem/ScimTokenStore/Cassandra.hs create mode 100644 services/spar/src/Spar/Sem/ScimUserTimesStore.hs create mode 100644 services/spar/src/Spar/Sem/ScimUserTimesStore/Cassandra.hs diff --git a/changelog.d/5-internal/misc-effects b/changelog.d/5-internal/misc-effects new file mode 100644 index 00000000000..c9dffe42031 --- /dev/null +++ b/changelog.d/5-internal/misc-effects @@ -0,0 +1 @@ +Pull more polysemy effects out of Spar. diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index 4272dcb5931..4dc34caf29b 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 920daea26e271c6f0d5688476b71beb67c388d49d00e6f57723aaf825eb3df0d +-- hash: f135fc7f6d1e85694286faaeb615c1808dedee43fd207e59f50864481c2a9cca name: spar version: 0.1 @@ -34,11 +34,19 @@ library Spar.Scim.Auth Spar.Scim.Types Spar.Scim.User + Spar.Sem.DefaultSsoCode + Spar.Sem.DefaultSsoCode.Cassandra Spar.Sem.IdP Spar.Sem.IdP.Cassandra Spar.Sem.IdP.Mem - Spar.Sem.SAMLUser - Spar.Sem.SAMLUser.Cassandra + Spar.Sem.SAMLUserStore + Spar.Sem.SAMLUserStore.Cassandra + Spar.Sem.ScimExternalIdStore + Spar.Sem.ScimExternalIdStore.Cassandra + Spar.Sem.ScimTokenStore + Spar.Sem.ScimTokenStore.Cassandra + Spar.Sem.ScimUserTimesStore + Spar.Sem.ScimUserTimesStore.Cassandra other-modules: Paths_spar hs-source-dirs: diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 18eeb481b0f..569906b4397 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -64,9 +64,15 @@ import qualified Spar.Intra.Brig as Brig import qualified Spar.Intra.Galley as Galley import Spar.Orphans () import Spar.Scim +import Spar.Sem.DefaultSsoCode (DefaultSsoCode) +import qualified Spar.Sem.DefaultSsoCode as DefaultSsoCode import qualified Spar.Sem.IdP as IdPEffect -import Spar.Sem.SAMLUser (SAMLUser) -import qualified Spar.Sem.SAMLUser as SAMLUser +import Spar.Sem.SAMLUserStore (SAMLUserStore) +import qualified Spar.Sem.SAMLUserStore as SAMLUserStore +import Spar.Sem.ScimExternalIdStore (ScimExternalIdStore) +import Spar.Sem.ScimTokenStore (ScimTokenStore) +import qualified Spar.Sem.ScimTokenStore as ScimTokenStore +import Spar.Sem.ScimUserTimesStore (ScimUserTimesStore) import qualified URI.ByteString as URI import Wire.API.Cookie import Wire.API.Routes.Public.Spar @@ -78,7 +84,7 @@ app ctx = SAML.setHttpCachePolicy $ serve (Proxy @API) (hoistServer (Proxy @API) (SAML.nt @SparError @(Spar _) ctx) (api $ sparCtxOpts ctx) :: Server API) -api :: Members [IdPEffect.IdP, SAMLUser] r => Opts -> ServerT API (Spar r) +api :: Members '[ScimExternalIdStore, ScimUserTimesStore, ScimTokenStore, DefaultSsoCode, IdPEffect.IdP, SAMLUserStore] r => Opts -> ServerT API (Spar r) api opts = apiSSO opts :<|> authreqPrecheck @@ -87,7 +93,7 @@ api opts = :<|> apiScim :<|> apiINTERNAL -apiSSO :: Members [IdPEffect.IdP, SAMLUser] r => Opts -> ServerT APISSO (Spar r) +apiSSO :: Members '[ScimTokenStore, DefaultSsoCode, IdPEffect.IdP, SAMLUserStore] r => Opts -> ServerT APISSO (Spar r) apiSSO opts = SAML.meta appName (sparSPIssuer Nothing) (sparResponseURI Nothing) :<|> (\tid -> SAML.meta appName (sparSPIssuer (Just tid)) (sparResponseURI (Just tid))) @@ -97,7 +103,7 @@ apiSSO opts = :<|> authresp . Just :<|> ssoSettings -apiIDP :: Members [IdPEffect.IdP, SAMLUser] r => ServerT APIIDP (Spar r) +apiIDP :: Members '[ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => ServerT APIIDP (Spar r) apiIDP = idpGet :<|> idpGetRaw @@ -106,7 +112,7 @@ apiIDP = :<|> idpUpdate :<|> idpDelete -apiINTERNAL :: Members [IdPEffect.IdP, SAMLUser] r => ServerT APIINTERNAL (Spar r) +apiINTERNAL :: Members '[ScimTokenStore, DefaultSsoCode, IdPEffect.IdP, SAMLUserStore] r => ServerT APIINTERNAL (Spar r) apiINTERNAL = internalStatus :<|> internalDeleteTeam @@ -181,7 +187,7 @@ validateRedirectURL uri = do unless ((SBS.length $ URI.serializeURIRef' uri) <= redirectURLMaxLength) $ do throwSpar $ SparBadInitiateLoginQueryParams "url-too-long" -authresp :: forall r. Members [IdPEffect.IdP, SAMLUser] r => Maybe TeamId -> Maybe ST -> SAML.AuthnResponseBody -> Spar r Void +authresp :: forall r. Members '[ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe TeamId -> Maybe ST -> SAML.AuthnResponseBody -> Spar r Void authresp mbtid ckyraw arbody = logErrors $ SAML.authresp mbtid (sparSPIssuer mbtid) (sparResponseURI mbtid) go arbody where cky :: Maybe BindCookie @@ -202,9 +208,9 @@ authresp mbtid ckyraw arbody = logErrors $ SAML.authresp mbtid (sparSPIssuer mbt (Multipart.inputs (SAML.authnResponseBodyRaw arbody)) ckyraw -ssoSettings :: Spar r SsoSettings +ssoSettings :: Member DefaultSsoCode r => Spar r SsoSettings ssoSettings = do - SsoSettings <$> wrapMonadClient Data.getDefaultSsoCode + SsoSettings <$> wrapMonadClientSem DefaultSsoCode.get ---------------------------------------------------------------------------- -- IdP API @@ -237,20 +243,20 @@ idpGetAll zusr = withDebugLog "idpGetAll" (const Nothing) $ do -- matter what the team size, it shouldn't choke any servers, just the client (which is -- probably curl running locally on one of the spar instances). -- https://github.com/zinfra/backend-issues/issues/1314 -idpDelete :: forall r. Members [SAMLUser, IdPEffect.IdP] r => Maybe UserId -> SAML.IdPId -> Maybe Bool -> Spar r NoContent +idpDelete :: forall r. Members '[ScimTokenStore, SAMLUserStore, IdPEffect.IdP] r => Maybe UserId -> SAML.IdPId -> Maybe Bool -> Spar r NoContent idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (const Nothing) $ do idp <- SAML.getIdPConfig idpid _ <- authorizeIdP zusr idp let issuer = idp ^. SAML.idpMetadata . SAML.edIssuer team = idp ^. SAML.idpExtraInfo . wiTeam -- if idp is not empty: fail or purge - idpIsEmpty <- wrapMonadClientSem $ isNothing <$> SAMLUser.getAnyByIssuer issuer + idpIsEmpty <- wrapMonadClientSem $ isNothing <$> SAMLUserStore.getAnyByIssuer issuer let doPurge :: Spar r () doPurge = do - some <- wrapMonadClientSem (SAMLUser.getSomeByIssuer issuer) + some <- wrapMonadClientSem (SAMLUserStore.getSomeByIssuer issuer) forM_ some $ \(uref, uid) -> do Brig.deleteBrigUser uid - wrapMonadClientSem (SAMLUser.delete uid uref) + wrapMonadClientSem (SAMLUserStore.delete uid uref) unless (null some) doPurge when (not idpIsEmpty) $ do if purge @@ -262,9 +268,9 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons -- Delete tokens associated with given IdP (we rely on the fact that -- each IdP has exactly one team so we can look up all tokens -- associated with the team and then filter them) - tokens <- liftMonadClient $ Data.getScimTokens team + tokens <- liftSem $ ScimTokenStore.getByTeam team for_ tokens $ \ScimTokenInfo {..} -> - when (stiIdP == Just idpid) $ liftMonadClient $ Data.deleteScimToken team stiId + when (stiIdP == Just idpid) $ liftSem $ ScimTokenStore.delete team stiId -- Delete IdP config liftSem $ do IdPEffect.deleteConfig idpid issuer team @@ -292,11 +298,11 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons -- | This handler only does the json parsing, and leaves all authorization checks and -- application logic to 'idpCreateXML'. -idpCreate :: Member IdPEffect.IdP r => Maybe UserId -> IdPMetadataInfo -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Spar r IdP +idpCreate :: Members '[ScimTokenStore, IdPEffect.IdP] r => Maybe UserId -> IdPMetadataInfo -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Spar r IdP idpCreate zusr (IdPMetadataValue raw xml) midpid apiversion = idpCreateXML zusr raw xml midpid apiversion -- | We generate a new UUID for each IdP used as IdPConfig's path, thereby ensuring uniqueness. -idpCreateXML :: Member IdPEffect.IdP r => Maybe UserId -> Text -> SAML.IdPMetadata -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Spar r IdP +idpCreateXML :: Members '[ScimTokenStore, IdPEffect.IdP] r => Maybe UserId -> Text -> SAML.IdPMetadata -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Spar r IdP idpCreateXML zusr raw idpmeta mReplaces (fromMaybe defWireIdPAPIVersion -> apiversion) = withDebugLog "idpCreate" (Just . show . (^. SAML.idpId)) $ do teamid <- Brig.getZUsrCheckPerm zusr CreateUpdateDeleteIdp Galley.assertSSOEnabled teamid @@ -312,9 +318,9 @@ idpCreateXML zusr raw idpmeta mReplaces (fromMaybe defWireIdPAPIVersion -> apive -- data contains no information about the idp issuer, only the user name, so no valid saml -- credentials can be created. To fix this, we need to implement a way to associate scim -- tokens with IdPs. https://wearezeta.atlassian.net/browse/SQSERVICES-165 -assertNoScimOrNoIdP :: Member IdPEffect.IdP r => TeamId -> Spar r () +assertNoScimOrNoIdP :: Members '[ScimTokenStore, IdPEffect.IdP] r => TeamId -> Spar r () assertNoScimOrNoIdP teamid = do - numTokens <- length <$> wrapMonadClient (Data.getScimTokens teamid) + numTokens <- length <$> wrapMonadClientSem (ScimTokenStore.getByTeam teamid) numIdps <- length <$> wrapMonadClientSem (IdPEffect.getConfigsByTeam teamid) when (numTokens > 0 && numIdps > 0) $ do throwSpar $ @@ -482,14 +488,14 @@ internalStatus = pure NoContent -- | Cleanup handler that is called by Galley whenever a team is about to -- get deleted. -internalDeleteTeam :: Members [IdPEffect.IdP, SAMLUser] r => TeamId -> Spar r NoContent +internalDeleteTeam :: Members '[ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => TeamId -> Spar r NoContent internalDeleteTeam team = do wrapSpar $ deleteTeam team pure NoContent -internalPutSsoSettings :: Member IdPEffect.IdP r => SsoSettings -> Spar r NoContent +internalPutSsoSettings :: Members '[DefaultSsoCode, IdPEffect.IdP] r => SsoSettings -> Spar r NoContent internalPutSsoSettings SsoSettings {defaultSsoCode = Nothing} = do - wrapMonadClient $ Data.deleteDefaultSsoCode + wrapMonadClientSem $ DefaultSsoCode.delete pure NoContent internalPutSsoSettings SsoSettings {defaultSsoCode = Just code} = do wrapMonadClientSem (IdPEffect.getConfig code) >>= \case @@ -499,5 +505,5 @@ internalPutSsoSettings SsoSettings {defaultSsoCode = Just code} = do -- "Could not find IdP". throwSpar $ SparIdPNotFound mempty Just _ -> do - wrapMonadClient $ Data.storeDefaultSsoCode code + wrapMonadClientSem $ DefaultSsoCode.store code pure NoContent diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index 0990c0f4dd5..9da98da45ee 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -98,12 +98,22 @@ import Spar.Error import qualified Spar.Intra.Brig as Intra import qualified Spar.Intra.Galley as Intra import Spar.Orphans () +import Spar.Sem.DefaultSsoCode (DefaultSsoCode) +import Spar.Sem.DefaultSsoCode.Cassandra (defaultSsoCodeToCassandra) import Spar.Sem.IdP (GetIdPResult (..)) import qualified Spar.Sem.IdP as IdPEffect import Spar.Sem.IdP.Cassandra (idPToCassandra) -import Spar.Sem.SAMLUser (SAMLUser) -import qualified Spar.Sem.SAMLUser as SAMLUser -import Spar.Sem.SAMLUser.Cassandra (interpretClientToIO, samlUserToCassandra) +import Spar.Sem.SAMLUserStore (SAMLUserStore) +import qualified Spar.Sem.SAMLUserStore as SAMLUserStore +import Spar.Sem.SAMLUserStore.Cassandra (interpretClientToIO, samlUserStoreToCassandra) +import Spar.Sem.ScimExternalIdStore (ScimExternalIdStore) +import qualified Spar.Sem.ScimExternalIdStore as ScimExternalIdStore +import Spar.Sem.ScimExternalIdStore.Cassandra (scimExternalIdStoreToCassandra) +import Spar.Sem.ScimTokenStore (ScimTokenStore) +import qualified Spar.Sem.ScimTokenStore as ScimTokenStore +import Spar.Sem.ScimTokenStore.Cassandra (scimTokenStoreToCassandra) +import Spar.Sem.ScimUserTimesStore (ScimUserTimesStore) +import Spar.Sem.ScimUserTimesStore.Cassandra (scimUserTimesStoreToCassandra) import qualified System.Logger as Log import System.Logger.Class (MonadLogger (log)) import URI.ByteString as URI @@ -252,8 +262,8 @@ wrapSpar action = Spar $ do fromSpar $ wrapMonadClientSem (runExceptT $ flip runReaderT env $ fromSpar action) >>= Spar . lift . except -insertUser :: Member SAMLUser r => SAML.UserRef -> UserId -> Spar r () -insertUser uref uid = wrapMonadClientSem $ SAMLUser.insert uref uid +insertUser :: Member SAMLUserStore r => SAML.UserRef -> UserId -> Spar r () +insertUser uref uid = wrapMonadClientSem $ SAMLUserStore.insert uref uid -- | Look up user locally in table @spar.user@ or @spar.scim_user@ (depending on the -- argument), then in brig, then return the 'UserId'. If either lookup fails, or user is not @@ -272,12 +282,12 @@ insertUser uref uid = wrapMonadClientSem $ SAMLUser.insert uref uid -- the team with valid SAML credentials. -- -- FUTUREWORK: Remove and reinstatate getUser, in AuthID refactoring PR. (in https://github.com/wireapp/wire-server/pull/1410, undo https://github.com/wireapp/wire-server/pull/1418) -getUserIdByUref :: Member SAMLUser r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult UserId) +getUserIdByUref :: Member SAMLUserStore r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult UserId) getUserIdByUref mbteam uref = userId <$$> getUserByUref mbteam uref -getUserByUref :: Member SAMLUser r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult User) +getUserByUref :: Member SAMLUserStore r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult User) getUserByUref mbteam uref = do - muid <- wrapMonadClientSem $ SAMLUser.get uref + muid <- wrapMonadClientSem $ SAMLUserStore.get uref case muid of Nothing -> pure GetUserNotFound Just uid -> do @@ -303,9 +313,9 @@ instance Functor GetUserResult where fmap _ GetUserWrongTeam = GetUserWrongTeam -- FUTUREWORK: Remove and reinstatate getUser, in AuthID refactoring PR -getUserIdByScimExternalId :: TeamId -> Email -> Spar r (Maybe UserId) +getUserIdByScimExternalId :: Member ScimExternalIdStore r => TeamId -> Email -> Spar r (Maybe UserId) getUserIdByScimExternalId tid email = do - muid <- wrapMonadClient $ (Data.lookupScimExternalId tid email) + muid <- wrapMonadClientSem $ (ScimExternalIdStore.lookup tid email) case muid of Nothing -> pure Nothing Just uid -> do @@ -329,7 +339,7 @@ getUserIdByScimExternalId tid email = do -- FUTUREWORK: once we support , brig will refuse to delete -- users that have an sso id, unless the request comes from spar. then we can make users -- undeletable in the team admin page, and ask admins to go talk to their IdP system. -createSamlUserWithId :: Member SAMLUser r => TeamId -> UserId -> SAML.UserRef -> Spar r () +createSamlUserWithId :: Member SAMLUserStore r => TeamId -> UserId -> SAML.UserRef -> Spar r () createSamlUserWithId teamid buid suid = do uname <- either (throwSpar . SparBadUserName . cs) pure $ Intra.mkUserName Nothing (UrefOnly suid) buid' <- Intra.createBrigUserSAML suid buid teamid uname ManagedByWire @@ -338,14 +348,14 @@ createSamlUserWithId teamid buid suid = do -- | If the team has no scim token, call 'createSamlUser'. Otherwise, raise "invalid -- credentials". -autoprovisionSamlUser :: Members [IdPEffect.IdP, SAMLUser] r => Maybe TeamId -> SAML.UserRef -> Spar r UserId +autoprovisionSamlUser :: Members '[ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe TeamId -> SAML.UserRef -> Spar r UserId autoprovisionSamlUser mbteam suid = do buid <- Id <$> liftIO UUID.nextRandom autoprovisionSamlUserWithId mbteam buid suid pure buid -- | Like 'autoprovisionSamlUser', but for an already existing 'UserId'. -autoprovisionSamlUserWithId :: forall r. Members [IdPEffect.IdP, SAMLUser] r => Maybe TeamId -> UserId -> SAML.UserRef -> Spar r () +autoprovisionSamlUserWithId :: forall r. Members '[ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe TeamId -> UserId -> SAML.UserRef -> Spar r () autoprovisionSamlUserWithId mbteam buid suid = do idp <- getIdPConfigByIssuerOptionalSPId (suid ^. uidTenant) mbteam guardReplacedIdP idp @@ -363,7 +373,7 @@ autoprovisionSamlUserWithId mbteam buid suid = do guardScimTokens :: IdP -> Spar r () guardScimTokens idp = do let teamid = idp ^. idpExtraInfo . wiTeam - scimtoks <- wrapMonadClient $ Data.getScimTokens teamid + scimtoks <- wrapMonadClientSem $ ScimTokenStore.getByTeam teamid unless (null scimtoks) $ do throwSpar SparSamlCredentialsNotFound @@ -388,7 +398,7 @@ validateEmailIfExists uid = \case -- -- Before returning, change account status or fail if account is nto active or pending an -- invitation. -bindUser :: Members [IdPEffect.IdP, SAMLUser] r => UserId -> SAML.UserRef -> Spar r UserId +bindUser :: Members '[IdPEffect.IdP, SAMLUserStore] r => UserId -> SAML.UserRef -> Spar r UserId bindUser buid userref = do oldStatus <- do let err :: Spar r a @@ -415,7 +425,7 @@ bindUser buid userref = do Ephemeral -> err oldStatus PendingInvitation -> Intra.setStatus buid Active -instance (r ~ '[IdPEffect.IdP, SAMLUser, Embed (Cas.Client), Embed IO, Final IO]) => SPHandler SparError (Spar r) where +instance (r ~ '[ScimExternalIdStore, ScimUserTimesStore, ScimTokenStore, DefaultSsoCode, IdPEffect.IdP, SAMLUserStore, Embed (Cas.Client), Embed IO, Final IO]) => SPHandler SparError (Spar r) where type NTCTX (Spar r) = Env nt :: forall a. Env -> Spar r a -> Handler a nt ctx (Spar action) = do @@ -423,7 +433,19 @@ instance (r ~ '[IdPEffect.IdP, SAMLUser, Embed (Cas.Client), Embed IO, Final IO] throwErrorAsHandlerException err where actionHandler :: Handler (Either SparError a) - actionHandler = liftIO $ runFinal $ embedToFinal @IO $ interpretClientToIO (sparCtxCas ctx) $ samlUserToCassandra @Cas.Client $ idPToCassandra @Cas.Client $ runExceptT $ runReaderT action ctx + actionHandler = + liftIO $ + runFinal $ + embedToFinal @IO $ + interpretClientToIO (sparCtxCas ctx) $ + samlUserStoreToCassandra @Cas.Client $ + idPToCassandra @Cas.Client $ + defaultSsoCodeToCassandra $ + scimTokenStoreToCassandra $ + scimUserTimesStoreToCassandra $ + scimExternalIdStoreToCassandra $ + runExceptT $ + runReaderT action ctx throwErrorAsHandlerException :: Either SparError a -> Handler a throwErrorAsHandlerException (Left err) = sparToServerErrorWithLogging (sparCtxLogger ctx) err >>= throwError @@ -453,7 +475,7 @@ instance Intra.MonadSparToGalley (Spar r) where -- signed in-response-to info in the assertions matches the unsigned in-response-to field in the -- 'SAML.Response', and fills in the response id in the header if missing, we can just go for the -- latter. -verdictHandler :: HasCallStack => Members [IdPEffect.IdP, SAMLUser] r => Maybe BindCookie -> Maybe TeamId -> SAML.AuthnResponse -> SAML.AccessVerdict -> Spar r SAML.ResponseVerdict +verdictHandler :: HasCallStack => Members '[ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe BindCookie -> Maybe TeamId -> SAML.AuthnResponse -> SAML.AccessVerdict -> Spar r SAML.ResponseVerdict verdictHandler cky mbteam aresp verdict = do -- [3/4.1.4.2] -- [...] If the containing message is in response to an , then @@ -478,7 +500,7 @@ data VerdictHandlerResult | VerifyHandlerError {_vhrLabel :: ST, _vhrMessage :: ST} deriving (Eq, Show) -verdictHandlerResult :: HasCallStack => Members [IdPEffect.IdP, SAMLUser] r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> Spar r VerdictHandlerResult +verdictHandlerResult :: HasCallStack => Members '[ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> Spar r VerdictHandlerResult verdictHandlerResult bindCky mbteam verdict = do SAML.logger SAML.Debug $ "entering verdictHandlerResult: " <> show (fromBindCookie <$> bindCky) result <- catchVerdictErrors $ verdictHandlerResultCore bindCky mbteam verdict @@ -499,7 +521,7 @@ catchVerdictErrors = (`catchError` hndlr) -- | If a user attempts to login presenting a new IdP issuer, but there is no entry in -- @"spar.user"@ for her: lookup @"old_issuers"@ from @"spar.idp"@ for the new IdP, and -- traverse the old IdPs in search for the old entry. Return that old entry. -findUserIdWithOldIssuer :: forall r. Members [IdPEffect.IdP, SAMLUser] r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult (SAML.UserRef, UserId)) +findUserIdWithOldIssuer :: forall r. Members '[IdPEffect.IdP, SAMLUserStore] r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult (SAML.UserRef, UserId)) findUserIdWithOldIssuer mbteam (SAML.UserRef issuer subject) = do idp <- getIdPConfigByIssuerOptionalSPId issuer mbteam let tryFind :: GetUserResult (SAML.UserRef, UserId) -> Issuer -> Spar r (GetUserResult (SAML.UserRef, UserId)) @@ -511,13 +533,13 @@ findUserIdWithOldIssuer mbteam (SAML.UserRef issuer subject) = do -- | After a user has been found using 'findUserWithOldIssuer', update it everywhere so that -- the old IdP is not needed any more next time. -moveUserToNewIssuer :: Member SAMLUser r => SAML.UserRef -> SAML.UserRef -> UserId -> Spar r () +moveUserToNewIssuer :: Member SAMLUserStore r => SAML.UserRef -> SAML.UserRef -> UserId -> Spar r () moveUserToNewIssuer oldUserRef newUserRef uid = do - wrapMonadClientSem $ SAMLUser.insert newUserRef uid + wrapMonadClientSem $ SAMLUserStore.insert newUserRef uid Intra.setBrigUserVeid uid (UrefOnly newUserRef) - wrapMonadClientSem $ SAMLUser.delete uid oldUserRef + wrapMonadClientSem $ SAMLUserStore.delete uid oldUserRef -verdictHandlerResultCore :: HasCallStack => Members [IdPEffect.IdP, SAMLUser] r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> Spar r VerdictHandlerResult +verdictHandlerResultCore :: HasCallStack => Members '[ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> Spar r VerdictHandlerResult verdictHandlerResultCore bindCky mbteam = \case SAML.AccessDenied reasons -> do pure $ VerifyHandlerDenied reasons @@ -730,7 +752,7 @@ getIdPIdByIssuerAllowOld issuer mbteam = do else mbv1v2 _ -> pure mbv1v2 --- | See 'getIdPIdByIssuer' and 'mapGetIdPResult'. +-- | See 'getIdPIdByIssuer'. getIdPConfigByIssuer :: (HasCallStack, Member IdPEffect.IdP r) => SAML.Issuer -> @@ -739,7 +761,7 @@ getIdPConfigByIssuer :: getIdPConfigByIssuer issuer = getIdPIdByIssuer issuer >=> mapGetIdPResult --- | See 'getIdPIdByIssuerAllowOld' and 'mapGetIdPResult'. +-- | See 'getIdPIdByIssuerAllowOld'. getIdPConfigByIssuerAllowOld :: (HasCallStack, Member IdPEffect.IdP r) => SAML.Issuer -> @@ -748,7 +770,8 @@ getIdPConfigByIssuerAllowOld :: getIdPConfigByIssuerAllowOld issuer = do getIdPIdByIssuerAllowOld issuer >=> mapGetIdPResult --- | Same as 'getIdPIdByIssuerAllowOld', but you are guaranteed that the 'TeamId' is passed. +-- | Lookup idp in table `issuer_idp_v2` (using both issuer entityID and teamid); if nothing +-- is found there or if teamid is 'Nothing', lookup under issuer in `issuer_idp`. getIdPIdByIssuer :: (HasCallStack, Member IdPEffect.IdP r) => SAML.Issuer -> @@ -767,17 +790,16 @@ mapGetIdPResult (GetIdPWrongTeam i) = pure (GetIdPWrongTeam i) -- | Delete all tokens belonging to a team. deleteTeam :: - (HasCallStack, Members [SAMLUser, IdPEffect.IdP] r) => + (HasCallStack, Members '[ScimTokenStore, SAMLUserStore, IdPEffect.IdP] r) => TeamId -> Spar r () -deleteTeam team = do - liftMonadClient $ Data.deleteTeamScimTokens team +deleteTeam team = liftSem $ do + ScimTokenStore.deleteByTeam team -- Since IdPs are not shared between teams, we can look at the set of IdPs -- used by the team, and remove everything related to those IdPs, too. - idps <- liftSem $ IdPEffect.getConfigsByTeam team + idps <- IdPEffect.getConfigsByTeam team for_ idps $ \idp -> do let idpid = idp ^. SAML.idpId issuer = idp ^. SAML.idpMetadata . SAML.edIssuer - liftSem $ do - SAMLUser.deleteByIssuer issuer - IdPEffect.deleteConfig idpid issuer team + SAMLUserStore.deleteByIssuer issuer + IdPEffect.deleteConfig idpid issuer team diff --git a/services/spar/src/Spar/Scim.hs b/services/spar/src/Spar/Scim.hs index 9042d605c1e..3e16b92bd79 100644 --- a/services/spar/src/Spar/Scim.hs +++ b/services/spar/src/Spar/Scim.hs @@ -83,7 +83,10 @@ import Spar.Error import Spar.Scim.Auth import Spar.Scim.User import qualified Spar.Sem.IdP as IdPEffect -import Spar.Sem.SAMLUser (SAMLUser) +import Spar.Sem.SAMLUserStore (SAMLUserStore) +import Spar.Sem.ScimExternalIdStore (ScimExternalIdStore) +import Spar.Sem.ScimTokenStore (ScimTokenStore) +import Spar.Sem.ScimUserTimesStore (ScimUserTimesStore) import qualified Web.Scim.Capabilities.MetaSchema as Scim.Meta import qualified Web.Scim.Class.Auth as Scim.Auth import qualified Web.Scim.Class.User as Scim.User @@ -101,7 +104,9 @@ import Wire.API.User.Scim configuration :: Scim.Meta.Configuration configuration = Scim.Meta.empty -apiScim :: Members [IdPEffect.IdP, SAMLUser] r => ServerT APIScim (Spar r) +apiScim :: + Members '[ScimExternalIdStore, ScimUserTimesStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + ServerT APIScim (Spar r) apiScim = hoistScim (toServant (server configuration)) :<|> apiScimToken diff --git a/services/spar/src/Spar/Scim/Auth.hs b/services/spar/src/Spar/Scim/Auth.hs index 519beb0f3a9..2b902309842 100644 --- a/services/spar/src/Spar/Scim/Auth.hs +++ b/services/spar/src/Spar/Scim/Auth.hs @@ -47,11 +47,12 @@ import OpenSSL.Random (randBytes) import Polysemy import qualified SAML2.WebSSO as SAML import Servant (NoContent (NoContent), ServerT, (:<|>) ((:<|>))) -import Spar.App (Spar, sparCtxOpts, wrapMonadClient, wrapMonadClientSem) -import qualified Spar.Data as Data hiding (clearReplacedBy, deleteIdPRawMetadata, getIdPConfig, getIdPConfigsByTeam, getIdPIdByIssuerWithTeam, getIdPIdByIssuerWithoutTeam, getIdPRawMetadata, setReplacedBy, storeIdPConfig, storeIdPRawMetadata) +import Spar.App (Spar, sparCtxOpts, wrapMonadClientSem) import qualified Spar.Error as E import qualified Spar.Intra.Brig as Intra.Brig import qualified Spar.Sem.IdP as IdPEffect +import Spar.Sem.ScimTokenStore (ScimTokenStore) +import qualified Spar.Sem.ScimTokenStore as ScimTokenStore import qualified Web.Scim.Class.Auth as Scim.Class.Auth import qualified Web.Scim.Handler as Scim import qualified Web.Scim.Schema.Error as Scim @@ -60,14 +61,14 @@ import Wire.API.User.Saml (maxScimTokens) import Wire.API.User.Scim -- | An instance that tells @hscim@ how authentication should be done for SCIM routes. -instance Scim.Class.Auth.AuthDB SparTag (Spar r) where +instance Member ScimTokenStore r => Scim.Class.Auth.AuthDB SparTag (Spar r) where -- Validate and resolve a given token authCheck :: Maybe ScimToken -> Scim.ScimHandler (Spar r) ScimTokenInfo authCheck Nothing = Scim.throwScim (Scim.unauthorized "Token not provided") authCheck (Just token) = maybe (Scim.throwScim (Scim.unauthorized "Invalid token")) pure - =<< lift (wrapMonadClient (Data.lookupScimToken token)) + =<< lift (wrapMonadClientSem (ScimTokenStore.lookup token)) ---------------------------------------------------------------------------- -- Token API @@ -76,7 +77,7 @@ instance Scim.Class.Auth.AuthDB SparTag (Spar r) where -- | API for manipulating SCIM tokens (protected by normal Wire authentication and available -- only to team owners). -apiScimToken :: Member IdPEffect.IdP r => ServerT APIScimToken (Spar r) +apiScimToken :: Members '[ScimTokenStore, IdPEffect.IdP] r => ServerT APIScimToken (Spar r) apiScimToken = createScimToken :<|> deleteScimToken @@ -86,7 +87,8 @@ apiScimToken = -- -- Create a token for user's team. createScimToken :: - Member IdPEffect.IdP r => + forall r. + Members '[ScimTokenStore, IdPEffect.IdP] r => -- | Who is trying to create a token Maybe UserId -> -- | Request body @@ -96,7 +98,7 @@ createScimToken zusr CreateScimToken {..} = do let descr = createScimTokenDescr teamid <- Intra.Brig.authorizeScimTokenManagement zusr Intra.Brig.ensureReAuthorised zusr createScimTokenPassword - tokenNumber <- fmap length $ wrapMonadClient $ Data.getScimTokens teamid + tokenNumber <- fmap length $ wrapMonadClientSem $ ScimTokenStore.getByTeam teamid maxTokens <- asks (maxScimTokens . sparCtxOpts) unless (tokenNumber < maxTokens) $ E.throwSpar E.SparProvisioningTokenLimitReached @@ -115,7 +117,7 @@ createScimToken zusr CreateScimToken {..} = do stiIdP = midpid, stiDescr = descr } - wrapMonadClient $ Data.insertScimToken token info + wrapMonadClientSem $ ScimTokenStore.insert token info pure $ CreateScimTokenResponse token info case idps of @@ -133,13 +135,14 @@ createScimToken zusr CreateScimToken {..} = do -- -- Delete a token belonging to user's team. deleteScimToken :: + Member ScimTokenStore r => -- | Who is trying to delete a token Maybe UserId -> ScimTokenId -> Spar r NoContent deleteScimToken zusr tokenid = do teamid <- Intra.Brig.authorizeScimTokenManagement zusr - wrapMonadClient $ Data.deleteScimToken teamid tokenid + wrapMonadClientSem $ ScimTokenStore.delete teamid tokenid pure NoContent -- | > docs/reference/provisioning/scim-token.md {#RefScimTokenList} @@ -147,9 +150,10 @@ deleteScimToken zusr tokenid = do -- List all tokens belonging to user's team. Tokens themselves are not available, only -- metadata about them. listScimTokens :: + Member ScimTokenStore r => -- | Who is trying to list tokens Maybe UserId -> Spar r ScimTokenList listScimTokens zusr = do teamid <- Intra.Brig.authorizeScimTokenManagement zusr - ScimTokenList <$> wrapMonadClient (Data.getScimTokens teamid) + ScimTokenList <$> wrapMonadClientSem (ScimTokenStore.getByTeam teamid) diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 9096450690c..c877687d37d 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -65,14 +65,17 @@ import Imports import Network.URI (URI, parseURI) import Polysemy import qualified SAML2.WebSSO as SAML -import Spar.App (GetUserResult (..), Spar, getUserIdByScimExternalId, getUserIdByUref, liftMonadClient, liftSem, sparCtxOpts, validateEmailIfExists, wrapMonadClient, wrapMonadClientSem, wrapSpar) -import qualified Spar.Data as Data hiding (clearReplacedBy, deleteIdPRawMetadata, getIdPConfig, getIdPConfigsByTeam, getIdPIdByIssuerWithTeam, getIdPIdByIssuerWithoutTeam, getIdPRawMetadata, setReplacedBy, storeIdPConfig, storeIdPRawMetadata) +import Spar.App (GetUserResult (..), Spar, getUserIdByScimExternalId, getUserIdByUref, sparCtxOpts, validateEmailIfExists, wrapMonadClientSem) import qualified Spar.Intra.Brig as Brig import Spar.Scim.Auth () import qualified Spar.Scim.Types as ST import qualified Spar.Sem.IdP as IdPEffect -import Spar.Sem.SAMLUser (SAMLUser) -import qualified Spar.Sem.SAMLUser as SAMLUser +import Spar.Sem.SAMLUserStore (SAMLUserStore) +import qualified Spar.Sem.SAMLUserStore as SAMLUserStore +import Spar.Sem.ScimExternalIdStore (ScimExternalIdStore) +import qualified Spar.Sem.ScimExternalIdStore as ScimExternalIdStore +import Spar.Sem.ScimUserTimesStore (ScimUserTimesStore) +import qualified Spar.Sem.ScimUserTimesStore as ScimUserTimesStore import qualified System.Logger.Class as Log import System.Logger.Message (Msg) import qualified URI.ByteString as URIBS @@ -98,7 +101,7 @@ import qualified Wire.API.User.Scim as ST ---------------------------------------------------------------------------- -- UserDB instance -instance (Members [IdPEffect.IdP, SAMLUser] r) => Scim.UserDB ST.SparTag (Spar r) where +instance Members '[ScimExternalIdStore, ScimUserTimesStore, IdPEffect.IdP, SAMLUserStore] r => Scim.UserDB ST.SparTag (Spar r) where getUsers :: ScimTokenInfo -> Maybe Scim.Filter -> @@ -366,7 +369,7 @@ veidEmail (ST.EmailOnly email) = Just email createValidScimUser :: forall m r. (m ~ Scim.ScimHandler (Spar r)) => - Member SAMLUser r => + Members '[ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore] r => ScimTokenInfo -> ST.ValidScimUser -> m (Scim.StoredUser ST.SparTag) @@ -426,12 +429,12 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid lift $ Log.debug (Log.msg $ "createValidScimUser: spar says " <> show storedUser) -- {(arianvp): these two actions we probably want to make transactional.} - lift . wrapSpar $ do + lift . wrapMonadClientSem $ do -- Store scim timestamps, saml credentials, scim externalId locally in spar. - liftMonadClient $ Data.writeScimUserTimes storedUser + ScimUserTimesStore.write storedUser ST.runValidExternalId - (liftSem . (`SAMLUser.insert` buid)) - (\email -> liftMonadClient $ Data.insertScimExternalId stiTeam email buid) + (`SAMLUserStore.insert` buid) + (\email -> ScimExternalIdStore.insert stiTeam email buid) veid -- If applicable, trigger email validation procedure on brig. @@ -448,8 +451,7 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid -- TODO(arianvp): how do we get this safe w.r.t. race conditions / crashes? updateValidScimUser :: forall m r. - Member IdPEffect.IdP r => - Member SAMLUser r => + Members '[ScimExternalIdStore, ScimUserTimesStore, IdPEffect.IdP, SAMLUserStore] r => (m ~ Scim.ScimHandler (Spar r)) => ScimTokenInfo -> UserId -> @@ -500,11 +502,11 @@ updateValidScimUser tokinfo@ScimTokenInfo {stiTeam} uid newValidScimUser = let new = ST.scimActiveFlagToAccountStatus old (Just $ newValidScimUser ^. ST.vsuActive) when (new /= old) $ Brig.setStatus uid new - wrapMonadClient $ Data.writeScimUserTimes newScimStoredUser + wrapMonadClientSem $ ScimUserTimesStore.write newScimStoredUser pure newScimStoredUser updateVsuUref :: - Member SAMLUser r => + Members '[ScimExternalIdStore, SAMLUserStore] r => TeamId -> UserId -> ST.ValidExternalId -> @@ -516,9 +518,9 @@ updateVsuUref team uid old new = do (mo, mn@(Just newuref)) | mo /= mn -> validateEmailIfExists uid newuref _ -> pure () - wrapSpar $ do - old & ST.runValidExternalId (liftSem . (SAMLUser.delete uid)) (liftMonadClient . Data.deleteScimExternalId team) - new & ST.runValidExternalId (liftSem . (`SAMLUser.insert` uid)) (\email -> liftMonadClient $ Data.insertScimExternalId team email uid) + wrapMonadClientSem $ do + old & ST.runValidExternalId (SAMLUserStore.delete uid) (ScimExternalIdStore.delete team) + new & ST.runValidExternalId (`SAMLUserStore.insert` uid) (\email -> ScimExternalIdStore.insert team email uid) Brig.setBrigUserVeid uid new @@ -576,7 +578,11 @@ updScimStoredUser' now usr (Scim.WithMeta meta (Scim.WithId scimuid _)) = Scim.version = calculateVersion scimuid usr } -deleteScimUser :: Members [SAMLUser, IdPEffect.IdP] r => ScimTokenInfo -> UserId -> Scim.ScimHandler (Spar r) () +deleteScimUser :: + Members '[ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore, IdPEffect.IdP] r => + ScimTokenInfo -> + UserId -> + Scim.ScimHandler (Spar r) () deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = logScim ( logFunction "Spar.Scim.User.deleteScimUser" @@ -603,13 +609,13 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = case Brig.veidFromBrigUser brigUser ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) of Left _ -> pure () Right veid -> - lift . wrapSpar $ + lift . wrapMonadClientSem $ ST.runValidExternalId - (liftSem . SAMLUser.delete uid) - (liftMonadClient . Data.deleteScimExternalId stiTeam) + (SAMLUserStore.delete uid) + (ScimExternalIdStore.delete stiTeam) veid - lift . wrapMonadClient $ Data.deleteScimUserTimes uid + lift . wrapMonadClientSem $ ScimUserTimesStore.delete uid lift $ Brig.deleteBrigUser uid return () @@ -640,7 +646,7 @@ calculateVersion uid usr = Scim.Weak (Text.pack (show h)) -- -- ASSUMPTION: every scim user has a 'SAML.UserRef', and the `SAML.NameID` in it corresponds -- to a single `externalId`. -assertExternalIdUnused :: Member SAMLUser r => TeamId -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) () +assertExternalIdUnused :: Members '[ScimExternalIdStore, SAMLUserStore] r => TeamId -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) () assertExternalIdUnused tid veid = do assertExternalIdInAllowedValues [Nothing] @@ -654,7 +660,7 @@ assertExternalIdUnused tid veid = do -- -- ASSUMPTION: every scim user has a 'SAML.UserRef', and the `SAML.NameID` in it corresponds -- to a single `externalId`. -assertExternalIdNotUsedElsewhere :: Member SAMLUser r => TeamId -> ST.ValidExternalId -> UserId -> Scim.ScimHandler (Spar r) () +assertExternalIdNotUsedElsewhere :: Members '[ScimExternalIdStore, SAMLUserStore] r => TeamId -> ST.ValidExternalId -> UserId -> Scim.ScimHandler (Spar r) () assertExternalIdNotUsedElsewhere tid veid wireUserId = do assertExternalIdInAllowedValues [Nothing, Just wireUserId] @@ -662,7 +668,7 @@ assertExternalIdNotUsedElsewhere tid veid wireUserId = do tid veid -assertExternalIdInAllowedValues :: Member SAMLUser r => [Maybe UserId] -> Text -> TeamId -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) () +assertExternalIdInAllowedValues :: Members '[ScimExternalIdStore, SAMLUserStore] r => [Maybe UserId] -> Text -> TeamId -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) () assertExternalIdInAllowedValues allowedValues errmsg tid veid = do isGood <- lift $ @@ -697,7 +703,7 @@ assertHandleNotUsedElsewhere uid hndl = do -- | Helper function that translates a given brig user into a 'Scim.StoredUser', with some -- effects like updating the 'ManagedBy' field in brig and storing creation and update time -- stamps. -synthesizeStoredUser :: UserAccount -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) (Scim.StoredUser ST.SparTag) +synthesizeStoredUser :: forall r. Member ScimUserTimesStore r => UserAccount -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) (Scim.StoredUser ST.SparTag) synthesizeStoredUser usr veid = logScim ( logFunction "Spar.Scim.User.synthesizeStoredUser" @@ -713,14 +719,14 @@ synthesizeStoredUser usr veid = let readState :: Spar r (RI.RichInfo, Maybe (UTCTimeMillis, UTCTimeMillis), URIBS.URI) readState = do richInfo <- Brig.getBrigUserRichInfo uid - accessTimes <- wrapMonadClient (Data.readScimUserTimes uid) + accessTimes <- wrapMonadClientSem (ScimUserTimesStore.read uid) baseuri <- asks $ derivedOptsScimBaseURI . derivedOpts . sparCtxOpts pure (richInfo, accessTimes, baseuri) let writeState :: Maybe (UTCTimeMillis, UTCTimeMillis) -> ManagedBy -> RI.RichInfo -> Scim.StoredUser ST.SparTag -> Spar r () writeState oldAccessTimes oldManagedBy oldRichInfo storedUser = do when (isNothing oldAccessTimes) $ do - wrapMonadClient $ Data.writeScimUserTimes storedUser + wrapMonadClientSem $ ScimUserTimesStore.write storedUser when (oldManagedBy /= ManagedByScim) $ do Brig.setBrigUserManagedBy uid ManagedByScim let newRichInfo = view ST.sueRichInfo . Scim.extra . Scim.value . Scim.thing $ storedUser @@ -783,7 +789,7 @@ synthesizeScimUser info = Scim.active = Just . Scim.ScimBool $ info ^. ST.vsuActive } -scimFindUserByHandle :: Maybe IdP -> TeamId -> Text -> MaybeT (Scim.ScimHandler (Spar r)) (Scim.StoredUser ST.SparTag) +scimFindUserByHandle :: Member ScimUserTimesStore r => Maybe IdP -> TeamId -> Text -> MaybeT (Scim.ScimHandler (Spar r)) (Scim.StoredUser ST.SparTag) scimFindUserByHandle mIdpConfig stiTeam hndl = do handle <- MaybeT . pure . parseHandle . Text.toLower $ hndl brigUser <- MaybeT . lift . Brig.getBrigUserByHandle $ handle @@ -798,7 +804,13 @@ scimFindUserByHandle mIdpConfig stiTeam hndl = do -- -- Note the user won't get an entry in `spar.user`. That will only happen on their first -- successful authentication with their SAML credentials. -scimFindUserByEmail :: forall r. Member SAMLUser r => Maybe IdP -> TeamId -> Text -> MaybeT (Scim.ScimHandler (Spar r)) (Scim.StoredUser ST.SparTag) +scimFindUserByEmail :: + forall r. + Members '[ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore] r => + Maybe IdP -> + TeamId -> + Text -> + MaybeT (Scim.ScimHandler (Spar r)) (Scim.StoredUser ST.SparTag) scimFindUserByEmail mIdpConfig stiTeam email = do -- Azure has been observed to search for externalIds that are not emails, even if the -- mapping is set up like it should be. This is a problem: if there is no SAML IdP, 'mkValidExternalId' @@ -814,7 +826,7 @@ scimFindUserByEmail mIdpConfig stiTeam email = do where withUref :: SAML.UserRef -> Spar r (Maybe UserId) withUref uref = do - wrapMonadClientSem (SAMLUser.get uref) >>= \case + wrapMonadClientSem (SAMLUserStore.get uref) >>= \case Nothing -> maybe (pure Nothing) withEmailOnly $ Brig.urefToEmail uref Just uid -> pure (Just uid) @@ -824,7 +836,7 @@ scimFindUserByEmail mIdpConfig stiTeam email = do -- FUTUREWORK: we could also always lookup brig, that's simpler and possibly faster, -- and it never should be visible in spar, but not in brig. inspar, inbrig :: Spar r (Maybe UserId) - inspar = wrapMonadClient $ Data.lookupScimExternalId stiTeam eml + inspar = wrapMonadClientSem $ ScimExternalIdStore.lookup stiTeam eml inbrig = userId . accountUser <$$> Brig.getBrigUserByEmail eml logFilter :: Filter -> (Msg -> Msg) diff --git a/services/spar/src/Spar/Sem/DefaultSsoCode.hs b/services/spar/src/Spar/Sem/DefaultSsoCode.hs new file mode 100644 index 00000000000..c18f0334b15 --- /dev/null +++ b/services/spar/src/Spar/Sem/DefaultSsoCode.hs @@ -0,0 +1,12 @@ +module Spar.Sem.DefaultSsoCode where + +import Imports +import Polysemy +import qualified SAML2.WebSSO as SAML + +data DefaultSsoCode m a where + Get :: DefaultSsoCode m (Maybe SAML.IdPId) + Store :: SAML.IdPId -> DefaultSsoCode m () + Delete :: DefaultSsoCode m () + +makeSem ''DefaultSsoCode diff --git a/services/spar/src/Spar/Sem/DefaultSsoCode/Cassandra.hs b/services/spar/src/Spar/Sem/DefaultSsoCode/Cassandra.hs new file mode 100644 index 00000000000..2a0ac8332aa --- /dev/null +++ b/services/spar/src/Spar/Sem/DefaultSsoCode/Cassandra.hs @@ -0,0 +1,21 @@ +{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-} + +module Spar.Sem.DefaultSsoCode.Cassandra where + +import Cassandra +import Imports +import Polysemy +import qualified Spar.Data as Data +import Spar.Sem.DefaultSsoCode + +defaultSsoCodeToCassandra :: + forall m r a. + (MonadClient m, Member (Embed m) r) => + Sem (DefaultSsoCode ': r) a -> + Sem r a +defaultSsoCodeToCassandra = + interpret $ + embed @m . \case + Get -> Data.getDefaultSsoCode + Store ip -> Data.storeDefaultSsoCode ip + Delete -> Data.deleteDefaultSsoCode diff --git a/services/spar/src/Spar/Sem/SAMLUser.hs b/services/spar/src/Spar/Sem/SAMLUser.hs deleted file mode 100644 index 0ddd7d51322..00000000000 --- a/services/spar/src/Spar/Sem/SAMLUser.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Spar.Sem.SAMLUser where - -import Data.Id -import Imports -import Polysemy -import qualified SAML2.WebSSO as SAML - -data SAMLUser m a where - Insert :: SAML.UserRef -> UserId -> SAMLUser m () - Get :: SAML.UserRef -> SAMLUser m (Maybe UserId) - GetAnyByIssuer :: SAML.Issuer -> SAMLUser m (Maybe UserId) - GetSomeByIssuer :: SAML.Issuer -> SAMLUser m [(SAML.UserRef, UserId)] - DeleteByIssuer :: SAML.Issuer -> SAMLUser m () - Delete :: UserId -> SAML.UserRef -> SAMLUser m () - --- TODO(sandy): Inline this definition --- no TH -makeSem ''SAMLUser diff --git a/services/spar/src/Spar/Sem/SAMLUserStore.hs b/services/spar/src/Spar/Sem/SAMLUserStore.hs new file mode 100644 index 00000000000..4b8dd379d63 --- /dev/null +++ b/services/spar/src/Spar/Sem/SAMLUserStore.hs @@ -0,0 +1,17 @@ +module Spar.Sem.SAMLUserStore where + +import Data.Id +import Imports +import Polysemy +import qualified SAML2.WebSSO as SAML + +data SAMLUserStore m a where + Insert :: SAML.UserRef -> UserId -> SAMLUserStore m () + Get :: SAML.UserRef -> SAMLUserStore m (Maybe UserId) + GetAnyByIssuer :: SAML.Issuer -> SAMLUserStore m (Maybe UserId) + GetSomeByIssuer :: SAML.Issuer -> SAMLUserStore m [(SAML.UserRef, UserId)] + DeleteByIssuer :: SAML.Issuer -> SAMLUserStore m () + Delete :: UserId -> SAML.UserRef -> SAMLUserStore m () + +-- TODO(sandy): Inline this definition --- no TH +makeSem ''SAMLUserStore diff --git a/services/spar/src/Spar/Sem/SAMLUser/Cassandra.hs b/services/spar/src/Spar/Sem/SAMLUserStore/Cassandra.hs similarity index 81% rename from services/spar/src/Spar/Sem/SAMLUser/Cassandra.hs rename to services/spar/src/Spar/Sem/SAMLUserStore/Cassandra.hs index 77a8f200f7e..409c5a4b2f3 100644 --- a/services/spar/src/Spar/Sem/SAMLUser/Cassandra.hs +++ b/services/spar/src/Spar/Sem/SAMLUserStore/Cassandra.hs @@ -1,19 +1,19 @@ {-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-} -module Spar.Sem.SAMLUser.Cassandra where +module Spar.Sem.SAMLUserStore.Cassandra where import Cassandra import Imports import Polysemy import qualified Spar.Data as Data -import Spar.Sem.SAMLUser +import Spar.Sem.SAMLUserStore -samlUserToCassandra :: +samlUserStoreToCassandra :: forall m r a. (MonadClient m, Member (Embed m) r) => - Sem (SAMLUser ': r) a -> + Sem (SAMLUserStore ': r) a -> Sem r a -samlUserToCassandra = +samlUserStoreToCassandra = interpret $ embed . \case Insert ur uid -> Data.insertSAMLUser ur uid diff --git a/services/spar/src/Spar/Sem/ScimExternalIdStore.hs b/services/spar/src/Spar/Sem/ScimExternalIdStore.hs new file mode 100644 index 00000000000..b2a43f6b327 --- /dev/null +++ b/services/spar/src/Spar/Sem/ScimExternalIdStore.hs @@ -0,0 +1,13 @@ +module Spar.Sem.ScimExternalIdStore where + +import Data.Id (TeamId, UserId) +import Imports +import Polysemy +import Wire.API.User.Identity (Email) + +data ScimExternalIdStore m a where + Insert :: TeamId -> Email -> UserId -> ScimExternalIdStore m () + Lookup :: TeamId -> Email -> ScimExternalIdStore m (Maybe UserId) + Delete :: TeamId -> Email -> ScimExternalIdStore m () + +makeSem ''ScimExternalIdStore diff --git a/services/spar/src/Spar/Sem/ScimExternalIdStore/Cassandra.hs b/services/spar/src/Spar/Sem/ScimExternalIdStore/Cassandra.hs new file mode 100644 index 00000000000..e2d9ef0274b --- /dev/null +++ b/services/spar/src/Spar/Sem/ScimExternalIdStore/Cassandra.hs @@ -0,0 +1,19 @@ +module Spar.Sem.ScimExternalIdStore.Cassandra where + +import Cassandra +import Imports +import Polysemy +import qualified Spar.Data as Data +import Spar.Sem.ScimExternalIdStore + +scimExternalIdStoreToCassandra :: + forall m r a. + (MonadClient m, Member (Embed m) r) => + Sem (ScimExternalIdStore ': r) a -> + Sem r a +scimExternalIdStoreToCassandra = + interpret $ + embed @m . \case + Insert tid em uid -> Data.insertScimExternalId tid em uid + Lookup tid em -> Data.lookupScimExternalId tid em + Delete tid em -> Data.deleteScimExternalId tid em diff --git a/services/spar/src/Spar/Sem/ScimTokenStore.hs b/services/spar/src/Spar/Sem/ScimTokenStore.hs new file mode 100644 index 00000000000..f2a35a4d422 --- /dev/null +++ b/services/spar/src/Spar/Sem/ScimTokenStore.hs @@ -0,0 +1,15 @@ +module Spar.Sem.ScimTokenStore where + +import Data.Id +import Imports +import Polysemy +import Wire.API.User.Scim + +data ScimTokenStore m a where + Insert :: ScimToken -> ScimTokenInfo -> ScimTokenStore m () + Lookup :: ScimToken -> ScimTokenStore m (Maybe ScimTokenInfo) + GetByTeam :: TeamId -> ScimTokenStore m [ScimTokenInfo] + Delete :: TeamId -> ScimTokenId -> ScimTokenStore m () + DeleteByTeam :: TeamId -> ScimTokenStore m () + +makeSem ''ScimTokenStore diff --git a/services/spar/src/Spar/Sem/ScimTokenStore/Cassandra.hs b/services/spar/src/Spar/Sem/ScimTokenStore/Cassandra.hs new file mode 100644 index 00000000000..a79bbc3e948 --- /dev/null +++ b/services/spar/src/Spar/Sem/ScimTokenStore/Cassandra.hs @@ -0,0 +1,23 @@ +{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-} + +module Spar.Sem.ScimTokenStore.Cassandra where + +import Cassandra +import Imports +import Polysemy +import qualified Spar.Data as Data +import Spar.Sem.ScimTokenStore + +scimTokenStoreToCassandra :: + forall m r a. + (MonadClient m, Member (Embed m) r) => + Sem (ScimTokenStore ': r) a -> + Sem r a +scimTokenStoreToCassandra = + interpret $ + embed @m . \case + Insert st sti -> Data.insertScimToken st sti + Lookup st -> Data.lookupScimToken st + GetByTeam tid -> Data.getScimTokens tid + Delete tid ur -> Data.deleteScimToken tid ur + DeleteByTeam tid -> Data.deleteTeamScimTokens tid diff --git a/services/spar/src/Spar/Sem/ScimUserTimesStore.hs b/services/spar/src/Spar/Sem/ScimUserTimesStore.hs new file mode 100644 index 00000000000..63065c7ad68 --- /dev/null +++ b/services/spar/src/Spar/Sem/ScimUserTimesStore.hs @@ -0,0 +1,15 @@ +module Spar.Sem.ScimUserTimesStore where + +import Data.Id (UserId) +import Data.Json.Util (UTCTimeMillis) +import Imports +import Polysemy +import Web.Scim.Schema.Common (WithId) +import Web.Scim.Schema.Meta (WithMeta) + +data ScimUserTimesStore m a where + Write :: WithMeta (WithId UserId a) -> ScimUserTimesStore m () + Read :: UserId -> ScimUserTimesStore m (Maybe (UTCTimeMillis, UTCTimeMillis)) + Delete :: UserId -> ScimUserTimesStore m () + +makeSem ''ScimUserTimesStore diff --git a/services/spar/src/Spar/Sem/ScimUserTimesStore/Cassandra.hs b/services/spar/src/Spar/Sem/ScimUserTimesStore/Cassandra.hs new file mode 100644 index 00000000000..f8b68e8d059 --- /dev/null +++ b/services/spar/src/Spar/Sem/ScimUserTimesStore/Cassandra.hs @@ -0,0 +1,15 @@ +module Spar.Sem.ScimUserTimesStore.Cassandra where + +import Cassandra (MonadClient) +import Imports +import Polysemy +import qualified Spar.Data as Data +import Spar.Sem.ScimUserTimesStore + +scimUserTimesStoreToCassandra :: forall m r a. (MonadClient m, Member (Embed m) r) => Sem (ScimUserTimesStore ': r) a -> Sem r a +scimUserTimesStoreToCassandra = + interpret $ + embed @m . \case + Write wm -> Data.writeScimUserTimes wm + Read uid -> Data.readScimUserTimes uid + Delete uid -> Data.deleteScimUserTimes uid diff --git a/services/spar/test-integration/Test/Spar/AppSpec.hs b/services/spar/test-integration/Test/Spar/AppSpec.hs index 8cee5f66520..0ee8760f00d 100644 --- a/services/spar/test-integration/Test/Spar/AppSpec.hs +++ b/services/spar/test-integration/Test/Spar/AppSpec.hs @@ -36,7 +36,7 @@ import qualified Servant import Spar.App (liftSem) import qualified Spar.App as Spar import Spar.Orphans () -import qualified Spar.Sem.SAMLUser as SAMLUser +import qualified Spar.Sem.SAMLUserStore as SAMLUserStore import qualified Text.XML as XML import qualified Text.XML.DSig as DSig import URI.ByteString as URI @@ -181,5 +181,5 @@ requestAccessVerdict idp isGranted mkAuthnReq = do $ outcome qry :: [(SBS, SBS)] qry = queryPairs $ uriQuery loc - muid <- runSpar $ liftSem $ SAMLUser.get uref + muid <- runSpar $ liftSem $ SAMLUserStore.get uref pure (muid, outcome, loc, qry) diff --git a/services/spar/test-integration/Test/Spar/DataSpec.hs b/services/spar/test-integration/Test/Spar/DataSpec.hs index 117e69fcb10..7c888890089 100644 --- a/services/spar/test-integration/Test/Spar/DataSpec.hs +++ b/services/spar/test-integration/Test/Spar/DataSpec.hs @@ -35,7 +35,8 @@ import Spar.App as App import Spar.Data as Data import Spar.Intra.Brig (veidFromUserSSOId) import qualified Spar.Sem.IdP as IdPEffect -import qualified Spar.Sem.SAMLUser as SAMLUser +import qualified Spar.Sem.SAMLUserStore as SAMLUserStore +import qualified Spar.Sem.ScimTokenStore as ScimTokenStore import Type.Reflection (typeRep) import URI.ByteString.QQ (uri) import Util.Core @@ -111,34 +112,34 @@ spec = do context "user is new" $ do it "getUser returns Nothing" $ do uref <- nextUserRef - muid <- runSpar $ liftSem $ SAMLUser.get uref + muid <- runSpar $ liftSem $ SAMLUserStore.get uref liftIO $ muid `shouldBe` Nothing it "inserts new user and responds with 201 / returns new user" $ do uref <- nextUserRef uid <- nextWireId - () <- runSpar $ liftSem $ SAMLUser.insert uref uid - muid <- runSpar $ liftSem $ SAMLUser.get uref + () <- runSpar $ liftSem $ SAMLUserStore.insert uref uid + muid <- runSpar $ liftSem $ SAMLUserStore.get uref liftIO $ muid `shouldBe` Just uid context "user already exists (idempotency)" $ do it "inserts new user and responds with 201 / returns new user" $ do uref <- nextUserRef uid <- nextWireId uid' <- nextWireId - () <- runSpar $ liftSem $ SAMLUser.insert uref uid - () <- runSpar $ liftSem $ SAMLUser.insert uref uid' - muid <- runSpar $ liftSem $ SAMLUser.get uref + () <- runSpar $ liftSem $ SAMLUserStore.insert uref uid + () <- runSpar $ liftSem $ SAMLUserStore.insert uref uid' + muid <- runSpar $ liftSem $ SAMLUserStore.get uref liftIO $ muid `shouldBe` Just uid' describe "DELETE" $ do it "works" $ do uref <- nextUserRef uid <- nextWireId do - () <- runSpar $ liftSem $ SAMLUser.insert uref uid - muid <- runSpar $ liftSem (SAMLUser.get uref) + () <- runSpar $ liftSem $ SAMLUserStore.insert uref uid + muid <- runSpar $ liftSem (SAMLUserStore.get uref) liftIO $ muid `shouldBe` Just uid do - () <- runSpar $ liftSem $ SAMLUser.delete uid uref - muid <- runSpar (liftSem $ SAMLUser.get uref) `aFewTimes` isNothing + () <- runSpar $ liftSem $ SAMLUserStore.delete uid uref + muid <- runSpar (liftSem $ SAMLUserStore.get uref) `aFewTimes` isNothing liftIO $ muid `shouldBe` Nothing describe "BindCookie" $ do let mkcky :: TestSpar SetBindCookie @@ -273,11 +274,11 @@ testDeleteTeam = it "cleans up all the right tables after deletion" $ do -- -- The token from 'team_provisioning_by_token': do - tokenInfo <- runSparCass $ Data.lookupScimToken tok + tokenInfo <- runSpar $ liftSem $ ScimTokenStore.lookup tok liftIO $ tokenInfo `shouldBe` Nothing -- The team from 'team_provisioning_by_team': do - tokens <- runSparCass $ Data.getScimTokens tid + tokens <- runSpar $ liftSem $ ScimTokenStore.getByTeam tid liftIO $ tokens `shouldBe` [] -- The users from 'user': do @@ -286,7 +287,7 @@ testDeleteTeam = it "cleans up all the right tables after deletion" $ do runSpar $ liftSem $ runValidExternalId - SAMLUser.get + SAMLUserStore.get undefined -- could be @Data.lookupScimExternalId@, but we don't hit that path. veid Left _email -> undefined -- runSparCass . Data.lookupScimExternalId . fromEmail $ _email @@ -297,7 +298,7 @@ testDeleteTeam = it "cleans up all the right tables after deletion" $ do runSpar $ liftSem $ runValidExternalId - SAMLUser.get + SAMLUserStore.get undefined veid Left _email -> undefined diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index 6a83fc540c9..127c5ef540e 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -32,7 +32,6 @@ import Bilge import Bilge.Assert import Brig.Types.Intra (AccountStatus (Active, PendingInvitation, Suspended), accountStatus, accountUser) import Brig.Types.User as Brig -import Cassandra import qualified Control.Exception import Control.Lens import Control.Monad.Except (MonadError (throwError)) @@ -61,12 +60,12 @@ import qualified Network.Wai.Utilities.Error as Wai import qualified SAML2.WebSSO as SAML import qualified SAML2.WebSSO.Test.MockResponse as SAML import Spar.App (liftSem) -import Spar.Data (lookupScimExternalId) -import qualified Spar.Data as Data import qualified Spar.Intra.Brig as Intra import Spar.Scim import qualified Spar.Scim.User as SU -import qualified Spar.Sem.SAMLUser as SAMLUser +import qualified Spar.Sem.SAMLUserStore as SAMLUserStore +import qualified Spar.Sem.ScimExternalIdStore as ScimExternalIdStore +import qualified Spar.Sem.ScimUserTimesStore as ScimUserTimesStore import qualified Text.XML.DSig as SAML import qualified URI.ByteString as URI import Util @@ -1319,7 +1318,7 @@ testUpdateExternalId withidp = do lookupByValidExternalId :: ValidExternalId -> TestSpar (Maybe UserId) lookupByValidExternalId = runValidExternalId - (runSpar . liftSem . SAMLUser.get) + (runSpar . liftSem . SAMLUserStore.get) ( \email -> do let action = SU.scimFindUserByEmail midp tid $ fromEmail email result <- runSpar . runExceptT . runMaybeT $ action @@ -1538,7 +1537,7 @@ specDeleteUser = do samlUser :: Maybe UserId <- aFewTimes (getUserIdViaRef' uref) isNothing scimUser <- - aFewTimes (runSparCass $ Data.readScimUserTimes uid) isNothing + aFewTimes (runSpar $ liftSem $ ScimUserTimesStore.read uid) isNothing liftIO $ (brigUser, samlUser, scimUser) `shouldBe` (Nothing, Nothing, Nothing) @@ -1719,7 +1718,6 @@ testDeletedUsersFreeExternalIdNoIdp = do env <- ask let brig = env ^. teBrig let spar = env ^. teSpar - let clientState = env ^. teCql (_owner, tid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley) tok <- registerScimToken tid Nothing @@ -1743,7 +1741,7 @@ testDeletedUsersFreeExternalIdNoIdp = do void $ aFewTimes - (runClient clientState $ lookupScimExternalId tid email) + (runSpar $ liftSem $ ScimExternalIdStore.lookup tid email) (== Nothing) specSCIMManaged :: SpecWith TestEnv diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index 4f5b2281c1c..d5ef39ad8fa 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -175,17 +175,26 @@ import qualified SAML2.WebSSO.API.Example as SAML import SAML2.WebSSO.Test.Lenses (userRefL) import SAML2.WebSSO.Test.MockResponse import SAML2.WebSSO.Test.Util (SampleIdP (..), makeSampleIdPMetadata) -import Spar.App (liftMonadClient, liftSem, toLevel) +import Spar.App (liftSem, toLevel) import qualified Spar.App as Spar import qualified Spar.Data as Data import qualified Spar.Intra.Brig as Intra import qualified Spar.Options import Spar.Run +import Spar.Sem.DefaultSsoCode (DefaultSsoCode) +import Spar.Sem.DefaultSsoCode.Cassandra (defaultSsoCodeToCassandra) import qualified Spar.Sem.IdP as IdPEffect import Spar.Sem.IdP.Cassandra -import Spar.Sem.SAMLUser (SAMLUser) -import qualified Spar.Sem.SAMLUser as SAMLUser -import Spar.Sem.SAMLUser.Cassandra +import Spar.Sem.SAMLUserStore (SAMLUserStore) +import qualified Spar.Sem.SAMLUserStore as SAMLUserStore +import Spar.Sem.SAMLUserStore.Cassandra +import Spar.Sem.ScimExternalIdStore (ScimExternalIdStore) +import qualified Spar.Sem.ScimExternalIdStore as ScimExternalIdStore +import Spar.Sem.ScimExternalIdStore.Cassandra (scimExternalIdStoreToCassandra) +import Spar.Sem.ScimTokenStore (ScimTokenStore) +import Spar.Sem.ScimTokenStore.Cassandra (scimTokenStoreToCassandra) +import Spar.Sem.ScimUserTimesStore (ScimUserTimesStore) +import Spar.Sem.ScimUserTimesStore.Cassandra (scimUserTimesStoreToCassandra) import qualified System.Logger.Extended as Log import System.Random (randomRIO) import Test.Hspec hiding (it, pending, pendingWith, xit) @@ -1211,8 +1220,8 @@ ssoToUidSpar tid ssoid = do veid <- either (error . ("could not parse brig sso_id: " <>)) pure $ Intra.veidFromUserSSOId ssoid runSpar $ runValidExternalId - (liftSem . SAMLUser.get) - (liftMonadClient . Data.lookupScimExternalId tid) + (liftSem . SAMLUserStore.get) + (liftSem . ScimExternalIdStore.lookup tid) veid runSparCass :: @@ -1245,11 +1254,22 @@ runSimpleSP action = do result <- SAML.runSimpleSP ctx action either (throwIO . ErrorCall . show) pure result -runSpar :: (MonadReader TestEnv m, MonadIO m) => Spar.Spar '[IdPEffect.IdP, SAMLUser, Embed Client, Embed IO, Final IO] a -> m a +runSpar :: (MonadReader TestEnv m, MonadIO m) => Spar.Spar '[ScimExternalIdStore, ScimUserTimesStore, DefaultSsoCode, ScimTokenStore, IdPEffect.IdP, SAMLUserStore, Embed Client, Embed IO, Final IO] a -> m a runSpar (Spar.Spar action) = do env <- (^. teSparEnv) <$> ask liftIO $ do - result <- runFinal $ embedToFinal @IO $ interpretClientToIO (Spar.sparCtxCas env) $ samlUserToCassandra @Cas.Client $ idPToCassandra @Cas.Client $ runExceptT $ action `runReaderT` env + result <- + runFinal $ + embedToFinal @IO $ + interpretClientToIO (Spar.sparCtxCas env) $ + samlUserStoreToCassandra @Cas.Client $ + idPToCassandra @Cas.Client $ + scimTokenStoreToCassandra @Cas.Client $ + defaultSsoCodeToCassandra @Cas.Client $ + scimUserTimesStoreToCassandra @Cas.Client $ + scimExternalIdStoreToCassandra @Cas.Client $ + runExceptT $ + action `runReaderT` env either (throwIO . ErrorCall . show) pure result getSsoidViaSelf :: HasCallStack => UserId -> TestSpar UserSSOId @@ -1270,7 +1290,7 @@ getUserIdViaRef uref = maybe (error "not found") pure =<< getUserIdViaRef' uref getUserIdViaRef' :: HasCallStack => UserRef -> TestSpar (Maybe UserId) getUserIdViaRef' uref = do - aFewTimes (runSpar $ liftSem $ SAMLUser.get uref) isJust + aFewTimes (runSpar $ liftSem $ SAMLUserStore.get uref) isJust checkErr :: HasCallStack => Int -> Maybe TestErrorLabel -> Assertions () checkErr status mlabel = do diff --git a/services/spar/test-integration/Util/Scim.hs b/services/spar/test-integration/Util/Scim.hs index f71101074b8..732df54d361 100644 --- a/services/spar/test-integration/Util/Scim.hs +++ b/services/spar/test-integration/Util/Scim.hs @@ -22,7 +22,6 @@ module Util.Scim where import Bilge import Bilge.Assert import Brig.Types.User -import Cassandra import Control.Lens import Control.Monad.Random import Data.ByteString.Conversion @@ -35,9 +34,10 @@ import Data.UUID.V4 as UUID import Imports import qualified SAML2.WebSSO as SAML import SAML2.WebSSO.Types (IdPId, idpId) -import Spar.Data as Data +import Spar.App (liftSem) import qualified Spar.Intra.Brig as Intra import Spar.Scim.User (synthesizeScimUser, validateScimUser') +import qualified Spar.Sem.ScimTokenStore as ScimTokenStore import Test.QuickCheck (arbitrary, generate) import qualified Text.Email.Parser as Email import qualified Text.XML.DSig as SAML @@ -75,23 +75,23 @@ registerIdPAndScimTokenWithMeta = do -- | Create a fresh SCIM token and register it for the team. registerScimToken :: HasCallStack => TeamId -> Maybe IdPId -> TestSpar ScimToken registerScimToken teamid midpid = do - env <- ask tok <- ScimToken <$> do code <- liftIO UUID.nextRandom pure $ "scim-test-token/" <> "team=" <> idToText teamid <> "/code=" <> UUID.toText code scimTokenId <- randomId now <- liftIO getCurrentTime - runClient (env ^. teCql) $ - Data.insertScimToken - tok - ScimTokenInfo - { stiTeam = teamid, - stiId = scimTokenId, - stiCreatedAt = now, - stiIdP = midpid, - stiDescr = "test token" - } + runSpar $ + liftSem $ + ScimTokenStore.insert + tok + ScimTokenInfo + { stiTeam = teamid, + stiId = scimTokenId, + stiCreatedAt = now, + stiIdP = midpid, + stiDescr = "test token" + } pure tok -- | Generate a SCIM user with a random name and handle. At the very least, everything considered From 54269779a32e3bbe7410ade266c1772ed58bec16 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Thu, 23 Sep 2021 23:58:47 -0700 Subject: [PATCH 52/72] Spar Polysemy: Final Cassandra effects (#1806) * AReqIDStore effect * make format * AssIDStore effect * Update Spar/API * Fix tests * make format * Add store/getVerdictFormat to AReqIDStore * BindCookieStore effect * Remove runSparCass* * Remove cassandra-specific utils * make format * changelog.d --- changelog.d/5-internal/last-spar-effects | 1 + services/spar/spar.cabal | 8 +- services/spar/src/Spar/API.hs | 53 ++++++- services/spar/src/Spar/App.hs | 139 +++++++++++------- services/spar/src/Spar/Sem/AReqIDStore.hs | 16 ++ .../src/Spar/Sem/AReqIDStore/Cassandra.hs | 38 +++++ services/spar/src/Spar/Sem/AssIDStore.hs | 13 ++ .../spar/src/Spar/Sem/AssIDStore/Cassandra.hs | 29 ++++ services/spar/src/Spar/Sem/BindCookieStore.hs | 13 ++ .../src/Spar/Sem/BindCookieStore/Cassandra.hs | 30 ++++ .../test-integration/Test/Spar/DataSpec.hs | 64 ++++---- services/spar/test-integration/Util/Core.hs | 88 ++++++----- 12 files changed, 361 insertions(+), 131 deletions(-) create mode 100644 changelog.d/5-internal/last-spar-effects create mode 100644 services/spar/src/Spar/Sem/AReqIDStore.hs create mode 100644 services/spar/src/Spar/Sem/AReqIDStore/Cassandra.hs create mode 100644 services/spar/src/Spar/Sem/AssIDStore.hs create mode 100644 services/spar/src/Spar/Sem/AssIDStore/Cassandra.hs create mode 100644 services/spar/src/Spar/Sem/BindCookieStore.hs create mode 100644 services/spar/src/Spar/Sem/BindCookieStore/Cassandra.hs diff --git a/changelog.d/5-internal/last-spar-effects b/changelog.d/5-internal/last-spar-effects new file mode 100644 index 00000000000..02ec91eaca2 --- /dev/null +++ b/changelog.d/5-internal/last-spar-effects @@ -0,0 +1 @@ +Polysemize the remainder of Spar's Cassandra effects diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index 4dc34caf29b..43574c643a9 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: f135fc7f6d1e85694286faaeb615c1808dedee43fd207e59f50864481c2a9cca +-- hash: d04f829f6801dc459cf2f535b387c77caf06d3d99c2d95c9b46c469c1ec8b890 name: spar version: 0.1 @@ -34,6 +34,12 @@ library Spar.Scim.Auth Spar.Scim.Types Spar.Scim.User + Spar.Sem.AReqIDStore + Spar.Sem.AReqIDStore.Cassandra + Spar.Sem.AssIDStore + Spar.Sem.AssIDStore.Cassandra + Spar.Sem.BindCookieStore + Spar.Sem.BindCookieStore.Cassandra Spar.Sem.DefaultSsoCode Spar.Sem.DefaultSsoCode.Cassandra Spar.Sem.IdP diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 569906b4397..fba2cad8fe2 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -58,12 +58,17 @@ import qualified SAML2.WebSSO as SAML import Servant import qualified Servant.Multipart as Multipart import Spar.App -import qualified Spar.Data as Data hiding (clearReplacedBy, deleteIdPRawMetadata, getIdPConfig, getIdPConfigsByTeam, getIdPIdByIssuerWithTeam, getIdPIdByIssuerWithoutTeam, getIdPRawMetadata, setReplacedBy, storeIdPConfig, storeIdPRawMetadata) +import qualified Spar.Data as Data (GetIdPResult (..), Replaced (..), Replacing (..)) import Spar.Error import qualified Spar.Intra.Brig as Brig import qualified Spar.Intra.Galley as Galley import Spar.Orphans () import Spar.Scim +import Spar.Sem.AReqIDStore (AReqIDStore) +import qualified Spar.Sem.AReqIDStore as AReqIDStore +import Spar.Sem.AssIDStore (AssIDStore) +import Spar.Sem.BindCookieStore (BindCookieStore) +import qualified Spar.Sem.BindCookieStore as BindCookieStore import Spar.Sem.DefaultSsoCode (DefaultSsoCode) import qualified Spar.Sem.DefaultSsoCode as DefaultSsoCode import qualified Spar.Sem.IdP as IdPEffect @@ -84,7 +89,21 @@ app ctx = SAML.setHttpCachePolicy $ serve (Proxy @API) (hoistServer (Proxy @API) (SAML.nt @SparError @(Spar _) ctx) (api $ sparCtxOpts ctx) :: Server API) -api :: Members '[ScimExternalIdStore, ScimUserTimesStore, ScimTokenStore, DefaultSsoCode, IdPEffect.IdP, SAMLUserStore] r => Opts -> ServerT API (Spar r) +api :: + Members + '[ BindCookieStore, + AssIDStore, + AReqIDStore, + ScimExternalIdStore, + ScimUserTimesStore, + ScimTokenStore, + DefaultSsoCode, + IdPEffect.IdP, + SAMLUserStore + ] + r => + Opts -> + ServerT API (Spar r) api opts = apiSSO opts :<|> authreqPrecheck @@ -93,7 +112,19 @@ api opts = :<|> apiScim :<|> apiINTERNAL -apiSSO :: Members '[ScimTokenStore, DefaultSsoCode, IdPEffect.IdP, SAMLUserStore] r => Opts -> ServerT APISSO (Spar r) +apiSSO :: + Members + '[ BindCookieStore, + AssIDStore, + AReqIDStore, + ScimTokenStore, + DefaultSsoCode, + IdPEffect.IdP, + SAMLUserStore + ] + r => + Opts -> + ServerT APISSO (Spar r) apiSSO opts = SAML.meta appName (sparSPIssuer Nothing) (sparResponseURI Nothing) :<|> (\tid -> SAML.meta appName (sparSPIssuer (Just tid)) (sparResponseURI (Just tid))) @@ -131,7 +162,7 @@ authreqPrecheck msucc merr idpid = *> return NoContent authreq :: - Member IdPEffect.IdP r => + Members '[BindCookieStore, AssIDStore, AReqIDStore, IdPEffect.IdP] r => NominalDiffTime -> DoInitiate -> Maybe UserId -> @@ -150,7 +181,7 @@ authreq authreqttl _ zusr msucc merr idpid = do WireIdPAPIV1 -> Nothing WireIdPAPIV2 -> Just $ idp ^. SAML.idpExtraInfo . wiTeam SAML.authreq authreqttl (sparSPIssuer mbtid) idpid - wrapMonadClient $ Data.storeVerdictFormat authreqttl reqid vformat + wrapMonadClientSem $ AReqIDStore.storeVerdictFormat authreqttl reqid vformat cky <- initializeBindCookie zusr authreqttl SAML.logger SAML.Debug $ "setting bind cookie: " <> show cky pure $ addHeader cky form @@ -158,7 +189,7 @@ authreq authreqttl _ zusr msucc merr idpid = do -- | If the user is already authenticated, create bind cookie with a given life expectancy and our -- domain, and store it in C*. If the user is not authenticated, return a deletion 'SetCookie' -- value that deletes any bind cookies on the client. -initializeBindCookie :: Maybe UserId -> NominalDiffTime -> Spar r SetBindCookie +initializeBindCookie :: Member BindCookieStore r => Maybe UserId -> NominalDiffTime -> Spar r SetBindCookie initializeBindCookie zusr authreqttl = do DerivedOpts {derivedOptsBindCookiePath} <- asks (derivedOpts . sparCtxOpts) msecret <- @@ -166,7 +197,7 @@ initializeBindCookie zusr authreqttl = do then liftIO $ Just . cs . ES.encode <$> randBytes 32 else pure Nothing cky <- fmap SetBindCookie . SAML.toggleCookie derivedOptsBindCookiePath $ (,authreqttl) <$> msecret - forM_ zusr $ \userid -> wrapMonadClientWithEnv $ Data.insertBindCookie cky userid authreqttl + forM_ zusr $ \userid -> wrapMonadClientSem $ BindCookieStore.insert cky userid authreqttl pure cky redirectURLMaxLength :: Int @@ -187,7 +218,13 @@ validateRedirectURL uri = do unless ((SBS.length $ URI.serializeURIRef' uri) <= redirectURLMaxLength) $ do throwSpar $ SparBadInitiateLoginQueryParams "url-too-long" -authresp :: forall r. Members '[ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe TeamId -> Maybe ST -> SAML.AuthnResponseBody -> Spar r Void +authresp :: + forall r. + Members '[BindCookieStore, AssIDStore, AReqIDStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Maybe TeamId -> + Maybe ST -> + SAML.AuthnResponseBody -> + Spar r Void authresp mbtid ckyraw arbody = logErrors $ SAML.authresp mbtid (sparSPIssuer mbtid) (sparResponseURI mbtid) go arbody where cky :: Maybe BindCookie diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index 9da98da45ee..7aeef5a9370 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -25,8 +25,6 @@ module Spar.App ( Spar (..), Env (..), toLevel, - wrapMonadClientWithEnv, - wrapMonadClient, wrapMonadClientSem, verdictHandler, GetUserResult (..), @@ -41,14 +39,12 @@ module Spar.App deleteTeam, wrapSpar, liftSem, - liftMonadClient, ) where import Bilge import Brig.Types (ManagedBy (..), User, userId, userTeam) import Brig.Types.Intra (AccountStatus (..), accountStatus, accountUser) -import Cassandra import qualified Cassandra as Cas import Control.Exception (assert) import Control.Lens hiding ((.=)) @@ -68,7 +64,9 @@ import Imports hiding (log) import qualified Network.HTTP.Types.Status as Http import qualified Network.Wai.Utilities.Error as Wai import Polysemy +import Polysemy.Error import Polysemy.Final +import qualified Polysemy.Reader as ReaderEff import SAML2.Util (renderURI) import SAML2.WebSSO ( Assertion (..), @@ -84,7 +82,6 @@ import SAML2.WebSSO SPStoreIdP (getIdPConfigByIssuerOptionalSPId), UnqualifiedNameID (..), explainDeniedReason, - fromTime, idpExtraInfo, idpId, uidTenant, @@ -93,11 +90,20 @@ import qualified SAML2.WebSSO as SAML import qualified SAML2.WebSSO.Types.Email as SAMLEmail import Servant import qualified Servant.Multipart as Multipart -import qualified Spar.Data as Data hiding (deleteSAMLUser, deleteSAMLUsersByIssuer, getIdPConfig, getSAMLAnyUserByIssuer, getSAMLSomeUsersByIssuer, getSAMLUser, insertSAMLUser, storeIdPConfig) +import qualified Spar.Data as Data (GetIdPResult (..)) import Spar.Error import qualified Spar.Intra.Brig as Intra import qualified Spar.Intra.Galley as Intra import Spar.Orphans () +import Spar.Sem.AReqIDStore (AReqIDStore) +import qualified Spar.Sem.AReqIDStore as AReqIDStore +import Spar.Sem.AReqIDStore.Cassandra (aReqIDStoreToCassandra, ttlErrorToSparError) +import Spar.Sem.AssIDStore (AssIDStore) +import qualified Spar.Sem.AssIDStore as AssIDStore +import Spar.Sem.AssIDStore.Cassandra (assIDStoreToCassandra) +import Spar.Sem.BindCookieStore (BindCookieStore) +import qualified Spar.Sem.BindCookieStore as BindCookieStore +import Spar.Sem.BindCookieStore.Cassandra (bindCookieStoreToCassandra) import Spar.Sem.DefaultSsoCode (DefaultSsoCode) import Spar.Sem.DefaultSsoCode.Cassandra (defaultSsoCodeToCassandra) import Spar.Sem.IdP (GetIdPResult (..)) @@ -186,15 +192,15 @@ toLevel = \case SAML.Debug -> Log.Debug SAML.Trace -> Log.Trace -instance SPStoreID AuthnRequest (Spar r) where - storeID i r = wrapMonadClientWithEnv $ Data.storeAReqID i r - unStoreID r = wrapMonadClient $ Data.unStoreAReqID r - isAliveID r = wrapMonadClient $ Data.isAliveAReqID r +instance Member AReqIDStore r => SPStoreID AuthnRequest (Spar r) where + storeID i r = wrapMonadClientSem $ AReqIDStore.store i r + unStoreID r = wrapMonadClientSem $ AReqIDStore.unStore r + isAliveID r = wrapMonadClientSem $ AReqIDStore.isAlive r -instance SPStoreID Assertion (Spar r) where - storeID i r = wrapMonadClientWithEnv $ Data.storeAssID i r - unStoreID r = wrapMonadClient $ Data.unStoreAssID r - isAliveID r = wrapMonadClient $ Data.isAliveAssID r +instance Member AssIDStore r => SPStoreID Assertion (Spar r) where + storeID i r = wrapMonadClientSem $ AssIDStore.store i r + unStoreID r = wrapMonadClientSem $ AssIDStore.unStore r + isAliveID r = wrapMonadClientSem $ AssIDStore.isAlive r instance Member IdPEffect.IdP r => SPStoreIdP SparError (Spar r) where type IdPConfigExtra (Spar r) = WireIdP @@ -215,13 +221,6 @@ instance Member IdPEffect.IdP r => SPStoreIdP SparError (Spar r) where res@(Data.GetIdPNonUnique _) -> throwSpar $ SparIdPNotFound (cs $ show res) res@(Data.GetIdPWrongTeam _) -> throwSpar $ SparIdPNotFound (cs $ show res) --- | 'wrapMonadClient' with an 'Env' in a 'ReaderT', and exceptions. If you --- don't need either of those, 'wrapMonadClient' will suffice. -wrapMonadClientWithEnv :: forall r a. ReaderT Data.Env (ExceptT TTLError Cas.Client) a -> Spar r a -wrapMonadClientWithEnv action = do - denv <- Data.mkEnv <$> (sparCtxOpts <$> ask) <*> (fromTime <$> getNow) - either (throwSpar . SparCassandraTTLError) pure =<< wrapMonadClient (runExceptT $ action `runReaderT` denv) - instance Member (Final IO) r => Catch.MonadThrow (Sem r) where throwM = embedFinal . Catch.throwM @IO @@ -232,22 +231,6 @@ instance Member (Final IO) r => Catch.MonadCatch (Sem r) where handler' <- bindS handler pure $ m' `Catch.catch` \e -> handler' $ e <$ st --- | Call a cassandra command in the 'Spar' monad. Catch all exceptions and re-throw them as 500 in --- Handler. -wrapMonadClient :: Cas.Client a -> Spar r a -wrapMonadClient action = - Spar $ do - ctx <- asks sparCtxCas - fromSpar $ wrapMonadClientSem $ embedFinal @IO $ runClient ctx action - --- | Lift a cassandra command into the 'Spar' monad. Like 'wrapMonadClient', --- but doesn't catch any exceptions. -liftMonadClient :: Cas.Client a -> Spar r a -liftMonadClient action = - Spar $ do - ctx <- asks sparCtxCas - lift $ lift $ embedFinal @IO $ runClient ctx action - -- | Call a 'Sem' command in the 'Spar' monad. Catch all (IO) exceptions and -- re-throw them as 500 in Handler. wrapMonadClientSem :: Sem r a -> Spar r a @@ -425,7 +408,27 @@ bindUser buid userref = do Ephemeral -> err oldStatus PendingInvitation -> Intra.setStatus buid Active -instance (r ~ '[ScimExternalIdStore, ScimUserTimesStore, ScimTokenStore, DefaultSsoCode, IdPEffect.IdP, SAMLUserStore, Embed (Cas.Client), Embed IO, Final IO]) => SPHandler SparError (Spar r) where +instance + ( r + ~ '[ BindCookieStore, + AssIDStore, + AReqIDStore, + ScimExternalIdStore, + ScimUserTimesStore, + ScimTokenStore, + DefaultSsoCode, + IdPEffect.IdP, + SAMLUserStore, + Embed (Cas.Client), + ReaderEff.Reader Opts, + Error TTLError, + Error SparError, + Embed IO, + Final IO + ] + ) => + SPHandler SparError (Spar r) + where type NTCTX (Spar r) = Env nt :: forall a. Env -> Spar r a -> Handler a nt ctx (Spar action) = do @@ -434,18 +437,25 @@ instance (r ~ '[ScimExternalIdStore, ScimUserTimesStore, ScimTokenStore, Default where actionHandler :: Handler (Either SparError a) actionHandler = - liftIO $ - runFinal $ - embedToFinal @IO $ - interpretClientToIO (sparCtxCas ctx) $ - samlUserStoreToCassandra @Cas.Client $ - idPToCassandra @Cas.Client $ - defaultSsoCodeToCassandra $ - scimTokenStoreToCassandra $ - scimUserTimesStoreToCassandra $ - scimExternalIdStoreToCassandra $ - runExceptT $ - runReaderT action ctx + fmap join $ + liftIO $ + runFinal $ + embedToFinal @IO $ + runError @SparError $ + ttlErrorToSparError $ + ReaderEff.runReader (sparCtxOpts ctx) $ + interpretClientToIO (sparCtxCas ctx) $ + samlUserStoreToCassandra @Cas.Client $ + idPToCassandra @Cas.Client $ + defaultSsoCodeToCassandra $ + scimTokenStoreToCassandra $ + scimUserTimesStoreToCassandra $ + scimExternalIdStoreToCassandra $ + aReqIDStoreToCassandra $ + assIDStoreToCassandra $ + bindCookieStoreToCassandra $ + runExceptT $ + runReaderT action ctx throwErrorAsHandlerException :: Either SparError a -> Handler a throwErrorAsHandlerException (Left err) = sparToServerErrorWithLogging (sparCtxLogger ctx) err >>= throwError @@ -475,14 +485,21 @@ instance Intra.MonadSparToGalley (Spar r) where -- signed in-response-to info in the assertions matches the unsigned in-response-to field in the -- 'SAML.Response', and fills in the response id in the header if missing, we can just go for the -- latter. -verdictHandler :: HasCallStack => Members '[ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe BindCookie -> Maybe TeamId -> SAML.AuthnResponse -> SAML.AccessVerdict -> Spar r SAML.ResponseVerdict +verdictHandler :: + HasCallStack => + Members '[BindCookieStore, AReqIDStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Maybe BindCookie -> + Maybe TeamId -> + SAML.AuthnResponse -> + SAML.AccessVerdict -> + Spar r SAML.ResponseVerdict verdictHandler cky mbteam aresp verdict = do -- [3/4.1.4.2] -- [...] If the containing message is in response to an , then -- the InResponseTo attribute MUST match the request's ID. SAML.logger SAML.Debug $ "entering verdictHandler: " <> show (fromBindCookie <$> cky, aresp, verdict) reqid <- either (throwSpar . SparNoRequestRefInResponse . cs) pure $ SAML.rspInResponseTo aresp - format :: Maybe VerdictFormat <- wrapMonadClient $ Data.getVerdictFormat reqid + format :: Maybe VerdictFormat <- wrapMonadClientSem $ AReqIDStore.getVerdictFormat reqid resp <- case format of Just (VerdictFormatWeb) -> verdictHandlerResult cky mbteam verdict >>= verdictHandlerWeb @@ -500,7 +517,13 @@ data VerdictHandlerResult | VerifyHandlerError {_vhrLabel :: ST, _vhrMessage :: ST} deriving (Eq, Show) -verdictHandlerResult :: HasCallStack => Members '[ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> Spar r VerdictHandlerResult +verdictHandlerResult :: + HasCallStack => + Members '[BindCookieStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Maybe BindCookie -> + Maybe TeamId -> + SAML.AccessVerdict -> + Spar r VerdictHandlerResult verdictHandlerResult bindCky mbteam verdict = do SAML.logger SAML.Debug $ "entering verdictHandlerResult: " <> show (fromBindCookie <$> bindCky) result <- catchVerdictErrors $ verdictHandlerResultCore bindCky mbteam verdict @@ -539,13 +562,19 @@ moveUserToNewIssuer oldUserRef newUserRef uid = do Intra.setBrigUserVeid uid (UrefOnly newUserRef) wrapMonadClientSem $ SAMLUserStore.delete uid oldUserRef -verdictHandlerResultCore :: HasCallStack => Members '[ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> Spar r VerdictHandlerResult +verdictHandlerResultCore :: + HasCallStack => + Members '[BindCookieStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Maybe BindCookie -> + Maybe TeamId -> + SAML.AccessVerdict -> + Spar r VerdictHandlerResult verdictHandlerResultCore bindCky mbteam = \case SAML.AccessDenied reasons -> do pure $ VerifyHandlerDenied reasons SAML.AccessGranted userref -> do uid :: UserId <- do - viaBindCookie <- maybe (pure Nothing) (wrapMonadClient . Data.lookupBindCookie) bindCky + viaBindCookie <- maybe (pure Nothing) (wrapMonadClientSem . BindCookieStore.lookup) bindCky viaSparCassandra <- getUserIdByUref mbteam userref -- race conditions: if the user has been created on spar, but not on brig, 'getUser' -- returns 'Nothing'. this is ok assuming 'createUser', 'bindUser' (called below) are diff --git a/services/spar/src/Spar/Sem/AReqIDStore.hs b/services/spar/src/Spar/Sem/AReqIDStore.hs new file mode 100644 index 00000000000..021fc94e719 --- /dev/null +++ b/services/spar/src/Spar/Sem/AReqIDStore.hs @@ -0,0 +1,16 @@ +module Spar.Sem.AReqIDStore where + +import Data.Time (NominalDiffTime) +import Imports +import Polysemy +import qualified SAML2.WebSSO.Types as SAML +import Wire.API.User.Saml (AReqId, VerdictFormat) + +data AReqIDStore m a where + Store :: AReqId -> SAML.Time -> AReqIDStore m () + UnStore :: AReqId -> AReqIDStore m () + IsAlive :: AReqId -> AReqIDStore m Bool + StoreVerdictFormat :: NominalDiffTime -> AReqId -> VerdictFormat -> AReqIDStore m () + GetVerdictFormat :: AReqId -> AReqIDStore m (Maybe VerdictFormat) + +makeSem ''AReqIDStore diff --git a/services/spar/src/Spar/Sem/AReqIDStore/Cassandra.hs b/services/spar/src/Spar/Sem/AReqIDStore/Cassandra.hs new file mode 100644 index 00000000000..8189ab9c568 --- /dev/null +++ b/services/spar/src/Spar/Sem/AReqIDStore/Cassandra.hs @@ -0,0 +1,38 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + +module Spar.Sem.AReqIDStore.Cassandra where + +import Cassandra +import Control.Monad.Except (runExceptT) +import Imports hiding (MonadReader (..), Reader) +import Polysemy +import Polysemy.Error +import Polysemy.Reader +import SAML2.WebSSO (HasNow, fromTime, getNow) +import qualified SAML2.WebSSO as SAML +import qualified Spar.Data as Data +import Spar.Error +import Spar.Sem.AReqIDStore +import Wire.API.User.Saml (Opts, TTLError) + +instance Member (Embed IO) r => HasNow (Sem r) + +aReqIDStoreToCassandra :: + forall m r a. + (MonadClient m, Members '[Embed m, Error TTLError, Embed IO, Reader Opts] r) => + Sem (AReqIDStore ': r) a -> + Sem r a +aReqIDStoreToCassandra = interpret $ \case + Store itla t -> do + denv <- Data.mkEnv <$> ask <*> (fromTime <$> getNow) + a <- embed @m $ runExceptT $ runReaderT (Data.storeAReqID itla t) denv + case a of + Left err -> throw err + Right () -> pure () + UnStore itla -> embed @m $ Data.unStoreAReqID itla + IsAlive itla -> embed @m $ Data.isAliveAReqID itla + StoreVerdictFormat ndt itla vf -> embed @m $ Data.storeVerdictFormat ndt itla vf + GetVerdictFormat itla -> embed @m $ Data.getVerdictFormat itla + +ttlErrorToSparError :: Member (Error SparError) r => Sem (Error TTLError ': r) a -> Sem r a +ttlErrorToSparError = mapError (SAML.CustomError . SparCassandraTTLError) diff --git a/services/spar/src/Spar/Sem/AssIDStore.hs b/services/spar/src/Spar/Sem/AssIDStore.hs new file mode 100644 index 00000000000..bee1e731d2a --- /dev/null +++ b/services/spar/src/Spar/Sem/AssIDStore.hs @@ -0,0 +1,13 @@ +module Spar.Sem.AssIDStore where + +import Imports +import Polysemy +import qualified SAML2.WebSSO.Types as SAML +import Wire.API.User.Saml (AssId) + +data AssIDStore m a where + Store :: AssId -> SAML.Time -> AssIDStore m () + UnStore :: AssId -> AssIDStore m () + IsAlive :: AssId -> AssIDStore m Bool + +makeSem ''AssIDStore diff --git a/services/spar/src/Spar/Sem/AssIDStore/Cassandra.hs b/services/spar/src/Spar/Sem/AssIDStore/Cassandra.hs new file mode 100644 index 00000000000..e746b1ed386 --- /dev/null +++ b/services/spar/src/Spar/Sem/AssIDStore/Cassandra.hs @@ -0,0 +1,29 @@ +module Spar.Sem.AssIDStore.Cassandra where + +import Cassandra +import Control.Monad.Except (runExceptT) +import Imports hiding (MonadReader (..), Reader) +import Polysemy +import Polysemy.Error +import Polysemy.Reader +import SAML2.WebSSO (fromTime, getNow) +import qualified Spar.Data as Data +import Spar.Sem.AReqIDStore.Cassandra () +import Spar.Sem.AssIDStore +import Wire.API.User.Saml (Opts, TTLError) + +assIDStoreToCassandra :: + forall m r a. + (MonadClient m, Members '[Embed m, Error TTLError, Embed IO, Reader Opts] r) => + Sem (AssIDStore ': r) a -> + Sem r a +assIDStoreToCassandra = + interpret $ \case + Store itla t -> do + denv <- Data.mkEnv <$> ask <*> (fromTime <$> getNow) + a <- embed @m $ runExceptT $ runReaderT (Data.storeAssID itla t) denv + case a of + Left err -> throw err + Right () -> pure () + UnStore itla -> embed @m $ Data.unStoreAssID itla + IsAlive itla -> embed @m $ Data.isAliveAssID itla diff --git a/services/spar/src/Spar/Sem/BindCookieStore.hs b/services/spar/src/Spar/Sem/BindCookieStore.hs new file mode 100644 index 00000000000..cf79fdeddb4 --- /dev/null +++ b/services/spar/src/Spar/Sem/BindCookieStore.hs @@ -0,0 +1,13 @@ +module Spar.Sem.BindCookieStore where + +import Data.Id (UserId) +import Data.Time (NominalDiffTime) +import Imports +import Polysemy +import Wire.API.Cookie + +data BindCookieStore m a where + Insert :: SetBindCookie -> UserId -> NominalDiffTime -> BindCookieStore m () + Lookup :: BindCookie -> BindCookieStore m (Maybe UserId) + +makeSem ''BindCookieStore diff --git a/services/spar/src/Spar/Sem/BindCookieStore/Cassandra.hs b/services/spar/src/Spar/Sem/BindCookieStore/Cassandra.hs new file mode 100644 index 00000000000..4a17043dcda --- /dev/null +++ b/services/spar/src/Spar/Sem/BindCookieStore/Cassandra.hs @@ -0,0 +1,30 @@ +{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-} + +module Spar.Sem.BindCookieStore.Cassandra where + +import Cassandra +import Control.Monad.Except (runExceptT) +import Imports hiding (MonadReader (..), Reader) +import Polysemy +import Polysemy.Error +import Polysemy.Reader +import SAML2.WebSSO (fromTime, getNow) +import qualified Spar.Data as Data +import Spar.Sem.AReqIDStore.Cassandra () +import Spar.Sem.BindCookieStore +import Wire.API.User.Saml (Opts, TTLError) + +bindCookieStoreToCassandra :: + forall m r a. + (MonadClient m, Members '[Embed m, Error TTLError, Embed IO, Reader Opts] r) => + Sem (BindCookieStore ': r) a -> + Sem r a +bindCookieStoreToCassandra = interpret $ \case + Insert sbc uid ndt -> do + denv <- Data.mkEnv <$> ask <*> (fromTime <$> getNow) + a <- embed @m $ runExceptT $ runReaderT (Data.insertBindCookie sbc uid ndt) denv + case a of + Left err -> throw err + Right () -> pure () + Lookup bc -> embed @m $ Data.lookupBindCookie bc diff --git a/services/spar/test-integration/Test/Spar/DataSpec.hs b/services/spar/test-integration/Test/Spar/DataSpec.hs index 7c888890089..7d69db0d3c4 100644 --- a/services/spar/test-integration/Test/Spar/DataSpec.hs +++ b/services/spar/test-integration/Test/Spar/DataSpec.hs @@ -30,10 +30,14 @@ import Data.Kind (Type) import Data.UUID as UUID import Data.UUID.V4 as UUID import Imports +import Polysemy import SAML2.WebSSO as SAML import Spar.App as App import Spar.Data as Data import Spar.Intra.Brig (veidFromUserSSOId) +import qualified Spar.Sem.AReqIDStore as AReqIDStore +import qualified Spar.Sem.AssIDStore as AssIDStore +import qualified Spar.Sem.BindCookieStore as BindCookieStore import qualified Spar.Sem.IdP as IdPEffect import qualified Spar.Sem.SAMLUserStore as SAMLUserStore import qualified Spar.Sem.ScimTokenStore as ScimTokenStore @@ -68,7 +72,7 @@ spec = do (_, _, (^. SAML.idpId) -> idpid) <- registerTestIdP (_, req) <- call $ callAuthnReq (env ^. teSpar) idpid let probe :: (MonadIO m, MonadReader TestEnv m) => m Bool - probe = runSparCass $ isAliveAReqID (req ^. SAML.rqID) + probe = runSpar $ liftSem $ AReqIDStore.isAlive (req ^. SAML.rqID) maxttl :: Int -- musec maxttl = (fromIntegral . fromTTL $ env ^. teOpts . to maxttlAuthreq) * 1000 * 1000 liftIO $ maxttl `shouldSatisfy` (< 60 * 1000 * 1000) -- otherwise the test will be really slow. @@ -82,31 +86,31 @@ spec = do liftIO $ p3 `shouldBe` False -- 1.5 lifetimes after birth describe "cql binding" $ do describe "AuthnRequest" $ do - testSPStoreID storeAReqID unStoreAReqID isAliveAReqID + testSPStoreID AReqIDStore.store AReqIDStore.unStore AReqIDStore.isAlive describe "Assertion" $ do - testSPStoreID storeAssID unStoreAssID isAliveAssID + testSPStoreID AssIDStore.store AssIDStore.unStore AssIDStore.isAlive describe "VerdictFormat" $ do context "insert and get are \"inverses\"" $ do let check vf = it (show vf) $ do vid <- nextSAMLID - () <- runSparCass $ storeVerdictFormat 1 vid vf - mvf <- runSparCass $ getVerdictFormat vid + () <- runSpar $ liftSem $ AReqIDStore.storeVerdictFormat 1 vid vf + mvf <- runSpar $ liftSem $ AReqIDStore.getVerdictFormat vid liftIO $ mvf `shouldBe` Just vf check `mapM_` [ VerdictFormatWeb, VerdictFormatMobile [uri|https://fw/ooph|] [uri|https://lu/gn|] ] context "has timed out" $ do - it "getVerdictFormat returns Nothing" $ do + it "AReqIDStore.getVerdictFormat returns Nothing" $ do vid <- nextSAMLID - () <- runSparCass $ storeVerdictFormat 1 vid VerdictFormatWeb + () <- runSpar $ liftSem $ AReqIDStore.storeVerdictFormat 1 vid VerdictFormatWeb liftIO $ threadDelay 2000000 - mvf <- runSparCass $ getVerdictFormat vid + mvf <- runSpar $ liftSem $ AReqIDStore.getVerdictFormat vid liftIO $ mvf `shouldBe` Nothing context "does not exist" $ do - it "getVerdictFormat returns Nothing" $ do + it "AReqIDStore.getVerdictFormat returns Nothing" $ do vid <- nextSAMLID - mvf <- runSparCass $ getVerdictFormat vid + mvf <- runSpar $ liftSem $ AReqIDStore.getVerdictFormat vid liftIO $ mvf `shouldBe` Nothing describe "User" $ do context "user is new" $ do @@ -147,21 +151,21 @@ spec = do it "insert and get are \"inverses\"" $ do uid <- nextWireId cky <- mkcky - () <- runSparCassWithEnv $ insertBindCookie cky uid 1 - muid <- runSparCass $ lookupBindCookie (setBindCookieValue cky) + () <- runSpar $ liftSem $ BindCookieStore.insert cky uid 1 + muid <- runSpar $ liftSem $ BindCookieStore.lookup (setBindCookieValue cky) liftIO $ muid `shouldBe` Just uid context "has timed out" $ do - it "lookupBindCookie returns Nothing" $ do + it "BindCookieStore.lookup returns Nothing" $ do uid <- nextWireId cky <- mkcky - () <- runSparCassWithEnv $ insertBindCookie cky uid 1 + () <- runSpar $ liftSem $ BindCookieStore.insert cky uid 1 liftIO $ threadDelay 2000000 - muid <- runSparCass $ lookupBindCookie (setBindCookieValue cky) + muid <- runSpar $ liftSem $ BindCookieStore.lookup (setBindCookieValue cky) liftIO $ muid `shouldBe` Nothing context "does not exist" $ do - it "lookupBindCookie returns Nothing" $ do + it "BindCookieStore.lookup returns Nothing" $ do cky <- mkcky - muid <- runSparCass $ lookupBindCookie (setBindCookieValue cky) + muid <- runSpar $ liftSem $ BindCookieStore.lookup (setBindCookieValue cky) liftIO $ muid `shouldBe` Nothing describe "Team" $ do testDeleteTeam @@ -221,12 +225,14 @@ spec = do idp2' <- runSpar $ liftSem (IdPEffect.getConfig (idp1 ^. idpId)) liftIO $ idp2' `shouldBe` Nothing +-- TODO(sandy): This function should be more polymorphic over it's polysemy +-- constraints than using 'RealInterpretation' in full anger. testSPStoreID :: - forall m (a :: Type). - (m ~ ReaderT Data.Env (ExceptT TTLError Client), Typeable a) => - (SAML.ID a -> SAML.Time -> m ()) -> - (SAML.ID a -> m ()) -> - (SAML.ID a -> m Bool) -> + forall (a :: Type). + (Typeable a) => + (SAML.ID a -> SAML.Time -> Sem RealInterpretation ()) -> + (SAML.ID a -> Sem RealInterpretation ()) -> + (SAML.ID a -> Sem RealInterpretation Bool) -> SpecWith TestEnv testSPStoreID store unstore isalive = do describe ("SPStoreID @" <> show (typeRep @a)) $ do @@ -234,24 +240,24 @@ testSPStoreID store unstore isalive = do it "isAliveID is True" $ do xid :: SAML.ID a <- nextSAMLID eol :: Time <- addTime 5 <$> runSimpleSP getNow - () <- runSparCassWithEnv $ store xid eol - isit <- runSparCassWithEnv $ isalive xid + () <- runSpar $ liftSem $ store xid eol + isit <- runSpar $ liftSem $ isalive xid liftIO $ isit `shouldBe` True context "after TTL" $ do it "isAliveID returns False" $ do xid :: SAML.ID a <- nextSAMLID eol :: Time <- addTime 2 <$> runSimpleSP getNow - () <- runSparCassWithEnv $ store xid eol + () <- runSpar $ liftSem $ store xid eol liftIO $ threadDelay 3000000 - isit <- runSparCassWithEnv $ isalive xid + isit <- runSpar $ liftSem $ isalive xid liftIO $ isit `shouldBe` False context "after call to unstore" $ do it "isAliveID returns False" $ do xid :: SAML.ID a <- nextSAMLID eol :: Time <- addTime 5 <$> runSimpleSP getNow - () <- runSparCassWithEnv $ store xid eol - () <- runSparCassWithEnv $ unstore xid - isit <- runSparCassWithEnv $ isalive xid + () <- runSpar $ liftSem $ store xid eol + () <- runSpar $ liftSem $ unstore xid + isit <- runSpar $ liftSem $ isalive xid liftIO $ isit `shouldBe` False -- | Test that when a team is deleted, all relevant data is pruned from the diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index d5ef39ad8fa..cbbc41273d7 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -114,10 +114,9 @@ module Util.Core callIdpDeletePurge', initCassandra, ssoToUidSpar, - runSparCass, - runSparCassWithEnv, runSimpleSP, runSpar, + type RealInterpretation, getSsoidViaSelf, getSsoidViaSelf', getUserIdViaRef, @@ -158,7 +157,6 @@ import Data.Range import Data.String.Conversions import qualified Data.Text.Ascii as Ascii import Data.Text.Encoding (encodeUtf8) -import Data.Time import Data.UUID as UUID hiding (fromByteString, null) import Data.UUID.V4 as UUID (nextRandom) import qualified Data.Yaml as Yaml @@ -170,6 +168,8 @@ import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Handler.Warp.Internal as Warp import qualified Options.Applicative as OPA import Polysemy +import qualified Polysemy.Error as ErrorEff +import qualified Polysemy.Reader as ReaderEff import SAML2.WebSSO as SAML import qualified SAML2.WebSSO.API.Example as SAML import SAML2.WebSSO.Test.Lenses (userRefL) @@ -177,10 +177,16 @@ import SAML2.WebSSO.Test.MockResponse import SAML2.WebSSO.Test.Util (SampleIdP (..), makeSampleIdPMetadata) import Spar.App (liftSem, toLevel) import qualified Spar.App as Spar -import qualified Spar.Data as Data +import Spar.Error (SparError) import qualified Spar.Intra.Brig as Intra import qualified Spar.Options import Spar.Run +import Spar.Sem.AReqIDStore (AReqIDStore) +import Spar.Sem.AReqIDStore.Cassandra (aReqIDStoreToCassandra, ttlErrorToSparError) +import Spar.Sem.AssIDStore (AssIDStore) +import Spar.Sem.AssIDStore.Cassandra (assIDStoreToCassandra) +import Spar.Sem.BindCookieStore (BindCookieStore) +import Spar.Sem.BindCookieStore.Cassandra (bindCookieStoreToCassandra) import Spar.Sem.DefaultSsoCode (DefaultSsoCode) import Spar.Sem.DefaultSsoCode.Cassandra (defaultSsoCodeToCassandra) import qualified Spar.Sem.IdP as IdPEffect @@ -1224,28 +1230,6 @@ ssoToUidSpar tid ssoid = do (liftSem . ScimExternalIdStore.lookup tid) veid -runSparCass :: - (HasCallStack, m ~ Client, MonadIO m', MonadReader TestEnv m') => - m a -> - m' a -runSparCass action = do - env <- ask - liftIO $ runClient (env ^. teCql) action - -runSparCassWithEnv :: - ( HasCallStack, - m ~ ReaderT Data.Env (ExceptT TTLError Cas.Client), - MonadIO m', - MonadReader TestEnv m' - ) => - m a -> - m' a -runSparCassWithEnv action = do - env <- ask - denv <- Data.mkEnv <$> (pure $ env ^. teOpts) <*> liftIO getCurrentTime - val <- runSparCass (runExceptT (action `runReaderT` denv)) - either (liftIO . throwIO . ErrorCall . show) pure val - runSimpleSP :: (MonadReader TestEnv m, MonadIO m) => SAML.SimpleSP a -> m a runSimpleSP action = do env <- ask @@ -1254,22 +1238,50 @@ runSimpleSP action = do result <- SAML.runSimpleSP ctx action either (throwIO . ErrorCall . show) pure result -runSpar :: (MonadReader TestEnv m, MonadIO m) => Spar.Spar '[ScimExternalIdStore, ScimUserTimesStore, DefaultSsoCode, ScimTokenStore, IdPEffect.IdP, SAMLUserStore, Embed Client, Embed IO, Final IO] a -> m a +type RealInterpretation = + '[ BindCookieStore, + AssIDStore, + AReqIDStore, + ScimExternalIdStore, + ScimUserTimesStore, + ScimTokenStore, + DefaultSsoCode, + IdPEffect.IdP, + SAMLUserStore, + Embed (Cas.Client), + ReaderEff.Reader Opts, + ErrorEff.Error TTLError, + ErrorEff.Error SparError, + Embed IO, + Final IO + ] + +runSpar :: + (MonadReader TestEnv m, MonadIO m) => + Spar.Spar RealInterpretation a -> + m a runSpar (Spar.Spar action) = do env <- (^. teSparEnv) <$> ask liftIO $ do result <- - runFinal $ - embedToFinal @IO $ - interpretClientToIO (Spar.sparCtxCas env) $ - samlUserStoreToCassandra @Cas.Client $ - idPToCassandra @Cas.Client $ - scimTokenStoreToCassandra @Cas.Client $ - defaultSsoCodeToCassandra @Cas.Client $ - scimUserTimesStoreToCassandra @Cas.Client $ - scimExternalIdStoreToCassandra @Cas.Client $ - runExceptT $ - action `runReaderT` env + fmap join $ + runFinal $ + embedToFinal @IO $ + ErrorEff.runError @SparError $ + ttlErrorToSparError $ + ReaderEff.runReader (Spar.sparCtxOpts env) $ + interpretClientToIO (Spar.sparCtxCas env) $ + samlUserStoreToCassandra @Cas.Client $ + idPToCassandra @Cas.Client $ + defaultSsoCodeToCassandra @Cas.Client $ + scimTokenStoreToCassandra @Cas.Client $ + scimUserTimesStoreToCassandra @Cas.Client $ + scimExternalIdStoreToCassandra @Cas.Client $ + aReqIDStoreToCassandra @Cas.Client $ + assIDStoreToCassandra @Cas.Client $ + bindCookieStoreToCassandra @Cas.Client $ + runExceptT $ + runReaderT action env either (throwIO . ErrorCall . show) pure result getSsoidViaSelf :: HasCallStack => UserId -> TestSpar UserSSOId From f97989825ff1e1a56fb801c6b5fda5c6f338e443 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 24 Sep 2021 10:22:54 +0200 Subject: [PATCH 53/72] Split `MultiTablePaging` module and add haddocks (#1803) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Split `MultiTablePaging` module and add haddocks Splitting the state encoding functions to a separate module makes it impossible to use them by mistake with the wrong bytestring (like the Cassandra paging token). Co-authored-by: Marko Dimjašević Co-authored-by: jschaul --- changelog.d/4-docs/multitable-docs | 1 + .../src/Wire/API/Routes/MultiTablePaging.hs | 77 ++++++++++--------- .../Wire/API/Routes/MultiTablePaging/State.hs | 73 ++++++++++++++++++ libs/wire-api/wire-api.cabal | 3 +- 4 files changed, 116 insertions(+), 38 deletions(-) create mode 100644 changelog.d/4-docs/multitable-docs create mode 100644 libs/wire-api/src/Wire/API/Routes/MultiTablePaging/State.hs diff --git a/changelog.d/4-docs/multitable-docs b/changelog.d/4-docs/multitable-docs new file mode 100644 index 00000000000..d648dfe4ce1 --- /dev/null +++ b/changelog.d/4-docs/multitable-docs @@ -0,0 +1 @@ +Add documentation of the multi-table paging abstraction diff --git a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs index 91f958a6c47..e05cbf6e987 100644 --- a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs +++ b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging.hs @@ -1,10 +1,30 @@ -module Wire.API.Routes.MultiTablePaging where +-- 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 Wire.API.Routes.MultiTablePaging + ( GetMultiTablePageRequest (..), + MultiTablePage (..), + LocalOrRemoteTable (..), + MultiTablePagingState (..), + ) +where import Control.Lens ((?~)) import Data.Aeson (FromJSON (..), ToJSON (..)) -import qualified Data.Attoparsec.ByteString as AB -import qualified Data.ByteString as BS -import Data.Json.Util (fromBase64Text, toBase64Text) import Data.Kind import Data.Proxy import Data.Range @@ -13,7 +33,17 @@ import qualified Data.Swagger as S import qualified Data.Text as Text import GHC.TypeLits import Imports - +import Wire.API.Routes.MultiTablePaging.State + +-- | A request for a page of results from the database. Type arguments: +-- +-- * @name@ Name of the resources being paginated through +-- * @tables@ A (usually finite) type that represent the table currently being +-- used (must be an instance of 'PagingTable') +-- * @max@ Maximum page size +-- * @def@ Default page size +-- +-- See 'ConversationPagingState' for an example. data GetMultiTablePageRequest (name :: Symbol) (tables :: Type) (max :: Nat) (def :: Nat) = GetMultiTablePageRequest { gmtprSize :: Range 1 max Int32, gmtprState :: Maybe (MultiTablePagingState name tables) @@ -69,38 +99,9 @@ textFromNat = Text.pack . show . natVal $ Proxy @n textFromSymbol :: forall s. KnownSymbol s => Text textFromSymbol = Text.pack . symbolVal $ Proxy @s -data MultiTablePagingState (name :: Symbol) tables = MultiTablePagingState - { mtpsTable :: tables, - mtpsState :: Maybe ByteString - } - deriving stock (Show, Eq) - deriving (ToJSON, FromJSON, S.ToSchema) via Schema (MultiTablePagingState name tables) - -class PagingTable t where - -- Using 'Word8' because 256 tables ought to be enough. - encodePagingTable :: t -> Word8 - decodePagingTable :: MonadFail m => Word8 -> m t - -instance (PagingTable tables, KnownSymbol name) => ToSchema (MultiTablePagingState name tables) where - schema = - (toBase64Text . encodePagingState) - .= parsedText (textFromSymbol @name <> "_PagingState") (parseConversationPagingState <=< fromBase64Text) - -encodePagingState :: PagingTable tables => MultiTablePagingState name tables -> ByteString -encodePagingState (MultiTablePagingState table state) = - let encodedTable = encodePagingTable table - encodedState = fromMaybe "" state - in BS.cons encodedTable encodedState - -parseConversationPagingState :: PagingTable tables => ByteString -> Either String (MultiTablePagingState name tables) -parseConversationPagingState = AB.parseOnly conversationPagingStateParser - -conversationPagingStateParser :: PagingTable tables => AB.Parser (MultiTablePagingState name tables) -conversationPagingStateParser = do - table <- AB.anyWord8 >>= decodePagingTable - state <- (AB.endOfInput $> Nothing) <|> (Just <$> AB.takeByteString <* AB.endOfInput) - pure $ MultiTablePagingState table state - +-- | The result of a multi-table paginated query. Contains the list of results, +-- a flag indicating whether there are more, and the state to pass to the next +-- query. data MultiTablePage (name :: Symbol) (resultsKey :: Symbol) (tables :: Type) a = MultiTablePage { mtpResults :: [a], mtpHasMore :: Bool, @@ -139,6 +140,8 @@ instance <*> mtpHasMore .= field "has_more" schema <*> mtpPagingState .= field "paging_state" schema +-- | A type to be used as the @tables@ argument of 'GetMultiTablePageRequest' +-- when the resources being paginated through are split into local and remote. data LocalOrRemoteTable = PagingLocals | PagingRemotes diff --git a/libs/wire-api/src/Wire/API/Routes/MultiTablePaging/State.hs b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging/State.hs new file mode 100644 index 00000000000..1443d90db25 --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/MultiTablePaging/State.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 Wire.API.Routes.MultiTablePaging.State + ( MultiTablePagingState (..), + PagingTable (..), + ) +where + +import Data.Aeson (FromJSON (..), ToJSON (..)) +import qualified Data.Attoparsec.ByteString as AB +import qualified Data.ByteString as BS +import Data.Json.Util (fromBase64Text, toBase64Text) +import Data.Proxy +import Data.Schema +import qualified Data.Swagger as S +import qualified Data.Text as Text +import GHC.TypeLits +import Imports + +-- | The state of a multi-table paginated query. It is made of a reference to +-- the table currently being paginated, as well as an opaque token returned by +-- Cassandra. +data MultiTablePagingState (name :: Symbol) tables = MultiTablePagingState + { mtpsTable :: tables, + mtpsState :: Maybe ByteString + } + deriving stock (Show, Eq) + deriving (ToJSON, FromJSON, S.ToSchema) via Schema (MultiTablePagingState name tables) + +encodePagingState :: PagingTable tables => MultiTablePagingState name tables -> ByteString +encodePagingState (MultiTablePagingState table state) = + let encodedTable = encodePagingTable table + encodedState = fromMaybe "" state + in BS.cons encodedTable encodedState + +parsePagingState :: PagingTable tables => ByteString -> Either String (MultiTablePagingState name tables) +parsePagingState = AB.parseOnly conversationPagingStateParser + +conversationPagingStateParser :: PagingTable tables => AB.Parser (MultiTablePagingState name tables) +conversationPagingStateParser = do + table <- AB.anyWord8 >>= decodePagingTable + state <- (AB.endOfInput $> Nothing) <|> (Just <$> AB.takeByteString <* AB.endOfInput) + pure $ MultiTablePagingState table state + +-- | A class for values that can be encoded with a single byte. Used to add a +-- byte of extra information to the paging state in order to recover the table +-- information from a paging token. +class PagingTable t where + -- Using 'Word8' because 256 tables ought to be enough. + encodePagingTable :: t -> Word8 + decodePagingTable :: MonadFail m => Word8 -> m t + +instance (PagingTable tables, KnownSymbol name) => ToSchema (MultiTablePagingState name tables) where + schema = + (toBase64Text . encodePagingState) + .= parsedText + (Text.pack (symbolVal (Proxy @name)) <> "_PagingState") + (parsePagingState <=< fromBase64Text) diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index b5ab6d34421..3e06a63f39a 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: 1dce25e4dabf58eac09c8e4f384829306931a35d0c9b902d22d4f29b7a592aae +-- hash: db0e289b12b344457a40dfe813de29c63bb9e236a45c4407a0f521833fd8cdbe name: wire-api version: 0.1.0 @@ -50,6 +50,7 @@ library Wire.API.Push.Token Wire.API.Push.V2.Token Wire.API.Routes.MultiTablePaging + Wire.API.Routes.MultiTablePaging.State Wire.API.Routes.MultiVerb Wire.API.Routes.Public Wire.API.Routes.Public.Brig From f88b09cff3697fcb0177229205480223e6d87019 Mon Sep 17 00:00:00 2001 From: jschaul Date: Mon, 27 Sep 2021 14:51:37 +0200 Subject: [PATCH 54/72] Remote connections schema (#1789) * schema migration * Extract schema change from #1773 * Uncomment queries Storing 1-1 conversation id into the database makes sense in case we decide to change the `(UserId, UserId) -> ConvId` mapping in the future. * Update cassandra schema file Co-authored-by: Paolo Capriotti --- .../6-federation/remote-connections-migration | 1 + docs/reference/cassandra-schema.cql | 25 +++++++++++ services/brig/brig.cabal | 3 +- services/brig/schema/src/Main.hs | 4 +- .../schema/src/V65_FederatedConnections.hs | 44 +++++++++++++++++++ services/brig/src/Brig/App.hs | 2 +- services/brig/src/Brig/Data/Connection.hs | 22 ++++++++++ 7 files changed, 98 insertions(+), 3 deletions(-) create mode 100644 changelog.d/6-federation/remote-connections-migration create mode 100644 services/brig/schema/src/V65_FederatedConnections.hs diff --git a/changelog.d/6-federation/remote-connections-migration b/changelog.d/6-federation/remote-connections-migration new file mode 100644 index 00000000000..facfec07c72 --- /dev/null +++ b/changelog.d/6-federation/remote-connections-migration @@ -0,0 +1 @@ +Add migration for remote connection table diff --git a/docs/reference/cassandra-schema.cql b/docs/reference/cassandra-schema.cql index fd39a8753e8..80d6cd8e373 100644 --- a/docs/reference/cassandra-schema.cql +++ b/docs/reference/cassandra-schema.cql @@ -1221,6 +1221,31 @@ CREATE TABLE brig_test.budget ( AND read_repair_chance = 0.0 AND speculative_retry = '99PERCENTILE'; +CREATE TABLE brig_test.connection_remote ( + left uuid, + right_domain text, + right_user uuid, + conv_domain text, + conv_id uuid, + last_update timestamp, + status int, + PRIMARY KEY (left, right_domain, right_user) +) WITH CLUSTERING ORDER BY (right_domain ASC, right_user ASC) + AND bloom_filter_fp_chance = 0.1 + AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'} + AND comment = '' + AND compaction = {'class': 'org.apache.cassandra.db.compaction.LeveledCompactionStrategy'} + AND compression = {'chunk_length_in_kb': '64', 'class': 'org.apache.cassandra.io.compress.LZ4Compressor'} + AND crc_check_chance = 1.0 + AND dclocal_read_repair_chance = 0.1 + AND default_time_to_live = 0 + AND gc_grace_seconds = 864000 + AND max_index_interval = 2048 + AND memtable_flush_period_in_ms = 0 + AND min_index_interval = 128 + AND read_repair_chance = 0.0 + AND speculative_retry = '99PERCENTILE'; + CREATE TABLE brig_test.users_pending_activation ( user uuid PRIMARY KEY, expires_at timestamp diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 38da5492674..b3fe3a5eee1 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 9964cbee009e206492e2a4bb74873592f1963ac4c13deb477b04491ee4471a2a +-- hash: 40cef77c160c1ffa8500043f465ab4ee307cf751450745d55010ef637b03b152 name: brig version: 1.35.0 @@ -435,6 +435,7 @@ executable brig-schema V62_RemoveFederationIdMapping V63_AddUsersPendingActivation V64_ClientCapabilities + V65_FederatedConnections V9 Paths_brig hs-source-dirs: diff --git a/services/brig/schema/src/Main.hs b/services/brig/schema/src/Main.hs index 32dedd9de84..1f3b6c597c3 100644 --- a/services/brig/schema/src/Main.hs +++ b/services/brig/schema/src/Main.hs @@ -74,6 +74,7 @@ import qualified V61_team_invitation_email import qualified V62_RemoveFederationIdMapping import qualified V63_AddUsersPendingActivation import qualified V64_ClientCapabilities +import qualified V65_FederatedConnections import qualified V9 main :: IO () @@ -137,7 +138,8 @@ main = do V61_team_invitation_email.migration, V62_RemoveFederationIdMapping.migration, V63_AddUsersPendingActivation.migration, - V64_ClientCapabilities.migration + V64_ClientCapabilities.migration, + V65_FederatedConnections.migration -- When adding migrations here, don't forget to update -- 'schemaVersion' in Brig.App diff --git a/services/brig/schema/src/V65_FederatedConnections.hs b/services/brig/schema/src/V65_FederatedConnections.hs new file mode 100644 index 00000000000..c67af2c1a7c --- /dev/null +++ b/services/brig/schema/src/V65_FederatedConnections.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# 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 V65_FederatedConnections + ( migration, + ) +where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = Migration 65 "Add table for federated (remote) connections" $ do + schema' + [r| CREATE TABLE connection_remote ( + left uuid, + right_domain text, + right_user uuid, + last_update timestamp, + status int, + conv_domain text, + conv_id uuid, + PRIMARY KEY (left, right_domain, right_user) + ) WITH CLUSTERING ORDER BY (right_domain ASC) + AND compaction = {'class': 'org.apache.cassandra.db.compaction.LeveledCompactionStrategy'} + |] diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index eed1cae7b5a..8d7b08607e3 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -134,7 +134,7 @@ import Wire.API.Federation.Client (HasFederatorConfig (..)) import Wire.API.User.Identity (Email) schemaVersion :: Int32 -schemaVersion = 64 +schemaVersion = 65 ------------------------------------------------------------------------------- -- Environment diff --git a/services/brig/src/Brig/Data/Connection.hs b/services/brig/src/Brig/Data/Connection.hs index 4acaac8c8f4..e4b5ab2f470 100644 --- a/services/brig/src/Brig/Data/Connection.hs +++ b/services/brig/src/Brig/Data/Connection.hs @@ -36,6 +36,11 @@ module Brig.Data.Connection lookupContactListWithRelation, countConnections, deleteConnections, + remoteConnectionInsert, + remoteConnectionSelect, + remoteConnectionSelectFrom, + remoteConnectionDelete, + remoteConnectionClear, -- * Re-exports module T, @@ -232,6 +237,23 @@ connectionDelete = "DELETE FROM connection WHERE left = ? AND right = ?" connectionClear :: PrepQuery W (Identity UserId) () connectionClear = "DELETE FROM connection WHERE left = ?" +-- Remote connections + +remoteConnectionInsert :: PrepQuery W (UserId, Domain, UserId, RelationWithHistory, UTCTimeMillis, Domain, ConvId) () +remoteConnectionInsert = "INSERT INTO connection_remote (left, right_domain, right_user, status, last_update, conv_domain, conv_id) VALUES (?, ?, ?, ?, ?, ?, ?)" + +remoteConnectionSelect :: PrepQuery R (Identity UserId) (Domain, UserId, RelationWithHistory, Domain, ConvId) +remoteConnectionSelect = "SELECT right_domain, right_user, status, conv_domain, conv_id FROM connection_remote where left = ?" + +remoteConnectionSelectFrom :: PrepQuery R (UserId, Domain, UserId) (RelationWithHistory, Domain, ConvId) +remoteConnectionSelectFrom = "SELECT status, conv_domain, conv_id FROM connection_remote where left = ? AND right_domain = ? AND right = ?" + +remoteConnectionDelete :: PrepQuery W (UserId, Domain, UserId) () +remoteConnectionDelete = "DELETE FROM connection_remote where left = ? AND right_domain = ? AND right = ?" + +remoteConnectionClear :: PrepQuery W (Identity UserId) () +remoteConnectionClear = "DELETE FROM connection_remote where left = ?" + -- Conversions toLocalUserConnection :: (UserId, UserId, RelationWithHistory, UTCTimeMillis, Maybe ConvId) -> LocalConnection From f6bf1659b1fa3742c25b2d1b700a25dc24936fdb Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 27 Sep 2021 15:59:05 +0200 Subject: [PATCH 55/72] Add value for client TLS verification depth (#1812) --- changelog.d/6-federation/chain-of-trust | 1 + charts/nginx-ingress-services/templates/ingress_federator.yaml | 1 + charts/nginx-ingress-services/values.yaml | 2 ++ 3 files changed, 4 insertions(+) create mode 100644 changelog.d/6-federation/chain-of-trust diff --git a/changelog.d/6-federation/chain-of-trust b/changelog.d/6-federation/chain-of-trust new file mode 100644 index 00000000000..3e8cd94baee --- /dev/null +++ b/changelog.d/6-federation/chain-of-trust @@ -0,0 +1 @@ +Add value for verification depth of client certificates in federator ingress diff --git a/charts/nginx-ingress-services/templates/ingress_federator.yaml b/charts/nginx-ingress-services/templates/ingress_federator.yaml index 215671505ec..946fcab7e48 100644 --- a/charts/nginx-ingress-services/templates/ingress_federator.yaml +++ b/charts/nginx-ingress-services/templates/ingress_federator.yaml @@ -13,6 +13,7 @@ metadata: 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-verify-depth: "{{ .Values.tls.verify_depth }}" 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; diff --git a/charts/nginx-ingress-services/values.yaml b/charts/nginx-ingress-services/values.yaml index 6a4c1a51d4a..93e1af48481 100644 --- a/charts/nginx-ingress-services/values.yaml +++ b/charts/nginx-ingress-services/values.yaml @@ -29,6 +29,8 @@ tls: # `helm upgrade --install -n cert-manager-ns --set 'installCRDs=true' cert-manager jetstack/cert-manager` # useCertManager: false + # the validation depth between a federator client certificate and tlsClientCA + verify_depth: 1 certManager: # Indicates whether Letsencrypt's staging API server is used and therefore certificates are NOT trusted From 89f67c5f71ed14e20b874f3a0c5eba338081a46f Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Mon, 27 Sep 2021 13:29:22 -0700 Subject: [PATCH 56/72] Spar Polysemy: Separate out Brig and Galley effects (#1810) * Make sure to actually wrap the action in 'wrapMonadClientSem' * Implement wrapMonadClient in terms of wrapMonadClientSem * Pull out IdP effect * Push Member IdP constraints throughout * Pull application logic out of Data and into App * Use application-level functions instead * Remove deleteTeam from Data too * Get rid of wrapMonadClientWithEnvSem * Implement wrapSpar * Undo accidental formatting * Update cabal * make format * Update changelog * Get rid of the untouchable variable in liftSem * Be very careful about wrapping in the same places * Resort exports * Changelog * DefaultSsoCode effect * ScimTokenStore effect * wip BindCookie effect * Forgot some callsites * Get tests compiling again * Get everything compiling * remove runSparCassSem * Change the tests to use IdP * Finish all SAMLUser and IdP effects refs in tests * Excise all references to IdP and SAMLUser effects * make format * make format * Remove all references to new effects * make format * Add ScimUserTimesStore effect * ScimExternalIdStore effect * make format * Implement scimExternalIdStoreToCassandra * Use Members when appropriate * make format * Fixes. * Remove unwritten BindCookie effect modules * SAMLUser -> SAMLUserStore * Don't do extraneous lifting * Changelog.d * AReqIDStore effect * make format * AssIDStore effect * Update Spar/API * Fix tests * make format * Add store/getVerdictFormat to AReqIDStore * BindCookieStore effect * Remove runSparCass* * Remove cassandra-specific utils * make format * Add BrigAccess effect * Make tests compile * make format * GalleyAccess effect * Comments/formatting * make format * Remove MonadHttp instance * Tear Brig and Galley apart into effects * Implement HTTP handlers for Brig and Galley * Remove commented instances * make format * Get tests compiling again * Stale comment * Implement MonadLogger for RunHttp * Fix build for :spec target * Add changelog * make formt --- changelog.d/5-internal/spar-no-io | 1 + services/spar/spar.cabal | 7 +- services/spar/src/Spar/API.hs | 105 ++++++--- services/spar/src/Spar/App.hs | 100 ++++----- services/spar/src/Spar/Intra/Brig.hs | 151 +------------ services/spar/src/Spar/Intra/BrigApp.hs | 202 ++++++++++++++++++ services/spar/src/Spar/Scim.hs | 5 +- services/spar/src/Spar/Scim/Auth.hs | 26 ++- services/spar/src/Spar/Scim/User.hs | 97 +++++---- services/spar/src/Spar/Sem/BrigAccess.hs | 36 ++++ services/spar/src/Spar/Sem/BrigAccess/Http.hs | 41 ++++ services/spar/src/Spar/Sem/GalleyAccess.hs | 14 ++ .../spar/src/Spar/Sem/GalleyAccess/Http.hs | 68 ++++++ .../test-integration/Test/Spar/APISpec.hs | 5 +- .../test-integration/Test/Spar/DataSpec.hs | 2 +- .../Test/Spar/Intra/BrigSpec.hs | 7 +- .../Test/Spar/Scim/UserSpec.hs | 57 ++--- services/spar/test-integration/Util/Core.hs | 18 +- services/spar/test-integration/Util/Scim.hs | 2 +- .../spar/test/Test/Spar/Intra/BrigSpec.hs | 2 +- 20 files changed, 619 insertions(+), 327 deletions(-) create mode 100644 changelog.d/5-internal/spar-no-io create mode 100644 services/spar/src/Spar/Intra/BrigApp.hs create mode 100644 services/spar/src/Spar/Sem/BrigAccess.hs create mode 100644 services/spar/src/Spar/Sem/BrigAccess/Http.hs create mode 100644 services/spar/src/Spar/Sem/GalleyAccess.hs create mode 100644 services/spar/src/Spar/Sem/GalleyAccess/Http.hs diff --git a/changelog.d/5-internal/spar-no-io b/changelog.d/5-internal/spar-no-io new file mode 100644 index 00000000000..31c02e241cf --- /dev/null +++ b/changelog.d/5-internal/spar-no-io @@ -0,0 +1 @@ +This PR pulls apart the Spar.Intra.(Brig|Galley) modules into polysemy effects, as part of ongoing work to excise all IO from Spar. diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index 43574c643a9..cf3a787eee1 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: d04f829f6801dc459cf2f535b387c77caf06d3d99c2d95c9b46c469c1ec8b890 +-- hash: 9e886413a5108fd6abf098b0c1d23473e27606b12e5a2a36934f2df41cd4c80d name: spar version: 0.1 @@ -26,6 +26,7 @@ library Spar.Data.Instances Spar.Error Spar.Intra.Brig + Spar.Intra.BrigApp Spar.Intra.Galley Spar.Options Spar.Orphans @@ -40,8 +41,12 @@ library Spar.Sem.AssIDStore.Cassandra Spar.Sem.BindCookieStore Spar.Sem.BindCookieStore.Cassandra + Spar.Sem.BrigAccess + Spar.Sem.BrigAccess.Http Spar.Sem.DefaultSsoCode Spar.Sem.DefaultSsoCode.Cassandra + Spar.Sem.GalleyAccess + Spar.Sem.GalleyAccess.Http Spar.Sem.IdP Spar.Sem.IdP.Cassandra Spar.Sem.IdP.Mem diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index fba2cad8fe2..ed4097fc811 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -54,14 +54,14 @@ import Galley.Types.Teams (HiddenPerm (CreateUpdateDeleteIdp, ReadIdp)) import Imports import OpenSSL.Random (randBytes) import Polysemy +import Polysemy.Error import qualified SAML2.WebSSO as SAML import Servant import qualified Servant.Multipart as Multipart import Spar.App import qualified Spar.Data as Data (GetIdPResult (..), Replaced (..), Replacing (..)) import Spar.Error -import qualified Spar.Intra.Brig as Brig -import qualified Spar.Intra.Galley as Galley +import qualified Spar.Intra.BrigApp as Brig import Spar.Orphans () import Spar.Scim import Spar.Sem.AReqIDStore (AReqIDStore) @@ -69,8 +69,12 @@ import qualified Spar.Sem.AReqIDStore as AReqIDStore import Spar.Sem.AssIDStore (AssIDStore) import Spar.Sem.BindCookieStore (BindCookieStore) import qualified Spar.Sem.BindCookieStore as BindCookieStore +import Spar.Sem.BrigAccess (BrigAccess) +import qualified Spar.Sem.BrigAccess as BrigAccess import Spar.Sem.DefaultSsoCode (DefaultSsoCode) import qualified Spar.Sem.DefaultSsoCode as DefaultSsoCode +import Spar.Sem.GalleyAccess (GalleyAccess) +import qualified Spar.Sem.GalleyAccess as GalleyAccess import qualified Spar.Sem.IdP as IdPEffect import Spar.Sem.SAMLUserStore (SAMLUserStore) import qualified Spar.Sem.SAMLUserStore as SAMLUserStore @@ -91,7 +95,9 @@ app ctx = api :: Members - '[ BindCookieStore, + '[ GalleyAccess, + BrigAccess, + BindCookieStore, AssIDStore, AReqIDStore, ScimExternalIdStore, @@ -99,7 +105,8 @@ api :: ScimTokenStore, DefaultSsoCode, IdPEffect.IdP, - SAMLUserStore + SAMLUserStore, + Error SparError ] r => Opts -> @@ -114,7 +121,9 @@ api opts = apiSSO :: Members - '[ BindCookieStore, + '[ GalleyAccess, + BrigAccess, + BindCookieStore, AssIDStore, AReqIDStore, ScimTokenStore, @@ -134,7 +143,7 @@ apiSSO opts = :<|> authresp . Just :<|> ssoSettings -apiIDP :: Members '[ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => ServerT APIIDP (Spar r) +apiIDP :: Members '[GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, SAMLUserStore, Error SparError] r => ServerT APIIDP (Spar r) apiIDP = idpGet :<|> idpGetRaw @@ -220,7 +229,7 @@ validateRedirectURL uri = do authresp :: forall r. - Members '[BindCookieStore, AssIDStore, AReqIDStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Members '[GalleyAccess, BrigAccess, BindCookieStore, AssIDStore, AReqIDStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe TeamId -> Maybe ST -> SAML.AuthnResponseBody -> @@ -252,23 +261,31 @@ ssoSettings = do ---------------------------------------------------------------------------- -- IdP API -idpGet :: Member IdPEffect.IdP r => Maybe UserId -> SAML.IdPId -> Spar r IdP +idpGet :: + Members '[GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => + Maybe UserId -> + SAML.IdPId -> + Spar r IdP idpGet zusr idpid = withDebugLog "idpGet" (Just . show . (^. SAML.idpId)) $ do idp <- SAML.getIdPConfig idpid - _ <- authorizeIdP zusr idp + _ <- liftSem $ authorizeIdP zusr idp pure idp -idpGetRaw :: Member IdPEffect.IdP r => Maybe UserId -> SAML.IdPId -> Spar r RawIdPMetadata +idpGetRaw :: + Members '[GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => + Maybe UserId -> + SAML.IdPId -> + Spar r RawIdPMetadata idpGetRaw zusr idpid = do idp <- SAML.getIdPConfig idpid - _ <- authorizeIdP zusr idp + _ <- liftSem $ authorizeIdP zusr idp wrapMonadClientSem (IdPEffect.getRawMetadata idpid) >>= \case Just txt -> pure $ RawIdPMetadata txt Nothing -> throwSpar $ SparIdPNotFound (cs $ show idpid) -idpGetAll :: Member IdPEffect.IdP r => Maybe UserId -> Spar r IdPList +idpGetAll :: Members '[GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => Maybe UserId -> Spar r IdPList idpGetAll zusr = withDebugLog "idpGetAll" (const Nothing) $ do - teamid <- Brig.getZUsrCheckPerm zusr ReadIdp + teamid <- liftSem $ Brig.getZUsrCheckPerm zusr ReadIdp _idplProviders <- wrapMonadClientSem $ IdPEffect.getConfigsByTeam teamid pure IdPList {..} @@ -280,10 +297,16 @@ idpGetAll zusr = withDebugLog "idpGetAll" (const Nothing) $ do -- matter what the team size, it shouldn't choke any servers, just the client (which is -- probably curl running locally on one of the spar instances). -- https://github.com/zinfra/backend-issues/issues/1314 -idpDelete :: forall r. Members '[ScimTokenStore, SAMLUserStore, IdPEffect.IdP] r => Maybe UserId -> SAML.IdPId -> Maybe Bool -> Spar r NoContent +idpDelete :: + forall r. + Members '[GalleyAccess, BrigAccess, ScimTokenStore, SAMLUserStore, IdPEffect.IdP, Error SparError] r => + Maybe UserId -> + SAML.IdPId -> + Maybe Bool -> + Spar r NoContent idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (const Nothing) $ do idp <- SAML.getIdPConfig idpid - _ <- authorizeIdP zusr idp + _ <- liftSem $ authorizeIdP zusr idp let issuer = idp ^. SAML.idpMetadata . SAML.edIssuer team = idp ^. SAML.idpExtraInfo . wiTeam -- if idp is not empty: fail or purge @@ -292,7 +315,7 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons doPurge = do some <- wrapMonadClientSem (SAMLUserStore.getSomeByIssuer issuer) forM_ some $ \(uref, uid) -> do - Brig.deleteBrigUser uid + liftSem $ BrigAccess.delete uid wrapMonadClientSem (SAMLUserStore.delete uid uref) unless (null some) doPurge when (not idpIsEmpty) $ do @@ -335,14 +358,27 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons -- | This handler only does the json parsing, and leaves all authorization checks and -- application logic to 'idpCreateXML'. -idpCreate :: Members '[ScimTokenStore, IdPEffect.IdP] r => Maybe UserId -> IdPMetadataInfo -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Spar r IdP +idpCreate :: + Members '[GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error SparError] r => + Maybe UserId -> + IdPMetadataInfo -> + Maybe SAML.IdPId -> + Maybe WireIdPAPIVersion -> + Spar r IdP idpCreate zusr (IdPMetadataValue raw xml) midpid apiversion = idpCreateXML zusr raw xml midpid apiversion -- | We generate a new UUID for each IdP used as IdPConfig's path, thereby ensuring uniqueness. -idpCreateXML :: Members '[ScimTokenStore, IdPEffect.IdP] r => Maybe UserId -> Text -> SAML.IdPMetadata -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Spar r IdP +idpCreateXML :: + Members '[GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error SparError] r => + Maybe UserId -> + Text -> + SAML.IdPMetadata -> + Maybe SAML.IdPId -> + Maybe WireIdPAPIVersion -> + Spar r IdP idpCreateXML zusr raw idpmeta mReplaces (fromMaybe defWireIdPAPIVersion -> apiversion) = withDebugLog "idpCreate" (Just . show . (^. SAML.idpId)) $ do - teamid <- Brig.getZUsrCheckPerm zusr CreateUpdateDeleteIdp - Galley.assertSSOEnabled teamid + teamid <- liftSem $ Brig.getZUsrCheckPerm zusr CreateUpdateDeleteIdp + liftSem $ GalleyAccess.assertSSOEnabled teamid assertNoScimOrNoIdP teamid idp <- validateNewIdP apiversion idpmeta teamid mReplaces wrapMonadClientSem $ IdPEffect.storeRawMetadata (idp ^. SAML.idpId) raw @@ -433,13 +469,24 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces = withDebugLog "validate -- | FUTUREWORK: 'idpUpdateXML' is only factored out of this function for symmetry with -- 'idpCreate', which is not a good reason. make this one function and pass around -- 'IdPMetadataInfo' directly where convenient. -idpUpdate :: Member IdPEffect.IdP r => Maybe UserId -> IdPMetadataInfo -> SAML.IdPId -> Spar r IdP +idpUpdate :: + Members '[GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => + Maybe UserId -> + IdPMetadataInfo -> + SAML.IdPId -> + Spar r IdP idpUpdate zusr (IdPMetadataValue raw xml) idpid = idpUpdateXML zusr raw xml idpid -idpUpdateXML :: Member IdPEffect.IdP r => Maybe UserId -> Text -> SAML.IdPMetadata -> SAML.IdPId -> Spar r IdP +idpUpdateXML :: + Members '[GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => + Maybe UserId -> + Text -> + SAML.IdPMetadata -> + SAML.IdPId -> + Spar r IdP idpUpdateXML zusr raw idpmeta idpid = withDebugLog "idpUpdate" (Just . show . (^. SAML.idpId)) $ do (teamid, idp) <- validateIdPUpdate zusr idpmeta idpid - Galley.assertSSOEnabled teamid + liftSem $ GalleyAccess.assertSSOEnabled teamid wrapMonadClientSem $ IdPEffect.storeRawMetadata (idp ^. SAML.idpId) raw -- (if raw metadata is stored and then spar goes out, raw metadata won't match the -- structured idp config. since this will lead to a 5xx response, the client is epected to @@ -454,7 +501,7 @@ idpUpdateXML zusr raw idpmeta idpid = withDebugLog "idpUpdate" (Just . show . (^ validateIdPUpdate :: forall m r. (HasCallStack, m ~ Spar r) => - Member IdPEffect.IdP r => + Members '[GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => Maybe UserId -> SAML.IdPMetadata -> SAML.IdPId -> @@ -464,7 +511,7 @@ validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateNewIdP" (Just wrapMonadClientSem (IdPEffect.getConfig _idpId) >>= \case Nothing -> throwError errUnknownIdPId Just idp -> pure idp - teamId <- authorizeIdP zusr previousIdP + teamId <- liftSem $ authorizeIdP zusr previousIdP unless (previousIdP ^. SAML.idpExtraInfo . wiTeam == teamId) $ do throwError errUnknownIdP _idpExtraInfo <- do @@ -502,14 +549,14 @@ withDebugLog msg showval action = do pure val authorizeIdP :: - (HasCallStack, MonadError SparError m, SAML.SP m, Galley.MonadSparToGalley m, Brig.MonadSparToBrig m) => + (HasCallStack, Members '[GalleyAccess, BrigAccess, Error SparError] r) => Maybe UserId -> IdP -> - m TeamId -authorizeIdP Nothing _ = throwSpar (SparNoPermission (cs $ show CreateUpdateDeleteIdp)) + Sem r TeamId +authorizeIdP Nothing _ = throw (SAML.CustomError $ SparNoPermission (cs $ show CreateUpdateDeleteIdp)) authorizeIdP (Just zusr) idp = do let teamid = idp ^. SAML.idpExtraInfo . wiTeam - Galley.assertHasPermission teamid CreateUpdateDeleteIdp zusr + GalleyAccess.assertHasPermission teamid CreateUpdateDeleteIdp zusr pure teamid enforceHttps :: URI.URI -> Spar r () diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index 7aeef5a9370..67a73acafff 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -92,8 +92,7 @@ import Servant import qualified Servant.Multipart as Multipart import qualified Spar.Data as Data (GetIdPResult (..)) import Spar.Error -import qualified Spar.Intra.Brig as Intra -import qualified Spar.Intra.Galley as Intra +import qualified Spar.Intra.BrigApp as Intra import Spar.Orphans () import Spar.Sem.AReqIDStore (AReqIDStore) import qualified Spar.Sem.AReqIDStore as AReqIDStore @@ -104,8 +103,14 @@ import Spar.Sem.AssIDStore.Cassandra (assIDStoreToCassandra) import Spar.Sem.BindCookieStore (BindCookieStore) import qualified Spar.Sem.BindCookieStore as BindCookieStore import Spar.Sem.BindCookieStore.Cassandra (bindCookieStoreToCassandra) +import Spar.Sem.BrigAccess (BrigAccess) +import qualified Spar.Sem.BrigAccess as BrigAccess +import Spar.Sem.BrigAccess.Http (brigAccessToHttp) import Spar.Sem.DefaultSsoCode (DefaultSsoCode) import Spar.Sem.DefaultSsoCode.Cassandra (defaultSsoCodeToCassandra) +import Spar.Sem.GalleyAccess (GalleyAccess) +import qualified Spar.Sem.GalleyAccess as GalleyAccess +import Spar.Sem.GalleyAccess.Http (galleyAccessToHttp) import Spar.Sem.IdP (GetIdPResult (..)) import qualified Spar.Sem.IdP as IdPEffect import Spar.Sem.IdP.Cassandra (idPToCassandra) @@ -265,17 +270,17 @@ insertUser uref uid = wrapMonadClientSem $ SAMLUserStore.insert uref uid -- the team with valid SAML credentials. -- -- FUTUREWORK: Remove and reinstatate getUser, in AuthID refactoring PR. (in https://github.com/wireapp/wire-server/pull/1410, undo https://github.com/wireapp/wire-server/pull/1418) -getUserIdByUref :: Member SAMLUserStore r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult UserId) +getUserIdByUref :: Members '[BrigAccess, SAMLUserStore] r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult UserId) getUserIdByUref mbteam uref = userId <$$> getUserByUref mbteam uref -getUserByUref :: Member SAMLUserStore r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult User) +getUserByUref :: Members '[BrigAccess, SAMLUserStore] r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult User) getUserByUref mbteam uref = do muid <- wrapMonadClientSem $ SAMLUserStore.get uref case muid of Nothing -> pure GetUserNotFound Just uid -> do let withpending = Intra.WithPendingInvitations -- see haddocks above - Intra.getBrigUser withpending uid >>= \case + liftSem (Intra.getBrigUser withpending uid) >>= \case Nothing -> pure GetUserNotFound Just user | isNothing (userTeam user) -> pure GetUserNoTeam @@ -296,14 +301,14 @@ instance Functor GetUserResult where fmap _ GetUserWrongTeam = GetUserWrongTeam -- FUTUREWORK: Remove and reinstatate getUser, in AuthID refactoring PR -getUserIdByScimExternalId :: Member ScimExternalIdStore r => TeamId -> Email -> Spar r (Maybe UserId) +getUserIdByScimExternalId :: Members '[BrigAccess, ScimExternalIdStore] r => TeamId -> Email -> Spar r (Maybe UserId) getUserIdByScimExternalId tid email = do muid <- wrapMonadClientSem $ (ScimExternalIdStore.lookup tid email) case muid of Nothing -> pure Nothing Just uid -> do let withpending = Intra.WithPendingInvitations -- see haddocks above - itis <- isJust <$> Intra.getBrigUserTeam withpending uid + itis <- liftSem $ isJust <$> Intra.getBrigUserTeam withpending uid pure $ if itis then Just uid else Nothing -- | Create a fresh 'UserId', store it on C* locally together with 'SAML.UserRef', then @@ -322,23 +327,23 @@ getUserIdByScimExternalId tid email = do -- FUTUREWORK: once we support , brig will refuse to delete -- users that have an sso id, unless the request comes from spar. then we can make users -- undeletable in the team admin page, and ask admins to go talk to their IdP system. -createSamlUserWithId :: Member SAMLUserStore r => TeamId -> UserId -> SAML.UserRef -> Spar r () +createSamlUserWithId :: Members '[BrigAccess, SAMLUserStore] r => TeamId -> UserId -> SAML.UserRef -> Spar r () createSamlUserWithId teamid buid suid = do uname <- either (throwSpar . SparBadUserName . cs) pure $ Intra.mkUserName Nothing (UrefOnly suid) - buid' <- Intra.createBrigUserSAML suid buid teamid uname ManagedByWire + buid' <- liftSem $ BrigAccess.createSAML suid buid teamid uname ManagedByWire assert (buid == buid') $ pure () insertUser suid buid -- | If the team has no scim token, call 'createSamlUser'. Otherwise, raise "invalid -- credentials". -autoprovisionSamlUser :: Members '[ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe TeamId -> SAML.UserRef -> Spar r UserId +autoprovisionSamlUser :: Members '[GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe TeamId -> SAML.UserRef -> Spar r UserId autoprovisionSamlUser mbteam suid = do buid <- Id <$> liftIO UUID.nextRandom autoprovisionSamlUserWithId mbteam buid suid pure buid -- | Like 'autoprovisionSamlUser', but for an already existing 'UserId'. -autoprovisionSamlUserWithId :: forall r. Members '[ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe TeamId -> UserId -> SAML.UserRef -> Spar r () +autoprovisionSamlUserWithId :: forall r. Members '[GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe TeamId -> UserId -> SAML.UserRef -> Spar r () autoprovisionSamlUserWithId mbteam buid suid = do idp <- getIdPConfigByIssuerOptionalSPId (suid ^. uidTenant) mbteam guardReplacedIdP idp @@ -362,7 +367,7 @@ autoprovisionSamlUserWithId mbteam buid suid = do -- | If user's 'NameID' is an email address and the team has email validation for SSO enabled, -- make brig initiate the email validate procedure. -validateEmailIfExists :: forall r. UserId -> SAML.UserRef -> Spar r () +validateEmailIfExists :: forall r. Members '[GalleyAccess, BrigAccess] r => UserId -> SAML.UserRef -> Spar r () validateEmailIfExists uid = \case (SAML.UserRef _ (view SAML.nameID -> UNameIDEmail email)) -> doValidate (CI.original email) _ -> pure () @@ -370,10 +375,10 @@ validateEmailIfExists uid = \case doValidate :: SAMLEmail.Email -> Spar r () doValidate email = do enabled <- do - tid <- Intra.getBrigUserTeam Intra.NoPendingInvitations uid - maybe (pure False) Intra.isEmailValidationEnabledTeam tid + tid <- liftSem $ Intra.getBrigUserTeam Intra.NoPendingInvitations uid + maybe (pure False) (liftSem . GalleyAccess.isEmailValidationEnabledTeam) tid when enabled $ do - Intra.updateEmail uid (Intra.emailFromSAML email) + liftSem $ BrigAccess.updateEmail uid (Intra.emailFromSAML email) -- | Check if 'UserId' is in the team that hosts the idp that owns the 'UserRef'. If so, -- register a the user under its SAML credentials and write the 'UserRef' into the @@ -381,7 +386,7 @@ validateEmailIfExists uid = \case -- -- Before returning, change account status or fail if account is nto active or pending an -- invitation. -bindUser :: Members '[IdPEffect.IdP, SAMLUserStore] r => UserId -> SAML.UserRef -> Spar r UserId +bindUser :: Members '[BrigAccess, IdPEffect.IdP, SAMLUserStore] r => UserId -> SAML.UserRef -> Spar r UserId bindUser buid userref = do oldStatus <- do let err :: Spar r a @@ -393,20 +398,20 @@ bindUser buid userref = do Data.GetIdPDanglingId _ -> err -- database inconsistency Data.GetIdPNonUnique is -> throwSpar $ SparUserRefInNoOrMultipleTeams (cs $ show (buid, is)) Data.GetIdPWrongTeam _ -> err -- impossible - acc <- Intra.getBrigUserAccount Intra.WithPendingInvitations buid >>= maybe err pure + acc <- liftSem (BrigAccess.getAccount Intra.WithPendingInvitations buid) >>= maybe err pure teamid' :: TeamId <- userTeam (accountUser acc) & maybe err pure unless (teamid' == teamid) err pure (accountStatus acc) insertUser userref buid buid <$ do - Intra.setBrigUserVeid buid (UrefOnly userref) + liftSem $ BrigAccess.setVeid buid (UrefOnly userref) let err = throwSpar . SparBindFromBadAccountStatus . cs . show case oldStatus of Active -> pure () Suspended -> err oldStatus Deleted -> err oldStatus Ephemeral -> err oldStatus - PendingInvitation -> Intra.setStatus buid Active + PendingInvitation -> liftSem $ BrigAccess.setStatus buid Active instance ( r @@ -420,6 +425,8 @@ instance IdPEffect.IdP, SAMLUserStore, Embed (Cas.Client), + BrigAccess, + GalleyAccess, ReaderEff.Reader Opts, Error TTLError, Error SparError, @@ -444,38 +451,25 @@ instance runError @SparError $ ttlErrorToSparError $ ReaderEff.runReader (sparCtxOpts ctx) $ - interpretClientToIO (sparCtxCas ctx) $ - samlUserStoreToCassandra @Cas.Client $ - idPToCassandra @Cas.Client $ - defaultSsoCodeToCassandra $ - scimTokenStoreToCassandra $ - scimUserTimesStoreToCassandra $ - scimExternalIdStoreToCassandra $ - aReqIDStoreToCassandra $ - assIDStoreToCassandra $ - bindCookieStoreToCassandra $ - runExceptT $ - runReaderT action ctx + galleyAccessToHttp (sparCtxLogger ctx) (sparCtxHttpManager ctx) (sparCtxHttpGalley ctx) $ + brigAccessToHttp (sparCtxLogger ctx) (sparCtxHttpManager ctx) (sparCtxHttpBrig ctx) $ + interpretClientToIO (sparCtxCas ctx) $ + samlUserStoreToCassandra @Cas.Client $ + idPToCassandra @Cas.Client $ + defaultSsoCodeToCassandra $ + scimTokenStoreToCassandra $ + scimUserTimesStoreToCassandra $ + scimExternalIdStoreToCassandra $ + aReqIDStoreToCassandra $ + assIDStoreToCassandra $ + bindCookieStoreToCassandra $ + runExceptT $ + runReaderT action ctx throwErrorAsHandlerException :: Either SparError a -> Handler a throwErrorAsHandlerException (Left err) = sparToServerErrorWithLogging (sparCtxLogger ctx) err >>= throwError throwErrorAsHandlerException (Right a) = pure a -instance MonadHttp (Spar r) where - handleRequestWithCont req handler = do - manager <- asks sparCtxHttpManager - liftIO $ withResponse req manager handler - -instance Intra.MonadSparToBrig (Spar r) where - call modreq = do - req <- asks sparCtxHttpBrig - httpLbs req modreq - -instance Intra.MonadSparToGalley (Spar r) where - call modreq = do - req <- asks sparCtxHttpGalley - httpLbs req modreq - -- | The from of the response on the finalize-login request depends on the verdict (denied or -- granted), plus the choice that the client has made during the initiate-login request. Here we -- call either 'verdictHandlerWeb' or 'verdictHandlerMobile', resp., on the 'SAML.AccessVerdict'. @@ -487,7 +481,7 @@ instance Intra.MonadSparToGalley (Spar r) where -- latter. verdictHandler :: HasCallStack => - Members '[BindCookieStore, AReqIDStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Members '[GalleyAccess, BrigAccess, BindCookieStore, AReqIDStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe BindCookie -> Maybe TeamId -> SAML.AuthnResponse -> @@ -519,7 +513,7 @@ data VerdictHandlerResult verdictHandlerResult :: HasCallStack => - Members '[BindCookieStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Members '[GalleyAccess, BrigAccess, BindCookieStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> @@ -544,7 +538,7 @@ catchVerdictErrors = (`catchError` hndlr) -- | If a user attempts to login presenting a new IdP issuer, but there is no entry in -- @"spar.user"@ for her: lookup @"old_issuers"@ from @"spar.idp"@ for the new IdP, and -- traverse the old IdPs in search for the old entry. Return that old entry. -findUserIdWithOldIssuer :: forall r. Members '[IdPEffect.IdP, SAMLUserStore] r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult (SAML.UserRef, UserId)) +findUserIdWithOldIssuer :: forall r. Members '[BrigAccess, IdPEffect.IdP, SAMLUserStore] r => Maybe TeamId -> SAML.UserRef -> Spar r (GetUserResult (SAML.UserRef, UserId)) findUserIdWithOldIssuer mbteam (SAML.UserRef issuer subject) = do idp <- getIdPConfigByIssuerOptionalSPId issuer mbteam let tryFind :: GetUserResult (SAML.UserRef, UserId) -> Issuer -> Spar r (GetUserResult (SAML.UserRef, UserId)) @@ -556,15 +550,15 @@ findUserIdWithOldIssuer mbteam (SAML.UserRef issuer subject) = do -- | After a user has been found using 'findUserWithOldIssuer', update it everywhere so that -- the old IdP is not needed any more next time. -moveUserToNewIssuer :: Member SAMLUserStore r => SAML.UserRef -> SAML.UserRef -> UserId -> Spar r () +moveUserToNewIssuer :: Members '[BrigAccess, SAMLUserStore] r => SAML.UserRef -> SAML.UserRef -> UserId -> Spar r () moveUserToNewIssuer oldUserRef newUserRef uid = do wrapMonadClientSem $ SAMLUserStore.insert newUserRef uid - Intra.setBrigUserVeid uid (UrefOnly newUserRef) + liftSem $ BrigAccess.setVeid uid (UrefOnly newUserRef) wrapMonadClientSem $ SAMLUserStore.delete uid oldUserRef verdictHandlerResultCore :: HasCallStack => - Members '[BindCookieStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Members '[GalleyAccess, BrigAccess, BindCookieStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> @@ -614,7 +608,7 @@ verdictHandlerResultCore bindCky mbteam = \case -- to see why, consider the condition on the call to 'findUserWithOldIssuer' above. error "impossible." SAML.logger SAML.Debug ("granting sso login for " <> show uid) - cky <- Intra.ssoLogin uid + cky <- liftSem $ BrigAccess.ssoLogin uid pure $ VerifyHandlerGranted cky uid -- | If the client is web, it will be served with an HTML page that it can process to decide whether diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index 751911f3fdd..fd118824789 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -19,21 +19,8 @@ -- | Client functions for interacting with the Brig API. module Spar.Intra.Brig - ( veidToUserSSOId, - urefToExternalId, - urefToEmail, - veidFromBrigUser, - veidFromUserSSOId, - mkUserName, - renderValidExternalId, - emailFromSAML, - emailToSAML, - emailToSAMLNameID, - emailFromSAMLNameID, + ( MonadSparToBrig (..), getBrigUserAccount, - HavePendingInvitations (..), - getBrigUser, - getBrigUserTeam, getBrigUserByHandle, getBrigUserByEmail, getBrigUserRichInfo, @@ -47,16 +34,11 @@ module Spar.Intra.Brig createBrigUserSAML, createBrigUserNoSAML, updateEmail, - getZUsrCheckPerm, - authorizeScimTokenManagement, ensureReAuthorised, ssoLogin, - parseResponse, - MonadSparToBrig (..), getStatus, getStatusMaybe, setStatus, - giveDefaultHandle, ) where @@ -64,22 +46,17 @@ import Bilge import Brig.Types.Intra import Brig.Types.User import Brig.Types.User.Auth (SsoLogin (..)) -import Control.Lens import Control.Monad.Except import Data.ByteString.Conversion -import qualified Data.CaseInsensitive as CI -import Data.Handle (Handle (Handle, fromHandle)) +import Data.Handle (Handle (fromHandle)) import Data.Id (Id (Id), TeamId, UserId) import Data.Misc (PlainTextPassword) import Data.String.Conversions -import Galley.Types.Teams (HiddenPerm (CreateReadDeleteScimToken), IsPerm) import Imports import Network.HTTP.Types.Method import qualified Network.Wai.Utilities.Error as Wai import qualified SAML2.WebSSO as SAML -import qualified SAML2.WebSSO.Types.Email as SAMLEmail import Spar.Error -import Spar.Intra.Galley as Galley (MonadSparToGalley, assertHasPermission) import qualified System.Logger.Class as Log import Web.Cookie import Wire.API.User @@ -94,59 +71,6 @@ veidToUserSSOId = runValidExternalId urefToUserSSOId (UserScimExternalId . fromE urefToUserSSOId :: SAML.UserRef -> UserSSOId urefToUserSSOId (SAML.UserRef t s) = UserSSOId (cs $ SAML.encodeElem t) (cs $ SAML.encodeElem s) -veidFromUserSSOId :: MonadError String m => UserSSOId -> m ValidExternalId -veidFromUserSSOId = \case - UserSSOId tenant subject -> - case (SAML.decodeElem $ cs tenant, SAML.decodeElem $ cs subject) of - (Right t, Right s) -> do - let uref = SAML.UserRef t s - case urefToEmail uref of - Nothing -> pure $ UrefOnly uref - Just email -> pure $ EmailAndUref email uref - (Left msg, _) -> throwError msg - (_, Left msg) -> throwError msg - UserScimExternalId email -> - maybe - (throwError "externalId not an email and no issuer") - (pure . EmailOnly) - (parseEmail email) - -urefToExternalId :: SAML.UserRef -> Maybe Text -urefToExternalId = fmap CI.original . SAML.shortShowNameID . view SAML.uidSubject - -urefToEmail :: SAML.UserRef -> Maybe Email -urefToEmail uref = case uref ^. SAML.uidSubject . SAML.nameID of - SAML.UNameIDEmail email -> Just . emailFromSAML . CI.original $ email - _ -> Nothing - --- | If the brig user has a 'UserSSOId', transform that into a 'ValidExternalId' (this is a --- total function as long as brig obeys the api). Otherwise, if the user has an email, we can --- construct a return value from that (and an optional saml issuer). If a user only has a --- phone number, or no identity at all, throw an error. --- --- Note: the saml issuer is only needed in the case where a user has been invited via team --- settings and is now onboarded to saml/scim. If this case can safely be ruled out, it's ok --- to just set it to 'Nothing'. -veidFromBrigUser :: MonadError String m => User -> Maybe SAML.Issuer -> m ValidExternalId -veidFromBrigUser usr mIssuer = case (userSSOId usr, userEmail usr, mIssuer) of - (Just ssoid, _, _) -> veidFromUserSSOId ssoid - (Nothing, Just email, Just issuer) -> pure $ EmailAndUref email (SAML.UserRef issuer (emailToSAMLNameID email)) - (Nothing, Just email, Nothing) -> pure $ EmailOnly email - (Nothing, Nothing, _) -> throwError "user has neither ssoIdentity nor userEmail" - --- | Take a maybe text, construct a 'Name' from what we have in a scim user. If the text --- isn't present, use an email address or a saml subject (usually also an email address). If --- both are 'Nothing', fail. -mkUserName :: Maybe Text -> ValidExternalId -> Either String Name -mkUserName (Just n) = const $ mkName n -mkUserName Nothing = - runValidExternalId - (\uref -> mkName (CI.original . SAML.unsafeShowNameID $ uref ^. SAML.uidSubject)) - (\email -> mkName (fromEmail email)) - -renderValidExternalId :: ValidExternalId -> Maybe Text -renderValidExternalId = runValidExternalId urefToExternalId (Just . fromEmail) - -- | Similar to 'Network.Wire.Client.API.Auth.tokenResponse', but easier: we just need to set the -- cookie in the response, and the redirect will make the client negotiate a fresh auth token. -- (This is the easiest way, since the login-request that we are in the middle of responding to here @@ -158,22 +82,6 @@ respToCookie resp = do unless (statusCode resp == 200) crash maybe crash (pure . parseSetCookie) $ getHeader "Set-Cookie" resp -emailFromSAML :: HasCallStack => SAMLEmail.Email -> Email -emailFromSAML = fromJust . parseEmail . SAMLEmail.render - -emailToSAML :: HasCallStack => Email -> SAMLEmail.Email -emailToSAML = CI.original . fromRight (error "emailToSAML") . SAMLEmail.validate . toByteString - --- | FUTUREWORK(fisx): if saml2-web-sso exported the 'NameID' constructor, we could make this --- function total without all that praying and hoping. -emailToSAMLNameID :: HasCallStack => Email -> SAML.NameID -emailToSAMLNameID = fromRight (error "impossible") . SAML.emailNameID . fromEmail - -emailFromSAMLNameID :: HasCallStack => SAML.NameID -> Maybe Email -emailFromSAMLNameID nid = case nid ^. SAML.nameID of - SAML.UNameIDEmail email -> Just . emailFromSAML . CI.original $ email - _ -> Nothing - ---------------------------------------------------------------------- class (Log.MonadLogger m, MonadError SparError m) => MonadSparToBrig m where @@ -240,9 +148,6 @@ updateEmail buid email = do 202 -> pure () _ -> rethrow "brig" resp -getBrigUser :: (HasCallStack, MonadSparToBrig m) => HavePendingInvitations -> UserId -> m (Maybe User) -getBrigUser ifpend = (accountUser <$$>) . getBrigUserAccount ifpend - -- | Get a user; returns 'Nothing' if the user was not found or has been deleted. getBrigUserAccount :: (HasCallStack, MonadSparToBrig m) => HavePendingInvitations -> UserId -> m (Maybe UserAccount) getBrigUserAccount havePending buid = do @@ -412,33 +317,6 @@ deleteBrigUser buid = do unless (statusCode resp == 202) $ rethrow "brig" resp --- | Check that an id maps to an user on brig that is 'Active' (or optionally --- 'PendingInvitation') and has a team id. -getBrigUserTeam :: (HasCallStack, MonadSparToBrig m) => HavePendingInvitations -> UserId -> m (Maybe TeamId) -getBrigUserTeam ifpend = fmap (userTeam =<<) . getBrigUser ifpend - --- | Pull team id for z-user from brig. Check permission in galley. Return team id. Fail if --- permission check fails or the user is not in status 'Active'. -getZUsrCheckPerm :: - (HasCallStack, SAML.SP m, MonadSparToBrig m, MonadSparToGalley m, IsPerm perm, Show perm) => - Maybe UserId -> - perm -> - m TeamId -getZUsrCheckPerm Nothing _ = throwSpar SparMissingZUsr -getZUsrCheckPerm (Just uid) perm = do - getBrigUserTeam NoPendingInvitations uid - >>= maybe - (throwSpar SparNotInTeam) - (\teamid -> teamid <$ Galley.assertHasPermission teamid perm uid) - -authorizeScimTokenManagement :: (HasCallStack, SAML.SP m, MonadSparToBrig m, MonadSparToGalley m) => Maybe UserId -> m TeamId -authorizeScimTokenManagement Nothing = throwSpar SparMissingZUsr -authorizeScimTokenManagement (Just uid) = do - getBrigUserTeam NoPendingInvitations uid - >>= maybe - (throwSpar SparNotInTeam) - (\teamid -> teamid <$ Galley.assertHasPermission teamid CreateReadDeleteScimToken uid) - -- | Verify user's password (needed for certain powerful operations). ensureReAuthorised :: (HasCallStack, MonadSparToBrig m) => @@ -465,7 +343,7 @@ ensureReAuthorised (Just uid) secret = do -- -- If brig responds with status >=400;<500, return Nothing. Otherwise, crash (500). ssoLogin :: - (HasCallStack, SAML.HasConfig m, MonadSparToBrig m) => + (HasCallStack, MonadSparToBrig m) => UserId -> m SetCookie ssoLogin buid = do @@ -509,26 +387,3 @@ setStatus uid status = do case statusCode resp of 200 -> pure () _ -> rethrow "brig" resp - --- | If the user has no 'Handle', set it to its 'UserId' and update the user in brig. --- Return the handle the user now has (the old one if it existed, the newly created one --- otherwise). --- --- RATIONALE: Finding the handle can fail for users that have been created without scim, and --- have stopped the onboarding process at the point where they are asked by the client to --- enter a handle. --- --- We make up a handle in this case, and the scim peer can find the user, see that the handle --- is not the one it expects, and update it. --- --- We cannot simply respond with 404 in this case, because the user exists. 404 would suggest --- do the scim peer that it should post the user to create it, but that would create a new --- user instead of finding the old that should be put under scim control. -giveDefaultHandle :: (HasCallStack, MonadSparToBrig m) => User -> m Handle -giveDefaultHandle usr = case userHandle usr of - Just handle -> pure handle - Nothing -> do - let handle = Handle . cs . toByteString' $ uid - uid = userId usr - setBrigUserHandle uid handle - pure handle diff --git a/services/spar/src/Spar/Intra/BrigApp.hs b/services/spar/src/Spar/Intra/BrigApp.hs new file mode 100644 index 00000000000..6c4d2d34f0e --- /dev/null +++ b/services/spar/src/Spar/Intra/BrigApp.hs @@ -0,0 +1,202 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-} + +-- 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 . + +-- | Client functions for interacting with the Brig API. +module Spar.Intra.BrigApp + ( veidToUserSSOId, + urefToExternalId, + urefToEmail, + veidFromBrigUser, + veidFromUserSSOId, + mkUserName, + renderValidExternalId, + emailFromSAML, + emailToSAML, + emailToSAMLNameID, + emailFromSAMLNameID, + HavePendingInvitations (..), + getBrigUser, + getBrigUserTeam, + getZUsrCheckPerm, + authorizeScimTokenManagement, + parseResponse, + giveDefaultHandle, + ) +where + +import Brig.Types.Intra +import Brig.Types.User +import Control.Lens +import Control.Monad.Except +import Data.ByteString.Conversion +import qualified Data.CaseInsensitive as CI +import Data.Handle (Handle (Handle)) +import Data.Id (TeamId, UserId) +import Data.String.Conversions +import Galley.Types.Teams (HiddenPerm (CreateReadDeleteScimToken), IsPerm) +import Imports +import Polysemy +import Polysemy.Error +import qualified SAML2.WebSSO as SAML +import qualified SAML2.WebSSO.Types.Email as SAMLEmail +import Spar.Error +import Spar.Sem.BrigAccess (BrigAccess) +import qualified Spar.Sem.BrigAccess as BrigAccess +import Spar.Sem.GalleyAccess (GalleyAccess) +import qualified Spar.Sem.GalleyAccess as GalleyAccess +import Wire.API.User +import Wire.API.User.Scim (ValidExternalId (..), runValidExternalId) + +---------------------------------------------------------------------- + +veidToUserSSOId :: ValidExternalId -> UserSSOId +veidToUserSSOId = runValidExternalId urefToUserSSOId (UserScimExternalId . fromEmail) + +urefToUserSSOId :: SAML.UserRef -> UserSSOId +urefToUserSSOId (SAML.UserRef t s) = UserSSOId (cs $ SAML.encodeElem t) (cs $ SAML.encodeElem s) + +veidFromUserSSOId :: MonadError String m => UserSSOId -> m ValidExternalId +veidFromUserSSOId = \case + UserSSOId tenant subject -> + case (SAML.decodeElem $ cs tenant, SAML.decodeElem $ cs subject) of + (Right t, Right s) -> do + let uref = SAML.UserRef t s + case urefToEmail uref of + Nothing -> pure $ UrefOnly uref + Just email -> pure $ EmailAndUref email uref + (Left msg, _) -> throwError msg + (_, Left msg) -> throwError msg + UserScimExternalId email -> + maybe + (throwError "externalId not an email and no issuer") + (pure . EmailOnly) + (parseEmail email) + +urefToExternalId :: SAML.UserRef -> Maybe Text +urefToExternalId = fmap CI.original . SAML.shortShowNameID . view SAML.uidSubject + +urefToEmail :: SAML.UserRef -> Maybe Email +urefToEmail uref = case uref ^. SAML.uidSubject . SAML.nameID of + SAML.UNameIDEmail email -> Just . emailFromSAML . CI.original $ email + _ -> Nothing + +-- | If the brig user has a 'UserSSOId', transform that into a 'ValidExternalId' (this is a +-- total function as long as brig obeys the api). Otherwise, if the user has an email, we can +-- construct a return value from that (and an optional saml issuer). If a user only has a +-- phone number, or no identity at all, throw an error. +-- +-- Note: the saml issuer is only needed in the case where a user has been invited via team +-- settings and is now onboarded to saml/scim. If this case can safely be ruled out, it's ok +-- to just set it to 'Nothing'. +veidFromBrigUser :: MonadError String m => User -> Maybe SAML.Issuer -> m ValidExternalId +veidFromBrigUser usr mIssuer = case (userSSOId usr, userEmail usr, mIssuer) of + (Just ssoid, _, _) -> veidFromUserSSOId ssoid + (Nothing, Just email, Just issuer) -> pure $ EmailAndUref email (SAML.UserRef issuer (emailToSAMLNameID email)) + (Nothing, Just email, Nothing) -> pure $ EmailOnly email + (Nothing, Nothing, _) -> throwError "user has neither ssoIdentity nor userEmail" + +-- | Take a maybe text, construct a 'Name' from what we have in a scim user. If the text +-- isn't present, use an email address or a saml subject (usually also an email address). If +-- both are 'Nothing', fail. +mkUserName :: Maybe Text -> ValidExternalId -> Either String Name +mkUserName (Just n) = const $ mkName n +mkUserName Nothing = + runValidExternalId + (\uref -> mkName (CI.original . SAML.unsafeShowNameID $ uref ^. SAML.uidSubject)) + (\email -> mkName (fromEmail email)) + +renderValidExternalId :: ValidExternalId -> Maybe Text +renderValidExternalId = runValidExternalId urefToExternalId (Just . fromEmail) + +emailFromSAML :: HasCallStack => SAMLEmail.Email -> Email +emailFromSAML = fromJust . parseEmail . SAMLEmail.render + +emailToSAML :: HasCallStack => Email -> SAMLEmail.Email +emailToSAML = CI.original . fromRight (error "emailToSAML") . SAMLEmail.validate . toByteString + +-- | FUTUREWORK(fisx): if saml2-web-sso exported the 'NameID' constructor, we could make this +-- function total without all that praying and hoping. +emailToSAMLNameID :: HasCallStack => Email -> SAML.NameID +emailToSAMLNameID = fromRight (error "impossible") . SAML.emailNameID . fromEmail + +emailFromSAMLNameID :: HasCallStack => SAML.NameID -> Maybe Email +emailFromSAMLNameID nid = case nid ^. SAML.nameID of + SAML.UNameIDEmail email -> Just . emailFromSAML . CI.original $ email + _ -> Nothing + +---------------------------------------------------------------------- + +getBrigUser :: (HasCallStack, Member BrigAccess r) => HavePendingInvitations -> UserId -> Sem r (Maybe User) +getBrigUser ifpend = (accountUser <$$>) . BrigAccess.getAccount ifpend + +-- | Check that an id maps to an user on brig that is 'Active' (or optionally +-- 'PendingInvitation') and has a team id. +getBrigUserTeam :: (HasCallStack, Member BrigAccess r) => HavePendingInvitations -> UserId -> Sem r (Maybe TeamId) +getBrigUserTeam ifpend = fmap (userTeam =<<) . getBrigUser ifpend + +-- | Pull team id for z-user from brig. Check permission in galley. Return team id. Fail if +-- permission check fails or the user is not in status 'Active'. +getZUsrCheckPerm :: + forall r perm. + (HasCallStack, Members '[BrigAccess, GalleyAccess, Error SparError] r, IsPerm perm, Show perm) => + Maybe UserId -> + perm -> + Sem r TeamId +getZUsrCheckPerm Nothing _ = throw $ SAML.CustomError SparMissingZUsr +getZUsrCheckPerm (Just uid) perm = do + getBrigUserTeam NoPendingInvitations uid + >>= maybe + (throw $ SAML.CustomError SparNotInTeam) + (\teamid -> teamid <$ GalleyAccess.assertHasPermission teamid perm uid) + +authorizeScimTokenManagement :: + forall r. + (HasCallStack, Members '[BrigAccess, GalleyAccess, Error SparError] r) => + Maybe UserId -> + Sem r TeamId +authorizeScimTokenManagement Nothing = throw $ SAML.CustomError SparMissingZUsr +authorizeScimTokenManagement (Just uid) = do + getBrigUserTeam NoPendingInvitations uid + >>= maybe + (throw $ SAML.CustomError SparNotInTeam) + (\teamid -> teamid <$ GalleyAccess.assertHasPermission teamid CreateReadDeleteScimToken uid) + +-- | If the user has no 'Handle', set it to its 'UserId' and update the user in brig. +-- Return the handle the user now has (the old one if it existed, the newly created one +-- otherwise). +-- +-- RATIONALE: Finding the handle can fail for users that have been created without scim, and +-- have stopped the onboarding process at the point where they are asked by the client to +-- enter a handle. +-- +-- We make up a handle in this case, and the scim peer can find the user, see that the handle +-- is not the one it expects, and update it. +-- +-- We cannot simply respond with 404 in this case, because the user exists. 404 would suggest +-- do the scim peer that it should post the user to create it, but that would create a new +-- user instead of finding the old that should be put under scim control. +giveDefaultHandle :: (HasCallStack, Member BrigAccess r) => User -> Sem r Handle +giveDefaultHandle usr = case userHandle usr of + Just handle -> pure handle + Nothing -> do + let handle = Handle . cs . toByteString' $ uid + uid = userId usr + BrigAccess.setHandle uid handle + pure handle diff --git a/services/spar/src/Spar/Scim.hs b/services/spar/src/Spar/Scim.hs index 3e16b92bd79..5da6d5d02d5 100644 --- a/services/spar/src/Spar/Scim.hs +++ b/services/spar/src/Spar/Scim.hs @@ -69,6 +69,7 @@ import Control.Monad.Except import Data.String.Conversions (cs) import Imports import Polysemy +import Polysemy.Error (Error) import qualified SAML2.WebSSO as SAML import Servant import Servant.API.Generic @@ -82,6 +83,8 @@ import Spar.Error ) import Spar.Scim.Auth import Spar.Scim.User +import Spar.Sem.BrigAccess (BrigAccess) +import Spar.Sem.GalleyAccess (GalleyAccess) import qualified Spar.Sem.IdP as IdPEffect import Spar.Sem.SAMLUserStore (SAMLUserStore) import Spar.Sem.ScimExternalIdStore (ScimExternalIdStore) @@ -105,7 +108,7 @@ configuration :: Scim.Meta.Configuration configuration = Scim.Meta.empty apiScim :: - Members '[ScimExternalIdStore, ScimUserTimesStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Members '[Error SparError, GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => ServerT APIScim (Spar r) apiScim = hoistScim (toServant (server configuration)) diff --git a/services/spar/src/Spar/Scim/Auth.hs b/services/spar/src/Spar/Scim/Auth.hs index 2b902309842..773f5781129 100644 --- a/services/spar/src/Spar/Scim/Auth.hs +++ b/services/spar/src/Spar/Scim/Auth.hs @@ -45,11 +45,15 @@ import OpenSSL.Random (randBytes) -- Spar.Scim.{Core,User,Group} to avoid at least some of the hscim name clashes? import Polysemy +import Polysemy.Error import qualified SAML2.WebSSO as SAML import Servant (NoContent (NoContent), ServerT, (:<|>) ((:<|>))) -import Spar.App (Spar, sparCtxOpts, wrapMonadClientSem) +import Spar.App (Spar, liftSem, sparCtxOpts, wrapMonadClientSem) import qualified Spar.Error as E -import qualified Spar.Intra.Brig as Intra.Brig +import qualified Spar.Intra.BrigApp as Intra.Brig +import Spar.Sem.BrigAccess (BrigAccess) +import qualified Spar.Sem.BrigAccess as BrigAccess +import Spar.Sem.GalleyAccess (GalleyAccess) import qualified Spar.Sem.IdP as IdPEffect import Spar.Sem.ScimTokenStore (ScimTokenStore) import qualified Spar.Sem.ScimTokenStore as ScimTokenStore @@ -77,7 +81,9 @@ instance Member ScimTokenStore r => Scim.Class.Auth.AuthDB SparTag (Spar r) wher -- | API for manipulating SCIM tokens (protected by normal Wire authentication and available -- only to team owners). -apiScimToken :: Members '[ScimTokenStore, IdPEffect.IdP] r => ServerT APIScimToken (Spar r) +apiScimToken :: + Members '[GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error E.SparError] r => + ServerT APIScimToken (Spar r) apiScimToken = createScimToken :<|> deleteScimToken @@ -88,7 +94,7 @@ apiScimToken = -- Create a token for user's team. createScimToken :: forall r. - Members '[ScimTokenStore, IdPEffect.IdP] r => + Members '[GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error E.SparError] r => -- | Who is trying to create a token Maybe UserId -> -- | Request body @@ -96,8 +102,8 @@ createScimToken :: Spar r CreateScimTokenResponse createScimToken zusr CreateScimToken {..} = do let descr = createScimTokenDescr - teamid <- Intra.Brig.authorizeScimTokenManagement zusr - Intra.Brig.ensureReAuthorised zusr createScimTokenPassword + teamid <- liftSem $ Intra.Brig.authorizeScimTokenManagement zusr + liftSem $ BrigAccess.ensureReAuthorised zusr createScimTokenPassword tokenNumber <- fmap length $ wrapMonadClientSem $ ScimTokenStore.getByTeam teamid maxTokens <- asks (maxScimTokens . sparCtxOpts) unless (tokenNumber < maxTokens) $ @@ -135,13 +141,13 @@ createScimToken zusr CreateScimToken {..} = do -- -- Delete a token belonging to user's team. deleteScimToken :: - Member ScimTokenStore r => + Members '[GalleyAccess, BrigAccess, ScimTokenStore, Error E.SparError] r => -- | Who is trying to delete a token Maybe UserId -> ScimTokenId -> Spar r NoContent deleteScimToken zusr tokenid = do - teamid <- Intra.Brig.authorizeScimTokenManagement zusr + teamid <- liftSem $ Intra.Brig.authorizeScimTokenManagement zusr wrapMonadClientSem $ ScimTokenStore.delete teamid tokenid pure NoContent @@ -150,10 +156,10 @@ deleteScimToken zusr tokenid = do -- List all tokens belonging to user's team. Tokens themselves are not available, only -- metadata about them. listScimTokens :: - Member ScimTokenStore r => + Members '[GalleyAccess, BrigAccess, ScimTokenStore, Error E.SparError] r => -- | Who is trying to list tokens Maybe UserId -> Spar r ScimTokenList listScimTokens zusr = do - teamid <- Intra.Brig.authorizeScimTokenManagement zusr + teamid <- liftSem $ Intra.Brig.authorizeScimTokenManagement zusr ScimTokenList <$> wrapMonadClientSem (ScimTokenStore.getByTeam teamid) diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index c877687d37d..2d1d922d8c4 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -65,10 +65,12 @@ import Imports import Network.URI (URI, parseURI) import Polysemy import qualified SAML2.WebSSO as SAML -import Spar.App (GetUserResult (..), Spar, getUserIdByScimExternalId, getUserIdByUref, sparCtxOpts, validateEmailIfExists, wrapMonadClientSem) -import qualified Spar.Intra.Brig as Brig +import Spar.App (GetUserResult (..), Spar, getUserIdByScimExternalId, getUserIdByUref, liftSem, sparCtxOpts, validateEmailIfExists, wrapMonadClientSem) +import qualified Spar.Intra.BrigApp as Brig import Spar.Scim.Auth () import qualified Spar.Scim.Types as ST +import Spar.Sem.BrigAccess as BrigAccess +import Spar.Sem.GalleyAccess (GalleyAccess) import qualified Spar.Sem.IdP as IdPEffect import Spar.Sem.SAMLUserStore (SAMLUserStore) import qualified Spar.Sem.SAMLUserStore as SAMLUserStore @@ -101,7 +103,7 @@ import qualified Wire.API.User.Scim as ST ---------------------------------------------------------------------------- -- UserDB instance -instance Members '[ScimExternalIdStore, ScimUserTimesStore, IdPEffect.IdP, SAMLUserStore] r => Scim.UserDB ST.SparTag (Spar r) where +instance Members '[GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, IdPEffect.IdP, SAMLUserStore] r => Scim.UserDB ST.SparTag (Spar r) where getUsers :: ScimTokenInfo -> Maybe Scim.Filter -> @@ -140,7 +142,7 @@ instance Members '[ScimExternalIdStore, ScimUserTimesStore, IdPEffect.IdP, SAMLU $ do mIdpConfig <- maybe (pure Nothing) (lift . wrapMonadClientSem . IdPEffect.getConfig) stiIdP let notfound = Scim.notFound "User" (idToText uid) - brigUser <- lift (Brig.getBrigUserAccount Brig.WithPendingInvitations uid) >>= maybe (throwError notfound) pure + brigUser <- lift (liftSem $ BrigAccess.getAccount Brig.WithPendingInvitations uid) >>= maybe (throwError notfound) pure unless (userTeam (accountUser brigUser) == Just stiTeam) (throwError notfound) case Brig.veidFromBrigUser (accountUser brigUser) ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) of Right veid -> synthesizeStoredUser brigUser veid @@ -369,7 +371,7 @@ veidEmail (ST.EmailOnly email) = Just email createValidScimUser :: forall m r. (m ~ Scim.ScimHandler (Spar r)) => - Members '[ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore] r => + Members '[GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore] r => ScimTokenInfo -> ST.ValidScimUser -> m (Scim.StoredUser ST.SparTag) @@ -395,10 +397,10 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid ( \uref -> do uid <- liftIO $ Id <$> UUID.nextRandom - Brig.createBrigUserSAML uref uid stiTeam name ManagedByScim + liftSem $ BrigAccess.createSAML uref uid stiTeam name ManagedByScim ) ( \email -> do - Brig.createBrigUserNoSAML email stiTeam name + liftSem $ BrigAccess.createNoSAML email stiTeam name ) veid @@ -409,8 +411,9 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid -- up. We should consider making setUserHandle part of createUser and -- making it transactional. If the user redoes the POST A new standalone -- user will be created.} - Brig.setBrigUserHandle buid handl - Brig.setBrigUserRichInfo buid richInfo + liftSem $ do + BrigAccess.setHandle buid handl + BrigAccess.setRichInfo buid richInfo pure buid -- {If we crash now, a POST retry will fail with 409 user already exists. @@ -423,7 +426,7 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid -- to reload the Account from brig. storedUser <- do acc <- - lift (Brig.getBrigUserAccount Brig.WithPendingInvitations buid) + lift (liftSem $ BrigAccess.getAccount Brig.WithPendingInvitations buid) >>= maybe (throwError $ Scim.serverError "Server error: user vanished") pure synthesizeStoredUser acc veid lift $ Log.debug (Log.msg $ "createValidScimUser: spar says " <> show storedUser) @@ -442,16 +445,16 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid -- {suspension via scim: if we don't reach the following line, the user will be active.} lift $ do - old <- Brig.getStatus buid + old <- liftSem $ BrigAccess.getStatus buid let new = ST.scimActiveFlagToAccountStatus old (Scim.unScimBool <$> active) active = Scim.active . Scim.value . Scim.thing $ storedUser - when (new /= old) $ Brig.setStatus buid new + when (new /= old) $ liftSem $ BrigAccess.setStatus buid new pure storedUser -- TODO(arianvp): how do we get this safe w.r.t. race conditions / crashes? updateValidScimUser :: forall m r. - Members '[ScimExternalIdStore, ScimUserTimesStore, IdPEffect.IdP, SAMLUserStore] r => + Members '[GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, IdPEffect.IdP, SAMLUserStore] r => (m ~ Scim.ScimHandler (Spar r)) => ScimTokenInfo -> UserId -> @@ -488,25 +491,26 @@ updateValidScimUser tokinfo@ScimTokenInfo {stiTeam} uid newValidScimUser = _ -> pure () when (newValidScimUser ^. ST.vsuName /= oldValidScimUser ^. ST.vsuName) $ do - Brig.setBrigUserName uid (newValidScimUser ^. ST.vsuName) + liftSem $ BrigAccess.setName uid (newValidScimUser ^. ST.vsuName) when (oldValidScimUser ^. ST.vsuHandle /= newValidScimUser ^. ST.vsuHandle) $ do - Brig.setBrigUserHandle uid (newValidScimUser ^. ST.vsuHandle) + liftSem $ BrigAccess.setHandle uid (newValidScimUser ^. ST.vsuHandle) when (oldValidScimUser ^. ST.vsuRichInfo /= newValidScimUser ^. ST.vsuRichInfo) $ do - Brig.setBrigUserRichInfo uid (newValidScimUser ^. ST.vsuRichInfo) + liftSem $ BrigAccess.setRichInfo uid (newValidScimUser ^. ST.vsuRichInfo) - Brig.getStatusMaybe uid >>= \case - Nothing -> pure () - Just old -> do - let new = ST.scimActiveFlagToAccountStatus old (Just $ newValidScimUser ^. ST.vsuActive) - when (new /= old) $ Brig.setStatus uid new + liftSem $ + BrigAccess.getStatusMaybe uid >>= \case + Nothing -> pure () + Just old -> do + let new = ST.scimActiveFlagToAccountStatus old (Just $ newValidScimUser ^. ST.vsuActive) + when (new /= old) $ BrigAccess.setStatus uid new wrapMonadClientSem $ ScimUserTimesStore.write newScimStoredUser pure newScimStoredUser updateVsuUref :: - Members '[ScimExternalIdStore, SAMLUserStore] r => + Members '[GalleyAccess, BrigAccess, ScimExternalIdStore, SAMLUserStore] r => TeamId -> UserId -> ST.ValidExternalId -> @@ -522,7 +526,7 @@ updateVsuUref team uid old new = do old & ST.runValidExternalId (SAMLUserStore.delete uid) (ScimExternalIdStore.delete team) new & ST.runValidExternalId (`SAMLUserStore.insert` uid) (\email -> ScimExternalIdStore.insert team email uid) - Brig.setBrigUserVeid uid new + liftSem $ BrigAccess.setVeid uid new toScimStoredUser' :: HasCallStack => @@ -579,7 +583,7 @@ updScimStoredUser' now usr (Scim.WithMeta meta (Scim.WithId scimuid _)) = } deleteScimUser :: - Members '[ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore, IdPEffect.IdP] r => + Members '[BrigAccess, ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore, IdPEffect.IdP] r => ScimTokenInfo -> UserId -> Scim.ScimHandler (Spar r) () @@ -590,7 +594,7 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = . logUser uid ) $ do - mbBrigUser <- lift (Brig.getBrigUser Brig.WithPendingInvitations uid) + mbBrigUser <- lift (liftSem $ Brig.getBrigUser Brig.WithPendingInvitations uid) case mbBrigUser of Nothing -> do -- double-deletion gets you a 404. @@ -616,7 +620,7 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = veid lift . wrapMonadClientSem $ ScimUserTimesStore.delete uid - lift $ Brig.deleteBrigUser uid + lift . liftSem $ BrigAccess.delete uid return () ---------------------------------------------------------------------------- @@ -646,7 +650,7 @@ calculateVersion uid usr = Scim.Weak (Text.pack (show h)) -- -- ASSUMPTION: every scim user has a 'SAML.UserRef', and the `SAML.NameID` in it corresponds -- to a single `externalId`. -assertExternalIdUnused :: Members '[ScimExternalIdStore, SAMLUserStore] r => TeamId -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) () +assertExternalIdUnused :: Members '[BrigAccess, ScimExternalIdStore, SAMLUserStore] r => TeamId -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) () assertExternalIdUnused tid veid = do assertExternalIdInAllowedValues [Nothing] @@ -660,7 +664,7 @@ assertExternalIdUnused tid veid = do -- -- ASSUMPTION: every scim user has a 'SAML.UserRef', and the `SAML.NameID` in it corresponds -- to a single `externalId`. -assertExternalIdNotUsedElsewhere :: Members '[ScimExternalIdStore, SAMLUserStore] r => TeamId -> ST.ValidExternalId -> UserId -> Scim.ScimHandler (Spar r) () +assertExternalIdNotUsedElsewhere :: Members '[BrigAccess, ScimExternalIdStore, SAMLUserStore] r => TeamId -> ST.ValidExternalId -> UserId -> Scim.ScimHandler (Spar r) () assertExternalIdNotUsedElsewhere tid veid wireUserId = do assertExternalIdInAllowedValues [Nothing, Just wireUserId] @@ -668,7 +672,7 @@ assertExternalIdNotUsedElsewhere tid veid wireUserId = do tid veid -assertExternalIdInAllowedValues :: Members '[ScimExternalIdStore, SAMLUserStore] r => [Maybe UserId] -> Text -> TeamId -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) () +assertExternalIdInAllowedValues :: Members '[BrigAccess, ScimExternalIdStore, SAMLUserStore] r => [Maybe UserId] -> Text -> TeamId -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) () assertExternalIdInAllowedValues allowedValues errmsg tid veid = do isGood <- lift $ @@ -685,25 +689,25 @@ assertExternalIdInAllowedValues allowedValues errmsg tid veid = do unless isGood $ throwError Scim.conflict {Scim.detail = Just errmsg} -assertHandleUnused :: Handle -> Scim.ScimHandler (Spar r) () +assertHandleUnused :: Member BrigAccess r => Handle -> Scim.ScimHandler (Spar r) () assertHandleUnused = assertHandleUnused' "userName is already taken" -assertHandleUnused' :: Text -> Handle -> Scim.ScimHandler (Spar r) () +assertHandleUnused' :: Member BrigAccess r => Text -> Handle -> Scim.ScimHandler (Spar r) () assertHandleUnused' msg hndl = - lift (Brig.checkHandleAvailable hndl) >>= \case + lift (liftSem $ BrigAccess.checkHandleAvailable hndl) >>= \case True -> pure () False -> throwError Scim.conflict {Scim.detail = Just msg} -assertHandleNotUsedElsewhere :: UserId -> Handle -> Scim.ScimHandler (Spar r) () +assertHandleNotUsedElsewhere :: Member BrigAccess r => UserId -> Handle -> Scim.ScimHandler (Spar r) () assertHandleNotUsedElsewhere uid hndl = do - musr <- lift $ Brig.getBrigUser Brig.WithPendingInvitations uid + musr <- lift $ liftSem $ Brig.getBrigUser Brig.WithPendingInvitations uid unless ((userHandle =<< musr) == Just hndl) $ assertHandleUnused' "userName already in use by another wire user" hndl -- | Helper function that translates a given brig user into a 'Scim.StoredUser', with some -- effects like updating the 'ManagedBy' field in brig and storing creation and update time -- stamps. -synthesizeStoredUser :: forall r. Member ScimUserTimesStore r => UserAccount -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) (Scim.StoredUser ST.SparTag) +synthesizeStoredUser :: forall r. Members '[BrigAccess, ScimUserTimesStore] r => UserAccount -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) (Scim.StoredUser ST.SparTag) synthesizeStoredUser usr veid = logScim ( logFunction "Spar.Scim.User.synthesizeStoredUser" @@ -718,7 +722,7 @@ synthesizeStoredUser usr veid = let readState :: Spar r (RI.RichInfo, Maybe (UTCTimeMillis, UTCTimeMillis), URIBS.URI) readState = do - richInfo <- Brig.getBrigUserRichInfo uid + richInfo <- liftSem $ BrigAccess.getRichInfo uid accessTimes <- wrapMonadClientSem (ScimUserTimesStore.read uid) baseuri <- asks $ derivedOptsScimBaseURI . derivedOpts . sparCtxOpts pure (richInfo, accessTimes, baseuri) @@ -728,16 +732,16 @@ synthesizeStoredUser usr veid = when (isNothing oldAccessTimes) $ do wrapMonadClientSem $ ScimUserTimesStore.write storedUser when (oldManagedBy /= ManagedByScim) $ do - Brig.setBrigUserManagedBy uid ManagedByScim + liftSem $ BrigAccess.setManagedBy uid ManagedByScim let newRichInfo = view ST.sueRichInfo . Scim.extra . Scim.value . Scim.thing $ storedUser when (oldRichInfo /= newRichInfo) $ do - Brig.setBrigUserRichInfo uid newRichInfo + liftSem $ BrigAccess.setRichInfo uid newRichInfo (richInfo, accessTimes, baseuri) <- lift readState SAML.Time (toUTCTimeMillis -> now) <- lift SAML.getNow let (createdAt, lastUpdatedAt) = fromMaybe (now, now) accessTimes - handle <- lift $ Brig.giveDefaultHandle (accountUser usr) + handle <- lift $ liftSem $ Brig.giveDefaultHandle (accountUser usr) storedUser <- synthesizeStoredUser' @@ -789,10 +793,15 @@ synthesizeScimUser info = Scim.active = Just . Scim.ScimBool $ info ^. ST.vsuActive } -scimFindUserByHandle :: Member ScimUserTimesStore r => Maybe IdP -> TeamId -> Text -> MaybeT (Scim.ScimHandler (Spar r)) (Scim.StoredUser ST.SparTag) +scimFindUserByHandle :: + Members '[BrigAccess, ScimUserTimesStore] r => + Maybe IdP -> + TeamId -> + Text -> + MaybeT (Scim.ScimHandler (Spar r)) (Scim.StoredUser ST.SparTag) scimFindUserByHandle mIdpConfig stiTeam hndl = do handle <- MaybeT . pure . parseHandle . Text.toLower $ hndl - brigUser <- MaybeT . lift . Brig.getBrigUserByHandle $ handle + brigUser <- MaybeT . lift . liftSem . BrigAccess.getByHandle $ handle guard $ userTeam (accountUser brigUser) == Just stiTeam case Brig.veidFromBrigUser (accountUser brigUser) ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) of Right veid -> lift $ synthesizeStoredUser brigUser veid @@ -806,7 +815,7 @@ scimFindUserByHandle mIdpConfig stiTeam hndl = do -- successful authentication with their SAML credentials. scimFindUserByEmail :: forall r. - Members '[ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore] r => + Members '[BrigAccess, ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore] r => Maybe IdP -> TeamId -> Text -> @@ -820,7 +829,7 @@ scimFindUserByEmail mIdpConfig stiTeam email = do -- a UUID, or any other text that is valid according to SCIM. veid <- MaybeT (either (const Nothing) Just <$> runExceptT (mkValidExternalId mIdpConfig (pure email))) uid <- MaybeT . lift $ ST.runValidExternalId withUref withEmailOnly veid - brigUser <- MaybeT . lift . Brig.getBrigUserAccount Brig.WithPendingInvitations $ uid + brigUser <- MaybeT . lift . liftSem . BrigAccess.getAccount Brig.WithPendingInvitations $ uid guard $ userTeam (accountUser brigUser) == Just stiTeam lift $ synthesizeStoredUser brigUser veid where @@ -837,7 +846,7 @@ scimFindUserByEmail mIdpConfig stiTeam email = do -- and it never should be visible in spar, but not in brig. inspar, inbrig :: Spar r (Maybe UserId) inspar = wrapMonadClientSem $ ScimExternalIdStore.lookup stiTeam eml - inbrig = userId . accountUser <$$> Brig.getBrigUserByEmail eml + inbrig = liftSem $ userId . accountUser <$$> BrigAccess.getByEmail eml logFilter :: Filter -> (Msg -> Msg) logFilter (FilterAttrCompare attr op val) = diff --git a/services/spar/src/Spar/Sem/BrigAccess.hs b/services/spar/src/Spar/Sem/BrigAccess.hs new file mode 100644 index 00000000000..8d5fb82b383 --- /dev/null +++ b/services/spar/src/Spar/Sem/BrigAccess.hs @@ -0,0 +1,36 @@ +module Spar.Sem.BrigAccess where + +import Brig.Types.Intra +import Brig.Types.User +import Data.Handle (Handle) +import Data.Id (TeamId, UserId) +import Data.Misc (PlainTextPassword) +import Imports +import Polysemy +import qualified SAML2.WebSSO as SAML +import Web.Cookie +import Wire.API.User.RichInfo as RichInfo +import Wire.API.User.Scim (ValidExternalId (..)) + +data BrigAccess m a where + CreateSAML :: SAML.UserRef -> UserId -> TeamId -> Name -> ManagedBy -> BrigAccess m UserId + CreateNoSAML :: Email -> TeamId -> Name -> BrigAccess m UserId + UpdateEmail :: UserId -> Email -> BrigAccess m () + GetAccount :: HavePendingInvitations -> UserId -> BrigAccess m (Maybe UserAccount) + GetByHandle :: Handle -> BrigAccess m (Maybe UserAccount) + GetByEmail :: Email -> BrigAccess m (Maybe UserAccount) + SetName :: UserId -> Name -> BrigAccess m () + SetHandle :: UserId -> Handle {- not 'HandleUpdate'! -} -> BrigAccess m () + SetManagedBy :: UserId -> ManagedBy -> BrigAccess m () + SetVeid :: UserId -> ValidExternalId -> BrigAccess m () + SetRichInfo :: UserId -> RichInfo -> BrigAccess m () + GetRichInfo :: UserId -> BrigAccess m RichInfo + CheckHandleAvailable :: Handle -> BrigAccess m Bool + Delete :: UserId -> BrigAccess m () + EnsureReAuthorised :: Maybe UserId -> Maybe PlainTextPassword -> BrigAccess m () + SsoLogin :: UserId -> BrigAccess m SetCookie + GetStatus :: UserId -> BrigAccess m AccountStatus + GetStatusMaybe :: UserId -> BrigAccess m (Maybe AccountStatus) + SetStatus :: UserId -> AccountStatus -> BrigAccess m () + +makeSem ''BrigAccess diff --git a/services/spar/src/Spar/Sem/BrigAccess/Http.hs b/services/spar/src/Spar/Sem/BrigAccess/Http.hs new file mode 100644 index 00000000000..547756bab7d --- /dev/null +++ b/services/spar/src/Spar/Sem/BrigAccess/Http.hs @@ -0,0 +1,41 @@ +module Spar.Sem.BrigAccess.Http where + +import Bilge +import Imports +import Polysemy +import Polysemy.Error (Error) +import Spar.Error (SparError) +import qualified Spar.Intra.Brig as Intra +import Spar.Sem.BrigAccess +import Spar.Sem.GalleyAccess.Http (RunHttpEnv (..), viaRunHttp) +import qualified System.Logger as Log + +brigAccessToHttp :: + Members '[Error SparError, Embed IO] r => + Log.Logger -> + Bilge.Manager -> + Bilge.Request -> + Sem (BrigAccess ': r) a -> + Sem r a +brigAccessToHttp logger mgr req = + interpret $ + viaRunHttp (RunHttpEnv logger mgr req) . \case + CreateSAML u itlu itlt n m -> Intra.createBrigUserSAML u itlu itlt n m + CreateNoSAML e itlt n -> Intra.createBrigUserNoSAML e itlt n + UpdateEmail itlu e -> Intra.updateEmail itlu e + GetAccount h itlu -> Intra.getBrigUserAccount h itlu + GetByHandle h -> Intra.getBrigUserByHandle h + GetByEmail e -> Intra.getBrigUserByEmail e + SetName itlu n -> Intra.setBrigUserName itlu n + SetHandle itlu h -> Intra.setBrigUserHandle itlu h + SetManagedBy itlu m -> Intra.setBrigUserManagedBy itlu m + SetVeid itlu v -> Intra.setBrigUserVeid itlu v + SetRichInfo itlu r -> Intra.setBrigUserRichInfo itlu r + GetRichInfo itlu -> Intra.getBrigUserRichInfo itlu + CheckHandleAvailable h -> Intra.checkHandleAvailable h + Delete itlu -> Intra.deleteBrigUser itlu + EnsureReAuthorised mitlu mp -> Intra.ensureReAuthorised mitlu mp + SsoLogin itlu -> Intra.ssoLogin itlu + GetStatus itlu -> Intra.getStatus itlu + GetStatusMaybe itlu -> Intra.getStatusMaybe itlu + SetStatus itlu a -> Intra.setStatus itlu a diff --git a/services/spar/src/Spar/Sem/GalleyAccess.hs b/services/spar/src/Spar/Sem/GalleyAccess.hs new file mode 100644 index 00000000000..8a3952db218 --- /dev/null +++ b/services/spar/src/Spar/Sem/GalleyAccess.hs @@ -0,0 +1,14 @@ +module Spar.Sem.GalleyAccess where + +import Data.Id (TeamId, UserId) +import Galley.Types.Teams (IsPerm, TeamMember) +import Imports +import Polysemy + +data GalleyAccess m a where + GetTeamMembers :: TeamId -> GalleyAccess m [TeamMember] + AssertHasPermission :: (Show perm, IsPerm perm) => TeamId -> perm -> UserId -> GalleyAccess m () + AssertSSOEnabled :: TeamId -> GalleyAccess m () + IsEmailValidationEnabledTeam :: TeamId -> GalleyAccess m Bool + +makeSem ''GalleyAccess diff --git a/services/spar/src/Spar/Sem/GalleyAccess/Http.hs b/services/spar/src/Spar/Sem/GalleyAccess/Http.hs new file mode 100644 index 00000000000..fca40c66bf1 --- /dev/null +++ b/services/spar/src/Spar/Sem/GalleyAccess/Http.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Spar.Sem.GalleyAccess.Http where + +import Bilge +import Control.Monad.Except +import Imports hiding (log) +import Polysemy +import Polysemy.Error +import Spar.Error (SparError) +import Spar.Intra.Brig (MonadSparToBrig (..)) +import Spar.Intra.Galley (MonadSparToGalley) +import qualified Spar.Intra.Galley as Intra +import Spar.Sem.GalleyAccess +import qualified System.Logger as Log +import qualified System.Logger.Class as LogClass + +data RunHttpEnv = RunHttpEnv + { rheLogger :: Log.Logger, + rheManager :: Bilge.Manager, + rheRequest :: Bilge.Request + } + +newtype RunHttp a = RunHttp + { unRunHttp :: ReaderT RunHttpEnv (ExceptT SparError (HttpT IO)) a + } + deriving newtype (Functor, Applicative, Monad, MonadError SparError, MonadIO, MonadHttp, MonadReader RunHttpEnv) + +viaRunHttp :: + Members '[Error SparError, Embed IO] r => + RunHttpEnv -> + RunHttp a -> + Sem r a +viaRunHttp env m = do + ma <- embed @IO $ runHttpT (rheManager env) $ runExceptT $ flip runReaderT env $ unRunHttp m + case ma of + Left err -> throw err + Right a -> pure a + +instance LogClass.MonadLogger RunHttp where + log lvl msg = do + logger <- asks rheLogger + Log.log logger lvl msg + +instance MonadSparToGalley RunHttp where + call modreq = do + req <- asks rheRequest + httpLbs req modreq + +instance MonadSparToBrig RunHttp where + call modreq = do + req <- asks rheRequest + httpLbs req modreq + +galleyAccessToHttp :: + Members '[Error SparError, Embed IO] r => + Log.Logger -> + Bilge.Manager -> + Bilge.Request -> + Sem (GalleyAccess ': r) a -> + Sem r a +galleyAccessToHttp logger mgr req = + interpret $ + viaRunHttp (RunHttpEnv logger mgr req) . \case + GetTeamMembers itlt -> Intra.getTeamMembers itlt + AssertHasPermission itlt perm itlu -> Intra.assertHasPermission itlt perm itlu + AssertSSOEnabled itlt -> Intra.assertSSOEnabled itlt + IsEmailValidationEnabledTeam itlt -> Intra.isEmailValidationEnabledTeam itlt diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs index dad4316f3b6..57afed49fd2 100644 --- a/services/spar/test-integration/Test/Spar/APISpec.hs +++ b/services/spar/test-integration/Test/Spar/APISpec.hs @@ -71,7 +71,8 @@ import SAML2.WebSSO.Test.Lenses import SAML2.WebSSO.Test.MockResponse import SAML2.WebSSO.Test.Util import Spar.App (liftSem) -import qualified Spar.Intra.Brig as Intra +import qualified Spar.Intra.BrigApp as Intra +import qualified Spar.Sem.BrigAccess as BrigAccess import qualified Spar.Sem.IdP as IdPEffect import Text.XML.DSig (SignPrivCreds, mkSignCredsWithCert) import qualified URI.ByteString as URI @@ -1297,7 +1298,7 @@ specDeleteCornerCases = describe "delete corner cases" $ do brig <- view teBrig resp <- call . delete $ brig . paths ["i", "users", toByteString' uid] liftIO $ responseStatus resp `shouldBe` status202 - void $ aFewTimes (runSpar $ Intra.getStatus uid) (== Deleted) + void $ aFewTimes (runSpar $ liftSem $ BrigAccess.getStatus uid) (== Deleted) specScimAndSAML :: SpecWith TestEnv specScimAndSAML = do diff --git a/services/spar/test-integration/Test/Spar/DataSpec.hs b/services/spar/test-integration/Test/Spar/DataSpec.hs index 7d69db0d3c4..b37ba065a80 100644 --- a/services/spar/test-integration/Test/Spar/DataSpec.hs +++ b/services/spar/test-integration/Test/Spar/DataSpec.hs @@ -34,7 +34,7 @@ import Polysemy import SAML2.WebSSO as SAML import Spar.App as App import Spar.Data as Data -import Spar.Intra.Brig (veidFromUserSSOId) +import Spar.Intra.BrigApp (veidFromUserSSOId) import qualified Spar.Sem.AReqIDStore as AReqIDStore import qualified Spar.Sem.AssIDStore as AssIDStore import qualified Spar.Sem.BindCookieStore as BindCookieStore diff --git a/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs b/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs index e6ed4aac923..84114d80278 100644 --- a/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs +++ b/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs @@ -25,7 +25,8 @@ import Control.Lens ((^.)) import Data.Id (Id (Id)) import qualified Data.UUID as UUID import Imports hiding (head) -import qualified Spar.Intra.Brig as Intra +import Spar.App (liftSem) +import qualified Spar.Intra.BrigApp as Intra import Util import qualified Web.Scim.Schema.User as Scim.User @@ -39,7 +40,7 @@ spec = do describe "getBrigUser" $ do it "return Nothing if n/a" $ do - musr <- runSpar $ Intra.getBrigUser Intra.WithPendingInvitations (Id . fromJust $ UUID.fromText "29546d9e-ed5b-11ea-8228-c324b1ea1030") + musr <- runSpar $ liftSem $ Intra.getBrigUser Intra.WithPendingInvitations (Id . fromJust $ UUID.fromText "29546d9e-ed5b-11ea-8228-c324b1ea1030") liftIO $ musr `shouldSatisfy` isNothing it "return Just if /a" $ do @@ -52,5 +53,5 @@ spec = do scimUserId <$> createUser tok scimUser uid <- setup - musr <- runSpar $ Intra.getBrigUser Intra.WithPendingInvitations uid + musr <- runSpar $ liftSem $ Intra.getBrigUser Intra.WithPendingInvitations uid liftIO $ musr `shouldSatisfy` isJust diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index 127c5ef540e..fa424629192 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -60,9 +60,10 @@ import qualified Network.Wai.Utilities.Error as Wai import qualified SAML2.WebSSO as SAML import qualified SAML2.WebSSO.Test.MockResponse as SAML import Spar.App (liftSem) -import qualified Spar.Intra.Brig as Intra +import qualified Spar.Intra.BrigApp as Intra import Spar.Scim import qualified Spar.Scim.User as SU +import qualified Spar.Sem.BrigAccess as BrigAccess import qualified Spar.Sem.SAMLUserStore as SAMLUserStore import qualified Spar.Sem.ScimExternalIdStore as ScimExternalIdStore import qualified Spar.Sem.ScimUserTimesStore as ScimUserTimesStore @@ -116,9 +117,9 @@ specSuspend = do -- NOTE: once SCIM is enabled, SSO Auto-provisioning is disabled tok <- registerScimToken teamid (Just (idp ^. SAML.idpId)) handle'@(Handle handle) <- nextHandle - runSpar $ Intra.setBrigUserHandle member handle' + runSpar $ liftSem $ BrigAccess.setHandle member handle' unless isActive $ do - runSpar $ Intra.setStatus member Suspended + runSpar $ liftSem $ BrigAccess.setStatus member Suspended [user] <- listUsers tok (Just (filterBy "userName" handle)) lift $ (fmap Scim.unScimBool . Scim.User.active . Scim.value . Scim.thing $ user) `shouldBe` Just isActive it "pre-existing suspended users are inactive" $ do @@ -137,19 +138,19 @@ specSuspend = do -- Once we get rid of the `scim` table and make scim serve brig records directly, this is -- not an issue anymore. lift $ (fmap Scim.unScimBool . Scim.User.active . Scim.value . Scim.thing $ scimStoredUserBlah) `shouldBe` Just True - void $ aFewTimes (runSpar $ Intra.getStatus uid) (== Active) + void $ aFewTimes (runSpar $ liftSem $ BrigAccess.getStatus uid) (== Active) do scimStoredUser <- putOrPatch tok uid user True lift $ (fmap Scim.unScimBool . Scim.User.active . Scim.value . Scim.thing $ scimStoredUser) `shouldBe` Just True - void $ aFewTimes (runSpar $ Intra.getStatus uid) (== Active) + void $ aFewTimes (runSpar $ liftSem $ BrigAccess.getStatus uid) (== Active) do scimStoredUser <- putOrPatch tok uid user False lift $ (fmap Scim.unScimBool . Scim.User.active . Scim.value . Scim.thing $ scimStoredUser) `shouldBe` Just False - void $ aFewTimes (runSpar $ Intra.getStatus uid) (== Suspended) + void $ aFewTimes (runSpar $ liftSem $ BrigAccess.getStatus uid) (== Suspended) do scimStoredUser <- putOrPatch tok uid user True lift $ (fmap Scim.unScimBool . Scim.User.active . Scim.value . Scim.thing $ scimStoredUser) `shouldBe` Just True - void $ aFewTimes (runSpar $ Intra.getStatus uid) (== Active) + void $ aFewTimes (runSpar $ liftSem $ BrigAccess.getStatus uid) (== Active) it "PUT will change state from active to inactive and back" $ do void . activeInactiveAndBack $ \tok uid user active -> @@ -188,10 +189,10 @@ specSuspend = do (tok, _) <- registerIdPAndScimToken scimStoredUserBlah <- createUser tok user let uid = Scim.id . Scim.thing $ scimStoredUserBlah - runSpar $ Intra.setStatus uid Suspended - void $ aFewTimes (runSpar $ Intra.getStatus uid) (== Suspended) + runSpar $ liftSem $ BrigAccess.setStatus uid Suspended + void $ aFewTimes (runSpar $ liftSem $ BrigAccess.getStatus uid) (== Suspended) void $ patchUser tok uid $ PatchOp.PatchOp [deleteAttrib "active"] - void $ aFewTimes (runSpar $ Intra.getStatus uid) (== Active) + void $ aFewTimes (runSpar $ liftSem $ BrigAccess.getStatus uid) (== Active) ---------------------------------------------------------------------------- -- User creation @@ -302,10 +303,10 @@ testCreateUserNoIdP = do -- get account from brig, status should be PendingInvitation do - aFewTimes (runSpar $ Intra.getBrigUserAccount Intra.NoPendingInvitations userid) isJust + aFewTimes (runSpar $ liftSem $ BrigAccess.getAccount Intra.NoPendingInvitations userid) isJust >>= maybe (pure ()) (error "pending user in brig is visible, even though it should not be") brigUserAccount <- - aFewTimes (runSpar $ Intra.getBrigUserAccount Intra.WithPendingInvitations userid) isJust + aFewTimes (runSpar $ liftSem $ BrigAccess.getAccount Intra.WithPendingInvitations userid) isJust >>= maybe (error "could not find user in brig") pure let brigUser = accountUser brigUserAccount brigUser `userShouldMatch` WrappedScimStoredUser scimStoredUser @@ -345,7 +346,7 @@ testCreateUserNoIdP = do -- user should now be active do brigUser <- - aFewTimes (runSpar $ Intra.getBrigUserAccount Intra.NoPendingInvitations userid) isJust + aFewTimes (runSpar $ liftSem $ BrigAccess.getAccount Intra.NoPendingInvitations userid) isJust >>= maybe (error "could not find user in brig") pure liftIO $ accountStatus brigUser `shouldBe` Active liftIO $ userManagedBy (accountUser brigUser) `shouldBe` ManagedByScim @@ -429,7 +430,7 @@ testCreateUserWithSamlIdP = do . expect2xx ) brigUser `userShouldMatch` WrappedScimStoredUser scimStoredUser - accStatus <- aFewTimes (runSpar $ Intra.getStatus (userId brigUser)) (== Active) + accStatus <- aFewTimes (runSpar $ liftSem $ BrigAccess.getStatus (userId brigUser)) (== Active) liftIO $ accStatus `shouldBe` Active liftIO $ userManagedBy brigUser `shouldBe` ManagedByScim @@ -820,9 +821,9 @@ testFindSamlAutoProvisionedUserMigratedWithEmailInTeamWithSSO = do -- auto-provision user via saml memberWithSSO <- do uid <- loginSsoUserFirstTime idp privCreds - Just usr <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations uid + Just usr <- runSpar $ liftSem $ Intra.getBrigUser Intra.NoPendingInvitations uid handle <- nextHandle - runSpar $ Intra.setBrigUserHandle uid handle + runSpar $ liftSem $ BrigAccess.setHandle uid handle pure usr let memberIdWithSSO = userId memberWithSSO externalId = either error id $ veidToText =<< Intra.veidFromBrigUser memberWithSSO Nothing @@ -833,7 +834,7 @@ testFindSamlAutoProvisionedUserMigratedWithEmailInTeamWithSSO = do liftIO $ userManagedBy memberWithSSO `shouldBe` ManagedByWire users <- listUsers tok (Just (filterBy "externalId" externalId)) liftIO $ (scimUserId <$> users) `shouldContain` [memberIdWithSSO] - Just brigUser' <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations memberIdWithSSO + Just brigUser' <- runSpar $ liftSem $ Intra.getBrigUser Intra.NoPendingInvitations memberIdWithSSO liftIO $ userManagedBy brigUser' `shouldBe` ManagedByScim where veidToText :: MonadError String m => ValidExternalId -> m Text @@ -854,7 +855,7 @@ testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSO = do users' <- listUsers tok (Just (filterBy "externalId" emailInvited)) liftIO $ (scimUserId <$> users') `shouldContain` [memberIdInvited] - Just brigUserInvited' <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations memberIdInvited + Just brigUserInvited' <- runSpar $ liftSem $ Intra.getBrigUser Intra.NoPendingInvitations memberIdInvited liftIO $ userManagedBy brigUserInvited' `shouldBe` ManagedByScim testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSOViaUserId :: TestSpar () @@ -866,7 +867,7 @@ testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSOViaUserId = do let memberIdInvited = userId memberInvited _ <- getUser tok memberIdInvited - Just brigUserInvited' <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations (memberIdInvited) + Just brigUserInvited' <- runSpar $ liftSem $ Intra.getBrigUser Intra.NoPendingInvitations (memberIdInvited) liftIO $ userManagedBy brigUserInvited' `shouldBe` ManagedByScim testFindProvisionedUserNoIdP :: TestSpar () @@ -885,8 +886,8 @@ testFindNonProvisionedUserNoIdP findBy = do uid <- userId <$> call (inviteAndRegisterUser (env ^. teBrig) owner teamid) handle <- nextHandle - runSpar $ Intra.setBrigUserHandle uid handle - Just brigUser <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations uid + runSpar $ liftSem $ BrigAccess.setHandle uid handle + Just brigUser <- runSpar $ liftSem $ Intra.getBrigUser Intra.NoPendingInvitations uid let Just email = userEmail brigUser do @@ -901,7 +902,7 @@ testFindNonProvisionedUserNoIdP findBy = do do liftIO $ users `shouldBe` [uid] - Just brigUser' <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations uid + Just brigUser' <- runSpar $ liftSem $ Intra.getBrigUser Intra.NoPendingInvitations uid liftIO $ userManagedBy brigUser' `shouldBe` ManagedByScim liftIO $ brigUser' `shouldBe` brigUser {userManagedBy = ManagedByScim} @@ -986,7 +987,7 @@ testGetUser = do shouldBeManagedBy :: HasCallStack => UserId -> ManagedBy -> TestSpar () shouldBeManagedBy uid flag = do - managedBy <- maybe (error "user not found") userManagedBy <$> runSpar (Intra.getBrigUser Intra.WithPendingInvitations uid) + managedBy <- maybe (error "user not found") userManagedBy <$> runSpar (liftSem $ Intra.getBrigUser Intra.WithPendingInvitations uid) liftIO $ managedBy `shouldBe` flag -- | This is (roughly) the behavior on develop as well as on the branch where this test was @@ -1039,12 +1040,12 @@ testGetUserWithNoHandle = do uid <- loginSsoUserFirstTime idp privcreds tok <- registerScimToken tid (Just (idp ^. SAML.idpId)) - mhandle :: Maybe Handle <- maybe (error "user not found") userHandle <$> runSpar (Intra.getBrigUser Intra.WithPendingInvitations uid) + mhandle :: Maybe Handle <- maybe (error "user not found") userHandle <$> runSpar (liftSem $ Intra.getBrigUser Intra.WithPendingInvitations uid) liftIO $ mhandle `shouldSatisfy` isNothing storedUser <- getUser tok uid liftIO $ (Scim.User.displayName . Scim.value . Scim.thing) storedUser `shouldSatisfy` isJust - mhandle' :: Maybe Handle <- aFewTimes (maybe (error "user not found") userHandle <$> runSpar (Intra.getBrigUser Intra.WithPendingInvitations uid)) isJust + mhandle' :: Maybe Handle <- aFewTimes (maybe (error "user not found") userHandle <$> runSpar (liftSem $ Intra.getBrigUser Intra.WithPendingInvitations uid)) isJust liftIO $ mhandle' `shouldSatisfy` isJust liftIO $ (fromHandle <$> mhandle') `shouldBe` (Just . Scim.User.userName . Scim.value . Scim.thing $ storedUser) @@ -1342,7 +1343,7 @@ testBrigSideIsUpdated = do validScimUser <- either (error . show) pure $ validateScimUser' (Just idp) 999999 user' - brigUser <- maybe (error "no brig user") pure =<< runSpar (Intra.getBrigUser Intra.WithPendingInvitations userid) + brigUser <- maybe (error "no brig user") pure =<< runSpar (liftSem $ Intra.getBrigUser Intra.WithPendingInvitations userid) brigUser `userShouldMatch` validScimUser ---------------------------------------------------------------------------- @@ -1524,7 +1525,7 @@ specDeleteUser = do storedUser <- createUser tok user let uid :: UserId = scimUserId storedUser uref :: SAML.UserRef <- do - usr <- runSpar $ Intra.getBrigUser Intra.WithPendingInvitations uid + usr <- runSpar $ liftSem $ Intra.getBrigUser Intra.WithPendingInvitations uid let err = error . ("brig user without UserRef: " <>) . show case (`Intra.veidFromBrigUser` Nothing) <$> usr of bad@(Just (Right veid)) -> runValidExternalId pure (const $ err bad) veid @@ -1533,7 +1534,7 @@ specDeleteUser = do deleteUser_ (Just tok) (Just uid) spar !!! const 204 === statusCode brigUser :: Maybe User <- - aFewTimes (runSpar $ Intra.getBrigUser Intra.WithPendingInvitations uid) isNothing + aFewTimes (runSpar $ liftSem $ Intra.getBrigUser Intra.WithPendingInvitations uid) isNothing samlUser :: Maybe UserId <- aFewTimes (getUserIdViaRef' uref) isNothing scimUser <- diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index cbbc41273d7..e6c00b5820a 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -178,7 +178,7 @@ import SAML2.WebSSO.Test.Util (SampleIdP (..), makeSampleIdPMetadata) import Spar.App (liftSem, toLevel) import qualified Spar.App as Spar import Spar.Error (SparError) -import qualified Spar.Intra.Brig as Intra +import qualified Spar.Intra.BrigApp as Intra import qualified Spar.Options import Spar.Run import Spar.Sem.AReqIDStore (AReqIDStore) @@ -187,8 +187,12 @@ import Spar.Sem.AssIDStore (AssIDStore) import Spar.Sem.AssIDStore.Cassandra (assIDStoreToCassandra) import Spar.Sem.BindCookieStore (BindCookieStore) import Spar.Sem.BindCookieStore.Cassandra (bindCookieStoreToCassandra) +import Spar.Sem.BrigAccess (BrigAccess) +import Spar.Sem.BrigAccess.Http (brigAccessToHttp) import Spar.Sem.DefaultSsoCode (DefaultSsoCode) import Spar.Sem.DefaultSsoCode.Cassandra (defaultSsoCodeToCassandra) +import Spar.Sem.GalleyAccess (GalleyAccess) +import Spar.Sem.GalleyAccess.Http (galleyAccessToHttp) import qualified Spar.Sem.IdP as IdPEffect import Spar.Sem.IdP.Cassandra import Spar.Sem.SAMLUserStore (SAMLUserStore) @@ -1239,7 +1243,9 @@ runSimpleSP action = do either (throwIO . ErrorCall . show) pure result type RealInterpretation = - '[ BindCookieStore, + '[ GalleyAccess, + BrigAccess, + BindCookieStore, AssIDStore, AReqIDStore, ScimExternalIdStore, @@ -1280,8 +1286,10 @@ runSpar (Spar.Spar action) = do aReqIDStoreToCassandra @Cas.Client $ assIDStoreToCassandra @Cas.Client $ bindCookieStoreToCassandra @Cas.Client $ - runExceptT $ - runReaderT action env + brigAccessToHttp (Spar.sparCtxLogger env) (Spar.sparCtxHttpManager env) (Spar.sparCtxHttpBrig env) $ + galleyAccessToHttp (Spar.sparCtxLogger env) (Spar.sparCtxHttpManager env) (Spar.sparCtxHttpBrig env) $ + runExceptT $ + runReaderT action env either (throwIO . ErrorCall . show) pure result getSsoidViaSelf :: HasCallStack => UserId -> TestSpar UserSSOId @@ -1289,7 +1297,7 @@ getSsoidViaSelf uid = maybe (error "not found") pure =<< getSsoidViaSelf' uid getSsoidViaSelf' :: HasCallStack => UserId -> TestSpar (Maybe UserSSOId) getSsoidViaSelf' uid = do - musr <- aFewTimes (runSpar $ Intra.getBrigUser Intra.NoPendingInvitations uid) isJust + musr <- aFewTimes (runSpar $ liftSem $ Intra.getBrigUser Intra.NoPendingInvitations uid) isJust pure $ case userIdentity =<< musr of Just (SSOIdentity ssoid _ _) -> Just ssoid Just (FullIdentity _ _) -> Nothing diff --git a/services/spar/test-integration/Util/Scim.hs b/services/spar/test-integration/Util/Scim.hs index 732df54d361..4f332e98855 100644 --- a/services/spar/test-integration/Util/Scim.hs +++ b/services/spar/test-integration/Util/Scim.hs @@ -35,7 +35,7 @@ import Imports import qualified SAML2.WebSSO as SAML import SAML2.WebSSO.Types (IdPId, idpId) import Spar.App (liftSem) -import qualified Spar.Intra.Brig as Intra +import qualified Spar.Intra.BrigApp as Intra import Spar.Scim.User (synthesizeScimUser, validateScimUser') import qualified Spar.Sem.ScimTokenStore as ScimTokenStore import Test.QuickCheck (arbitrary, generate) diff --git a/services/spar/test/Test/Spar/Intra/BrigSpec.hs b/services/spar/test/Test/Spar/Intra/BrigSpec.hs index 44aa7e0d588..d37e98582f5 100644 --- a/services/spar/test/Test/Spar/Intra/BrigSpec.hs +++ b/services/spar/test/Test/Spar/Intra/BrigSpec.hs @@ -26,7 +26,7 @@ import Control.Lens ((^.)) import Data.String.Conversions (ST, cs) import Imports import SAML2.WebSSO as SAML -import Spar.Intra.Brig +import Spar.Intra.BrigApp import Test.Hspec import Test.QuickCheck import URI.ByteString (URI, laxURIParserOptions, parseURI) From 0eea2203b7869943c958fc905e28f4a5343f7466 Mon Sep 17 00:00:00 2001 From: fisx Date: Mon, 27 Sep 2021 22:32:25 +0200 Subject: [PATCH 57/72] Scim users get distorted between construct, post, get. (#1754) * More entropy in integration tests. * Remove bogus name. * Normalize scim data before responding to `POST /scim/v2/Users`. * Unit tests. * Smart constructors for RichInfoMapAndList, RichInfoAssocList. also: - no more Arbitrary instances for un-normalized types. - more coherent normalization. - fixes a couple of failing test cases. * The FIX!! * Not The REAL FIX!!! either * The third fix at least makes one test pass... * Don't brutally and point-lessly lower-case case-insensitive json. I don't remember why I did this, but I think the reason has evaporated. Now it seems quite silly. * Haddocks. --- changelog.d/5-internal/various-fixes-3 | 1 + libs/hscim/src/Web/Scim/AttrName.hs | 9 +- libs/hscim/src/Web/Scim/Schema/Common.hs | 16 +- libs/hscim/src/Web/Scim/Schema/PatchOp.hs | 16 +- libs/hscim/src/Web/Scim/Schema/Schema.hs | 20 + libs/hscim/src/Web/Scim/Schema/User.hs | 5 +- libs/hscim/src/Web/Scim/Server/Mock.hs | 5 +- libs/hscim/test/Test/Schema/UserSpec.hs | 5 +- libs/hscim/test/Test/Schema/Util.hs | 3 +- libs/wire-api/package.yaml | 4 +- libs/wire-api/src/Wire/API/User/RichInfo.hs | 121 +- libs/wire-api/src/Wire/API/User/Scim.hs | 37 +- .../testObject_RichInfoMapAndList_user_1.json | 44 +- ...testObject_RichInfoMapAndList_user_10.json | 17 +- ...testObject_RichInfoMapAndList_user_11.json | 41 +- ...testObject_RichInfoMapAndList_user_12.json | 23 +- ...testObject_RichInfoMapAndList_user_13.json | 37 +- ...testObject_RichInfoMapAndList_user_14.json | 24 +- ...testObject_RichInfoMapAndList_user_15.json | 39 +- ...testObject_RichInfoMapAndList_user_16.json | 43 +- ...testObject_RichInfoMapAndList_user_17.json | 87 +- ...testObject_RichInfoMapAndList_user_18.json | 18 +- ...testObject_RichInfoMapAndList_user_19.json | 5 +- .../testObject_RichInfoMapAndList_user_2.json | 36 +- ...testObject_RichInfoMapAndList_user_20.json | 20 +- .../testObject_RichInfoMapAndList_user_3.json | 35 +- .../testObject_RichInfoMapAndList_user_4.json | 16 +- .../testObject_RichInfoMapAndList_user_5.json | 13 +- .../testObject_RichInfoMapAndList_user_6.json | 18 +- .../testObject_RichInfoMapAndList_user_7.json | 42 +- .../testObject_RichInfoMapAndList_user_8.json | 16 +- .../testObject_RichInfoMapAndList_user_9.json | 29 +- .../Generated/RichInfoAssocList_user.hs | 2446 ++++++++------- .../Generated/RichInfoMapAndList_user.hs | 2630 +++++++---------- .../API/Golden/Generated/RichInfo_user.hs | 2062 +++++++------ .../test/unit/Test/Wire/API/User/RichInfo.hs | 51 +- libs/wire-api/wire-api.cabal | 4 +- services/brig/src/Brig/API/Internal.hs | 8 +- services/brig/src/Brig/API/Public.hs | 2 +- .../test/integration/API/User/RichInfo.hs | 36 +- services/spar/src/Spar/Scim/Types.hs | 19 + services/spar/src/Spar/Scim/User.hs | 3 +- .../Test/Spar/Scim/UserSpec.hs | 14 +- services/spar/test-integration/Util/Scim.hs | 2 +- services/spar/test/Test/Spar/ScimSpec.hs | 58 +- 45 files changed, 3765 insertions(+), 4415 deletions(-) create mode 100644 changelog.d/5-internal/various-fixes-3 diff --git a/changelog.d/5-internal/various-fixes-3 b/changelog.d/5-internal/various-fixes-3 new file mode 100644 index 00000000000..ce09daa6efb --- /dev/null +++ b/changelog.d/5-internal/various-fixes-3 @@ -0,0 +1 @@ +Handle upper/lower case more consistently in scim and rich-info data. \ No newline at end of file diff --git a/libs/hscim/src/Web/Scim/AttrName.hs b/libs/hscim/src/Web/Scim/AttrName.hs index 9950cad9771..4c9a48b0ef2 100644 --- a/libs/hscim/src/Web/Scim/AttrName.hs +++ b/libs/hscim/src/Web/Scim/AttrName.hs @@ -22,9 +22,10 @@ module Web.Scim.AttrName where import Data.Aeson.Types (FromJSONKey, ToJSONKey) import Data.Attoparsec.ByteString.Char8 +import qualified Data.CaseInsensitive as CI import Data.Hashable import Data.String (IsString, fromString) -import Data.Text (Text, cons, toCaseFold) +import Data.Text (Text, cons) import Data.Text.Encoding (decodeUtf8) import Prelude hiding (takeWhile) @@ -38,13 +39,13 @@ newtype AttrName deriving (Show, FromJSONKey, ToJSONKey) instance Eq AttrName where - AttrName a == AttrName b = toCaseFold a == toCaseFold b + AttrName a == AttrName b = CI.foldCase a == CI.foldCase b instance Ord AttrName where - compare (AttrName a) (AttrName b) = compare (toCaseFold a) (toCaseFold b) + compare (AttrName a) (AttrName b) = compare (CI.foldCase a) (CI.foldCase b) instance Hashable AttrName where - hashWithSalt x (AttrName a) = hashWithSalt x (toCaseFold a) + hashWithSalt x (AttrName a) = hashWithSalt x (CI.foldCase a) instance IsString AttrName where fromString = AttrName . fromString diff --git a/libs/hscim/src/Web/Scim/Schema/Common.hs b/libs/hscim/src/Web/Scim/Schema/Common.hs index 80f25a4d30f..cca4131239e 100644 --- a/libs/hscim/src/Web/Scim/Schema/Common.hs +++ b/libs/hscim/src/Web/Scim/Schema/Common.hs @@ -22,11 +22,10 @@ module Web.Scim.Schema.Common where import Data.Aeson 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.Conversions (cs) -import Data.Text hiding (dropWhile) +import Data.Text (pack, unpack) import qualified Network.URI as Network data WithId id a = WithId @@ -83,17 +82,24 @@ serializeOptions = parseOptions :: Options parseOptions = defaultOptions - { fieldLabelModifier = toKeyword . fmap Char.toLower + { fieldLabelModifier = toKeyword . CI.foldCase } -- | 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. -- +-- NB: be careful to not mix 'Data.Text.{toLower,toCaseFold', 'Data.Char.toLower', and +-- 'Data.CaseInsensitive.foldCase'. They're not all the same thing! +-- https://github.com/basvandijk/case-insensitive/issues/31 +-- -- (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) + lowerPair (key, val) = (CI.foldCase key, jsonLower val) jsonLower (Array x) = Array (jsonLower <$> x) -jsonLower x = x +jsonLower same@(String _) = same -- (only object attributes, not all texts in the value side of objects!) +jsonLower same@(Number _) = same +jsonLower same@(Bool _) = same +jsonLower same@Null = same diff --git a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs b/libs/hscim/src/Web/Scim/Schema/PatchOp.hs index 66ddf7c2bb0..4353726910c 100644 --- a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs +++ b/libs/hscim/src/Web/Scim/Schema/PatchOp.hs @@ -23,9 +23,9 @@ import Data.Aeson.Types (FromJSON (parseJSON), ToJSON (toJSON), Value (String), import qualified Data.Aeson.Types as Aeson import Data.Attoparsec.ByteString (Parser, endOfInput, parseOnly) import Data.Bifunctor (first) -import qualified Data.HashMap.Strict as HM +import qualified Data.CaseInsensitive as CI import qualified Data.HashMap.Strict as HashMap -import Data.Text (Text, toCaseFold, toLower) +import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) import Web.Scim.AttrName (AttrName (..)) import Web.Scim.Filter (AttrPath (..), SubAttr (..), ValuePath (..), pAttrPath, pSubAttr, pValuePath, rAttrPath, rSubAttr, rValuePath) @@ -85,7 +85,7 @@ rPath (IntoValuePath valuePath subAttr) = rValuePath valuePath <> maybe "" rSubA -- can't control what errors FromJSON throws :/ instance UserTypes tag => FromJSON (PatchOp tag) where parseJSON = withObject "PatchOp" $ \v -> do - let o = HashMap.fromList . map (first toLower) . HashMap.toList $ v + let o = HashMap.fromList . map (first CI.foldCase) . HashMap.toList $ v schemas' :: [Schema] <- o .: "schemas" guard $ PatchOp20 `elem` schemas' operations <- Aeson.explicitParseField (Aeson.listParser $ operationFromJSON (supportedSchemas @tag)) o "operations" @@ -100,7 +100,7 @@ instance ToJSON (PatchOp tag) where operationFromJSON :: [Schema] -> Value -> Aeson.Parser Operation operationFromJSON schemas' = withObject "Operation" $ \v -> do - let o = HashMap.fromList . map (first toLower) . HashMap.toList $ v + let o = HashMap.fromList . map (first CI.foldCase) . HashMap.toList $ v Operation <$> (o .: "op") <*> (Aeson.explicitParseFieldMaybe (pathFromJSON schemas') o "path") @@ -120,7 +120,7 @@ instance ToJSON Operation where instance FromJSON Op where parseJSON = withText "Op" $ \op' -> - case toCaseFold op' of + case CI.foldCase op' of "add" -> pure Add "replace" -> pure Replace "remove" -> pure Remove @@ -139,9 +139,9 @@ instance ToJSON Path where class Patchable a where applyOperation :: (MonadError ScimError m) => a -> Operation -> m a -instance Patchable (HM.HashMap Text Text) where +instance Patchable (HashMap.HashMap Text Text) where applyOperation theMap (Operation Remove (Just (NormalPath (AttrPath _schema (AttrName attrName) _subAttr))) _) = - pure $ HM.delete attrName theMap + pure $ HashMap.delete attrName theMap applyOperation theMap (Operation _AddOrReplace (Just (NormalPath (AttrPath _schema (AttrName attrName) _subAttr))) (Just (String val))) = - pure $ HM.insert attrName val theMap + pure $ HashMap.insert attrName val theMap applyOperation _ _ = throwError $ badRequest InvalidValue $ Just "Unsupported operation" diff --git a/libs/hscim/src/Web/Scim/Schema/Schema.hs b/libs/hscim/src/Web/Scim/Schema/Schema.hs index 2e5fce8ed0a..e875faf4a76 100644 --- a/libs/hscim/src/Web/Scim/Schema/Schema.hs +++ b/libs/hscim/src/Web/Scim/Schema/Schema.hs @@ -41,6 +41,26 @@ data Schema | CustomSchema Text deriving (Show, Eq) +-- | 'Schema' is *almost* a straight-forward enum type, except for 'CustomSchema'. +-- Enumerations are nice because they let you write quickcheck generators as @elements +-- [minBound..]@. 'fakeEnumSchema' is a work-around. +fakeEnumSchema :: [Schema] +fakeEnumSchema = + [ User20, + ServiceProviderConfig20, + Group20, + Schema20, + ResourceType20, + ListResponse20, + Error20, + PatchOp20, + CustomSchema "", + CustomSchema "asdf", + CustomSchema "123", + CustomSchema "aos8wejv09837", + CustomSchema "aos8wejv09837wfeu09wuee0976t0213!!'#@" + ] + instance FromJSON Schema where parseJSON = withText "schema" $ \t -> pure (fromSchemaUri t) diff --git a/libs/hscim/src/Web/Scim/Schema/User.hs b/libs/hscim/src/Web/Scim/Schema/User.hs index 09ee76d016d..659cff77c81 100644 --- a/libs/hscim/src/Web/Scim/Schema/User.hs +++ b/libs/hscim/src/Web/Scim/Schema/User.hs @@ -74,9 +74,10 @@ where import Control.Monad.Except import Data.Aeson +import qualified Data.CaseInsensitive as CI import qualified Data.HashMap.Strict as HM import Data.List ((\\)) -import Data.Text (Text, pack, toLower) +import Data.Text (Text, pack) import qualified Data.Text as Text import GHC.Generics (Generic) import Lens.Micro @@ -180,7 +181,7 @@ empty schemas userName extra = instance FromJSON (UserExtra tag) => FromJSON (User tag) where parseJSON = withObject "User" $ \obj -> do -- Lowercase all fields - let o = HM.fromList . map (over _1 toLower) . HM.toList $ obj + let o = HM.fromList . map (over _1 CI.foldCase) . HM.toList $ obj schemas <- o .:? "schemas" <&> \case Nothing -> [User20] diff --git a/libs/hscim/src/Web/Scim/Server/Mock.hs b/libs/hscim/src/Web/Scim/Server/Mock.hs index 5a8d89dedcf..6d46030cacc 100644 --- a/libs/hscim/src/Web/Scim/Server/Mock.hs +++ b/libs/hscim/src/Web/Scim/Server/Mock.hs @@ -27,8 +27,9 @@ import Control.Monad.Morph import Control.Monad.Reader import Control.Monad.STM (STM, atomically) import Data.Aeson +import qualified Data.CaseInsensitive as CI import Data.Hashable -import Data.Text (Text, pack, toCaseFold) +import Data.Text (Text, pack) import Data.Time.Calendar import Data.Time.Clock import GHC.Exts (sortWith) @@ -244,7 +245,7 @@ filterUser (FilterAttrCompare (AttrPath schema' attrib subAttr) op val) user case (subAttr, val) of (Nothing, (ValString str)) | attrib == "userName" -> - Right (compareStr op (toCaseFold (userName user)) (toCaseFold str)) + Right (compareStr op (CI.foldCase (userName user)) (CI.foldCase str)) (Nothing, _) | attrib == "userName" -> Left "usernames can only be compared with strings" diff --git a/libs/hscim/test/Test/Schema/UserSpec.hs b/libs/hscim/test/Test/Schema/UserSpec.hs index d44075fcc68..6c8fd374bfd 100644 --- a/libs/hscim/test/Test/Schema/UserSpec.hs +++ b/libs/hscim/test/Test/Schema/UserSpec.hs @@ -25,10 +25,11 @@ module Test.Schema.UserSpec where import Data.Aeson +import qualified Data.CaseInsensitive as CI import Data.Either (isLeft, isRight) import Data.Foldable (for_) import qualified Data.HashMap.Strict as HM -import Data.Text (Text, toLower) +import Data.Text (Text) import HaskellWorks.Hspec.Hedgehog (require) import Hedgehog import qualified Hedgehog.Gen as Gen @@ -443,7 +444,7 @@ instance FromJSON UserExtraTest where Nothing -> pure UserExtraEmpty Just (lowercase -> o2) -> UserExtraObject <$> o2 .: "test" where - lowercase = HM.fromList . map (over _1 toLower) . HM.toList + lowercase = HM.fromList . map (over _1 CI.foldCase) . HM.toList instance ToJSON UserExtraTest where toJSON UserExtraEmpty = object [] diff --git a/libs/hscim/test/Test/Schema/Util.hs b/libs/hscim/test/Test/Schema/Util.hs index b88eb82ffcb..eb321b2dbb7 100644 --- a/libs/hscim/test/Test/Schema/Util.hs +++ b/libs/hscim/test/Test/Schema/Util.hs @@ -26,7 +26,7 @@ where import Data.Aeson import qualified Data.HashMap.Strict as HM -import Data.Text (Text, toLower, toUpper) +import Data.Text (Text, toCaseFold, toLower, toUpper) import Hedgehog import Hedgehog.Gen as Gen import Network.URI.Static @@ -43,6 +43,7 @@ mk_prop_caseInsensitive gen = property $ do val <- forAll gen fromJSON (withCasing toUpper $ toJSON val) === Success val fromJSON (withCasing toLower $ toJSON val) === Success val + fromJSON (withCasing toCaseFold $ toJSON val) === Success val where withCasing :: (Text -> Text) -> Value -> Value withCasing toCasing = \case diff --git a/libs/wire-api/package.yaml b/libs/wire-api/package.yaml index d32a04a4e64..3dae32a4b82 100644 --- a/libs/wire-api/package.yaml +++ b/libs/wire-api/package.yaml @@ -13,6 +13,8 @@ dependencies: - containers >=0.5 - imports - types-common >=0.16 +- case-insensitive +- hscim library: source-dirs: src dependencies: @@ -22,7 +24,6 @@ library: - binary - bytestring >=0.9 - bytestring-conversion >=0.2 - - case-insensitive - cassandra-util - cassava >= 0.5 - cereal @@ -40,7 +41,6 @@ library: - ghc-prim - hashable - hostname-validate - - hscim - http-api-data - http-media - http-types diff --git a/libs/wire-api/src/Wire/API/User/RichInfo.hs b/libs/wire-api/src/Wire/API/User/RichInfo.hs index a3c176771b9..65ca1e1d0bd 100644 --- a/libs/wire-api/src/Wire/API/User/RichInfo.hs +++ b/libs/wire-api/src/Wire/API/User/RichInfo.hs @@ -22,18 +22,20 @@ module Wire.API.User.RichInfo ( -- * RichInfo RichInfo (..), - toRichInfoAssocList, - fromRichInfoAssocList, richInfoSize, richInfoMapURN, -- * RichInfoMapAndList - RichInfoMapAndList (..), + RichInfoMapAndList (richInfoMap, richInfoAssocList), + mkRichInfoMapAndList, + toRichInfoAssocList, + fromRichInfoAssocList, -- * RichInfoAssocList - RichInfoAssocList (..), - emptyRichInfoAssocList, + RichInfoAssocList (unRichInfoAssocList), + mkRichInfoAssocList, normalizeRichInfoAssocList, + richInfoAssocListFromObject, richInfoAssocListURN, -- * RichField @@ -106,6 +108,46 @@ data RichInfoMapAndList = RichInfoMapAndList } deriving stock (Eq, Show, Generic) +-- | Uses 'normalizeRichInfoMapAndList'. +mkRichInfoMapAndList :: [RichField] -> RichInfoMapAndList +mkRichInfoMapAndList = normalizeRichInfoMapAndList . RichInfoMapAndList mempty + +-- | Remove fields with @""@ values; make both map and assoc list contain the union of their +-- data; handle case insensitivity. See also: 'normalizeRichInfo'. +normalizeRichInfoMapAndList :: RichInfoMapAndList -> RichInfoMapAndList +normalizeRichInfoMapAndList = fromRichInfoAssocList . toRichInfoAssocList + +-- | Lossy transformation of map-and-list representation into list-only representation. The +-- order of the list part of 'RichInfo' is not changed in the output; keys in the map that do +-- not appear in the list are appended in alpha order. +-- +-- Uses 'mkRichInfoAssocList'; used as one half of 'normalizeRichInfoAssocList'. +toRichInfoAssocList :: RichInfoMapAndList -> RichInfoAssocList +toRichInfoAssocList (RichInfoMapAndList mp al) = + mkRichInfoAssocList $ foldl' go al (Map.toAscList mp) + where + go :: [RichField] -> (CI Text, Text) -> [RichField] + go rfs (key, val) = + case break (\(RichField rfKey _) -> rfKey == key) rfs of + (xs, []) -> xs <> [RichField key val] + (xs, (_ : ys)) -> xs <> [RichField key val] <> ys + +-- | This is called by spar to recover the more type that also contains a map. Since we don't +-- know where the data came from when it was posted or where the SCIM peer expects the data to +-- be (map or assoc list), we copy the assoc list into the map, and provide all attributes +-- twice. +-- +-- Used as the other half of 'normalizeRichInfoAssocList' (next to 'toRichInfoAssocList'. +fromRichInfoAssocList :: RichInfoAssocList -> RichInfoMapAndList +fromRichInfoAssocList (RichInfoAssocList riList) = + RichInfoMapAndList + { richInfoMap = riMap, + richInfoAssocList = riList' + } + where + riList' = normalizeRichInfoAssocListInt riList + riMap = Map.fromList $ (\(RichField k v) -> (k, v)) <$> riList' + -- | TODO: this is model is wrong, it says nothing about the map part. modelRichInfo :: Doc.Model modelRichInfo = Doc.defineModel "RichInfo" $ do @@ -146,6 +188,7 @@ instance FromJSON RichInfoMapAndList where Nothing -> pure mempty Just innerObj -> do Map.mapKeys CI.mk <$> parseJSON innerObj + extractAssocList :: HashMap (CI Text) Value -> Aeson.Parser [RichField] extractAssocList o = case HM.lookup (CI.mk richInfoAssocListURN) o of @@ -157,42 +200,19 @@ instance FromJSON RichInfoMapAndList where fields <- richInfoAssocListFromObject richinfoObj pure fields Array fields -> parseJSON (Array fields) - v -> Aeson.typeMismatch "Object" v + v -> Aeson.typeMismatch "Object or Array" v Just v -> Aeson.typeMismatch "Object" v + hmMapKeys :: (Eq k2, Hashable k2) => (k1 -> k2) -> HashMap k1 v -> HashMap k2 v hmMapKeys f = HashMap.fromList . (map (\(k, v) -> (f k, v))) . HashMap.toList + lookupOrFail :: (MonadFail m, Show k, Eq k, Hashable k) => k -> HashMap k v -> m v lookupOrFail key theMap = case HM.lookup key theMap of Nothing -> fail $ "key '" ++ show key ++ "' not found" Just v -> return v instance Arbitrary RichInfoMapAndList where - arbitrary = do - RichInfoAssocList richInfoAssocList <- arbitrary - richInfoMap <- arbitrary - pure RichInfoMapAndList {..} - --- | Lossy transformation of map-and-list representation into list-only representation. The --- order of the list part of 'RichInfo' is not changed in the output; keys in the map that do --- not appear in the list are appended in alpha order. -toRichInfoAssocList :: RichInfoMapAndList -> RichInfoAssocList -toRichInfoAssocList (RichInfoMapAndList mp al) = - RichInfoAssocList $ foldl' go al (Map.toAscList mp) - where - go :: [RichField] -> (CI Text, Text) -> [RichField] - go rfs (key, val) = - case break (\(RichField rfKey _) -> rfKey == key) rfs of - (xs, []) -> xs <> [RichField key val] - (xs, (_ : ys)) -> xs <> [RichField key val] <> ys - --- | This is called by spar to recover the more type that also contains a map. Since we don't --- know where the data came from when it was posted or where the SCIM peer expects the data to --- be (map or assoc list), we copy the assoc list into the map, and provide all attributes --- twice. -fromRichInfoAssocList :: RichInfoAssocList -> RichInfoMapAndList -fromRichInfoAssocList (RichInfoAssocList riList) = RichInfoMapAndList riMap riList - where - riMap = Map.fromList $ map (\(RichField key value) -> (key, value)) riList + arbitrary = mkRichInfoMapAndList <$> arbitrary -- | Uniform Resource Names used for serialization of 'RichInfo'. richInfoMapURN, richInfoAssocListURN :: Text @@ -205,6 +225,19 @@ richInfoAssocListURN = "urn:wire:scim:schemas:profile:1.0" newtype RichInfoAssocList = RichInfoAssocList {unRichInfoAssocList :: [RichField]} deriving stock (Eq, Show, Generic) +-- | Uses 'normalizeRichInfoAssocList'. +mkRichInfoAssocList :: [RichField] -> RichInfoAssocList +mkRichInfoAssocList = RichInfoAssocList . normalizeRichInfoAssocListInt + +normalizeRichInfoAssocList :: RichInfoAssocList -> RichInfoAssocList +normalizeRichInfoAssocList = RichInfoAssocList . normalizeRichInfoAssocListInt . unRichInfoAssocList + +normalizeRichInfoAssocListInt :: [RichField] -> [RichField] +normalizeRichInfoAssocListInt = nubOrdOn nubber . filter ((/= mempty) . richFieldValue) + where + -- see also: https://github.com/basvandijk/case-insensitive/issues/31 + nubber = Text.toLower . Text.toCaseFold . CI.foldedCase . richFieldType + instance Monoid RichInfoAssocList where mempty = RichInfoAssocList mempty @@ -220,7 +253,7 @@ instance ToJSON RichInfoAssocList where instance FromJSON RichInfoAssocList where parseJSON v = - RichInfoAssocList <$> withObject "RichInfoAssocList" richInfoAssocListFromObject v + mkRichInfoAssocList <$> withObject "RichInfoAssocList" richInfoAssocListFromObject v richInfoAssocListFromObject :: Object -> Aeson.Parser [RichField] richInfoAssocListFromObject richinfoObj = do @@ -237,10 +270,8 @@ richInfoAssocListFromObject richinfoObj = do ds -> fail ("duplicate fields: " <> show (map head ds)) instance Arbitrary RichInfoAssocList where - arbitrary = RichInfoAssocList <$> nubOrdOn richFieldType <$> arbitrary - -emptyRichInfoAssocList :: RichInfoAssocList -emptyRichInfoAssocList = RichInfoAssocList [] + arbitrary = mkRichInfoAssocList <$> arbitrary + shrink (RichInfoAssocList things) = mkRichInfoAssocList <$> QC.shrink things -------------------------------------------------------------------------------- -- RichField @@ -280,7 +311,8 @@ instance Arbitrary RichField where arbitrary = RichField <$> (CI.mk . cs . QC.getPrintableString <$> arbitrary) - <*> (cs . QC.getPrintableString <$> arbitrary `QC.suchThat` (/= QC.PrintableString "")) -- This is required because FromJSON calls @normalizeRichInfo*@ and roundtrip tests fail + <*> (cs . QC.getPrintableString <$> arbitrary) + shrink (RichField k v) = RichField <$> QC.shrink k <*> QC.shrink v -------------------------------------------------------------------------------- -- convenience functions @@ -292,16 +324,3 @@ instance Arbitrary RichField where -- if our JSON encoding changes, existing payloads might become unacceptable. richInfoSize :: RichInfo -> Int richInfoSize (RichInfo (RichInfoAssocList fields)) = sum [Text.length (CI.original t) + Text.length v | RichField t v <- fields] - --- | Remove fields with @""@ values. See also: 'canonicalizeRichInfo'. -normalizeRichInfoMapAndList :: RichInfoMapAndList -> RichInfoMapAndList -normalizeRichInfoMapAndList (RichInfoMapAndList rifMap assocList) = - RichInfoMapAndList - { richInfoAssocList = filter (not . Text.null . richFieldValue) assocList, - richInfoMap = rifMap - } - --- | Remove fields with @""@ values. -normalizeRichInfoAssocList :: RichInfoAssocList -> RichInfoAssocList -normalizeRichInfoAssocList (RichInfoAssocList l) = - RichInfoAssocList $ filter (not . Text.null . richFieldValue) l diff --git a/libs/wire-api/src/Wire/API/User/Scim.hs b/libs/wire-api/src/Wire/API/User/Scim.hs index b861751add5..7ae904573a2 100644 --- a/libs/wire-api/src/Wire/API/User/Scim.hs +++ b/libs/wire-api/src/Wire/API/User/Scim.hs @@ -68,17 +68,20 @@ import Imports import qualified SAML2.WebSSO as SAML import SAML2.WebSSO.Test.Arbitrary () import Servant.API (FromHttpApiData (..), ToHttpApiData (..)) +import qualified Test.QuickCheck as QC import Web.HttpApiData (parseHeaderWithPrefix) import Web.Scim.AttrName (AttrName (..)) import qualified Web.Scim.Class.Auth as Scim.Auth import qualified Web.Scim.Class.Group as Scim.Group import qualified Web.Scim.Class.User as Scim.User import Web.Scim.Filter (AttrPath (..)) +import qualified Web.Scim.Schema.Common as Scim import qualified Web.Scim.Schema.Error as Scim import Web.Scim.Schema.PatchOp (Operation (..), Path (NormalPath)) import qualified Web.Scim.Schema.PatchOp as Scim import Web.Scim.Schema.Schema (Schema (CustomSchema)) import qualified Web.Scim.Schema.Schema as Scim +import qualified Web.Scim.Schema.User as Scim import qualified Web.Scim.Schema.User as Scim.User import Wire.API.User.Identity (Email) import Wire.API.User.Profile as BT @@ -238,11 +241,41 @@ instance A.FromJSON ScimUserExtra where instance A.ToJSON ScimUserExtra where toJSON (ScimUserExtra rif) = A.toJSON rif +instance QC.Arbitrary ScimUserExtra where + arbitrary = ScimUserExtra <$> QC.arbitrary + +instance QC.Arbitrary (Scim.User SparTag) where + arbitrary = + addFields =<< (Scim.empty <$> genSchemas <*> genUserName <*> genExtra) + where + addFields :: Scim.User.User tag -> QC.Gen (Scim.User.User tag) + addFields usr = do + gexternalId <- cs . QC.getPrintableString <$$> QC.arbitrary + gdisplayName <- cs . QC.getPrintableString <$$> QC.arbitrary + gactive <- Just . Scim.ScimBool <$> QC.arbitrary -- (`Nothing` maps on `Just True` and was in the way of a unit test.) + gemails <- catMaybes <$> (A.decode <$$> QC.listOf (QC.elements ["a@b.c", "x@y,z", "roland@st.uv"])) + pure + usr + { Scim.User.externalId = gexternalId, + Scim.User.displayName = gdisplayName, + Scim.User.active = gactive, + Scim.User.emails = gemails + } + + genSchemas :: QC.Gen [Scim.Schema] + genSchemas = QC.listOf1 $ QC.elements Scim.fakeEnumSchema + + genUserName :: QC.Gen Text + genUserName = cs . QC.getPrintableString <$> QC.arbitrary + + genExtra :: QC.Gen ScimUserExtra + genExtra = QC.arbitrary + instance Scim.Patchable ScimUserExtra where applyOperation (ScimUserExtra (RI.RichInfo rinfRaw)) (Operation o (Just (NormalPath (AttrPath (Just (CustomSchema sch)) (AttrName (CI.mk -> ciAttrName)) Nothing))) val) | sch == RI.richInfoMapURN = let rinf = RI.richInfoMap $ RI.fromRichInfoAssocList rinfRaw - unrinf = ScimUserExtra . RI.RichInfo . RI.toRichInfoAssocList . (`RI.RichInfoMapAndList` mempty) + unrinf = ScimUserExtra . RI.RichInfo . RI.toRichInfoAssocList . RI.mkRichInfoMapAndList . fmap (uncurry RI.RichField) . Map.assocs in unrinf <$> case o of Scim.Remove -> pure $ Map.delete ciAttrName rinf @@ -253,7 +286,7 @@ instance Scim.Patchable ScimUserExtra where _ -> throwError $ Scim.badRequest Scim.InvalidValue $ Just "rich info values can only be text" | sch == RI.richInfoAssocListURN = let rinf = RI.richInfoAssocList $ RI.fromRichInfoAssocList rinfRaw - unrinf = ScimUserExtra . RI.RichInfo . RI.toRichInfoAssocList . (mempty `RI.RichInfoMapAndList`) + unrinf = ScimUserExtra . RI.RichInfo . RI.toRichInfoAssocList . RI.mkRichInfoMapAndList matchesAttrName (RI.RichField k _) = k == ciAttrName in unrinf <$> case o of Scim.Remove -> diff --git a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_1.json b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_1.json index 79d04b67138..b779c0cacde 100644 --- a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_1.json +++ b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_1.json @@ -1,22 +1,32 @@ { "urn:ietf:params:scim:schemas:extension:wire:1.0:User": { - "\r\u0004-󺴐𠙅g좾𫍰(d|󹇙[\u0014": "", - "\u0011f澆􇙪qj𬲘\t􁛫C\u0012V忇ZnY": "\u0014|􄩡g\"]#S𗐏\u0012\u0016/[\u000fH츚𝘡󺆳K+𫃴S𡱡N􄿻", - "\u0014𤉶<8g\u0006": "\u0007󻝎􆞦𮮏P'[􇝓'\u0016>\\󷠘\u0004", - "\u0019)𢭛R􌸑@_z,l": "'\u000cS?\u0010k'􈪪a />|Fk\u000e􇜣x󰈵󼁹K􎕍猫kp闇", - "\u001c\u001cPXw致&\u0015歳Kr얌7": "(e=z\"𫨃pLmg󺹛}2j𨕧OA󴕝_q\u0011󶓠", - "\"{^\u0017\u0012\u0018>𪢛\u0000섩w\u0013e4\u0002\u000f\\`\nJ\u0005[m㢕vd": "\u001fW[˸A+h}󶽺zQ쨗🔧\u0003", - ")\u0004dQ󰤰􃦞􀌼􊍣6_𨶚.|𫆋_": "I", - "4 X": "\u0017W󵥏m󷅭\u001cXA𭑫N`󻍂B󵎿", - "Fl𩣣\u000f*uBgcwKo\u0008\u0015𬼒\u0001𭱔\r%𮂅4~'\u0000ilE󹩀": "\u0003\u0006\u001e*􀷕󴷥8󾁍_\u001d􅊒ឲH􋡒Jmw\u001a,A", - "P.\u0006墭=輟A𩏤|c": "Q󰌰𨛟h􉪙}~\u0007?:Xq2q3Ց", - "XN\u001e\u0006<(4𗯔k1ON󳿩𭥥]\u0002𡗛𦙐d\u001aᾞ": "n󳪵𞺳0y{𭼓zH\n\u0011Cs\u0005", - "k7􏫠e)[*󺕫𩚻\u0018": "\u0003\u000cZS\u0000\u0018 報^", - "tڵ󷾎U𮖇/o$\u000cc": "\u00071㊎􁋔H]#󰻜𡇥\u0002*LYqs[", - "𗢲e": "Oࡁp", - "𦓔㈨'5q<𫡈": "@􎉤M쑝m\\𮐺a1B༮[S#=,.|S0\u0000j\r%", - "󹾣\u0007S!𥫶0:": "(]􀺚sJ\u0011󽕞􂦌C𮞒9\u000e􎛑\\\u0004Wu󻏦J᪓􇰴x\u000c.", - "􌷷䱅\u001b_􈚼5\u001c": "􏸻\t%b𬆘\u001c≙B#\u001e𮛗󻊆\u0005" + "\u0000m\u0016:I􎵻62𡟆pV16\u0003󴆍6䴓k": "6􀓪?h\u0007􄔼𗺉d􌾿", + "\u0000p􍠄\u0017}8#􍩐i)\u000e7J􋌮E^~􉕅*h>􂼦\r+l2": "HV\u0013M\u0006\u0016Z\"󹇔\nFs\u0011-\n;", + "\u0005[\u001cb󸾾䛵\u0013웶<􆍼\u0005f*[\u0005f𠗷􁗕w𫬰N\u0008h ⊖": "圭𤽕l&0\u00024󼮒r-E\u0006󷈽", + "\u0010󺗮A\u001e\u0014nUXi<📃S@\\0\u0010", + "\"L+KR󱴬og\u001fo􊿚+䇀o\tw󶊃0ﲉ\u0016\u0003y󴒜": "67𐭪#h󱊓P󾊭J", + ".": "8SOe", + "1\u0014\u0005󽅶㿜\u0005\u0008\u001f\u001c󵡤ᩓ": "󼴳\u0008`+|+eu嶭(Z𭚣D󻁶󷼙6Y\"U", + "YD\t󺦀N\u0014\u0004􂓺+v􏝁\u0003𗈰J􃪑>": "𧞬􆟅䭮𩵐唺󼈓\u001e(J\u0004>n곇\u0005몔v􁑾C󳿟D.P䭣𐭾󲂳HS@", + "\\𠡙lRJ": "]#\u0017b鹡𦒦R2\u0008𘇱kv=.g0\nF+-", + "a\u0010G\u0014\u001eEJ🨅im𢾺qZ\u0016/`>\u0010R󳐊": "\u001b󼥚U\u0019r\u00173m~Ἶ𨍖u[xV@i𐌚~$\u001b킻􎌋\u0001{`2B󻣦", + "󸩽i􄹺𪱪\u0010q\\O􈫯\u000f𢏽\u0012臊􉑞p\t": "𧙢\u0005" }, "urn:wire:scim:schemas:profile:1.0": { "richInfo": { diff --git a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_10.json b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_10.json index 910b5be343f..a605fb8113b 100644 --- a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_10.json +++ b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_10.json @@ -1,16 +1,11 @@ { "urn:ietf:params:scim:schemas:extension:wire:1.0:User": { - "\rw쵨f\u0010𗼙􉹸󾏓{4𡦝*𣮰𝦪H\u001f󲻷%\u0004H󲂏": "\u0011󹉓\u0002", - "\u0017D􆃅\u001a!𠂭􁽥󷒬z": "\"e曲q\t󾲶C𫲄욊qd$H\u0006n\u001a&s%5", - "\u0018􋢝+󱐮5䎐h\n󻴏@➙\u0001X\u001dH돖E": "0\u0000,@𝥕𑃞\u000fD}\u000c!MLXPZ5H􊈸Aa-𮧿L𥜿", - "&󴹭G$Dh􏄄;b\u0002-~𦲋W𪤯􌳇𡪌I\u0010i4􁳰": "A 𦽗<", - "Kt䑑\u0001oT󲟮x2)􇀊K\u0010𐔆r𩵔􃒔", - "Rsᐤs뽿A1𬽶}\u001e㺯rNA$󺝿\u000f": "0\u0004d98X\u00047", - "`;\u000f]籠󺈚!67:O_\u0002": "\u000bl惯\r\u001b󱪱6](􄣘Ps\u0005\u001dy𤏵\u000e􊁁\u0007дf\u0010巟w\\", - "l\u000c\u0008U\u001b\u0016+:󷬹\"􇭗%$lP𑂲\"\u0003츾\u0019\u000fz]": "d#\\\u0003v,􇙆􄲉D󱩮{\\🕓2sQO-J􊰽:󺁆:<􅌍\u001c\u0016>^", - "#N?􉠡䯩\u0003\u0003Z󿉃WPs\u001d(A": "|L2\u0014Iuf,?\u0007\u0014쩗S'\u0002󺋦bໃ", - "𠆶Vb𫵟y>\u0004􌯙\u0002􌒰nQY􋁲󳲛,XY􄢕󵪭": "" + "\u0008%\u0017󰂆e\u0013^\u0013B𦒦": "qa)\u0002l/󳝚\u0016\u0010𡝤+\u0002ztSih\u001e5e", + "\u0008N/󵦵:3􉟦%[􃋫BȄ{\no𐧕\u0019`%D(\"\u0019𩆣􃨢􄋬": "웑\u001b󽃍􇩅􊝤􁫩l\u0017": "J\u0019\u000b􀧓\u0018?\u000b\u0016H5Rcb𤦛", + "K􈇀􄻴w/𮪶d \u0019s酭\u0001w󷤵􃢣5Z讼m􂜸LQ}:r\u001d": "􁋭`oi", + "𘘔\n\u001dr\u001b,>{􍘫l#9*\u0007u\u0019􆡣\u0015": "H􍹭\u0010;󿀚`|;G\u00182LD💩l*", + "𧬂𗻹\u001d7\u0018'\u000b]U\u0004{rs0'": "'/𡙮󼉤LL\u001fv𝩠_W𒂊⾒e" }, "urn:wire:scim:schemas:profile:1.0": { "richInfo": { diff --git a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_11.json b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_11.json index 7d4c5f26c0a..62a32d9cd3b 100644 --- a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_11.json +++ b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_11.json @@ -1,28 +1,23 @@ { "urn:ietf:params:scim:schemas:extension:wire:1.0:User": { - "": "o!🚓AZn\u001c\u0007\"", - "\u0005󰛥y": "\u0004", - "\u0010\u000bw!FZa#j≈o𤦹􆧂\rL􋷃rQ\u00163\u000bᘽ𠗳1": "Qz)􂒞\u0000AAWZ\u0002H\u0003􋘴O-%󵷿\\", - " \u0012\u0013\n􈯅󰛞V쐡Sr.lH🥣\u0013D􌺨􄕗󴓻\no𤗽'yc3󳩴󹚫\u0017": "􃜂\u0004\u0010~\u000fCx\u0016k\u0013Q󾹲􃡅\rZr魦tX[", - "(#\u00120쯍R\r\u0010\u0011VJk\u0011\u000c:zTi": "\u0005󳛝/ﾽQ𛀇ﾾGp𗳣=~A\u0016󳇇w\u0012\u0008", - "7l𥹡!q": "!Wa9o𓂵^", - "7yF\u0011\u0000Oye𨥋\u0001\u0001": "G\u0002\u000b.\u0004;𣱇\u00025Q", - "8Z$\u0016뾮O𢚹󵯌dDV\u0007": "춴薈y\u000c=", - ":\u000fE\u001b\u0006\u0012t": "}\n\u0019󷡋", - ":#_𢿆x\u0015􊨨y쭴$N\u000e_\nO\r{]𖼦ꊧ􃏪_": "\u001a~溮t)\u000em󵁲𞴰1\u0017􊶨􃨔", - "GJ\u0007h\u001cjd\u00118", - "O\u0017'Vj':\u001b'\u000e\u0015ᣮ\u000e\u0018\nQ􎜡\u0002\u0019읬;Jx": "}\u0004!\u001e\u0017Myk􆛼𣫃`", - "VR:v;ZqL𬺂l\u001fn󲔃􃅢𧘝𐒝M𠘘": "\u001dhu崙l􎥤𠉨?1Ꝫ>\u0012D󽝤􊦆", - "`%􋐶d": "l|\u001b+l\u0016𣮛”􊗒\u0000\u001a\"$􎰼󳿽<\u0016Q7𥑭FHᕄ\"*", - "`k4^{\u0012再X􎡑N}%lI9P\u0001z)\u0011\u0012쀥$": "𡕙~", - "si𦱢\\Z96?\u0007F}\u0008𔗴\r=C郳꽡\u000bx_": "a\u001d𬖽", - "}\u0014􁎒I\u000eY󻱭": "ld\u000fx&󶆌ꗕ󰹖Mg(􄐼\u0007a", - "栊{쀼\u000b", - "𡗌 󺅔fN?`􏒑M8+\u0012Ai@\u0006h\u000c": "0\u0014vᗅ\u000cU󱼁WV󱾩c𗶢=\u000e\u0019%𤝵", - "􅞀_\u0018⓼\"9\u001a藤@\u0013|.\u000302!{8*7\u0019𦱬q~t𥃠": "@^Zb󺻘^K힎T0T~@x" + "\u0005sI~jB􅥁z󱫣\u0002\u000e󽷧\u0017q4M4􏾳\u0007]8\u0004Z􌘓j": "#쌔\\:zs\u00015K󿃶C\u0001=\"𣪻󿒅\u000f􅀜寅", + "\u0006𣊸,R\u0008\u0002(": "&42鱶\u0007SXkꙸ$GT󿣻6󼝐􄣄\rY=߁\u001d𪤥", + "\u0008􎡢7b𐌵Z(m7\u001e眺p]E^-m\u0004.\u001fq);𤜦y𡫝(\u001f": "\u0010\u0016+he\u001cx󳭴\"\u001d\u0012P5<\u001e匋䛗+", + "\u0017󻌹\u0018": "􍑑겱􏮊𪸒IhWi󷍦\u0010𮥵Y\u0005/\u00072w󱝖", + "\u0019\u0016": "󹗀Yq<&8\u0016b𝙕\u001fOi\u00011/8󸖬⣩\u001a\u0011:\u00003", + "\u0019Xr_svft\\i𘃈󵟰𮍺𡅟|l@c#q쮩p\\": "W#qᯟ􎁜净", + "=殟Y𠶓\u00142(=;\u0011V袽 𤴍󸳆𬎎Zp\r󷙂􁷹4F􄹖\u0014": "爵᧖", + ">\u000c8p𐘲𤪓󶀔rj𩪐LA\u0018q󳕉EG􊘶\u001fgF􉒍􆂙𗎣<􌴚\u0014㞏簋do:\nZ@*@K󶆕󿬡a/\u0008𮧒", + "?f|𦈔psj󵥑]y>􏛹󽘰-ᥦ": "|Wa_K􊝼𪋆", + "E&(#ZwW\u0001􂈳80\r&.N]H􏀑/$\"\u001f齗9\n\u001cAd": "2. n\u0014bHjg𔕝b", + "iJ>󺿄f𪵇\u001a녘\u0017\u0019G󲥑􁸝\"\u0005": "H󸖬g8\u001392|􅙯\u000b|)\u0004\u0010M\u00082k_": "T􆛭R6􂬯K\u0002`\u00048KCK𪈨􄠗", + "x_H3J􆓶\u0019g􌦃": "䞸Q>(>F,\u00065", + "zu㧇X\u0019󺮷m𨢷\"o\\G𨖿aJ\u001a": "gR\u0006[Il*𢪔,\u00137sb\u0017󿋯zSo6\t㔠𔒊z$\u001d\u0014ꙮ%\u0005", + "|\tKli\\𘇹𢺯金d\n!𥗞HO􋰃5\u001du\u0014+􉸁I\u001d|\u0005\u001f": "JU󴌴O\u0017\u0018𭋭𠣊^G]5󳏓", + "~𫢎pM1@2s⥓k^;􏼲-": "X𣼚e&3t", + "𤄀-K4[6^/𬖂tLt\u0016🢢󸾲𪽕伻󾗝'閌3􉅪󼱘": "\u0008𢔶&􂗧ww栾m䁢r㘤]󽩙M\u0018󻅐\u0001\u00073Z=􎍈𮩢B!\u001a􊷵f햲", + "𪾀􌰣H\u00162V󽮑&𖤼*\t_M%𮮥\u0018;􆏌S\u00164\u0002^\u001fk􉱛,!98": "\u0000`r\u0010Y􍋻󼣓4𨦖@􈷹1zCYPqi󵩌\u000fp󳅎󾬾\u0001􏪯~" }, "urn:wire:scim:schemas:profile:1.0": { "richInfo": { diff --git a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_12.json b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_12.json index dd2569daa7a..c8a9429bcf4 100644 --- a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_12.json +++ b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_12.json @@ -1,21 +1,12 @@ { "urn:ietf:params:scim:schemas:extension:wire:1.0:User": { - "": "􈧭;)XGD\u0004/Qr$Yg\u0001A+d_\u000f+\u001aI,%{\u0003<'㰋;", - "\r\u0001U\u0005\u0004󿅳\u0017\u001f~\u0016C𤃇!8\u000b戸󱧻\u001cN@铝S8{:ﴸe": "U;rKHG+9", - "\u0019\u0007`<*?\u001d#􊥻/5\u0013춓V\u0000\nBi\u001f\u001f햟\u000b𫯓HPᛁ󽭀זּ\u00010": "f7]\u0012\u0015V\u000eHTꥻ$P", - "\u001e𥫼DC\u001cD𥤙I)6ik": "፮PA멕r\u0003􈢕2U\t q𩣜(|ᇅfS\u0013A", - "7V\u0017Z)󳐍": "_H\u0015cꁖG2W9뽌+*", - "9*󵁮}~\u0019􌒀,^+Nrw'\u0004e\u001c`𓀊": "󴽭𬵥J𮏏􏜻󵗥𢋇_𧻉pGuO7<󲌢I\u001c", - "I\u000c\u001f\t𝝀k]􅆋Ml*􈥭󱛽\u0007,lt}": "^[󸁆\u0000[g~U\u0008y\u001aX\u001dW\u0007􃆍\\_\u0017pK𝂽", - "qv'Ip\u0008 𡴺}𤥊mU𭀤": "O󶵺D1𩬏h\u0010\u0001㾥溫\u0008=!\u0005\u0001𫧅!Fꚷ", - "vy\u0003\u0015\"𮭎%g𬁬􍗎􎡢i7": "H*o㶇y3!r'w㕥%Y0\u000bUO믽g", - "淋/\u000b/\u000e]𬯐,\"𨓼􉚞.y緇g\t𨽣I\u0004_9􈓫\u000b󿁛/": "㋹㸕↓>d6􇅌;\u0013n\u0003", - "𩜄 󳬞nCx-t\u001e;": "T󱗱F\u0010󶜭'7rﻙ!HF㌈󱽉\u001b\tt𡜂𨪡$\u001d􁪷\u0016󵣼\u001b,󵶉󼇍", - "󳲮)r\u0010r": "\u00034M\u001f>\u0000`y4\u0012\u0004/MJ5𮓪T\u001d", - "󼘯𫾵x1(~W\u0014娌\u001b]m\u001d\u0013\u0015A\u0005Rm\u000e\u0005\u000fC\u000c𪩾:]\u0010\u000e": "􉓭󲨧(.Vi]􇓷VQ󾆑fi\u001ah@.\u001e\u00037ij\"U𬫟L󰄪", - "󽟹": "N\u0001D+ꯖY􏬰QY1M7𢬧\u0003𤅱W𣓄p|𩩥", - "\u0004s촻􇆾 \"u>\u0004󲯟2a\u0006+󵖬c\u001b": "􈴭\u001a", - ")j𓃴9$\u0001XxjZ𧥌70󲈊\u0004*@..󳽽": "\t\u000c􌱺j\u0004\u001d󿲭re\u001c\t o\u001bEx\u001a􀭽\u0005\u0004T靠@\u0008_L<\u0004": "B(H\u001bTU\u0019\u001b", - "JV|􎘣FR(k󸼂Kr󾵪췮􀳊#/냠#6W/\u0018pk}\u0004@􄹰n~": "SH5Ou_\r\u000682j", - "O\"l\\稊a0 .15\u0003": "v", - "P\u0019)\n/\u00001O": "m\u0005\u0019P\u0008^\u001dN󽱴us(\u000b}󺴺\u0011zd􅱱|\u00149❸va[@\u0019O", - "\\O^f#": "m\u001d􁮺PBv~Pc\u0005\u000fvg𨎝󰘉UP󶖞[", - "e󺔼D\u000c7\u001a\u0011x=W)0R?xAw[K\u0011\u00117j": "\u0015um\t𢜝pI|7\u0007[壏\u0004F's􉺢2󸖌\t󸪓Eu憎􉗿", - "k&": "7Uᶲ\n8CI2fjtH", - "~AE\u001b𒉞\u0012U\u00014\u000f𬌂󿽭": "\u000c\u0015􌎻𘍒I룾🆃\u0008󱁛Ly)[W$\u0006󷧌\u0002`\u0016󱴫I*" + "": "TBA6)r<", + "\u0000f𝥉`vc": "󼈴𦳅󾽅v!\u000bS.g\u0006V\\*k⊯p󱪣|\u0010r@$\u001d\u0018>􅒆(󻌖Fɣ", + "\u0003\u0016`𨨢;\u0018J\"s>s\nN-&󾴘>ZMK\u0016ᒆb啁": "i\u001e􉒛𘩷_\u001bb𬎇2C춀KKqLhT􋌺,\u000bᧀ\u0017W臬󷧨􏹡", + "\u0008\u0012": "D\")`􌯄\u001cw^𞄌", + ",B𥠦(s⑇eh􃐆": "\"\u0011P@n.", + "-i": "9_7󹾤!𨢸\u0008'󺓊\u0016N(N\u0007]𮜔9A𗱧sm[0", + "/\u0005\u0008`y\r0C\u000f~f>j\u00148q g=vwx\u000e\u001d କ𥺙": "𦤭VXV`\\'jT󽭗o@h]\u0003\u0001\"\u0015\u000em", + "0\u0000􈼩\u000b": "x\u0005\u0005𗉘\u0002F􋇅/tuVf&1矛\u001d𬜦O𧽹􍎦", + "4g󸗽𨁈>\u0007kK蜞\u000f\u001a[W??!b": "𠹤\u001f\u0013aD\\􇍃􌎸>.U\u000b\u0012IV\u0010h%\u0017󵘱?7􊙄\"\n", + ";􈰢i󹈇3淗⧗􍵶5MG:G": "ꍪ󱪀𝆰􉙔\u0012d𢕪8A絒f󴘂[^4-<𡥳", + "FL𝖄􈛮\u0019䖘􈴓\rk\u0004\u0012MF䒳1\rYZ\t󺣜\u0001": "cw8|\t)", + "_<􅬌OO": "󿜸CE\u001b\u0010\u00007󼱡\u0006\u001bM\u0015:~릹𥭰/", + "hR𫆌⼬𣊚筬\u0012z𩒌\u0008K痾ꔈ𘕷gM\u0006􊇞|V\u0008x": "󽵇󼃘\u0018󳼺\u0018􊄭G^\u0006x|K\u001b-\u000c\u000cf𬫍𒐽[", + "l5霿\u001c8󽥦": "ᔢ\u0012&{\u0017싳o`捖\u0019K\u000f6j5L+􌨇BtM<", + "𐩾#𘨧󾄓𠜒􊤶1􇆓5p󶲼󻪴湳": "\u001eP𬈇퉥v\u0017yfj⸜z~6&\u001as;Pz0", + "𣍖󱺬:\t3R@𛆏/5Vw\u001b0󾑰\u001a7􄳫]": "㯓@o􋰤\u0013轪讷𡈥g󻀦k髝𑿍\u0007\u0006", + "𧍏􀷁\u0005%\u001c􍼕󱚦uZ.𐧉\t\u0019f󱺢uoe!𒑋1li𦾹#8󻈳_": "Hs󵇌cZ]𗁖􄓐*󿶵\u0016k𥟫4𬐜\u0011\u0017xL`jh$\u001cR~", + "󹴻\u001f\u001b\u0008󸂬\u0011": "/o\u0011𩔸!B󼽘􉓋\u0000t~=", + "󽱗*k󴁬𗝬": "􆁣9p\u0002p\toB낗F'𣢇#lG6e𣻸P" }, "urn:wire:scim:schemas:profile:1.0": { "richInfo": { diff --git a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_14.json b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_14.json index ee1fd8901a5..be5d53fb749 100644 --- a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_14.json +++ b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_14.json @@ -1,23 +1,11 @@ { "urn:ietf:params:scim:schemas:extension:wire:1.0:User": { - "\u0000􈐙𞡏": "& [\r\u0008C\u001d\u001a]F\u000bp\u001a>d", - "\u0005<\u0008^\u000cO": "X󱚥\u0010#\u0000s$􎾊𘍉\u000f", - "\u0006\u001fF;a􈖳\u0018x\u0016Q􊇞G/EF\t": "[𭿰v\u001f󻺬5&⩟􎏸}􀶌&;IGz󲃬8􍉸#󻧾", - "\t􀃐i\u000e\u001e@R\u000f>[\n#𣔿䩕qQ&䤵T.": "O\u0008T淝}Z3\\Cvd", - "\u000ct^⁍_剑𘞌d𢂆􇄎%": "􉰥\nLGSY7􀕳;N\u000b𣴿\u0019", - "\u0012j𠓣i\u0016\u001aUAalz2𨳐\u0012hKᯛ": "𐠘+󿌠G𤫈IaHb0$\u0013Y0)uJO-l􍪐", - "\u001b􌺈6𩾉e𬶊蜨I}姀\u001e\u001c󰆰F\u001d": "\u0016o鉏𒄟xMem2r?t\u0011l𡢿^􊜮VjG\u0004𗃨[;뢱\u0019_𔓣", - "-+\u0007NS\u0002dY\u0019\u0006\u0004􃦟er#<<幼i󸣲r\u0005􏺘grq𨨃\u0006": "UE􊷅쮎\u0013􄾥􋣢9􌟟T􂴕\u001d󼺫ツᮇz𗛃`*􎆜HO$o󵗎!󳴰\u0007", - "0𘛾U5\u0012\u001cZMM=䋋": "󹦭_􎠽yw􁕶Z󵐩q%\u0011]\u0011󵥦\u0003\u0011𪌧{hsb󸋣n󷂶\u000f\u001d󼯳\u000e", - ":DO󸢉\u0001\u0002,u󹅔󲪁W\u0001H\u0016\u0000ag􌧠􊶉": "zFb]K󵙿\u0000zLQ?\u0013W,&i𫟦`𦰤U𤂙WMLZ鶴|", - "D7𨃱\u0017\u001dV\u001dg\u001b􆘇_(4zO𡔡#h𣔧8l󶏨\u00173󷲥P􆋗\u0010r": "]󶆤ദT\u001dXq*@𗮣hx洎*\u0016𥏁\\\u0016^悪^\u001fTBTv", - "f\u0001@\u0006\u001c9\\WXL*S\\{\u000c0\u0008\u0004": "G`󶶚\r?𮞣MJ􈔕󻶼f\u0008\u001bM!jqqn𫣐\u00069𧣹<\u0016]t\u0005", - "v": "\u001ac鲹jl\r\u0004\u0003F􍬟~JS(Y\u0004􃇌󱿃3l\u00194\u001f\u000e\u0011n羅", - "x_\u001c": "!S\u00186⊞o&𑩪􇽱", - "z'~9𑪉:2󼊼⡌>": "𬖛F𫼂\u0003󹈊󺣮we\u000fꑶ2#", - "ྜ󷿋Jd𮇇\"關X\u000c\u0007븏\u000bg\u0018\\": "\u0018G\u0001\u0002\u000b颣M𑦻\u001f軦:A(C", - "󶜀b=eD󼒉\u0006\u001d\u0019mK\u0003􅑈\r\u0006􎰉-": "\u0017Ez⣅IEd.a􅶣bS 6f#\u0010蛑'\u0016蜶", - "󷥛y(\t": "\u001e\u0007w􋐷:" + "\u0019q%*Bq𬒦q*󴩙e\u0012\u0010\u000ekBv\u0016": "𩠌퀁\u0013eYmQ8HmG􉔬𪩜N\u000b𭴛", + "\u001cq󳭕r𫷜{𫒐𧫨󻆈K󺆛*g[闞\u0018": "\u0013B", + ".Z\u0013zn}\u0014": "󳓠􀸪wQ]i\u0017S\u001fkh$\u001e\u0018\u00038\u0013󳸊R[\u0000E􎊧>+0Zg", + ": )L!G󿮞xZ𪴿9󱎰肼PO1RK󿪨^": "vpm)P𤚏\u001f􀳳-􁶿<喆\u0008\u0016n", + "H󱀌\r5󱎛􇹕풻󸜈7𤅉􀟻": "Qꞝ0\\l\u0000\u0006\r𨚔핃\u0003", + "K캧H\u001c\u0010tG{z\u000fw1\u0016I􁺵\u001e󻴩=&妇j<\u001307_r": "Sw󰽵󺡻󰹞(" }, "urn:wire:scim:schemas:profile:1.0": { "richInfo": { diff --git a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_15.json b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_15.json index 7aed4f79058..2a282cc11ff 100644 --- a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_15.json +++ b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_15.json @@ -1,15 +1,34 @@ { "urn:ietf:params:scim:schemas:extension:wire:1.0:User": { - "": "\u0014", - "\u0000􂐛WB\u0004\u0010MC𢠴e󱵎,z\u000f󼽥-h􍡇IF\u0003\u0018W\u000b󱔾F": "l蝍cS`", - "\u0001<": "\u00154􄀠k\u00118I\u001e󻢠􉎎'D剕u􇩎RZ󺱌$\u0005+\u001aL󵯼9ZxRͱ\u0000H2􄏿\u0019&\u0019\u0017l-$\u00133aD2-", + "?e\u0000q󵖨\u001b`\u0012{𦟾[\u000c6:\u001aY󾎦,󱏿&\u0000\u0015": "`u\u0001f0l_\u001d4R〧!赉6뾈3BI胋", + "B-8d\u000e": "NzDk:@T5\u0011\u0018jmg2V", + "U뺡h􁤥􂾬S\u0014;;\u0016k􎶫\u0017\u0007S=7󳭷\u001e>􏅶 ": "􎻀󶘥V\u001c\u001a𐓰\u000bl%󱴏XU<𨣳TB\u0012𘥦`􆯏v0\t", + "`>𧸴𗓢󷿎􅎭󵺏fB\u0012Q\u0013Yꨒ>": "jE𫙱'l", + "bhAL[v/CW\r.^KU\u0006.HnO𘁉\u0017nDg\u000cqZ\n": "|9!", + "q)4j􍒞?Q8aȣif!zA\u0019􅥴𥡍": "\u0007P𤓢pW𠊲", + "s􊑓󽟱5\u0001\\𬩎": "\rn𬛈V7$g𑄸􇵓,󼶯\u001f\u001e[􆄏󺘸.\u0018Y쀾沀\u001a", + "x󰧀RA\u001eNXCq􍇕󺊑\u001e\u000b𪪙}nf$C૦=R􋌦\u001cl\u0012\u0016'\"\u0015": "↶y\u0001", + "ං𠍠ꮨ􍫡t%y-V\u001a\u0018󱕱}5𑃝󽴵0U+ 퍧": "\u0017\u0006􏟏I􀂶5\ns𦰡_\u0017𢈊i\u0016鼧", + "㹨𩿜I󳕚l#\"T􌵶N:\rPK\u0018\u001b󾾔\u001ah#It(e𡔾󺊠": "yL􄻬L\u0010fK󹇘\u0011I~yv|", + "無\u000e$\u00073𢾫5\u0017\u0019\u0005": "8q𐙦L𬙚\u0018", + "璫`m􄠰i6󴏿a󷎌覹􎣢_𦻹R.R\u0015?": "\u001f5􍘽\u0018c\u001a\u0008v7𪆯\u0006\u0015􆸇", + "𢢞\"\u001c6y}󰈱A0b𮣄[": "\t9𠵚𖹿/o𝩕j᭛Z‖D~F", + "𨁜\u001e칒&:Xel\u0000􅍎B0􃳱iU\u001d y\u00001b)暢z": "I󺓮\u001f󹊪7\u0017\\𮏫\u001f􀄙Y8E\u001dI𐳃\u001d\tl󻼥\u001a", + "𬱩􈀟@𝂁􎗱阺\u0008\n\u000e\u001b\t,/􉦧𫺊C": "4\u000bBv钽􇏷\u001bZ\rj", + "𭈱\u000c햘U􉡈q\u0005<𨓦": "`VP󳆬)􃒧\t;", + "󳆥􀄐‪􃚠%𠕃Y|獇%5&󾻪A\r4>󵬪𝃊.󽋱\u0007\u001e": "[", + "􍾬bY􀥧A\u0015": "^zj,\r\u0000}󷈛\u001b$c #L" }, "urn:wire:scim:schemas:profile:1.0": { "richInfo": { diff --git a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_16.json b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_16.json index 549e4c0efbc..da646310c9a 100644 --- a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_16.json +++ b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_16.json @@ -1,29 +1,24 @@ { "urn:ietf:params:scim:schemas:extension:wire:1.0:User": { - "": "Edpv􇨫y^{[𩼲㑡\u0019f\u001844󻦪󺤀󻺎", - "\u0003dC𭝇\u000b\u001f󳇽": "M\"f𩠠q󲜻D\u001e>\u000f𢅱", - "\t9$]𠟓4jn\u0019\u001e?\u001e": "pE\n𤻝a+-\u0013󷼸*,yzB\u0013⼩=\u0005", - "\u000ePT": "6^#i=a\u0016\u0004", - "\u0012蛯อ⸲ퟦ_𣬗􇗶\t\u00034EG𢠺Lm𧆹󴝌􍟣駭\u0004𐃟?": "帜!\u000eW\u0011\u001c􎤌!E6\u0015j󺽙t𫠹Ko5pwx\u0018T", - "\u0015(􏦡󸵱L^󶶻-𪬅~": ":\r\r燀毘T\u0002\u001d2/s􎀡", - ")4n󲵱ZN2": "\u001c󿊧Wq\u000cqZ\u001cJA\u0015\rB?f<\"\u00130M|\u0004", - "Gs􌜄41\u001b􈨬󳈌ⶉ𧆫fj\rd𫉌\u0006\u00018qj\"<\u0012𑓖|󱂉": "􈮀\u0018uS󱆻w􉖑\u0006/𠗑𘕴\u000e2q\u0014;h󶕪\u0017;O?􇑖", + "8<_󾐜\u0010+\u0015􉻑j􎜟H󸧹nl\u000b\u0000C@弴k]\u001d%9🛨": "g8+", + "8e􊧯󻶔04󲎸r\tK𨑨p\u001c/ᚗ": "Lp*J\u0018S/塠\u0004􈧅", + "8󲦰y\u001b\u001a11l𬛱І.(􅣴漑Vv#": "L[2𘡐r,\u0017 `9\u0017󴚢<䁢\u001d\u000e􅖞S\u0001_qo", + "w~vmF􉕸\u0017'󿵁.dr􈎷\u0010\u0004愞-\u000c`\u001d\u0008%٨\u0006": "`Rl錴𨋷亭K\u0019\u0016^\u0017󾴰󰂇Vn󺆷\u0004G󻤙x纰F𩄁?ps󼛍\u001b", + "࿋&@\u0014}󻌻\\~5𢷠*𐒊]\u001bZ𦫝": "22g\u0004j*𣢘9\u00057a:", + "앒\u0012>\"􊠵ON\u001fG󷇲GC\u0013@0\u000b\u0016\rA3:\u0005*": "􎍅餾⩈\u0006SUu󹴥z잚", + "𧓂\u001b挊{􁺥": "Z컄\rq)D\u0012z쿍]@t%]\u000f", + "𭄂2,Y􄋵$h5棦-B\u0019x)\u0001*I떠O;\\b": "𨡩3mGW塲l뫌ſt\u000c𣞢.=", + "󽡘LT#𮕮5O􀯶\u00077PC", + "􁱨,{3𡟄1􁥜􍢆\r\"?hGYO󿖿t𩀞4{\u0016@": "x5􃮃o", + "􅎏󰲌鐩": "\u0010(𢾍𤔼V𗎆𥌸9𮨭􇠫{􍎁\u0015u\u001es`i\u001b𑣋^j􇻭􋣬", + "􌱏\u001aq\u0007\u000fBs": "Q", + "􏟓ି=􈛨4v\t𢞜TB": "&\u001b~s􇹠똄*y\u0003zL@~\u00079D𧼀" }, "urn:wire:scim:schemas:profile:1.0": { "richInfo": { diff --git a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_17.json b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_17.json index 190277a8f8e..344bff6f71c 100644 --- a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_17.json +++ b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_17.json @@ -2,92 +2,7 @@ "urn:ietf:params:scim:schemas:extension:wire:1.0:User": {}, "urn:wire:scim:schemas:profile:1.0": { "richInfo": { - "fields": [ - { - "type": "􊖉D鼗j\u0005HMgz󺺶(r", - "value": "(7D􁉴􂥇\u0010FP%Y𪾔,}\u0015\u0015" - }, - { - "type": "ybx\u00016\u0015+o\\d%\u0014@@", - "value": "|\u000e\u0008&\"륧󰼨j𤰇`l􆟪~\u0002%zl\u001ep􃗩ⰸ4󽒾\n鯈y-" - }, - { - "type": "0\u0014s󶝆􇑦ﲡT\r\u0000Sຈ𮎏󻶷S,", - "value": "\u0003\u0002a" - }, - { - "type": "6\u000b\u0011.@p\u0016⽽7 m2nm􋂴1󾈳󳓋𛅾\u0017-􌠊E􂈃/", - "value": "􅆳\u0006[S\u0002󵖏fIBz􄱻\u0010[d-" - }, - { - "type": "YbO\t\u0017𑱸dYꬔ\u000b\r􏈊󸬏\u000c(𔓪q𗔏𪩐\u0005𣹃󹑊p", - "value": ")R󳡢." - }, - { - "type": "𒍷t#T", - "value": "󻏱>G{9" - }, - { - "type": "q 匿󼂕\"􎪑c\u0004>􋍴'B󱇝𗬙𗏪􆈣\u00044\u001c\u0012:ew", - "value": "\u0008!󱮶竞󸜍Mi*'M᳙]낄䛚\u0016%𘞏\u001f:\u001eg(]6,1挒𗓫hX" - }, - { - "type": "𩐝lB~53k綮𨒤", - "value": "&l􂛼0" - }, - { - "type": "p`묓𖠷O7^\t{D\u0006A", - "value": "U􈰶X\u001ciÕ\u000cU|7K5\u001bm 󺈎?􂗎Z􋩢𦖽D!,\n" - }, - { - "type": "\\𩽺\u0005\u0013􋴅l\u00192\u000fj􆽍\\󽩒v3v*\u001f~-dM󽸲e\u0010\u001d􊊋", - "value": "\u0014N𒅐`Pp\u000c𢚏|9K\n`Io󴠬瞒\\j,󳕒B4:).uY>\u000b" - }, - { - "type": "z𪯬􊂤Y󵥴Y9qM$ b", - "value": "\u0013V}\u001e𬖿%􏩫Y\u001bH.eJZ;sZ?c𭯷\u0001\u001d\u0002=V" - }, - { - "type": "22𥥽!<$R􉯝\u000bE𩡵􌇓 _c􁀃", - "value": "􏞇𥈩/lb𬻏(]󵯁𒉿G)9𝃚`A󵧠s\u0011O􅗐[Z" - }, - { - "type": "󵪻v\u001a􀺡", - "value": "Cs𨽾􋣄\u000e􇄻\u0011dA𨎳\tt⧄iSU=\r􆒓\u000e𠲘󸎁Z􎫟@𝠌231" - }, - { - "type": "bu􂌜\u001f󺭑E􋣘硫x\u0000\u000erRw\u0007", - "value": "􌵗F󺣦<\u0010\u00155/\u0016IlgX𩉮KE." - }, - { - "type": "𠌸@oؚ^M􂖳!\u000c],\u0006\"4", - "value": ";yG<.D芆k0X^󿿊\u0005!􄁣z\u0010\u0019>I$W$" - }, - { - "type": "#K􋧎\u0012e\u0000t(u\u0006}q􈣔c(i󵋆J⎢a$Z<", - "value": "P|M6t0 \u0017\u0004벷p-N\u001eEd\u0019n\"{􃁑/鈸*u1" - }, - { - "type": ",\u00115󱽋𬟅\u001ek*𑩃S􄜑\ro$,2𫲵*S]󶑁^", - "value": ")0\u0016\u001dCG\u0012􂨻j邥%\u0017􂳢" - }, - { - "type": "#􁘺\u0003g\u0001\u000c\u0005>􌵠,&􌄊𩅏\u0019h\u000b.\u001d󻍌", - "value": "쿘@\u0000o0󶿬󹰞󷍧}󵓽􂻏㣢\u001dw\u001b,唸%/\u0006\u0001" - }, - { - "type": "\u0005u\u001c𮤓EĒ\u0008󳴚p􉳎9𖫓,\u0016F󰣰􃝛$", + "/`𣠮/}砲𝂜󷑛Qr􃲱>p󸯶󹬮$\nt6󰪦􍕡Y}\u0010\u0010􌤘,": "▩\u000c", + ">-E[?l􆄍\u0013h\u0003A$u{p|-W97u\u0017f\u0016": "#\u0001􌈜/9󻱾EϺH\u0012P\u0010", + "G7t\u0018c": "~*\rm", + "Z􈔍;}3\u001c": "\u0000𑖂􎃧󲦟@󻛪\u000f@𢥺@", + "^􍟿󴆙`": "\u0012\u001cMl", + "j\u0012\u00158a_": "g<􆵪2FV\u0004=[!{U`", + "o\"𫠯@}𘕾C􎃩{!)󴭂\t,󼍕Q,l󹊎󽆬􎪱\\N攆Cq\r\u0001Q": "ᖀ:\u001eJN⪟C9JoA)i^\u0005]vZ=􎲴p􌀏K\u0019𪥯nb\u0015􆟯", + "s𗔴(󷴖𛈄\u001fi󵠋Io🖻q1%l/\u00101e\u0003": "\u0013\u0012ꅔ聈M4ri4K=zA", + "x𫐇s": "\n\u0008G𣘓\u000e\u0019\u00055%𓍶6Gz!Wj/i\u0011qk􉑡U󹱒", + "{\u001duHh1c": "wwMX@\u0010t\u0000􇩿\u0010\u0014'/Qb􅗭󽄣󰲩B\u001az", + "𧭜⠶*2􊗰󷭦\u000f\u000b:": "B􁌚J;", + "󻪋)􋽊A+r𖧃0fHG쁫iH\u0019󽤔\rl%u'\u000b􃛹\t9𦇮Ud𦝾": "􎙤0헭􆞇呐󷈘A𭗌dF\u0012g\u0013a\u0015|\u0008", + "􈲕p-\u0010\u0013𤊖\u0006􈖺|\u0000e}yY": "𥴨L+j$󹯗}{뼃\t_=𓎜ズ좇[\u0018\n𪥕i𐬢Y)󲹕" }, "urn:wire:scim:schemas:profile:1.0": { "richInfo": { diff --git a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_19.json b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_19.json index 6898bc8c717..d6a305efc10 100644 --- a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_19.json +++ b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_19.json @@ -1,8 +1,7 @@ { "urn:ietf:params:scim:schemas:extension:wire:1.0:User": { - "\r\"鶮T|l0$\u0013": "ᕺq\u0011\u0006&牸つp𦗛\u0010\u001cY", - "P2\u0008\u00051&󻼋\u0007㥎\u001e󷫞_q,-u𦽹_u\u001b2𒇭;k\u0018": "GJ􋆊", - "𠱀K􇞵P.7􃧈s|\u001bUv\u0014w𖫜\u000eB/\u001e𔐭/[T\u0016YF𩞋": "\u000c\u0000𧏿E\u001f47(\n" + "\u0013\u0012󺤝vS\t\u0000\u0014􆅯<\u0019ț\u0010<\u0000xR\u001aU\u001cx\u0016\\JtiN?&􊨪": "󴒷􂢊x孴3\n䡕󾃽俸\r0e\u0010󻖀", + "l%豒\u0006\u0014b𔐊𝒇\u0019$󶾿5~f錠H": "d蔈􆖦)A䞲k@\u001a􌀸<􁚚𠏰I󵁞\u0011}:\u0016􉇤󲱞$\u000b\u0019\u0012&OMW" }, "urn:wire:scim:schemas:profile:1.0": { "richInfo": { diff --git a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_2.json b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_2.json index 472918e60e8..73804097682 100644 --- a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_2.json +++ b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_2.json @@ -1,31 +1,15 @@ { "urn:ietf:params:scim:schemas:extension:wire:1.0:User": { - "\u001d}+C": "2\"`$^\u001ew\u001b􆹁&)c\rH", - "\u001f\u001fF𡮸{\u0013\u0008r\u0002%$%Q󸱪씐v![V\t\u0008B=\u001d": "\u0007􆸘{􉬪~趗Va~QG􍴦^c\u0000Uk~{\u0011S", - "\"ᛈ\u0011](􏏠": "\u000cNL\nW𢘿𧎷g7\u0007\"n>􂽥\u0001󺈇6𤬻􃷲󰈰zj5󹄨]畗o", - "%\"hn%'Ls^\"Ej": "M𣞅2h6\"", - ".r\u0000ASiNn": "@(A)𦫦󽷐\"^\u001e𥘄nT )\u0000𡍃go%7i󹘨", - "1Dj\u0012n𒋾$#\u0007\u0017": "\u001a&\u0014⨝\u0003P\u000c[", - "98\nJ𫈖s\u0006\u000fG󻆤": "^Ꞁ𨼜𠢺<1y:D𦘯\u0004G\u0005^𝖧+𗁴 卒\u000f𧮼y", - ">hI\u0002s\u0007K3_\u0000fO": "\r+", - ">腵!]􀠂A7~􀜦<5Qom\rn􌄬ZKZHL\u000b": "rh􉾺𦞧󷗻󶂓j", - "K\u0008N\u0016𩣐4\u0006i": "m\u0017~􄑤􌞣\u0005􀨿", - "Mc\u001f􉬹J;": "V*IL\u0002⍤W\u0018\u000efL(xbD􋞯Au@(U;", - "TI􌟀l8\r\u000c": "Bxe\u0012󵈊}L1#Z", - "T𦞂+A:\u0002\u001c\u0014@􉩑󶺮ri\\𭕠\u0011A\"5дk􆍪󹟭q": "u\ni󺹻\n=yf!V\u001e𠱣􍸫iq", - "U}􂼛;Q􁘟4\u001e=㘲w": "<9󱍝\u0012\u0017𪋃蔃󺸛U󴗬f𡲧>󱏟󹣤\u001f", - "W\u001f\u001e/𗈚zPM𢅍6\u0007鰔\u0000\u000bA󼘾2𩘉\"I": "q􀗬􊀝ൌ}C~l󳝄\u000eg?ꄜ]l5\r\u0001br􋙑tMk", - "cB)#": "\u0018:AjO\u0011\u0017c#{\rǬX\u0000釜", - "ꯗ\\~\u0017+/A\u0003": "TㄾV􍞨Tcb\"\u0013󻌅", - "𔖮~K𩂽1[\u0017󹥝\u001bAx\u0011_r`p>?𒊜󳰩K_􉗃WqQzW9": "C􃄐.~\\^1)昄T", - "𗨄*": "4\u0015U䘗W\u0012ea𘓠\u0001󲙻􇑝\u0016𡞀☯", - "𧫸\"^>:tx􀟧􄌬𑅙2*\u001bL\nd;n%}": "!􉺞\\j􅓚𣥊(3㈻\\tytDĜV𓅪NU\u001f`Q𗑢I\u0003CI\u0006𨠌", - "𫏵Ly󱥢\u0017}𡅰ZH\u000e󽻞𥺲o}\u000c􈷪w\u001cf3\u0012]J\u001a\u0016": "xi󵠏^\u0001X\u001c", - "𭅰qB\u0017\u0011\"󲁏􊯫+⅊\u001fL": "r􀑣\u0019^-𑊑J\u0014fY>\u0007p s\u000ez", - "󵌆": "\u0005\u0004B􎞤\u001c󶺠'3p9􋆼\u001bl蟧\u0007\u0001􅱢w", - "󹍋OH6": "ml󼼔𗯑􏔼𥡦'", - "󹜃e󽢩q?vY𪶳R洼U\u0006>5rr\u001e\u0017[𠄇𡾃P\u000c\u0016\r?𓍱": "\u0001󺷳Q-\u000eb(rT􌔩", - "󻗟\u000bh\u001a\u001dY\u0015𢲢c𫍫t~󿭸L\u0003\tEH&􀋅yT y\u0017S\u0010": "N~F彀Z<\u0005􂾠a8Y" + "\u000e𣾱ٍ\u0003𢾜􄅿1up\u0014\u0008W_P,mu": "􊨚T/I+8Q拰6m􇣗𗈝;󹏖;5󹈍E󹚫|\t\t𑠠\u0018", + "\u001b󾣝𑁍\u0000\u0015\u000cc􆧹󿈪Q%\u0014IDɝYLlMRu": "\u0004䂨+_\\1\u0016\u0005𗖔GyIl&\u0010k\u0015􎹎.Vy\u0017䫚(8", + "5^s꺈ꡅ􋕂\u0003_\u0010\u0000\u0015슼䫞V <": "𠻕E\u001c\\Oy9M\u0015bK", + "Cr\u001f𢣰훊䉄x󳛐󿁾t\n䅩z; F𬾜r𤼑𤼍-\u0001": "󺺔􏸘\u001dD􁈊rN􊝤N󿴓挎;|q7", + "N\u0002􋷤\u0007󴰏e𦢟Aw": "?W􉓚󳛤4;𠀶)\u0013-Z?\u001ceUjw𪲅h", + "kzXo[1\u001eI\t󰳱T\u0007\u0010󻇐U𮃏\u000eo\rJҽb󺫭󱶨K~": "\u0017\u0017c𭔑LY\u0013\u0002󼭗𗍀Q oEo", + "ow󽌆\u001bLe`\u0003-\u0010en*Ứ!󿤼󴩪󿿨󵔕[D4{\u0001\u0004\u0004H6": "U+延\u0016a󳱓m\\,n\u0014D𢉉5𘢅mY󰷘\u00010MS󸑑\tZ\r(#藕=󾲉+d󽋋𪅏": "V\u0003􊭗\u000e즭r\u0006a" }, "urn:wire:scim:schemas:profile:1.0": { "richInfo": { diff --git a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_3.json b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_3.json index 57d8be0fe22..8af8375f206 100644 --- a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_3.json +++ b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_3.json @@ -1,19 +1,26 @@ { "urn:ietf:params:scim:schemas:extension:wire:1.0:User": { - "\u0000iy\u0002^@\u00111qF󼣁d\u001fa>\u0015\u0002$]-=󳉧\u0010\u0004": "\u0014!󸼪𡶲i%$m?빔K=𭂟Z,􊱂", - "\u0001[z\u0014\n&:15\t󼶩砓\n𩧢&􆠱w󽏖z$K󽹀\u0010B󲊽/=󴤉0": "\u001f\u0012y핲Vh\u001exꝿm𣹊L\u0001􂏰/#𠤔", - "\u0019,Ky\u0007n-N\u0019b꫰": "G$O^󹑝𣓛w6􋂘\u0010㗓\u0001􄦎C㬸d怨\u0015ln|!oﶉ;\u0010[𩖥J", - "51􇴡&->": "󲖲铻Hষ􁔵y2\t\u0004p\u00072𬜐󼢉Gm})", - "B5𪇺u􈵭\u000f=h\u000c\u0008\n?pv,\u0003\u0006N4𣀪": "-󾚔𭑙󺖢vY\u000fя(", - "L\u0005􈶸": "\u0003󴰍y", - "Y": "=􂨛􋡬(|𐛈xb𡀾\u0010􉁩u*􆮅]1𣣂\u001f􎘠ﾬ둡", - "\\\u001d|\u0013hy𢂼\u0013唘W\u0000\u001dXHq\u0017D\u0011I\u0016􃥁\rK0b拴􁪐\u001e": "}o棲\"\u001d󸹓-`!𦓯QIn􁥹7uI\u000f\u0019\u001f𖽸F", - "`ਝQ8㫠W%􀘶U􃿗9": "\u0018U𝕭>\u0002JcZ\u0002\u001dt\u001eb\u0001\u0017􆒶쯽*\u0010𞋔b\u001dTඹ", - "k\u001d0*\u0014\u001fG𑊵?p\u0016a:&\u0010vN\u001dt\u001a/B,􄋭z_W": "I\u000c􊵌9g\u0017]\r𧰀缡-X7ꁵU=K󱚇,\u0019󷻆$=󳺮\u001c", - "n4🞓䬍K1\u00037ॷ􍒷󿱱PE\u0012\u0000CU\u0002\u0014􆏣􅤛󽭪ʠ4i~b": "rc\u0012􏪪\u0010􋺝?\u0014󠀯D纷k􂑃􇆰Y􋪙󰂷hK𪋄󲓽|􍭦\u0002@\u0016\u001eb􏜐", - "{*\u000c": "|S|=\u000b", - "𨜁\u001aoP⟞@p\u0003!𫃩\u0016$1󹖞\u0010 [𠌔ﴌ<􂒉󳵔𨊏滏Q\u0015": "\u0003󶒡빧pC9𣱻N􀑘療7-#\u0014􎩟", - "󳔫`$C󼐛+\u00198(m_t컴<*%\u001a󹙖󽮂[\u0015!󷤴'􀸀": "\u001a#z.􇲁\u0002\u0019\n" + "": "_E_􏎈􌙮\u001bY", + "#𖣽\u0005q𮖕휩󲌚\u0019\u0018@A5U𭘣Aj􍏌fi𪧚2I5􀃸s": "iOv\u0007j|tl#lu*UF􌹥$\"H", + "&\n䐯gg𖽗\u0001\u0000Zu\u0013󵞺\u0005l4yv`n鼳\u0007`\r4ꀳ`:": "7YA\u000e\u0012kvꞟ䰈𫳰㻘􇤠:·#*pm7蕋\u000f\u001a󽟛憕u\u0005!\u0015", + "),􃲻u\u0012󶵪l#󴁃w辴\u000f𥐌I@a𐳋GpzB8": "d Y𘐺𡮽𝟮as{\n+󵰵I🁷U\u0003n", + "-\u0014x􅰧􅩖󴧈": "𡿳\u0006\u001b􄼉HB􌑭\na𧂱=>e\u0008", + "B􌰤?wѫ{𭒃i#?~}x\u0013\r\u001fc4𗙍C": "[!h쵄孳Nz\r󳶉􅙻𥗢ibz?", + "C\u0001𒆳🄓'lT𩕑`𫰍!I뱝􎜆TK𪤻b)􂂆\r": "\u0006𦋉H", + "D.钥C􍏈󳅝\u000ef𡚣t𭪓G;Qp㷐􈩓\u0008": "\u0011b.h\u001a_󷫇\n\u0010𬿓!JHᱪn􅩳㶬6oQ󽬋", + "O \t晨a|,-\u000fuXwiL깲𫉭c&\u0018BDuG\t2": "쀆\u000cuXTC;󳅫u(厲\\鮷萧􊆶Y 󵱤𝁐\u0014", + "S𮃖􅩯󷴴v󶶣wE2\"\u000c\u0007\u0007\"\u0015ᄽ/0}k,g#.": "-Q糡l>T8~%)0m8𤕵Z󹔢QD\u0012w􏝃vT⒓k`C", + "^냸󰹫𧕥m\"\u0004B􋟣`麰󲶺l#𥷍\u0000<\no`+󳞆v\"Y󾞖": "\u001fx\u0001𐧯􇜄\u001b󴘸?􈻊\u000e,\u0005󺅄p\u001c/컏w": "D5􈅀🨤Q󻜣*@􀛥G\u0013􍗱𤽫暐", + "􍼀󵱕u𓂋󳕱𣚢d": "苧eFEhD$\u0001L\u000f &tu", + "􎗏vu/\u0000ಅK㬱8;;\u0003)𩸵M\u0004-qM\u0011\u000b𔔲": "Kh;𩯊𫒯)Y礹\u0006" }, "urn:wire:scim:schemas:profile:1.0": { "richInfo": { diff --git a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_4.json b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_4.json index 27e3361a282..b1049ad1cc6 100644 --- a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_4.json +++ b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_4.json @@ -1,9 +1,17 @@ { "urn:ietf:params:scim:schemas:extension:wire:1.0:User": { - "!B􅟃(󿛖^": "o|~2V⁼-⽊>\u0010\rh\r𤿗𤍥^so𡬂󶢊", - "=[3kw􉹿ൡ􈭅V𢛞]\"h𗂓K= V\u0007z7𤳸x\\𫬗\u000e󵵅\t,": "P𛂽,\u0010󲲱8􄢻S壐󼩾Ja2<9i\u000e\u0000]􉮄\u0012𫾽", - "𒔤\u0018 RS\u0000\u0002󳏏_\u000bubE\u0015:x:U6dj\u000be󽁢MS+V\u0005X": "M$.󵂋d\rB{Y", - "𠁣\u001a\u0000\u0001o=U󽆊Cf𪧇􏩠􉓍lf螰\u0014X3>Sdb􆿒": "[=h{H\"􆺉됬3jd@􉧎{" + "": "𩶙􏻕A", + "\u0008󵌒􊂨L9=.r𐃸)/\u0001PB.fr=Kh怮I􋠹Y娂l􃗞~U": "", + "\u0012*1A:)𠼺\r}q7~𗍼\u0000#Ze!􎫽ᤍ\u000b}(": "p牦豗K\u0003\u0017Du𠉸FAE󠇎]-M\u0000", + ".XV󱊶𧭇\u0015\u0019o퓡\u000bq󼞪WB󱟎󿗞(\u001b󰄱B󻳛*": "LJ󰖁'\u0012M|(󱹗XS\u0019!i04", + "?-\u001a􅏃𪣒\u0006D.&y2=\u0000􋅡M􅶖꧕+\r+\u000c": "𤰷𪿍\u00059󲹀\t", + "A󲜀𥴯<},\u001fzf}K8+𣓟𤑨N󶰍zI준o銃A𖢡\u0010𦏧\u001f": "~􌠋Y􏘟젔>X􊡆𥇬\u0014\u0018`\u001b𨉉\u0010\"45\u0000\u0006z\u0019􄴍\u001e", + "R>떶)\u0008d$\\nH􈗩𭙊𬒰\u001c|𨼨-􅳯 \u0010C󸸺0\u0011󿱏UP~": "\u001cZB䣓𠲉\"D;\u001eaG􆤳Pr󷺳CI􃤦\u0003", + "v*:ㅦt\u0003\u0014*\u0019󰣍💮𛉽𡝶󲏒": "@\u000ex𢄜B􊩺_ I\u0013\t\u0014䀩\u0011%", + "𧅳\u0005+\u000c:\u0006<": "x;9?Q(d6\u0016𢤶&󳬖smp\tkDn\u000e󰏯\u001a\u000eD", + "󱌦𤅏`Z峿b": "$\u0000]J\u0017\u0017Lg󷰱𧋑󽉦96I/2K", + "󺶁\u0008(k\u0015]": "Q󱂨󲽧Kf\u001c\u0003𫒝^\u001d\u0004􀌐<𩍊𢎕󱇓Hb@r\u000f0N;𤗆kX>", + "􄤂m\u0014󱰐w\"\u00176_": "\u0019\u0004􉢻y\u0015篖fr𬃗𣉄􆭉*Nq\u0011x.:]0\u0000" }, "urn:wire:scim:schemas:profile:1.0": { "richInfo": { diff --git a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_5.json b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_5.json index 44c7b929949..344bff6f71c 100644 --- a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_5.json +++ b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_5.json @@ -1,16 +1,5 @@ { - "urn:ietf:params:scim:schemas:extension:wire:1.0:User": { - "\u001a=3%w󶾡𘘧 u~󺿉t徭y+-󶞡Q[󿂚": "O'(\u0000􇈵\u0003'08𗱚b쫮ya\u0007󳕞󽸊c􁑡\u001a\u0002⪍뛺\u001a\u0004l", - "#\u001cmPU]朚g𗎍U\u000cWMoHJG>7b\u0004뽚􂀸\u000e\u0004{Y\u0005$": "􋽐zI𢒃󱉊Dp𩯪\u0014'g\u0007b_VC+0v\u0007c\u001e􎬵y\u000f\u0001K](U", - "2𭓓^": "矦\\󵨢Uw\u0004u3𥊄2Kn", - "mL\u0015[𧤘𛈂屜Ẻ𠦺K\u001b󹐥C\u0006ws騐}z\u0003\u0001\u0004􂕖䳖\u0013": "\u000f8t#\u001br5\u001d\u0008\u0001AJj뮲rQnkU􅰪oᵧ(/<\u001b𭸼z􍝇7", - "nz🔀\u0007𨡴/;'I󰢫]𝒂(\u0016in@45\u0012": "𥦎\u0018\u001b𣃦\r􏈫8𦪅8\u0001\u001d6l\ty\u0001􇙺\u001d!2T0H\u000c\u0005>𬗼OmK\u001aF@ܨ𫨊e\u0013P\u0007J𭡳M\u0016􉌮]6", - "쎩": "⻘\u001d6\n📳zv5t扟􈉆𬄏m\u0011\u00069𬁬\r󰈾", - "𥠻w󱪿!\u000e7U\t|7𩘾a𗙀𬎳": "\u0001􋴛󹖌*Q\u000cHH6", - "𮌄Z􇌭7Vo𑢶􃧫}": "\u0000P\u0007𨄆菝󻎱󷁤󺒄\u0018Y_.YO", - "􋥠𗵣G\u0007:㖀$+\u001d|": "fs5)毠;\u000br#\u00076&\u0004\u0006\u001dڟy\u0018" - }, + "urn:ietf:params:scim:schemas:extension:wire:1.0:User": {}, "urn:wire:scim:schemas:profile:1.0": { "richInfo": { "fields": [], diff --git a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_6.json b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_6.json index 43071735841..853d3de5fd8 100644 --- a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_6.json +++ b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_6.json @@ -1,15 +1,13 @@ { "urn:ietf:params:scim:schemas:extension:wire:1.0:User": { - "\u0007𫈲E󸞲􍘎];\u0017&A(& 𨗫󷋋p󰥇\u000f𭺂\u0013Ak}\u001b.-\"'": "\r", - "\u000b8𐘃\u0002": "􈠇x4\nam@봉\u000cd'扲4g%ngl\\g3d唝\u0010.􀟕a", - "\u0018": "\u000eS󱘳􌿉𑨼\n-s", - "0\u0005\"u\u001eS%": "\"\u0017󳷲\u0017sI􏵋󱭆\u001b\t\u0004wA\u001c?RUi􃁗_\u00144流/􏸑", - "K\"rO": "\u000b\u001c\u0017\u0019b𦋸s𩿓\u000f?􌐤2\")贞)", - "Q\u001e.󷏂􍅔󰱏\u0007\u0017FEj\u0012󹣨?j >Cv82vY~ mqy": "l>rV\u0017Yz𔕶pJF\u000f|,", - "X\u0014󶼂􀽟𤑓?A𘋾ꟿ𐫢@𦨬\u0007󹸍N@62\u0004r#d􍇂b\u0010": "􃓂t7", - "𮎞󽁞y󴄘--DG.D": "t}l뛥B\u00169\u0013D􏴦T􎭞!K|\u0005|:KU\u0019􍴮@𒀕+\u001b\u000e牺", - "󱛥8\r!弊R[\u0013G䕗\u0016\u0001\u000f?>LPKE\r劈\u0017􄭔": "􀝊@)R2I􋭲𪞲󴂢m6n8𫑉R𬰀𧹳9J1𮤲󰋔󰳤\u0001LRw\u0016􀚬", - "󽜔􄕪0琇􋸂󵵴󰁽ib\\RI𦊹Bb4\u0017􌑠&bTVv\u000f𐳆tꨚ􈾖9\u0013": "􂏷婫􁋊H󻆭\u0012𗊿6HE5󽢌\u0017𗓉􌙸Ἧ" + "": "a\u0004\u001f󱲫th𪩏󵖝", + "$\u0019𗆻_𝒾[\u00071(𡿸\u0013\u0001": "&\u0018󹽩'𫶱f!􂀸BF\u0015𢨑b𧗩P츃h􄫸%้cࣣ􆶅(", + "^#􅯥!\u000eB\u0006 Q􄑃󴎮O\t𨽏X@\u001d葻L\u0011g\u0005U\u0018󸆹R|": "𢧩􏮲Y,󹢵󰔳􏀔𘤝", + "cf|\u0016{\u0017d󼣦􆏈JoLS󶸝S\u000e|𦇤|eE<": "\u0003􅂬\u001b𒐒둡󾪕i\u0014.d", + "gIcTc\u0018;b䚱\u0010~\t󰵭mWU~_)avv": "r\u0001b󼒉:􌏮𧘑谅%󻠭o]㾠󽙨h]N{\u00163H&𒁪x\u0014", + "{󳪥㋘󵣝 󰞻": "TH`􃹷󷷩\u001b\u0012", + "󹿽􎐯": "z퐩\u00019[\u001b9f4ࢡ", + "􈴰1𛊇[\\y": "\nq{A\u0016􍣀ή(}\u001b􉝝K2K\u0008\u0011Cit𪔁" }, "urn:wire:scim:schemas:profile:1.0": { "richInfo": { diff --git a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_7.json b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_7.json index 1074a202852..8713e0b5260 100644 --- a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_7.json +++ b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_7.json @@ -1,25 +1,27 @@ { "urn:ietf:params:scim:schemas:extension:wire:1.0:User": { - "\u0005Jy띉acIXK4\u0006𥗄": "yk_󳬒", - "\u000b\u0002j,$󵑳(\u0005󲑖𫸗I8堟驟\u0019\u001e𡺽F": "q컺\u0002d럄p裤\u0016􌤹[𫅚􆊠tl󺉷hF?", - "\u0012\"\u0016\u0015)𗛢𥫘\u0013#Yf3\u000c": "0&UI+􈿝O𐴘Hl\"P\u001c\u0018X", - "\u001d󺋛-TdC/\\\u0000omf/﹈⾽𢛔_*\u0003󷫌선": "踾*🩅􄛍G\u0003'𬪉~𧇽KOI\u00190󰀞_'\u0017ꕓ󠅂𐧩:Q=9U", - "4\u0012\r􀐻\u0010": "\u0011B\r\r\u0004B𭄋剻8󿢞NR'⛙S%y@o\u001bPG", - "=b@\u00146Z/m[": "vF捡J󺘉\u0017\u00146F󶨋\"\u00184tB\u0019\u000cRhbt`H\u0019H+󿼮󳈿", - "YL󼕇\r": "", - "fM1_e%": "\u000c󱼇怕\u0005\u0011􎮚􉎀󽭴K/y", - "p\u000cj㘦u\n\rr钌hL4\u0014ꑟph\u0010F-": "􋧎69u~\\04븤\u001a9\u0017p", - "u𦙡%󽭞\u0007[!\u0010𮤂\t:M%": "b𤐑jb󺝰\u000b~y\u001b", - "}p*\u00191n󼮴\u0002I𝓗􈧩Z䩍m": "\r\u001b\u001b\u000c!󼄹<󹃷\u0003k󷭷h𐭘g\u0000 Yퟓo", - "􌃠|\u0006.\\VO\t\u0008O": "\u000c @\u001c𦖡􉈔\u0004xU\u0015􃻎C^O\u001b4\u0003\u0013a6c\u0007-\u001c󸳳7e𨨔", - "ꝃf&\u0000󿁻𣨢𦑫~q\u000c\u000c)M0手D&tu\u0007\u000b": "BH\u000c'ꅎ}a\u0002\u000eJ=V'𥟅􎨈t!9𭍕.􋭟\u000e", - "𠱩;\u0015SOmﴷb\u001aBq\u0016\t\\𝑤\\􃰝\u0010x 󼨐": "5v\u0013!焘+P㉢𗠶\u0000𠜦", - "𣉃cz𤸠(0\u0017/\u001eiKwut\u001e\u0004}􀁞\u0008\u000c󵤕\n": "#", - "𪔣$󷘗#E𩳉(󼇴N['𤈡o~wL䴃\u001b r:7⭸dmA": "{M𨆐rud`󶌜]v𐘀􊍥􊚘]\u001f\u0004(\u0003Aah𡀤Z.\u0012\u0016 ", - "󶃛C.IE\u0018": "mI%*O􀢩>!;D4`h\u0010T_v􀮻4e.", - "󻺦8i-m": "{GUBA&󷥨+\u0006R&\u001bSsDVk1", - "􃶓B->": "Q𤸟K𧿨􋑑𡸮󸏴g", - "􍵯U": "\\u\r嗭𒅞􋇽􌓅sWJ#𡐈d\u0017e.\u0007m􊪑tz<\u0007" + "\u0006\u0001T􈪥􌱶\u000c\u001cOr,𘌝Khᔅ멋́*r\u0017Yo)L$\u000fdGH": "!踋Wg\\ꔿ$𤒂<6pb!\u0003􅳉BH\u0013􉈘:+\u0019\u0002F\u0018=\u0000", + "\u0006,bOfoZ*+*🌝nd4\u0005𫰥V]𖦚3": "\u001b,\u0012󿻸W]Y\u001bE󶕴vDiw𦔋\u0007w崽\u001e毲􂗲\u000cD\tUY􁗈Y", + "\u0008]\u001f𬬼+t𤇌\tt\"(豓|@": "Z<\u0018%D\\FV|𧦎qS`@\u0013", + "\u00181=􏬪t􃷊퐓c\u0015;萈P𪗐%󹬑🐨Ug𬎾@o\\ao\u0012\u001c/": "4𩇀𡇉𗺖\u001b𧏾<>d~H\u0015VQ", + "\u00192&\u001dﾱc9-\u0016\u0008-Z锷\u0005l>": "W>\u0005-\na=,jm􅜙\u001c􀛍D𭋤M", + "+\u001bA9z󾟑E\u0014𡵔|Jk홄\u000e􏏿s;~yPY󷟟)\u000cw)": "\u001bl᷾􄅚𩕻䙶\u000c\u0004?szC𭒰u\u0018\u0014\u0000𠋍I𢭕", + "B\u0001\u0002V\u0019Ernb𬇚\u0011堮𮠓𩫎󳜺U󲛮\u0012p?\u000f\u0019Tl\u0015OH𪟾": "\u001a&=", + "Cᘹ?L\u0004\n󸙑\r3󳩅": "공𥇋󽗾㰔mr1\u001e𡃒@\u001b 𥔣BCm1\u0011Pw􋤄Vs\\", + "R51𢐥}\u0008V3\u0004=M}": "*9\"", + "W\u000c7|%": "6\u0003\u0010Xqꭡ\u0005", + "Wb仉U\u0004+7𨇼􂬅\u0000\u001c4󻯹]eM턅=沲ᨑ\u0008\\4\u001c􉶪": "􌆺𥀌󱰺~sg􆵦?𫘗w\u001e𫘡𫡥>7", + "_𪵗󽹪zK\r}": "p4􀬎&oh\u0014X󲼼&oHE;'eNj\nI@", + "jZ􎔎4P̞{B󿡂N󻿠𒒯aZ": "D𗱀󱲙\u0013\u001cI1", + "tK1R𝍵 󴿍󶮦\u0001": "󰓂\u0007zmw\rJꕗu\u000ec9\u001d\u0002􉈒󿎣", + "yVr􅗙'􅎯𫫧[𑌤W!𫮇𝥹x'!d": "􄖤", + "zt?\u0002\u0001": "\u0006󹳗^r\nLX]󲕫", + "~2+􆣹qp)𭕷&դ\u000c󿘯\u001c𡉛\u00087𬷬\u000fO%?􎛿Z7i" }, "urn:wire:scim:schemas:profile:1.0": { "richInfo": { diff --git a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_8.json b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_8.json index 6c923ecf637..139c35ea269 100644 --- a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_8.json +++ b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_8.json @@ -1,15 +1,11 @@ { "urn:ietf:params:scim:schemas:extension:wire:1.0:User": { - "": "𩌞", - ".1󸠬\u00012.?K>p\u0006GG𐃆U~": "\u0013\u001a\u00127\u0011S\u0019𣦲\u001c􍜯\u001c\u0006𩕐n󾠕x,H􅊕ZFrrU\n", - "=\u0016bD𥶛`8>󼄧'󶤜": "\\[\u0004\"\tg*~\u0017𤎬{\u00162%7_X镛\u0013bC\niE", - "A󰛘<\u0017u(ZbMख𭩰UeS!􎕾<\u0001;@\u0014\u0002+fwF\u000ea􀹶": "􉟯0\u00104\u0007𢐂(k\u0007c🄲䝢-󹗮W𠛪v\u0004\u000b&5J", - "Xpr3&D􇧕🥘^𡍎d\u0004\u001b{?\u0002Od軭\u000b\u0017\n􀏼,": "\u0010,[q\u0011B󷦪𖣜", - "p󼘖AclBh\t\u001ctf􆨺": "\u0006𫦏\t1F\tᒾ", - "yi\u0011:\"v綁b)\u0014.@E{𮘔󼃁𩵋YO": "`_h𨶲", - "𨃊𨋸_ꇺ\u001b^p": "B@\u000bE\n\r]P\u0002", - "􆥙󶖍\u000cU:": "Q%:t\u0012\u0005(ૺ:\u0000jꂽ8r>\u0012kmu𗎆", - "􌾧᧣$黈@􃊮7hQ8𨍋*\u0004-'I\u001d𤰜\u001f^?Oe\u0002ꗊj": "𥟱\t𝍒^oG\u0013T\u0017+\u000e\u0014g􈋷O<󰇟n,mcPi2%= " + "\u000c&3გ$ur𫚞oQ󹄏o\u0004": "~\u0017􈫞􏸍LR", + "1=D=\u0000v𬴂jD\u0005O(": "\u000bAlLMb\u0018vvn\u0013\u001bM𮇱X`𩇭", + "3\u0000𦰷\u0001\u0002􅥗`𣌕P\u001fKEV􍮈4U瞒Ox": "}83i𪨗􉩚􎦌\u0015􂢒𣗁6h\u0008𡿣I􂖶S\u0014\u0013OW%_\u0012*𡾒", + "CV󺦎/\u0014C󺴜EB*􅿳r󺏁\u0008󻩿󱬯𤽶m5𣓄i": "\u0015Ik\u0014", + "D\u001a\"𗎨d\u0002\u0000": "\r\u0012\u001b9罣C𗜬\u0011H𤼔𗧗\u0017󱼚wZ􄯒䆶𡹳\u0001}x>Fd\u000e&ጯ", + "􈉥🨑\u000b9\u0006yXg􏆫NU\u0005𐢉\u001e𐓛4e6󸖾\u0007$𗚽~": "E/V+~p􉧶\u0013ⲍa\u0003𓇒\u000b\u000c󺘿A[n6^N\t7" }, "urn:wire:scim:schemas:profile:1.0": { "richInfo": { diff --git a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_9.json b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_9.json index 7e91a1ee136..bf766e3949e 100644 --- a/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_9.json +++ b/libs/wire-api/test/golden/testObject_RichInfoMapAndList_user_9.json @@ -1,18 +1,21 @@ { "urn:ietf:params:scim:schemas:extension:wire:1.0:User": { - "\u0011C=D􊵯6m𬰚󻡤^􋈈]􏹒I]x\n\u000f\u001b\u001bt$\u001f\u0000iX\u0010\u001a󺄿": "H\u00004\tE(􋿷[𧁹l\u0003Gm\u00030y󽢸]𣴪􋬗)\u0013z?", - "\u0015􇺊R𓌐s": "\u0012\u000c𫡔4􌦜\u001f\r\u0013𨔒x", - " 𮏁􌪌b": "^L!𬒝?~i^\u0012W\u0017g󰹮􌸋*𑪋󷫜\u0017\"8􆌮j", - "55K鷕󶌜\r䘁􂴑􊡙󶠇\t󰅇R": "*H𩂞\u0008g􅽰$oU!9qDd;ተ;z𣸐R󴥢", - ";`)O􋹺㹭􎡖D(4l􄵰w\u000825": "󸒅\u0004o\u0000󺘴󷝴$㿿􊴒DH􆧒􉡥\tk(\u0018\u00051M􍣃𪓽\u0003cJ'", - "H렔󽥖􉾲%􅍠ꩄH\u001b;]󵚛\u0005𫙥\\x": "T巽􀖩\u001d𭐁mA8XI\u0005", - "Md6DS􍈰󰀿#\u00169e\u001f(\\󺋙L{𢉽􆤮\u0014𘁢\u001fp𩆊`vꍇ8\u0015": "B8S󰤊;Tc\u0014蓛那󰁔􂭽\u0000hp\\+󲛀]p1|M9RD𫆖n-\u0018", - "w㸣돽\u000f󺡞S&􏸐𬅷n;ᴎpo\u0008\u0006􆁱]I.8󾖰Nd􍏙\u000c\u0017U\u0007A": "\u000e>", - "}S{;䌆j|􆚹󹑃": "\n1+𨤇󸅮!Ix󼋙L\u0003੍𫦁z?邒5\u0014\u000b\"U%=ﬗe禴U", - "𧵯\u0019*􁠄\\t𨂶K𩷅x⍞󽼖愣5􊷛\u001e󸾢ᤘ": "nSq`\t\u000br\u001eQ\"Qj\u001fyE𩶺58e2\u0013:D\u0011𧼴Un\u001d", - "𭃁\u000b\u0018􌮱ᖙH㈤\u0004<\\󳕜􊯍W(Y\u0000􎑋": "\tb\u0010A䔞;䬓S嶴󿡙뛈%󶮮!/􋚤k􌤜", - "𮛿)󹸐is𩹼贞\u0006jJ*{p􃞯1𧶴zm6g^𫊨𐧘": "=y=\u001c𭣑K\u001e\u001dy8\u0010", - "􀌙wz󿘎坐\u000e󿿮\u0019+oqC𪐡^a[l󹌉Z𝒶7&\u001e\u0014r}": "Ihel\u0018\u0014邶󷌚\u000c2^*h`u\u0006\u001cu𩲑󸒋\u0014" + "": "6cPៀR", + "\u0014v-\u0002\u0004?\u0004Q[0𣸬mnFN\t/>\u0003􏼫V󴗩B\u0006F𪵖": "o\u0017?}7H𣮉Z𩁋7󰘟%4𪐛༧𨶾", + "\u0018\u0007\u0013H[s\u000693": "󾍔繩H\u0015􋮯🠢K􆥪\u0013(\u0016𬎖{X\u001c𮒁wV󼪂", + "\u001c@$'᭬LR􂠈w~o󶀹'\u0008": "Ms󺕢󼪁B󹯓M", + "$迓T􍺬nf\u0001T𠩬{z󺣘Goz\u001e_@[V\u0019󻴹8C6D": "F\u0013𑻠=k\u0014󱹲\u001d􂿸i𨁸1􃛭J𗿝m'P󺲼plO𭺰􁰉", + "2󹿺\u0008\"f}+ \u0005v\r󻣺\u0003]F@􅃆0R㻂": ",\u0006R􁈺!g𭣿", + "4fJ%*\u001f}Y󿢦\u0006V󷍄\u0013O􃗿\u001b2:{H*c󵥂𮒋z\t󹓳W": "G𩱳􊏈", + "?󿯲~d\u0013;U􎋐P󳉶zJ*{*T": ")|\u0013\u000cK", + "C􉑣}\"j2𡷰\u000bWi􀥌ࣛ󼒚\u000fDn𝣆􇿓􏟟傘9\u0007\u0007𥘷A\u0016": "&,61\u0001C󰵬uj>_", + "K\u000b`=7NH\t뵤󿈖\u0004H": "^_\\\\*𥡘𫛄\u001b\u0007󻻠󽼥AW\u0006'", + "RxS\u0018}\u0005i5鲘*Z󽡔󺩈": "{%\u0003IEz\u0019$O9嗐 󼣴RLt𠃤\t𧨽C\u0017󹖢[", + "^:;\u0018\u001cy4": "􂪁(0\u0012\u00033蕕U𫧊2􄼔౮F+=pd\rp􎳽瀕o", + "m9d5:O.4􌼸\u0013m": "V\r", + "𤪥": "\u0012I櫩\u0011&T𦼒x󿁸i\u0005下𦸪‥絁ZoH~P{4", + "󷵏<^ߏ\u001b𬼱lIdb􅻆\u0011^t\u0012𪭘􌲣𬩤Pb": "\u0003d-𮃧\u001e𫿟 z);],nC󹧹􄵙𬀎D󳿈\u0016\r2\u001cD", + "􀩏e4\u001e宏h^x^\u0019v\u0003+XJ𠽆[X􊭹\u0004􇊗'\u0010K􊿪𦃼": "T5⻃\u0017󿵂](}{\u0003󾮉'􇽓Mq5󹈴\u001a\u0005`s똾\u0012Zw" }, "urn:wire:scim:schemas:profile:1.0": { "richInfo": { diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/RichInfoAssocList_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/RichInfoAssocList_user.hs index abac2ff5bdb..0059d41573b 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/RichInfoAssocList_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/RichInfoAssocList_user.hs @@ -18,1304 +18,1266 @@ -- with this program. If not, see . module Test.Wire.API.Golden.Generated.RichInfoAssocList_user where -import Wire.API.User.RichInfo (RichField (RichField, richFieldType, richFieldValue), RichInfoAssocList (..)) +import Wire.API.User.RichInfo (RichField (RichField, richFieldType, richFieldValue), RichInfoAssocList (..), mkRichInfoAssocList) testObject_RichInfoAssocList_user_1 :: RichInfoAssocList testObject_RichInfoAssocList_user_1 = - RichInfoAssocList - { unRichInfoAssocList = - [ RichField - { richFieldType = - "\175690U\1001990z\1062812\1034953pFn\46922\n\152230uF*\ACK\v\SUB\ENQOx\1113270\61465\74578t3+\DC1\1019107K", - richFieldValue = "\1066577" - }, - RichField - { richFieldType = "M\DC1M\1016348\CAN\178322\1023014\&5d\1032312>VVg", - richFieldValue = "\1104094\1016210\92746\44474.&\DC3\1075849Y\155369\1934 zZjp?X" - }, - RichField {richFieldType = ",\1113069\NAK\"yC}\1093085\1084246e[;\10771b+", richFieldValue = "k6"}, - RichField - { richFieldType = "FYx}|N\DC4M\a\b]w%$F\1058804b1\180791?n\1062811\&6\1014474[\66243\DC1}\1089377", - richFieldValue = "s\v\1067524u" - }, - RichField - { richFieldType = - "\SYN9nO\SYN\68308\18659\984437\1027352\171032\CAN\160163k\1048886=4\ETX\18561ygxJCXX\1001592}\1086193\EOT\1029978\NULBI", - richFieldValue = "\181670\CAN'f\46768\&1X\95193\1017832n/\155865\&7'\STX\7195XvG\1088455+\10022m\SI]" - }, - RichField - { richFieldType = "\162153Cy\46767`*\f\1024362\137139.=}\DC3V\996360(\bb`\v\ENQ", - richFieldValue = "7}H\DELZg&V.\136826g" - }, - RichField - { richFieldType = "o\ETB\1091033\1014944\\g\98509w\US\aOsko\DC3}[\41196Tno\ETB", - richFieldValue = "\1104736\13635\"\73952" - }, - RichField - { richFieldType = - "a\991899l0vr\164444\ax%\r\985008\9732\38517\&4O+\181596\1031735&%\128604|\155652&\CAN\1100158\1002876", - richFieldValue = "O\1019876n\v-J\18561ygxJCXX\1001592}\1086193\EOT\1029978\NULBI", + richFieldValue = "\181670\CAN'f\46768\&1X\95193\1017832n/\155865\&7'\STX\7195XvG\1088455+\10022m\SI]" + }, + RichField + { richFieldType = "\162153Cy\46767`*\f\1024362\137139.=}\DC3V\996360(\bb`\v\ENQ", + richFieldValue = "7}H\DELZg&V.\136826g" + }, + RichField + { richFieldType = "o\ETB\1091033\1014944\\g\98509w\US\aOsko\DC3}[\41196Tno\ETB", + richFieldValue = "\1104736\13635\"\73952" + }, + RichField + { richFieldType = + "a\991899l0vr\164444\ax%\r\985008\9732\38517\&4O+\181596\1031735&%\128604|\155652&\CAN\1100158\1002876", + richFieldValue = "O\1019876n\v-J\SOH\t\25583\SIJC" - }, - RichField - { richFieldType = "\1111249DJ:\v\ACK\72192\985685hw0\t5", - richFieldValue = - "%\1091251\1085038\1059328\170243\136224\157033\1109474\142450\ETB\RS=7q\142668\75071SIs|\188045" - }, - RichField - { richFieldType = "G\ETX\ENQ\NUL\158597%@u\1023936\ESC\1034951ekh*\47107=", - richFieldValue = "\CAN/\n\CAN7;\1070882~X\3661nn\ETB\EMk|" - }, - RichField - { richFieldType = "-q\1023900\&3*Z\13478\NAK\US\bz67x; \SI", - richFieldValue = "\NAKr\185504e3x\STX>I#\ETB" - } - ] - } + mkRichInfoAssocList + [ RichField {richFieldType = "=\SI2\USH4g\1062242\f\DELL", richFieldValue = "a_*l8=\DLE$\1059691`\DC4\27751G"}, + RichField + { richFieldType = "\ESC&\DELws\1008180j\141960B\1030633\GS\n5\1048921\18933fI", + richFieldValue = + "h\DEL\1086305\1051590\1057796\5309\149513|ll/\CANe\ENQ\1020084NS\148765\&6>\SOH\t\25583\SIJC" + }, + RichField + { richFieldType = "\1111249DJ:\v\ACK\72192\985685hw0\t5", + richFieldValue = + "%\1091251\1085038\1059328\170243\136224\157033\1109474\142450\ETB\RS=7q\142668\75071SIs|\188045" + }, + RichField + { richFieldType = "G\ETX\ENQ\NUL\158597%@u\1023936\ESC\1034951ekh*\47107=", + richFieldValue = "\CAN/\n\CAN7;\1070882~X\3661nn\ETB\EMk|" + }, + RichField + { richFieldType = "-q\1023900\&3*Z\13478\NAK\US\bz67x; \SI", + richFieldValue = "\NAKr\185504e3x\STX>I#\ETB" + } + ] testObject_RichInfoAssocList_user_4 :: RichInfoAssocList testObject_RichInfoAssocList_user_4 = - RichInfoAssocList - { unRichInfoAssocList = - [ RichField - { richFieldType = "\1063796Rv\"\ENQs\CAN:1\SUBy\24238:", - richFieldValue = "\1058512F\NULhN\119622\1085667\&0\35686\181574" - }, - RichField - { richFieldType = "\1072040\16645s-\DLE\DC26\ESC@\SOH{\1064389\STX\194917\SO[4\SI\SOH", - richFieldValue = "9z=+\NAK*\SYNv3\136097\&7c\SI\DEL,Uy(u\r\nD\1045945\f\1088722" - }, - RichField - { richFieldType = "\154903\191088\NUL_\139176\164860\SOH\a.Q%IS\DC4", - richFieldValue = - "9Em\1063039\54874\ETXn\52578\EOT\NAKg+OF:\25064\NAKf\136698\97355\DLEQ8\EOT\ENQ\ETB`\SOH" - }, - RichField - { richFieldType = "\135951\DC1\US\NULH\EM2\GS\1031474\r\1043874&\16461\1013753~\61075g\1077972", - richFieldValue = "\ETBX" - }, - RichField - { richFieldType = "\1104463A+J.U+Q\DC2Py\1072407#.\1095281\1082444\nQ\44985_\1082407\16166.\1045722U;}", - richFieldValue = "\992542u\b*V5.>^-\26805-6V\174900\&6W/=\6501@\DC37k&;L\16676\ENQ\f" - }, - RichField - { richFieldType = "\134553\1036306O\1044451\1070819e\vk", - richFieldValue = "q\DC2sp/Y`44aRH}vs/<&\1067308?" - }, - RichField - { richFieldType = "&pL>5\997769\98479@", - richFieldValue = "\15639T\22034P<9qowDH\992582\159448p\16784\1071699C]#:\992074\18883\1111543\24972g" - }, - RichField - { richFieldType = "V\159272~yRTv\SOH\1091070C\1083996{D?0\27179\EOT&:\EOT]\1110508n\FSM\1029905", - richFieldValue = "\b\1094782\ETX\CANeeJab\NAK9\DC2\36545" - }, - RichField - { richFieldType = "\n\1104020\RS\181086\DELy\53844w", - richFieldValue = "=hJSu\a\STX\119918\&0$\SOHh>B\r\7410X>\STX\61823\&9\DLE,LOFw_P" - }, - RichField - { richFieldType = "", - richFieldValue = "{`\CAN\69918\1027349hI\1456\1058251y\1060373\f\30561\6721:u6\EM" - }, - RichField - { richFieldType = "\1087288R\1071817\190670+\2641& M\FS\186013Ulb,\1047278F}", - richFieldValue = "(\1061394\CANg\62997g\DC2=-AI-ZA8h\1074489\&7\STX\51230\EOT%R\GS\GSQW\21501\GS\NUL" - }, - RichField - { richFieldType = "\1026517sQddV[JX3\144338uPC\73930_", - richFieldValue = " \b\996044a%\1088184~\"\26135\GSHtZn\NAK\NAKEAYo\ACK2h\1102057\v" - }, - RichField - { richFieldType = - "xj\a\59803\1082871F\37221\DELSP\989768U(\31784]K\1082084t\1108265,\SUB*\1009478\DC3\173155J\1028380u\DC4", - richFieldValue = "#t[(a!\39215\&9z\\\181430kD\31932\ENQ\SI\DC1R\SYN\1056336\SYN\149936\FSLj" - }, - RichField {richFieldType = "XldA/\1108527\ESC\994759\94477&\"W<\f,\50096\f", richFieldValue = "\168892"}, - RichField - { richFieldType = "hZz", - richFieldValue = "\EOT\1064667\142317\1033140(?&\SI\1018361\ETX\f\NULK\1040290" - }, - RichField - { richFieldType = "T\162850-\NULjvKg7\46656\ETB\a@}", - richFieldValue = "\DLE\t\21385\SYNA\RS\RS\v\1043435\1065850L\SIID\STX\31932KD;l?G\SOHp\1040338u]" - }, - RichField - { richFieldType = "\DC4\1044844d\1031332\DC2!y%\1089873Mal<", - richFieldValue = "\tv\ETBw\GS\1034593\ACK\999322" - }, - RichField - { richFieldType = "\\L45&\r\171350\&5\SUBL\1084727\1094820rnD\SO36\1074959]mqnq", - richFieldValue = "i\GSv@<\ENQ\r\CANk\7534\174235O\44135&\153712" - }, - RichField {richFieldType = "\aS<", richFieldValue = "\174385@wz.\GS\188137M"} - ] - } + mkRichInfoAssocList + [ RichField + { richFieldType = "\1063796Rv\"\ENQs\CAN:1\SUBy\24238:", + richFieldValue = "\1058512F\NULhN\119622\1085667\&0\35686\181574" + }, + RichField + { richFieldType = "\1072040\16645s-\DLE\DC26\ESC@\SOH{\1064389\STX\194917\SO[4\SI\SOH", + richFieldValue = "9z=+\NAK*\SYNv3\136097\&7c\SI\DEL,Uy(u\r\nD\1045945\f\1088722" + }, + RichField + { richFieldType = "\154903\191088\NUL_\139176\164860\SOH\a.Q%IS\DC4", + richFieldValue = + "9Em\1063039\54874\ETXn\52578\EOT\NAKg+OF:\25064\NAKf\136698\97355\DLEQ8\EOT\ENQ\ETB`\SOH" + }, + RichField + { richFieldType = "\135951\DC1\US\NULH\EM2\GS\1031474\r\1043874&\16461\1013753~\61075g\1077972", + richFieldValue = "\ETBX" + }, + RichField + { richFieldType = "\1104463A+J.U+Q\DC2Py\1072407#.\1095281\1082444\nQ\44985_\1082407\16166.\1045722U;}", + richFieldValue = "\992542u\b*V5.>^-\26805-6V\174900\&6W/=\6501@\DC37k&;L\16676\ENQ\f" + }, + RichField + { richFieldType = "\134553\1036306O\1044451\1070819e\vk", + richFieldValue = "q\DC2sp/Y`44aRH}vs/<&\1067308?" + }, + RichField + { richFieldType = "&pL>5\997769\98479@", + richFieldValue = "\15639T\22034P<9qowDH\992582\159448p\16784\1071699C]#:\992074\18883\1111543\24972g" + }, + RichField + { richFieldType = "V\159272~yRTv\SOH\1091070C\1083996{D?0\27179\EOT&:\EOT]\1110508n\FSM\1029905", + richFieldValue = "\b\1094782\ETX\CANeeJab\NAK9\DC2\36545" + }, + RichField + { richFieldType = "\n\1104020\RS\181086\DELy\53844w", + richFieldValue = "=hJSu\a\STX\119918\&0$\SOHh>B\r\7410X>\STX\61823\&9\DLE,LOFw_P" + }, + RichField + { richFieldType = "", + richFieldValue = "{`\CAN\69918\1027349hI\1456\1058251y\1060373\f\30561\6721:u6\EM" + }, + RichField + { richFieldType = "\1087288R\1071817\190670+\2641& M\FS\186013Ulb,\1047278F}", + richFieldValue = "(\1061394\CANg\62997g\DC2=-AI-ZA8h\1074489\&7\STX\51230\EOT%R\GS\GSQW\21501\GS\NUL" + }, + RichField + { richFieldType = "\1026517sQddV[JX3\144338uPC\73930_", + richFieldValue = " \b\996044a%\1088184~\"\26135\GSHtZn\NAK\NAKEAYo\ACK2h\1102057\v" + }, + RichField + { richFieldType = + "xj\a\59803\1082871F\37221\DELSP\989768U(\31784]K\1082084t\1108265,\SUB*\1009478\DC3\173155J\1028380u\DC4", + richFieldValue = "#t[(a!\39215\&9z\\\181430kD\31932\ENQ\SI\DC1R\SYN\1056336\SYN\149936\FSLj" + }, + RichField {richFieldType = "XldA/\1108527\ESC\994759\94477&\"W<\f,\50096\f", richFieldValue = "\168892"}, + RichField + { richFieldType = "hZz", + richFieldValue = "\EOT\1064667\142317\1033140(?&\SI\1018361\ETX\f\NULK\1040290" + }, + RichField + { richFieldType = "T\162850-\NULjvKg7\46656\ETB\a@}", + richFieldValue = "\DLE\t\21385\SYNA\RS\RS\v\1043435\1065850L\SIID\STX\31932KD;l?G\SOHp\1040338u]" + }, + RichField + { richFieldType = "\DC4\1044844d\1031332\DC2!y%\1089873Mal<", + richFieldValue = "\tv\ETBw\GS\1034593\ACK\999322" + }, + RichField + { richFieldType = "\\L45&\r\171350\&5\SUBL\1084727\1094820rnD\SO36\1074959]mqnq", + richFieldValue = "i\GSv@<\ENQ\r\CANk\7534\174235O\44135&\153712" + }, + RichField {richFieldType = "\aS<", richFieldValue = "\174385@wz.\GS\188137M"} + ] testObject_RichInfoAssocList_user_5 :: RichInfoAssocList testObject_RichInfoAssocList_user_5 = - RichInfoAssocList - { unRichInfoAssocList = - [ RichField - { richFieldType = - "\1058074Sp\b[I\29193\997210\1058853\19289B,}\DC3\NUL\187059!\1012205\987236~\tTqV\SUB\a\SYN\110844k", - richFieldValue = "=S\140630\1012243\161698F\SYN~\fR\ETXqZ`Bx" - }, - RichField - { richFieldType = "hE\1012964\1056279~\SOH\nN/\FS\t\17418dO\2151O;T8_\n\1021592\t\NULOv\USb\153584", - richFieldValue = "``]Q\1071467\bA\ACK\"\f\RS\183455\998498\83488\&2\1106229\128464," - }, - RichField - { richFieldType = "'v\150628B\16214\&0\1073332\1103105\35421\1113333\170900#", - richFieldValue = "=\142650F" - }, - RichField {richFieldType = "\4034E", richFieldValue = "\1045535#Q\180166[W"}, - RichField - { richFieldType = "\DC3}\a\994220", - richFieldValue = "rBpC\1024450\SUBo00}\f\63157\39933\44397&V4U\1101222qI<" - }, - RichField - { richFieldType = "\SOHe", - richFieldValue = "\DEL<\1050297ThA\4266\&35\61423OIR+\SO0\NULGTv\STX\ESC\DLE\1076990M\NAK" - }, - RichField - { richFieldType = "\49319\1053232\54741&\37706\NUL,(z\97385\DC1p\STX\1076216(", - richFieldValue = "i_\1098716\EMM!\26326" - }, - RichField - { richFieldType = - "?.J\1019207\&3um+\48924jD\SYNd\39798\CAN\ACK/\tP&\147834\65883z)\\\1020210\5241\1071076n6", - richFieldValue = "=GTO\v\1092875d~f_R/\ENQE\187859p_N\EM2Y4\DC1p\182613\1026233\1031051\&1" - }, - RichField - { richFieldType = "$jc\99360\1012255\EM\v\ETX\1061187\31226\&5W\\\1041202lk$", - richFieldValue = "\1099337\ETB\NUL>Pb\1093386\n\1098407\&7t\1068018MHR\1034725*" - }, - RichField {richFieldType = "\1050912", richFieldValue = "/"}, - RichField - { richFieldType = "G\DC1D\SUBRr\SYN.\ETX\1087908,\SOH\f(\SUB", - richFieldValue = - "\144978W\SO\1030982+a\1093774}\999895\151152\151022\1056699\147086\ENQ\74190I\150719\1056992\17624[p\NAK\ETB\DEL91:=" - }, - RichField - { richFieldType = "D\DLE\1106169\SYN.CXF>c\1047901\1056176", - richFieldValue = "\25918uT,-/\1079561\\\GS" - }, - RichField - { richFieldType = "\167873\EMUt\65679\1108698Qi\194661w\GS&\20039\EOT5\NAK\173596\&1\23481", - richFieldValue = - "\SYNM\92352B'\993478\1036322y\EMB8\1015721C\28847\ETX\47769\SYNZ\DLE\144749.j;C)4\153569r" - }, - RichField - { richFieldType = "0x{\12350';\EOT\55052\49650\ENQ8\136958?>\FS=-j\bx", - richFieldValue = "Hb\1070422\1045972-\172774g\NUL\29030.\b\176622xRxg\1005506n=\997223\ENQqf}\EOT\GSo" - }, - RichField - { richFieldType = "d\1087700\FS+^\174809\1045962\">T\SYNq/f\1069165\&8ik", - richFieldValue = "L\r\40597D\ESCajF\1100046\986986\78522O\t\1105182.\r7\144450" - }, - RichField - { richFieldType = "n\DC1\1078355=\33947\1111389\68166\ENQ\RS\SOp/>y\1037592'lgq\136635\1554\DC38^>G", - richFieldValue = "t\SYNx\US\FS{9\160406\133909gr:\ACK~\CAN1\SUB(Kyo+\993260>" - }, - RichField - { richFieldType = "Td", - richFieldValue = - "\69934/\STXDl\USb\n\GS\144622)]\DC2s{M(m\1021550\26164\1056212\SYN\ENQU\1064419\ETXU\8643!:" - }, - RichField - { richFieldType = "z\110859UTUu\ETXxB*\1020552R\DC4", - richFieldValue = - "2\1024021\1090650\ETX\177428\1080339+}\45258\1021612<\ESCa\97827\&9\STX\1044763\v\37608\1040635\1031653\1111650\987794" - }, - RichField - { richFieldType = "6\NAK\1019574\txd\1011615\fD\CANWap\ETXO\1097230r\1039464\36065z\DLE", - richFieldValue = "\1065855\SYN\US||\1112228}\97211S[\1071544K\r\32092.g\59753" - } - ] - } + mkRichInfoAssocList + [ RichField + { richFieldType = + "\1058074Sp\b[I\29193\997210\1058853\19289B,}\DC3\NUL\187059!\1012205\987236~\tTqV\SUB\a\SYN\110844k", + richFieldValue = "=S\140630\1012243\161698F\SYN~\fR\ETXqZ`Bx" + }, + RichField + { richFieldType = "hE\1012964\1056279~\SOH\nN/\FS\t\17418dO\2151O;T8_\n\1021592\t\NULOv\USb\153584", + richFieldValue = "``]Q\1071467\bA\ACK\"\f\RS\183455\998498\83488\&2\1106229\128464," + }, + RichField + { richFieldType = "'v\150628B\16214\&0\1073332\1103105\35421\1113333\170900#", + richFieldValue = "=\142650F" + }, + RichField {richFieldType = "\4034E", richFieldValue = "\1045535#Q\180166[W"}, + RichField + { richFieldType = "\DC3}\a\994220", + richFieldValue = "rBpC\1024450\SUBo00}\f\63157\39933\44397&V4U\1101222qI<" + }, + RichField + { richFieldType = "\SOHe", + richFieldValue = "\DEL<\1050297ThA\4266\&35\61423OIR+\SO0\NULGTv\STX\ESC\DLE\1076990M\NAK" + }, + RichField + { richFieldType = "\49319\1053232\54741&\37706\NUL,(z\97385\DC1p\STX\1076216(", + richFieldValue = "i_\1098716\EMM!\26326" + }, + RichField + { richFieldType = + "?.J\1019207\&3um+\48924jD\SYNd\39798\CAN\ACK/\tP&\147834\65883z)\\\1020210\5241\1071076n6", + richFieldValue = "=GTO\v\1092875d~f_R/\ENQE\187859p_N\EM2Y4\DC1p\182613\1026233\1031051\&1" + }, + RichField + { richFieldType = "$jc\99360\1012255\EM\v\ETX\1061187\31226\&5W\\\1041202lk$", + richFieldValue = "\1099337\ETB\NUL>Pb\1093386\n\1098407\&7t\1068018MHR\1034725*" + }, + RichField {richFieldType = "\1050912", richFieldValue = "/"}, + RichField + { richFieldType = "G\DC1D\SUBRr\SYN.\ETX\1087908,\SOH\f(\SUB", + richFieldValue = + "\144978W\SO\1030982+a\1093774}\999895\151152\151022\1056699\147086\ENQ\74190I\150719\1056992\17624[p\NAK\ETB\DEL91:=" + }, + RichField + { richFieldType = "D\DLE\1106169\SYN.CXF>c\1047901\1056176", + richFieldValue = "\25918uT,-/\1079561\\\GS" + }, + RichField + { richFieldType = "\167873\EMUt\65679\1108698Qi\194661w\GS&\20039\EOT5\NAK\173596\&1\23481", + richFieldValue = + "\SYNM\92352B'\993478\1036322y\EMB8\1015721C\28847\ETX\47769\SYNZ\DLE\144749.j;C)4\153569r" + }, + RichField + { richFieldType = "0x{\12350';\EOT\55052\49650\ENQ8\136958?>\FS=-j\bx", + richFieldValue = "Hb\1070422\1045972-\172774g\NUL\29030.\b\176622xRxg\1005506n=\997223\ENQqf}\EOT\GSo" + }, + RichField + { richFieldType = "d\1087700\FS+^\174809\1045962\">T\SYNq/f\1069165\&8ik", + richFieldValue = "L\r\40597D\ESCajF\1100046\986986\78522O\t\1105182.\r7\144450" + }, + RichField + { richFieldType = "n\DC1\1078355=\33947\1111389\68166\ENQ\RS\SOp/>y\1037592'lgq\136635\1554\DC38^>G", + richFieldValue = "t\SYNx\US\FS{9\160406\133909gr:\ACK~\CAN1\SUB(Kyo+\993260>" + }, + RichField + { richFieldType = "Td", + richFieldValue = + "\69934/\STXDl\USb\n\GS\144622)]\DC2s{M(m\1021550\26164\1056212\SYN\ENQU\1064419\ETXU\8643!:" + }, + RichField + { richFieldType = "z\110859UTUu\ETXxB*\1020552R\DC4", + richFieldValue = + "2\1024021\1090650\ETX\177428\1080339+}\45258\1021612<\ESCa\97827\&9\STX\1044763\v\37608\1040635\1031653\1111650\987794" + }, + RichField + { richFieldType = "6\NAK\1019574\txd\1011615\fD\CANWap\ETXO\1097230r\1039464\36065z\DLE", + richFieldValue = "\1065855\SYN\US||\1112228}\97211S[\1071544K\r\32092.g\59753" + } + ] testObject_RichInfoAssocList_user_6 :: RichInfoAssocList testObject_RichInfoAssocList_user_6 = - RichInfoAssocList - { unRichInfoAssocList = - [ RichField - { richFieldType = "a\998215y\1077716\RS\100535\37565n\SUBMr&Pw32Ov\DC3S\FS\34138W\54492}\4177(\13419\SO", - richFieldValue = "\120944{y\97231NE\f-\1047143zG~7x`\ENQ\164539\ENQ\1028264;\25203\170629\33810\EM\DC4" - }, - RichField - { richFieldType = "gS\64579L2RM\f~\b]5$vT", - richFieldValue = "\29272\1078238gN\156081(v\58001:ZHY\63999M" - }, - RichField {richFieldType = "8\ACK\DC2\SUBC\SYN", richFieldValue = "S\998908\917537\DC3;"}, - RichField {richFieldType = "%\162737c[6\SOH", richFieldValue = "2\24307\"<\154824"}, - RichField - { richFieldType = "@\CAN\bH\157749TB Hf mgi", - richFieldValue = "\EMZ`>\1062402w.\EMVz\137144\1051317\STX\SUBO\DC1\100606\94682\NAK\CANXAO5@" - }, - RichField - { richFieldType = "E\CAN\f\DLE\a\SOH/G\f\1059169\38328\1059714U]:y\ETB[j8:\37815\150478\43855u", - richFieldValue = "O,&`\1101021\STX\1015213i.\DLEF G\1101217\&5" - }, - RichField - { richFieldType = "\1096285\FSs\r\73789t\ETX\175357h", - richFieldValue = "_&j\152667\172804c\EOT\a\GSw\n\157792Ot\31750\37291O\1025275\993101\121061!w\143203\n" - }, - RichField - { richFieldType = "J\1004813\36545WP\rFxM\ESC\SYNS", - richFieldValue = - "f\1063472nX\16750`\DC3\160311\DC1\DC1\131450\1048339WhW\SI;\NUL}p\58983\188907\DC4>\34382e" - }, - RichField - { richFieldType = "ZTu\CANc\SO\DC4[=2\1052981UcC-jV@\1092854fN", - richFieldValue = "8\"gFT\51988X&\23259\1001492D\1096274\1043113\1031228" - }, - RichField - { richFieldType = "E~L\DC4\CAN\128531p)\ESCW", - richFieldValue = "?X\US\SYN\v\126535\174210\&2\23683J\175559\&5F*BT\EOT\985655\ETX\DC3&" - }, - RichField - { richFieldType = "6z\1009540\1092302G/T)e!v\175881\ENQ|\US%B9\ETB]\DC2lL\1106533", - richFieldValue = "\f\994495n\161852\&3\1032458:\177020\1072546}\\BI\185727@'[\RS2w\1050892" - }, - RichField - { richFieldType = "]S\1070258\984714\1107851w\US\1015967\ACK*o\1105591O`\EM\v\STXl(", - richFieldValue = "\ESC\1060700V\1010105jv" - }, - RichField - { richFieldType = "6\SOl\SO\SYNEb!\1106786\159268C", - richFieldValue = "\189345\SYNas\1054844r>\986723" - }, - RichField - { richFieldType = "BkfZq*C>I\1010114\1044822\DC3#\158977.\1034261%\CANX\1029958(_,\36557", - richFieldValue = "xy\1037182\61200Pw\22772\US\991289\DC1p\NUL\ENQ#" - }, - RichField - { richFieldType = ",{\ENQ\ENQER\151822\bB\US\\;\DC4\34102\1020482\&7\DLE\996367Bk\1032765\EM\1074745]\SOHY", - richFieldValue = "\GS\67664\&4\vH\194626\15866\DC2\68473\1017057\ACKJZc\74900" - }, - RichField - { richFieldType = "\ESC4\1099678\35269A\"9\DC34\DEL\DLE\1005531g", - richFieldValue = "\RSM[\987902x\60790\1036742\f\DC2/\ab\r.#s\\\"w)?\161633\1099638\&3\SYNw\1089908" - }, - RichField - { richFieldType = "\1074883G\132288\1056622\SOH\STX\1086605._e\SUBQv\1099099dn\GS\1085394\1008173\18149", - richFieldValue = "\95396H\133595" - }, - RichField - { richFieldType = "3\RS<\NAK>O\51074\1044903\vHJDXU+\1105619~4+", - richFieldValue = "T\1032335\DEL\1015247\EOT*" - }, - RichField {richFieldType = ",", richFieldValue = "\SOx\2364X\ETX@\168743xll;*\137532"}, - RichField - { richFieldType = - "ksP~R\994672\171515mo\999143\1086881\NAK\32864K\v\1047794\GS\nV\48748\181856\RSZ\1061540\1012713", - richFieldValue = "\a\5508" - } - ] - } + mkRichInfoAssocList + [ RichField + { richFieldType = "a\998215y\1077716\RS\100535\37565n\SUBMr&Pw32Ov\DC3S\FS\34138W\54492}\4177(\13419\SO", + richFieldValue = "\120944{y\97231NE\f-\1047143zG~7x`\ENQ\164539\ENQ\1028264;\25203\170629\33810\EM\DC4" + }, + RichField + { richFieldType = "gS\64579L2RM\f~\b]5$vT", + richFieldValue = "\29272\1078238gN\156081(v\58001:ZHY\63999M" + }, + RichField {richFieldType = "8\ACK\DC2\SUBC\SYN", richFieldValue = "S\998908\917537\DC3;"}, + RichField {richFieldType = "%\162737c[6\SOH", richFieldValue = "2\24307\"<\154824"}, + RichField + { richFieldType = "@\CAN\bH\157749TB Hf mgi", + richFieldValue = "\EMZ`>\1062402w.\EMVz\137144\1051317\STX\SUBO\DC1\100606\94682\NAK\CANXAO5@" + }, + RichField + { richFieldType = "E\CAN\f\DLE\a\SOH/G\f\1059169\38328\1059714U]:y\ETB[j8:\37815\150478\43855u", + richFieldValue = "O,&`\1101021\STX\1015213i.\DLEF G\1101217\&5" + }, + RichField + { richFieldType = "\1096285\FSs\r\73789t\ETX\175357h", + richFieldValue = "_&j\152667\172804c\EOT\a\GSw\n\157792Ot\31750\37291O\1025275\993101\121061!w\143203\n" + }, + RichField + { richFieldType = "J\1004813\36545WP\rFxM\ESC\SYNS", + richFieldValue = + "f\1063472nX\16750`\DC3\160311\DC1\DC1\131450\1048339WhW\SI;\NUL}p\58983\188907\DC4>\34382e" + }, + RichField + { richFieldType = "ZTu\CANc\SO\DC4[=2\1052981UcC-jV@\1092854fN", + richFieldValue = "8\"gFT\51988X&\23259\1001492D\1096274\1043113\1031228" + }, + RichField + { richFieldType = "E~L\DC4\CAN\128531p)\ESCW", + richFieldValue = "?X\US\SYN\v\126535\174210\&2\23683J\175559\&5F*BT\EOT\985655\ETX\DC3&" + }, + RichField + { richFieldType = "6z\1009540\1092302G/T)e!v\175881\ENQ|\US%B9\ETB]\DC2lL\1106533", + richFieldValue = "\f\994495n\161852\&3\1032458:\177020\1072546}\\BI\185727@'[\RS2w\1050892" + }, + RichField + { richFieldType = "]S\1070258\984714\1107851w\US\1015967\ACK*o\1105591O`\EM\v\STXl(", + richFieldValue = "\ESC\1060700V\1010105jv" + }, + RichField + { richFieldType = "6\SOl\SO\SYNEb!\1106786\159268C", + richFieldValue = "\189345\SYNas\1054844r>\986723" + }, + RichField + { richFieldType = "BkfZq*C>I\1010114\1044822\DC3#\158977.\1034261%\CANX\1029958(_,\36557", + richFieldValue = "xy\1037182\61200Pw\22772\US\991289\DC1p\NUL\ENQ#" + }, + RichField + { richFieldType = ",{\ENQ\ENQER\151822\bB\US\\;\DC4\34102\1020482\&7\DLE\996367Bk\1032765\EM\1074745]\SOHY", + richFieldValue = "\GS\67664\&4\vH\194626\15866\DC2\68473\1017057\ACKJZc\74900" + }, + RichField + { richFieldType = "\ESC4\1099678\35269A\"9\DC34\DEL\DLE\1005531g", + richFieldValue = "\RSM[\987902x\60790\1036742\f\DC2/\ab\r.#s\\\"w)?\161633\1099638\&3\SYNw\1089908" + }, + RichField + { richFieldType = "\1074883G\132288\1056622\SOH\STX\1086605._e\SUBQv\1099099dn\GS\1085394\1008173\18149", + richFieldValue = "\95396H\133595" + }, + RichField + { richFieldType = "3\RS<\NAK>O\51074\1044903\vHJDXU+\1105619~4+", + richFieldValue = "T\1032335\DEL\1015247\EOT*" + }, + RichField {richFieldType = ",", richFieldValue = "\SOx\2364X\ETX@\168743xll;*\137532"}, + RichField + { richFieldType = + "ksP~R\994672\171515mo\999143\1086881\NAK\32864K\v\1047794\GS\nV\48748\181856\RSZ\1061540\1012713", + richFieldValue = "\a\5508" + } + ] testObject_RichInfoAssocList_user_7 :: RichInfoAssocList testObject_RichInfoAssocList_user_7 = - RichInfoAssocList - { unRichInfoAssocList = - [ RichField {richFieldType = "\59760O,*w%5inz`\1079939", richFieldValue = " "}, - RichField - { richFieldType = "Bz\DC2\59467g\v\STX\fY\57696,\1001271mvfB*#;", - richFieldValue = "\1014004\170809\1044242kYf\41280\164164\96853P\1011806\1010965\94530\SIr\1015277\SYN" - }, - RichField - { richFieldType = "\DC2\13392\a2\52387X\FS\1104589", - richFieldValue = "\fw\1003354\&6\49983\b\1060610lJmp;\1004965" - }, - RichField - { richFieldType = "3\1018102\&8@\USw", - richFieldValue = "p\USl\SOH\1056408\33374\138542jM|\FS\96426o\155784\DC2FeN\DC1\94061\v\10893\ACK\ENQ" - }, - RichField - { richFieldType = "m\57461+\NUL\ETB\SUBZw\95429+T2", - richFieldValue = "\DC2\9735\1060543m\185975E\20063.\bu6\"#w\24235\ETXs<\a'@\RS\EMy\DC4\ETX\SOs" - }, - RichField - { richFieldType = "%2\1036525=[\1073532M([w", - richFieldValue = "n\111074\174053<8\1060215E]R-S5]Blc\NAK\STX\1075421\DC3Y\147359\SYN\EM?" - }, - RichField - { richFieldType = ".\1077117L\tgU\DELM4\1018961ypK\1107896\990422/\182543+u]V{\20798", - richFieldValue = "\1049116\ETX\1103128-l\183670bXBE\1015532\985399\&2\1105082" - }, - RichField - { richFieldType = "\1049031\&1G&\1071220\1109534}\1085264(p\1113553\SOH", - richFieldValue = "J\EOT\DC1O\RSb\917996;\ETB8NQ\DC3\t" - }, - RichField - { richFieldType = "Wa\1105889dR+p\98617\1041299\SI\180275\995201p\bx\175081t\1037024\NUL1\SO\SIPD", - richFieldValue = "7\1087241f\1031652f" - }, - RichField - { richFieldType = "JW\SO\STXus\STX\1112624\992907K\984541\127051\141895", - richFieldValue = "\SO\SI.1\1064812\SOH\1076879:^kJ\154373\fdQj\1089754]\SOH" - }, - RichField - { richFieldType = "\ENQ\185659\&5l\1041167\&3n{\ACK\CANU\18977" - }, - RichField - { richFieldType = "72&9B$o\DELAzN`C\US\SOD\1063128\&8", - richFieldValue = "\DC3/\96708<\1062693\NAK\36858\59443\1067685\EOTm(_PL" - }, - RichField - { richFieldType = "9\ENQU\1051553\991936HU^l\29748\ENQ?*\DC1\131383Td\1033364", - richFieldValue = "\1022953\138591\139774?f" - }, - RichField - { richFieldType = "O\DEL\USX4h\50123a\1095417\RSf{/<\1051397@\\CbvtN\v\v2\1009859t\NAK\ETB", - richFieldValue = "\1026487\1067138FS`#\ESC" - }, - RichField - { richFieldType = - "KGO\1076639X\1038322%}\1063168Z\155249U\1055475_`\1029627q\DC1\25719\EOT$\US\178421\SYNXN\DC2R", - richFieldValue = - "8g\990491\48286\US\\<\1007728\ESCI\NUL\7993l\SO\1014465i\STXg\121153\\y\171297\ENQ\FS_\62300" - }, - RichField - { richFieldType = - "\1099017\147532nF\1025208$>\1008575#\159235\ENQ\DC4d\NAK\US\984526F]\166620\1074705w\35634\1034322", - richFieldValue = "\rx{\ACKu\134937vL\38752\DEL\1074929\\;)*Kk\DC3\DC4~\ETX{\66629$\99826" - }, - RichField - { richFieldType = "kd(X$\190599\ETX]rP6\25769>wi\39881\CAN8\STX}\1009277\SUBw2", - richFieldValue = "\185962\1111906q4t\EOTB" - }, - RichField {richFieldType = "90\1061585#\b-/G", richFieldValue = "m\DC1,\8378"} - ] - } + mkRichInfoAssocList + [ RichField + { richFieldType = + "Dz\155855s\999889\1101510\157964\&7u\998749\15517\EOT\25197}k=R\139889\DC4\ETB+\SYNY73\1014748:", + richFieldValue = "+5+[\v\a*>\DC3n/.BG\166195\NUL\185948Y?i" + }, + RichField + { richFieldType = "g\DC2\1084586\DC3\37348h\1089059\&8`\SYN\EMx<\1044822\ACKc@3\t&Cv", + richFieldValue = "\1051479\28869K]\128252j8\4946\167477#,\1010498\185879\1106675V}\STX\SI\ETB" + }, + RichField + { richFieldType = "Z\997327\1019741@07\1059071\ESC\DC30\SI\SOH\EOTfVP\20857\DLE)", + richFieldValue = "I\EMO\168876\DEL\SI&bP\1014446\SOHb\1074688Z\168011S\1005710E\r]3j<|2:\a" + }, + RichField + { richFieldType = "\1111387/ guMT\SOH\1068615\"{S\t\1027927\917983M\160781\ETXZ.F6", + richFieldValue = "a]\1071896\EOT?@;!\1080766\a\178638\990706\1072699\t#x\STX\1004848" + }, + RichField + { richFieldType = "\ETBVLH%B&\STXq\1066510\"o\CAN", + richFieldValue = "\SOZ}\t\ESCY(G\128003'\EOTJ:\f[g^X\r\984532" + }, + RichField + { richFieldType = "\1068401\GS\\\4179\RS/w\ACK\170076,f", + richFieldValue = "s\SOon\SOHt\150057M\1029781\SO\33256Ul\65130GG+b3\167477" + }, + RichField {richFieldType = "Nl\SUB\175775Qk\DC3", richFieldValue = "\156365\187519\1073758{&\SO\62820P2@"}, + RichField {richFieldType = "d\1111898\1096424g", richFieldValue = "2\1039259"}, + RichField + { richFieldType = "\NAK:%j\ETBD\154437\1103727M?\69721Jo\ENQ\185659\&5l\1041167\&3n{\ACK\CANU\18977" + }, + RichField + { richFieldType = "72&9B$o\DELAzN`C\US\SOD\1063128\&8", + richFieldValue = "\DC3/\96708<\1062693\NAK\36858\59443\1067685\EOTm(_PL" + }, + RichField + { richFieldType = "9\ENQU\1051553\991936HU^l\29748\ENQ?*\DC1\131383Td\1033364", + richFieldValue = "\1022953\138591\139774?f" + }, + RichField + { richFieldType = "O\DEL\USX4h\50123a\1095417\RSf{/<\1051397@\\CbvtN\v\v2\1009859t\NAK\ETB", + richFieldValue = "\1026487\1067138FS`#\ESC" + }, + RichField + { richFieldType = + "KGO\1076639X\1038322%}\1063168Z\155249U\1055475_`\1029627q\DC1\25719\EOT$\US\178421\SYNXN\DC2R", + richFieldValue = + "8g\990491\48286\US\\<\1007728\ESCI\NUL\7993l\SO\1014465i\STXg\121153\\y\171297\ENQ\FS_\62300" + }, + RichField + { richFieldType = + "\1099017\147532nF\1025208$>\1008575#\159235\ENQ\DC4d\NAK\US\984526F]\166620\1074705w\35634\1034322", + richFieldValue = "\rx{\ACKu\134937vL\38752\DEL\1074929\\;)*Kk\DC3\DC4~\ETX{\66629$\99826" + }, + RichField + { richFieldType = "kd(X$\190599\ETX]rP6\25769>wi\39881\CAN8\STX}\1009277\SUBw2", + richFieldValue = "\185962\1111906q4t\EOTB" + }, + RichField {richFieldType = "90\1061585#\b-/G", richFieldValue = "m\DC1,\8378"} + ] testObject_RichInfoAssocList_user_9 :: RichInfoAssocList testObject_RichInfoAssocList_user_9 = - RichInfoAssocList - { unRichInfoAssocList = - [ RichField - { richFieldType = "", - richFieldValue = - "Q\53780\EMf\SO\DC1\1048800(W\1056864\988934;\179116s5\GSb;U\ETB\984630D*\DC3\30451\SUB\f4" - }, - RichField - { richFieldType = "\SUB\27593o$\tm1\NULPIe\96689!e\151526\CAND\139821b\73918\1012381\&87N\1106457\SOH", - richFieldValue = - "\\\CAN-%N\186394rW\1069397\182654\STX\32472\1096218?{\t\1103035c\992153}C\v\1051414>\156522\&9" - }, - RichField - { richFieldType = - "\DC2\ETB:#j\1016570\995014R\SUB\8139\46197\DC3\1001317\fX\1019967{\a\FS\1088211$\DC1@\NUL", - richFieldValue = "!3\ENQ#\8659\984383aA\990391\RS\1024087" - }, - RichField - { richFieldType = "\GS!\EOT\DC1[.\EM\43062\18906\NAK\73677\1008044 \1031011V@\1103400\995687uX", - richFieldValue = "\ENQF\143759}w" - }, - RichField {richFieldType = "i|O;?\f8*\NUL{\r`\1102254", richFieldValue = "\1058311],%5gtF&\DC1\100311"}, - RichField - { richFieldType = - "\1083150X\53916\28226\&6Y|\SOHq\21832,$\992122k\ESCA\156055\121501X\EOT\181872^^\142236\&4\US#Lh", - richFieldValue = "E(*\166750\SIF\191040\ETBf\STX." - }, - RichField - { richFieldType = "D\96871|\19034\t\165096\ENQP\DLE\135992.HT%\148302\STX21\r\137838]\t\DC4\DC4\1023982\f", - richFieldValue = ")#\ETB\1093437Xv\172325\DLEC\n\995484" - }, - RichField {richFieldType = "_\1100172DV", richFieldValue = "<_y\NULnqk\rQCrz\FS2\ENQ\1019845\&3\DC4."}, - RichField - { richFieldType = "A\26230AyU*U\1040076X\2792p\1089124/\49419\US^\NULA\ESC\EM]\159839\58492\1084799%?C", - richFieldValue = " {\171966&\134026M7c@&_\US\1041536\DC2q\71108\179421" - }, - RichField - { richFieldType = "\SI\132269W2\DC1O\1035974t\SOH\1003251\36469", - richFieldValue = "\ETX\1025341\ESC" - }, - RichField - { richFieldType = "\"k\GS\70419\26199\1014184\ESC05M\f\n\r\t,;", - richFieldValue = "9Q\168871\1056271\&2&8`\137772\\J;\SI&\44400\1097338\14079\&0\1086128|" - }, - RichField - { richFieldType = - " \992150T\1002985+\US)q<\989166s\1014574\1092067]M\SO\v<\b@c\1001106)\SO\139144o6\1010975\21132S", - richFieldValue = "\1060216\1083797.-\SUB" - }, - RichField - { richFieldType = "\34229!1\185302\&0\f\r\120200\ETB\170354", - richFieldValue = "+q\158710\181545\&5%O-\SOZG\EM\DC3\f:J\995860D_^\31249\SOH" - }, - RichField - { richFieldType = "\EOTo1bv\EOT+\EOT\155925d\1066890\SYN?'w\30888\177205\1058893M7kV\DC3\ETB\GSqc", - richFieldValue = "J[\DLE~gi/\DC4EW\"64b\NAK1\1048818':_1" - }, - RichField - { richFieldType = - "\73962\62453\CAN\SI\1066456RF(T\CAN\983962`\145919\RS\DC4\14179\DC3\188204:E\1014493\180955\22787", - richFieldValue = "\ETBp\28133\SUB&" - }, - RichField - { richFieldType = "\"4\1079772\1085218\996306h\SUBu\1033018\DC1\186497\STX", - richFieldValue = "\1003323!R|jE\31928" - } - ] - } + mkRichInfoAssocList + [ RichField + { richFieldType = "", + richFieldValue = + "Q\53780\EMf\SO\DC1\1048800(W\1056864\988934;\179116s5\GSb;U\ETB\984630D*\DC3\30451\SUB\f4" + }, + RichField + { richFieldType = "\SUB\27593o$\tm1\NULPIe\96689!e\151526\CAND\139821b\73918\1012381\&87N\1106457\SOH", + richFieldValue = + "\\\CAN-%N\186394rW\1069397\182654\STX\32472\1096218?{\t\1103035c\992153}C\v\1051414>\156522\&9" + }, + RichField + { richFieldType = + "\DC2\ETB:#j\1016570\995014R\SUB\8139\46197\DC3\1001317\fX\1019967{\a\FS\1088211$\DC1@\NUL", + richFieldValue = "!3\ENQ#\8659\984383aA\990391\RS\1024087" + }, + RichField + { richFieldType = "\GS!\EOT\DC1[.\EM\43062\18906\NAK\73677\1008044 \1031011V@\1103400\995687uX", + richFieldValue = "\ENQF\143759}w" + }, + RichField {richFieldType = "i|O;?\f8*\NUL{\r`\1102254", richFieldValue = "\1058311],%5gtF&\DC1\100311"}, + RichField + { richFieldType = + "\1083150X\53916\28226\&6Y|\SOHq\21832,$\992122k\ESCA\156055\121501X\EOT\181872^^\142236\&4\US#Lh", + richFieldValue = "E(*\166750\SIF\191040\ETBf\STX." + }, + RichField + { richFieldType = "D\96871|\19034\t\165096\ENQP\DLE\135992.HT%\148302\STX21\r\137838]\t\DC4\DC4\1023982\f", + richFieldValue = ")#\ETB\1093437Xv\172325\DLEC\n\995484" + }, + RichField {richFieldType = "_\1100172DV", richFieldValue = "<_y\NULnqk\rQCrz\FS2\ENQ\1019845\&3\DC4."}, + RichField + { richFieldType = "A\26230AyU*U\1040076X\2792p\1089124/\49419\US^\NULA\ESC\EM]\159839\58492\1084799%?C", + richFieldValue = " {\171966&\134026M7c@&_\US\1041536\DC2q\71108\179421" + }, + RichField + { richFieldType = "\SI\132269W2\DC1O\1035974t\SOH\1003251\36469", + richFieldValue = "\ETX\1025341\ESC" + }, + RichField + { richFieldType = "\"k\GS\70419\26199\1014184\ESC05M\f\n\r\t,;", + richFieldValue = "9Q\168871\1056271\&2&8`\137772\\J;\SI&\44400\1097338\14079\&0\1086128|" + }, + RichField + { richFieldType = + " \992150T\1002985+\US)q<\989166s\1014574\1092067]M\SO\v<\b@c\1001106)\SO\139144o6\1010975\21132S", + richFieldValue = "\1060216\1083797.-\SUB" + }, + RichField + { richFieldType = "\34229!1\185302\&0\f\r\120200\ETB\170354", + richFieldValue = "+q\158710\181545\&5%O-\SOZG\EM\DC3\f:J\995860D_^\31249\SOH" + }, + RichField + { richFieldType = "\EOTo1bv\EOT+\EOT\155925d\1066890\SYN?'w\30888\177205\1058893M7kV\DC3\ETB\GSqc", + richFieldValue = "J[\DLE~gi/\DC4EW\"64b\NAK1\1048818':_1" + }, + RichField + { richFieldType = + "\73962\62453\CAN\SI\1066456RF(T\CAN\983962`\145919\RS\DC4\14179\DC3\188204:E\1014493\180955\22787", + richFieldValue = "\ETBp\28133\SUB&" + }, + RichField + { richFieldType = "\"4\1079772\1085218\996306h\SUBu\1033018\DC1\186497\STX", + richFieldValue = "\1003323!R|jE\31928" + } + ] testObject_RichInfoAssocList_user_10 :: RichInfoAssocList testObject_RichInfoAssocList_user_10 = - RichInfoAssocList - { unRichInfoAssocList = - [ RichField - { richFieldType = "K\CANS\DELN0\72832\149961.54\19512\1108628fY\1004417\45657)", - richFieldValue = "_=x\ACK\SOHh\ETB" - }, - RichField - { richFieldType = "\154824\1070277\&1O\1087683o\1062374\NUL\1004673\ETX\1103214\1102453\1065475zri=", - richFieldValue = ".=\DEL@}OdoKl*YU_I(H\t \985441\DC2-" - }, - RichField {richFieldType = "\bu\15327\CAN\DC1u@}", richFieldValue = "]09|\1082373\\\1079514\a}xY"}, - RichField - { richFieldType = ": U\fLm\1030806CZ\SO4}Nt", - richFieldValue = "\1112946\DC3o\f+\137006\&8\143818\ETB.cq/0u**\41286\SOs" - }, - RichField - { richFieldType = "a\9906\v", - richFieldValue = "\134958~\DLE`\EOTEF\DC3\\\t\1061880g\1052395f_D\FS\NAKvn\DELE\1096954\RS\1000011D" - }, - RichField - { richFieldType = "\1057131\1054895I\"\1084918c\1042046", - richFieldValue = "\1085897]f\1059629\FSAe\7735$\EM\29111\175788a%A\DC3\1089240\1105420\GSI" - }, - RichField - { richFieldType = "\67130v3|JT^?@!j\RS\1031456\a", - richFieldValue = "v-)i\1017124=\DC3Ww\b\1044637D2\1069284#CZ" - }, - RichField - { richFieldType = "\180696$\CANh=?G^\175140\152687\&89^\9515\RS\b\1090022#\1012534\194602a", - richFieldValue = "@\"\DC4\70346t@\v\1028945N6\1003753\b\188898b\EOT`%\1100090\ENQ\41979|" - }, - RichField - { richFieldType = "$1\GS\14382\39424n", - richFieldValue = "9\179845{\CAN'T\DC1q-\98814\152376\1092545_\\j]\NULSp\110834N\US\1068418)&D\EM" - }, - RichField - { richFieldType = "b\STX\54181\173461:~}\997096i\1018231Q\42164\SI\28267nI9C\52603\99308\DEL'\9572A", - richFieldValue = "c(L\1093389\160911\136219\64532^\1032670\DC4\FS\1048424\\V\1086409\&1eOsl\US\"]" - }, - RichField {richFieldType = "iFy\DC2\1021166\189442d\"eV,\1003575;\DEL\a(\1022161", - richFieldValue = "b\NUL\45571\991124g\183057=\1014985\ACK^\94975^\a\1110019\&9\136337'c?" - }, - RichField - { richFieldType = "\1000130\FS6\NUL\US)n$\1003097\SIY~", - richFieldValue = "\3329 :\NUL5\1089559z\1016906\1062456N\1058351\175725\&5@Qb" - }, - RichField {richFieldType = "\\\1030927\1084367", richFieldValue = "#(N\EOT\fL\55225]K,\44208\1051392"}, - RichField {richFieldType = "K\DEL", richFieldValue = "\142451\NUL?.[_JU`"}, - RichField - { richFieldType = "\1041679;8\154902n=\vA\foZcKo\EOT\1041969=g{*\EM", - richFieldValue = "\1095683\45550\tI4VNUh" - } - ] - } + mkRichInfoAssocList + [ RichField {richFieldType = "%\SYNA\ENQ@O\1014133\SO)y ", richFieldValue = "\1096740\1024372\987815Y~\"Y"}, + RichField + { richFieldType = ")\1039064c\1074846\1039059P @(^x\RS5", + richFieldValue = "r>\rh\NUL>\1044429$?\19446\SOH\EM&T" + }, + RichField + { richFieldType = "\1060481UK", + richFieldValue = "~\7474c\182864R\58649\95355qz\182951$>z\ACK`5\EML#\ETB;\18314T" + }, + RichField {richFieldType = "/c^z\1010950", richFieldValue = "\RST*\a"}, + RichField + { richFieldType = "\DC3M\1048131`\38151\\\148994E\152441\NAK\EME\f`\aiFy\DC2\1021166\189442d\"eV,\1003575;\DEL\a(\1022161", + richFieldValue = "b\NUL\45571\991124g\183057=\1014985\ACK^\94975^\a\1110019\&9\136337'c?" + }, + RichField + { richFieldType = "\1000130\FS6\NUL\US)n$\1003097\SIY~", + richFieldValue = "\3329 :\NUL5\1089559z\1016906\1062456N\1058351\175725\&5@Qb" + }, + RichField {richFieldType = "\\\1030927\1084367", richFieldValue = "#(N\EOT\fL\55225]K,\44208\1051392"}, + RichField {richFieldType = "K\DEL", richFieldValue = "\142451\NUL?.[_JU`"}, + RichField + { richFieldType = "\1041679;8\154902n=\vA\foZcKo\EOT\1041969=g{*\EM", + richFieldValue = "\1095683\45550\tI4VNUh" + } + ] testObject_RichInfoAssocList_user_12 :: RichInfoAssocList testObject_RichInfoAssocList_user_12 = - RichInfoAssocList - { unRichInfoAssocList = - [ RichField - { richFieldType = "", - richFieldValue = - "t\DLE\148634e\23003j\18631L\1086162\DC1\SUB\145633\SUB\1077695\ETB\DC4sTk\33039\1091745\&2#-" - }, - RichField - { richFieldType = "W['&]\1050921_\1079506\DC2kW\ESCs\1092389\EOT1}Xm\1020116`\DC1\1043008its\1064350", - richFieldValue = "5=[n\131583%\1108118\134584\18919aEv#CS\1079492=\r\1017862g1,HM\NAK\\\51441" - }, - RichField - { richFieldType = "oRl\992064-*\EM?:M'/\n\133906\145327", - richFieldValue = "`E_J\ACK|BXW/.\59551*M\CAN\FSP\DC2\1016301Jj7|U\ENQ\STXH" - }, - RichField - { richFieldType = "h\135051\SOH\1036512\CAN9\68637]\1008353\DEL\1047560\&3]", - richFieldValue = "h\STXs)\1022692C6\ACK\1085551(=\1085875\1034442\\v\ENQ\t-)\985664-^R@e\DC4;d\1002359D" - }, - RichField - { richFieldType = "hjp\f\1022302\NAK\168399\FS\n\44376\194617\r2\128305y\STX", - richFieldValue = "\DC4@ PC\1030676\DC1.H\1104780\DLE\1102785,2n" - }, - RichField - { richFieldType = "xmAm\SO`\111027f#\DC3I\DC2QC#|lu_c\CAN\64758l", - richFieldValue = "v:^\EOT\142194H\101000" - }, - RichField - { richFieldType = ";\1065386\t\n*\NAKUq|\1058447.\EOT\16800A\38963z\143264\1097416\1054127T;+\SI1`Hk^", - richFieldValue = "\f\1104642_kH\b\bQG-m\SYNNJ<_jft@\6784{&{o9\EOT\1004862*" - }, - RichField - { richFieldType = "'\146668gRX\996133\NUL\171676pvh\NAK_p\ESC\GS\1052545\1062264ygA1K\1053755", - richFieldValue = "\28970^PW\RS2_OZ\125031N\SI\US\DC1\1094238=i1\SI#g\1041191\SYN\SUB`U" - }, - RichField - { richFieldType = "|h\a_@\159199K\SYNs;@\1016366\147728\134294\1042468\34840+\bQ\SOHb\SUB", - richFieldValue = "\CAN" - }, - RichField - { richFieldType = "\7203$\998893\1095441\1000456\r\1095001PJ\1035417|7\95018\31453ddi\135639\f", - richFieldValue = - "X\1097244\1100125\EM\49220+\133929M\1059039Z\DC3\147368\"L\nOD\31402Wf\ACKn\SI\GS\1074117" - }, - RichField {richFieldType = "6\24420L\GS\185021Ycgi}o#", richFieldValue = "Ze"}, - RichField - { richFieldType = "%\1110214\&9Mp2", - richFieldValue = "\r\182466\148037\1072548I\GS<\988315\FS\9939@" - }, - RichField - { richFieldType = "\NUL\STX\SO\1100778\to\tc", - richFieldValue = "\155686\ETB\1011159\144437cg!`\1019631\a\EOTq&\SYNp[\SOH\SOf" - }, - RichField - { richFieldType = "\GSf\1062854}MV;u\NULV\11221#Nm\175360_M]\t_6?\SYN\r\ACK7Y\1005701$X", - richFieldValue = "\181525\37639" - }, - RichField {richFieldType = "S+V1\aH\1031581A3\DEL\DC4\"\DC3\19120;jKXE4\998157Jy]_+R\1012299\173977\CAN\65058\t\DC48\150835\25267\47373\157659\1017683A\35411", - richFieldValue = "Fuj\n\134903|\78484\DLE\SId3\183407\1072096{rZV" - }, - RichField - { richFieldType = "f\151892\177151\NAKsJ&\")\1075883,\1030117\DC3\DC2hu\1072042P\134770\173515t", - richFieldValue = "Q=e\bf\f\69415\1061667\&1/m~M\DC2\152938\128922WT\1005374\&4\CAN\CAN\154644\29221s" - }, - RichField - { richFieldType = "R u\1006552~\92515\SUB\43813\29591\DC4\170171kE\183750H@\176287\1068967Yx,g\152483", - richFieldValue = "{\39126\SUBu>\CAN\44830v4~{" - }, - RichField - { richFieldType = "R\USj\RSY\CANL", - richFieldValue = "2\"^g\EMY\1071435\nMny\31093\1039466\1031533s\36258\DC3U\1030452.\DLE\FSrE{r1E" - }, - RichField - { richFieldType = "\1062033$\9393\CAN\48956'2(\EM\140921\SUB\DC2\991441_7[\1002178\1060316\FS\DC2$\1074974", - richFieldValue = "3u8K\v\\\n\f^=\1030450\DLE`\nu\136951;\1100432\30791.\172068\1087728\SO\30866\SYN\DC2" - } - ] - } + mkRichInfoAssocList + [ RichField + { richFieldType = "", + richFieldValue = + "t\DLE\148634e\23003j\18631L\1086162\DC1\SUB\145633\SUB\1077695\ETB\DC4sTk\33039\1091745\&2#-" + }, + RichField + { richFieldType = "W['&]\1050921_\1079506\DC2kW\ESCs\1092389\EOT1}Xm\1020116`\DC1\1043008its\1064350", + richFieldValue = "5=[n\131583%\1108118\134584\18919aEv#CS\1079492=\r\1017862g1,HM\NAK\\\51441" + }, + RichField + { richFieldType = "oRl\992064-*\EM?:M'/\n\133906\145327", + richFieldValue = "`E_J\ACK|BXW/.\59551*M\CAN\FSP\DC2\1016301Jj7|U\ENQ\STXH" + }, + RichField + { richFieldType = "h\135051\SOH\1036512\CAN9\68637]\1008353\DEL\1047560\&3]", + richFieldValue = "h\STXs)\1022692C6\ACK\1085551(=\1085875\1034442\\v\ENQ\t-)\985664-^R@e\DC4;d\1002359D" + }, + RichField + { richFieldType = "hjp\f\1022302\NAK\168399\FS\n\44376\194617\r2\128305y\STX", + richFieldValue = "\DC4@ PC\1030676\DC1.H\1104780\DLE\1102785,2n" + }, + RichField + { richFieldType = "xmAm\SO`\111027f#\DC3I\DC2QC#|lu_c\CAN\64758l", + richFieldValue = "v:^\EOT\142194H\101000" + }, + RichField + { richFieldType = ";\1065386\t\n*\NAKUq|\1058447.\EOT\16800A\38963z\143264\1097416\1054127T;+\SI1`Hk^", + richFieldValue = "\f\1104642_kH\b\bQG-m\SYNNJ<_jft@\6784{&{o9\EOT\1004862*" + }, + RichField + { richFieldType = "'\146668gRX\996133\NUL\171676pvh\NAK_p\ESC\GS\1052545\1062264ygA1K\1053755", + richFieldValue = "\28970^PW\RS2_OZ\125031N\SI\US\DC1\1094238=i1\SI#g\1041191\SYN\SUB`U" + }, + RichField + { richFieldType = "|h\a_@\159199K\SYNs;@\1016366\147728\134294\1042468\34840+\bQ\SOHb\SUB", + richFieldValue = "\CAN" + }, + RichField + { richFieldType = "\7203$\998893\1095441\1000456\r\1095001PJ\1035417|7\95018\31453ddi\135639\f", + richFieldValue = + "X\1097244\1100125\EM\49220+\133929M\1059039Z\DC3\147368\"L\nOD\31402Wf\ACKn\SI\GS\1074117" + }, + RichField {richFieldType = "6\24420L\GS\185021Ycgi}o#", richFieldValue = "Ze"}, + RichField + { richFieldType = "%\1110214\&9Mp2", + richFieldValue = "\r\182466\148037\1072548I\GS<\988315\FS\9939@" + }, + RichField + { richFieldType = "\NUL\STX\SO\1100778\to\tc", + richFieldValue = "\155686\ETB\1011159\144437cg!`\1019631\a\EOTq&\SYNp[\SOH\SOf" + }, + RichField + { richFieldType = "\GSf\1062854}MV;u\NULV\11221#Nm\175360_M]\t_6?\SYN\r\ACK7Y\1005701$X", + richFieldValue = "\181525\37639" + }, + RichField {richFieldType = "S+V1\aH\1031581A3\DEL\DC4\"\DC3\19120;jKXE4\998157Jy]_+R\1012299\173977\CAN\65058\t\DC48\150835\25267\47373\157659\1017683A\35411", + richFieldValue = "Fuj\n\134903|\78484\DLE\SId3\183407\1072096{rZV" + }, + RichField + { richFieldType = "f\151892\177151\NAKsJ&\")\1075883,\1030117\DC3\DC2hu\1072042P\134770\173515t", + richFieldValue = "Q=e\bf\f\69415\1061667\&1/m~M\DC2\152938\128922WT\1005374\&4\CAN\CAN\154644\29221s" + }, + RichField + { richFieldType = "R u\1006552~\92515\SUB\43813\29591\DC4\170171kE\183750H@\176287\1068967Yx,g\152483", + richFieldValue = "{\39126\SUBu>\CAN\44830v4~{" + }, + RichField + { richFieldType = "R\USj\RSY\CANL", + richFieldValue = "2\"^g\EMY\1071435\nMny\31093\1039466\1031533s\36258\DC3U\1030452.\DLE\FSrE{r1E" + }, + RichField + { richFieldType = "\1062033$\9393\CAN\48956'2(\EM\140921\SUB\DC2\991441_7[\1002178\1060316\FS\DC2$\1074974", + richFieldValue = "3u8K\v\\\n\f^=\1030450\DLE`\nu\136951;\1100432\30791.\172068\1087728\SO\30866\SYN\DC2" + } + ] testObject_RichInfoAssocList_user_13 :: RichInfoAssocList testObject_RichInfoAssocList_user_13 = - RichInfoAssocList - { unRichInfoAssocList = - [ RichField - { richFieldType = "z*\DLE\31321I\1077672\134474m[\148755)\9512fKT\1020823\NAK\"p\ENQ8:cp\SOHxi", - richFieldValue = "\189083y]*GCEk9?\ESC.\1030218^r\1079191\&6\8171{P0\DEL\1016504\&1;\CANv\14838a" - }, - RichField - { richFieldType = "`\ESCHBX\176949\989433\DC1\tX\47848Q)1\SI\1036075d", - richFieldValue = "3:aru=B(YX/\39193\1041309U\996066\\?\1058753\ETX" - }, - RichField - { richFieldType = "\166872R\FS\SYN[\DC3\r\22084\1103594\&5h\ESCl\1030588\EM7t\GS ,\bKj\1040655\ESCG6", - richFieldValue = "_\SI>|%\ACK\NAK0\DELk\1015390N ef\1105518\1017325c\23243)\7007\&2\8552N>|\141095" - }, - RichField {richFieldType = "Nf\\T", richFieldValue = "\b\110753[\62680\US\120398rVr]\145902pw\1049222nT3FG"}, - RichField - { richFieldType = - "\69223y\SI\US\172832\983886LU\EOT8h\RS\SOH\1011542\NUL\1037009t \47998\180586\19102\CANxX", - richFieldValue = "\1078914\ETB\SO]\f'\SI\ESC" - }, - RichField - { richFieldType = "FN\EM&\1110855U\188712~\1008639t\152157`\1103563s", - richFieldValue = "\153838=\32995!9nRi\GS\1100075\43424" - }, - RichField - { richFieldType = "\99828\61985;R\ay\"\ESC:\1019725\94567f\a\5102DD\1078450", - richFieldValue = " \1067811\SI\DEL\"u\993873\60871\&3\1040938Jl\RSxx:\FShx\DEL\ENQu" - }, - RichField - { richFieldType = "\1044052\1077640|\3935\1061461GmZ\95079\&8k_JF\SUBlI\128437LP\123176", - richFieldValue = "\153973#{\54355\&5s\DC3/s\"#\FS:el\SOH" - }, - RichField {richFieldType = "L", richFieldValue = "\1043935]"}, - RichField - { richFieldType = "\23372q)r\70829*SA1:", - richFieldValue = "*\95281\SOH~-6i ?\1060940`\ETX\SO\139351R\f\136994t\DC1\1095903-3c.\38557" - }, - RichField - { richFieldType = "\125072m\DELSH\1043641Y\US\94416\1084814\CAN,w4uFD\SO\"A\32214\SOH", - richFieldValue = "N" - }, - RichField - { richFieldType = "\174674\989621 :T0\14263\n\49265\&3\SOH\DC1\SO@\1033839\ETX\48176\&0\161673", - richFieldValue = "/\142036;\169241E%\94322l\n\DC4.:{|]T@%\DC4\1093834`\1051069\SI\1110394\EM\185572" - }, - RichField - { richFieldType = "I5\RS\96725\&1;v?\147690@4\1112574\1095920\983961|Pc", - richFieldValue = "!\SOHu?\92753\1054641Dz\178220aIu" - }, - RichField - { richFieldType = "\1009136 ?\ETBL+\t\nq\113815\DC2\NUL+\48474\ENQ\b/F\153958o\99707\SOHG", - richFieldValue = "\b18c0\SIU\1093193'\1034908\162955\&8\ETX" - }, - RichField {richFieldType = "`vi\ESC\1031206z+%\1080549", richFieldValue = "\182432\1031952"}, - RichField - { richFieldType = "\1088160^TJ", - richFieldValue = "\r8\\\60064YqNh\148872\ETX8u\1003970Q\162050o&\14731\43508s\1083131\SUB\991285LV\RSqKu" - }, - RichField - { richFieldType = "\101030(B\a/'\35699\1001724\DC40\41844#U@CJV\1032544\500pzR_\ENQ\183810[F\191069 5", - richFieldValue = "\STX?fB\1043911\23842\177720iNI\ETXiH\1084560\SYN+\DC3&o" - }, - RichField - { richFieldType = "\ETBV{\f?Z#b\1061992\120046\163615]\RSG\DC2\15471bi\1025939\49463(\1003889\991384\bu\\", - richFieldValue = "\1083296\26385%Y\1048194\96776WDE\1038521^\190773jt\1052690\SOH\FS0\1069662N\f\100270" - }, - RichField - { richFieldType = "\ACKr\a\t[\DC3'(\"/vSeljA\DLE{\SOH\1028813m\DEL\147968", - richFieldValue = "\1071832Z<\DC4\21657<\SUBF(MQq\991303\EOT\\\1015006\95427x|\RS\b\DC1m\165083U" - }, - RichField - { richFieldType = "\168063my5_\28282\DC3\GS?iA\997869i\ACK\42697\1039319[~\997273GPc", - richFieldValue = "\DC1\SI\EOT\SYN\STX@\DC1='h\CAN8\STXd^GM\985740\1087667n" - }, - RichField - { richFieldType = "'H\"\1001346\1016998\1044621\r\110660D\61926;rP\EM \12364e\CAN", - richFieldValue = "\DC3\CAN,N\ENQ" - }, - RichField - { richFieldType = - "\147972\1039228\\\DC2\\%(j\1103902\1046720\1067115_@\157861X\EOT\162276\EM6\DC3\1045522\NUL\194583\EM", - richFieldValue = "/" - }, - RichField {richFieldType = "\SUBogWc\182133oCY\1028241\1099230\133244\&2PO_", richFieldValue = "-\186026M"}, - RichField {richFieldType = "vV9~\1111403\&4L,\DC3jz{\1087288\990666;", richFieldValue = "B"}, - RichField - { richFieldType = - "\190901(\175512#\1021845\73107\994211\&7\t\ETBA\23938y\1108785\US\ACK\ETB\NUL\66688\983969\62023", - richFieldValue = - "x\1061o\DC4\146905,\153006\DC4\1102566t\1063122\&0\tq\ETB\1079045u\83491Q\1087141\1042247TpM\131093\US:" - }, - RichField - { richFieldType = "y\DLE\STX]\DC1R\GSH>^'\1039075v\18508\v", - richFieldValue = "8Av1Gu+(\16771\180818IK]r\RS\f\FS\53783\12276*6^x|N\1060399e\93031-w" - } - ] - } + mkRichInfoAssocList + [ RichField + { richFieldType = "z*\DLE\31321I\1077672\134474m[\148755)\9512fKT\1020823\NAK\"p\ENQ8:cp\SOHxi", + richFieldValue = "\189083y]*GCEk9?\ESC.\1030218^r\1079191\&6\8171{P0\DEL\1016504\&1;\CANv\14838a" + }, + RichField + { richFieldType = "`\ESCHBX\176949\989433\DC1\tX\47848Q)1\SI\1036075d", + richFieldValue = "3:aru=B(YX/\39193\1041309U\996066\\?\1058753\ETX" + }, + RichField + { richFieldType = "\166872R\FS\SYN[\DC3\r\22084\1103594\&5h\ESCl\1030588\EM7t\GS ,\bKj\1040655\ESCG6", + richFieldValue = "_\SI>|%\ACK\NAK0\DELk\1015390N ef\1105518\1017325c\23243)\7007\&2\8552N>|\141095" + }, + RichField {richFieldType = "Nf\\T", richFieldValue = "\b\110753[\62680\US\120398rVr]\145902pw\1049222nT3FG"}, + RichField + { richFieldType = + "\69223y\SI\US\172832\983886LU\EOT8h\RS\SOH\1011542\NUL\1037009t \47998\180586\19102\CANxX", + richFieldValue = "\1078914\ETB\SO]\f'\SI\ESC" + }, + RichField + { richFieldType = "FN\EM&\1110855U\188712~\1008639t\152157`\1103563s", + richFieldValue = "\153838=\32995!9nRi\GS\1100075\43424" + }, + RichField + { richFieldType = "\99828\61985;R\ay\"\ESC:\1019725\94567f\a\5102DD\1078450", + richFieldValue = " \1067811\SI\DEL\"u\993873\60871\&3\1040938Jl\RSxx:\FShx\DEL\ENQu" + }, + RichField + { richFieldType = "\1044052\1077640|\3935\1061461GmZ\95079\&8k_JF\SUBlI\128437LP\123176", + richFieldValue = "\153973#{\54355\&5s\DC3/s\"#\FS:el\SOH" + }, + RichField {richFieldType = "L", richFieldValue = "\1043935]"}, + RichField + { richFieldType = "\23372q)r\70829*SA1:", + richFieldValue = "*\95281\SOH~-6i ?\1060940`\ETX\SO\139351R\f\136994t\DC1\1095903-3c.\38557" + }, + RichField + { richFieldType = "\125072m\DELSH\1043641Y\US\94416\1084814\CAN,w4uFD\SO\"A\32214\SOH", + richFieldValue = "N" + }, + RichField + { richFieldType = "\174674\989621 :T0\14263\n\49265\&3\SOH\DC1\SO@\1033839\ETX\48176\&0\161673", + richFieldValue = "/\142036;\169241E%\94322l\n\DC4.:{|]T@%\DC4\1093834`\1051069\SI\1110394\EM\185572" + }, + RichField + { richFieldType = "I5\RS\96725\&1;v?\147690@4\1112574\1095920\983961|Pc", + richFieldValue = "!\SOHu?\92753\1054641Dz\178220aIu" + }, + RichField + { richFieldType = "\1009136 ?\ETBL+\t\nq\113815\DC2\NUL+\48474\ENQ\b/F\153958o\99707\SOHG", + richFieldValue = "\b18c0\SIU\1093193'\1034908\162955\&8\ETX" + }, + RichField {richFieldType = "`vi\ESC\1031206z+%\1080549", richFieldValue = "\182432\1031952"}, + RichField + { richFieldType = "\1088160^TJ", + richFieldValue = "\r8\\\60064YqNh\148872\ETX8u\1003970Q\162050o&\14731\43508s\1083131\SUB\991285LV\RSqKu" + }, + RichField + { richFieldType = "\101030(B\a/'\35699\1001724\DC40\41844#U@CJV\1032544\500pzR_\ENQ\183810[F\191069 5", + richFieldValue = "\STX?fB\1043911\23842\177720iNI\ETXiH\1084560\SYN+\DC3&o" + }, + RichField + { richFieldType = "\ETBV{\f?Z#b\1061992\120046\163615]\RSG\DC2\15471bi\1025939\49463(\1003889\991384\bu\\", + richFieldValue = "\1083296\26385%Y\1048194\96776WDE\1038521^\190773jt\1052690\SOH\FS0\1069662N\f\100270" + }, + RichField + { richFieldType = "\ACKr\a\t[\DC3'(\"/vSeljA\DLE{\SOH\1028813m\DEL\147968", + richFieldValue = "\1071832Z<\DC4\21657<\SUBF(MQq\991303\EOT\\\1015006\95427x|\RS\b\DC1m\165083U" + }, + RichField + { richFieldType = "\168063my5_\28282\DC3\GS?iA\997869i\ACK\42697\1039319[~\997273GPc", + richFieldValue = "\DC1\SI\EOT\SYN\STX@\DC1='h\CAN8\STXd^GM\985740\1087667n" + }, + RichField + { richFieldType = "'H\"\1001346\1016998\1044621\r\110660D\61926;rP\EM \12364e\CAN", + richFieldValue = "\DC3\CAN,N\ENQ" + }, + RichField + { richFieldType = + "\147972\1039228\\\DC2\\%(j\1103902\1046720\1067115_@\157861X\EOT\162276\EM6\DC3\1045522\NUL\194583\EM", + richFieldValue = "/" + }, + RichField {richFieldType = "\SUBogWc\182133oCY\1028241\1099230\133244\&2PO_", richFieldValue = "-\186026M"}, + RichField {richFieldType = "vV9~\1111403\&4L,\DC3jz{\1087288\990666;", richFieldValue = "B"}, + RichField + { richFieldType = + "\190901(\175512#\1021845\73107\994211\&7\t\ETBA\23938y\1108785\US\ACK\ETB\NUL\66688\983969\62023", + richFieldValue = + "x\1061o\DC4\146905,\153006\DC4\1102566t\1063122\&0\tq\ETB\1079045u\83491Q\1087141\1042247TpM\131093\US:" + }, + RichField + { richFieldType = "y\DLE\STX]\DC1R\GSH>^'\1039075v\18508\v", + richFieldValue = "8Av1Gu+(\16771\180818IK]r\RS\f\FS\53783\12276*6^x|N\1060399e\93031-w" + } + ] testObject_RichInfoAssocList_user_14 :: RichInfoAssocList testObject_RichInfoAssocList_user_14 = - RichInfoAssocList - { unRichInfoAssocList = - [ RichField - { richFieldType = "Y\1097278d\NULRI", - richFieldValue = "\"\175546/8\1104241&n\20186:\18558\n\US\170938@gB_K" - }, - RichField - { richFieldType = "\ETXM&S<\DC1d2Pk+\apM\b", - richFieldValue = "\1097099|\CANj\EMLuCp \146457\1074891l3h\1067130\38003\&5g\1022231\155107X" - }, - RichField - { richFieldType = "\1099895r$ss>~0[\1079495:9\75013]Ew%\1018618\146400\53026(\1021664}\ESC", - richFieldValue = ":\"" - }, - RichField - { richFieldType = "w\160820\t\137366K/\DC4Um\ACK\121176\1017693I\SOr=$W_\CAN", - richFieldValue = "f\1088765\DC1\FS\1040413\DC4\1110769\988254y\92162\64522\1074674:G\ESC" - }, - RichField - { richFieldType = "", - richFieldValue = - "\ETXB\164951\NAK\171616C\138976H~T*6\SI\16458\STXdb\DEL\n\991433\ENQTC\ACK%\SI\r\ru\1077920" - }, - RichField - { richFieldType = "\DC3cYvJ\1021129dBMW\SI _\142549V", - richFieldValue = "\DC2e\48476\rR\162679W0\DC2\ACK\1040001\r\1102288" - }, - RichField - { richFieldType = "\1063575\1011847W0fY\v\995827\r>l3mo6s2+\DLE\1034735*g'H", - richFieldValue = "\1010358\ETBX\fQ@2\DC3!TH\987799X\STX\bz\SUBt`\STXa]\1103652o\1040123\1075382\54633\NUL" - }, - RichField - { richFieldType = "RAc\ETXu[\1045432rFF7s", - richFieldValue = "\150126Q\fNq\DC3S=hT9\999699\t\EOT\DC2\16565\58633\DLEl\DEL" - }, - RichField - { richFieldType = "HM\n\DEL\FS&x\US\157560!\t\15295\CAN\SI8\USJ\US\72311\DELK\CANODm\a\ETBh\146734", - richFieldValue = "\127256\1062065<\1084134G\1013838\57436\1055208\DC1?%" - }, - RichField - { richFieldType = "C\STX\5295F\1066043Io{\1084579}h", - richFieldValue = - "%t[\DC3\a\1097838\b-\DC3r\\\DC1/1\1080556\EMgn\1090973\42459\DEL\1075433,?\180913w\145836" - }, - RichField {richFieldType = ">ldT\43466", richFieldValue = "\EOT@\988446\&4O\SUB9\SYN\STX\EM/,1\1043788"}, - RichField - { richFieldType = "(cCiV\1049352\SUB\1079784\&5\STX\"*\1093981\147914\&2DK\ro0q]5\34259/<", - richFieldValue = "\v\NAK\1039703\1017160Z\19335'\DC4K%\t\DC1\RS\47565C\176722HtuLW%\DC4LQ7%!\GSy" - }, - RichField - { richFieldType = " {YA7\DC2\92747\40298\1001169", - richFieldValue = - "A\1030311.^P$u0\CAN\111199fP\129523\1099159NZ\GS\RSn\1035384\189801<<\994100\1068633\ACK\DC23f" - }, - RichField {richFieldType = "4%+i\54430\1042341a\a_J\ETX*", richFieldValue = "\990556\STXOq~"}, - RichField {richFieldType = "\ESC\37189DD\EM(+9&axn\\", richFieldValue = "^\FS\ETX\148544"}, - RichField - { richFieldType = - "QM+\1049013s]\1005208\1046292\13212\1018425\ETB\14896+a%\1006669\1011902\1019721\NUL\1030068{G\985550I\DEL\1094491h", - richFieldValue = "\1110451_ru?\177123G^_\1037833.\1012576\1096856\1105016\169817K=QH" - }, - RichField - { richFieldType = "{r\DLEv\DC4z\t.p\1007902\142703|Ld@\GSh^\1070198\&8", - richFieldValue = "\1052479\&3\21714\1040108rJ\DC3/\DEL\DC3\51045)\22626~4\1092666\1088011\1055205\"b]\FS\STXX\"^==1l1", - richFieldValue = "\DLE'X-_\a\STXHaR\SUBZ\US\EMAu\1001395\32538\60712\RS" - }, - RichField - { richFieldType = "\f\DC4Q\EM8\US\35453[e\39694\ACK\1066257", - richFieldValue = "TZb\1034718ps\28692Yf\174875w[" - }, - RichField - { richFieldType = "\31940\1043617K,3\1075707*C.w\1049282\SYNh\1004322c", - richFieldValue = "&1uQ\"xsPA\1097585\a\1083181}\DEL\DC2\DLE\121455\33537,\1029578f\ETB+$" - }, - RichField - { richFieldType = "\SOH\1029313B\1008715\17751\992279bQ\DC1\r\RS\ft\CAN\138436\49486\ENQ\GS", - richFieldValue = "x$#\ENQ\vtMJ,\DEL\38676k\1113690h\1033164 9\GS;)fQS?i" - }, - RichField - { richFieldType = "\48107p7\62073$\1031007\f-Bq", - richFieldValue = "~\132861[m|V\1006179p\35718N\139105\&2PPp+(\CAN" - }, - RichField - { richFieldType = "\DC14\SOH\33641\151576\1022090d\995914\1106034\1111939x\30824j\44610y\DLE", - richFieldValue = "\94553\t,\n*C\RS" - }, - RichField - { richFieldType = "\164033%\a\SOH^\a\SO\US\161788@}\1034691\119984g99h", - richFieldValue = "\172519P\67358;\14146Dlw:c\DC2\1092080\158061\175487\b>\RS<\1018130`u\DELN\1062895" - } - ] - } + mkRichInfoAssocList + [ RichField + { richFieldType = "Y\1097278d\NULRI", + richFieldValue = "\"\175546/8\1104241&n\20186:\18558\n\US\170938@gB_K" + }, + RichField + { richFieldType = "\ETXM&S<\DC1d2Pk+\apM\b", + richFieldValue = "\1097099|\CANj\EMLuCp \146457\1074891l3h\1067130\38003\&5g\1022231\155107X" + }, + RichField + { richFieldType = "\1099895r$ss>~0[\1079495:9\75013]Ew%\1018618\146400\53026(\1021664}\ESC", + richFieldValue = ":\"" + }, + RichField + { richFieldType = "w\160820\t\137366K/\DC4Um\ACK\121176\1017693I\SOr=$W_\CAN", + richFieldValue = "f\1088765\DC1\FS\1040413\DC4\1110769\988254y\92162\64522\1074674:G\ESC" + }, + RichField + { richFieldType = "", + richFieldValue = + "\ETXB\164951\NAK\171616C\138976H~T*6\SI\16458\STXdb\DEL\n\991433\ENQTC\ACK%\SI\r\ru\1077920" + }, + RichField + { richFieldType = "\DC3cYvJ\1021129dBMW\SI _\142549V", + richFieldValue = "\DC2e\48476\rR\162679W0\DC2\ACK\1040001\r\1102288" + }, + RichField + { richFieldType = "\1063575\1011847W0fY\v\995827\r>l3mo6s2+\DLE\1034735*g'H", + richFieldValue = "\1010358\ETBX\fQ@2\DC3!TH\987799X\STX\bz\SUBt`\STXa]\1103652o\1040123\1075382\54633\NUL" + }, + RichField + { richFieldType = "RAc\ETXu[\1045432rFF7s", + richFieldValue = "\150126Q\fNq\DC3S=hT9\999699\t\EOT\DC2\16565\58633\DLEl\DEL" + }, + RichField + { richFieldType = "HM\n\DEL\FS&x\US\157560!\t\15295\CAN\SI8\USJ\US\72311\DELK\CANODm\a\ETBh\146734", + richFieldValue = "\127256\1062065<\1084134G\1013838\57436\1055208\DC1?%" + }, + RichField + { richFieldType = "C\STX\5295F\1066043Io{\1084579}h", + richFieldValue = + "%t[\DC3\a\1097838\b-\DC3r\\\DC1/1\1080556\EMgn\1090973\42459\DEL\1075433,?\180913w\145836" + }, + RichField {richFieldType = ">ldT\43466", richFieldValue = "\EOT@\988446\&4O\SUB9\SYN\STX\EM/,1\1043788"}, + RichField + { richFieldType = "(cCiV\1049352\SUB\1079784\&5\STX\"*\1093981\147914\&2DK\ro0q]5\34259/<", + richFieldValue = "\v\NAK\1039703\1017160Z\19335'\DC4K%\t\DC1\RS\47565C\176722HtuLW%\DC4LQ7%!\GSy" + }, + RichField + { richFieldType = " {YA7\DC2\92747\40298\1001169", + richFieldValue = + "A\1030311.^P$u0\CAN\111199fP\129523\1099159NZ\GS\RSn\1035384\189801<<\994100\1068633\ACK\DC23f" + }, + RichField {richFieldType = "4%+i\54430\1042341a\a_J\ETX*", richFieldValue = "\990556\STXOq~"}, + RichField {richFieldType = "\ESC\37189DD\EM(+9&axn\\", richFieldValue = "^\FS\ETX\148544"}, + RichField + { richFieldType = + "QM+\1049013s]\1005208\1046292\13212\1018425\ETB\14896+a%\1006669\1011902\1019721\NUL\1030068{G\985550I\DEL\1094491h", + richFieldValue = "\1110451_ru?\177123G^_\1037833.\1012576\1096856\1105016\169817K=QH" + }, + RichField + { richFieldType = "{r\DLEv\DC4z\t.p\1007902\142703|Ld@\GSh^\1070198\&8", + richFieldValue = "\1052479\&3\21714\1040108rJ\DC3/\DEL\DC3\51045)\22626~4\1092666\1088011\1055205\"b]\FS\STXX\"^==1l1", + richFieldValue = "\DLE'X-_\a\STXHaR\SUBZ\US\EMAu\1001395\32538\60712\RS" + }, + RichField + { richFieldType = "\f\DC4Q\EM8\US\35453[e\39694\ACK\1066257", + richFieldValue = "TZb\1034718ps\28692Yf\174875w[" + }, + RichField + { richFieldType = "\31940\1043617K,3\1075707*C.w\1049282\SYNh\1004322c", + richFieldValue = "&1uQ\"xsPA\1097585\a\1083181}\DEL\DC2\DLE\121455\33537,\1029578f\ETB+$" + }, + RichField + { richFieldType = "\SOH\1029313B\1008715\17751\992279bQ\DC1\r\RS\ft\CAN\138436\49486\ENQ\GS", + richFieldValue = "x$#\ENQ\vtMJ,\DEL\38676k\1113690h\1033164 9\GS;)fQS?i" + }, + RichField + { richFieldType = "\48107p7\62073$\1031007\f-Bq", + richFieldValue = "~\132861[m|V\1006179p\35718N\139105\&2PPp+(\CAN" + }, + RichField + { richFieldType = "\DC14\SOH\33641\151576\1022090d\995914\1106034\1111939x\30824j\44610y\DLE", + richFieldValue = "\94553\t,\n*C\RS" + }, + RichField + { richFieldType = "\164033%\a\SOH^\a\SO\US\161788@}\1034691\119984g99h", + richFieldValue = "\172519P\67358;\14146Dlw:c\DC2\1092080\158061\175487\b>\RS<\1018130`u\DELN\1062895" + } + ] testObject_RichInfoAssocList_user_15 :: RichInfoAssocList testObject_RichInfoAssocList_user_15 = - RichInfoAssocList - { unRichInfoAssocList = - [ RichField - { richFieldType = "\GS{!\SUB\1083131\134054\1040277K\133871,\1011175\NAK\1010828", - richFieldValue = "f\STX\rb" - }, - RichField - { richFieldType = "/\1013214#\DLEXxM\54627Dg\tI\121274I9%", - richFieldValue = "\1709\1012581\"N\1023165(Jm" - }, - RichField {richFieldType = "\1082871-yR7L\ENQ\1567'Ly", richFieldValue = "\1077720 \132842f\DC4I\1067140\&2v"}, - RichField - { richFieldType = "p)J*f \181598\&9\1061422/$\bO\1003862\66209\1039628\EOT\NAK\rmS\DLEw\175790dN", - richFieldValue = "]\STX<\97559\1066211$:\92367\149442\"4\16922\GS\1110134IO\996894%kZ\b" - }, - RichField - { richFieldType = "k\DC4H\167541X\182285\&8,bJK\aH\ESC\as\1109280\STXm \1042478}8\991578gaOPJ", - richFieldValue = "\b+\155297\1068427\988226V\1092290\&0\147573g N\DC1O0>" - }, - RichField {richFieldType = "i\20224=", richFieldValue = "\US\58796bnE\156085\155507\&9;@\1030069v"}, - RichField - { richFieldType = "\NUL\EM^t\DLEP^+/\54036N\178634\ETXH\160143\1103847\SUB\SO?xfC\133011zZ\1062666\49732", - richFieldValue = " \1014695\987898\NAKprv\1009646\180617\US2j_\1055693\17674\n}>6\FS\25406g?X\ETX" - }, - RichField - { richFieldType = "F ]QW\1114078\37987\1020224dEZ\1056088xqD\SYN50y\fU\b}N", - richFieldValue = "\36531\&7\8787b,\1031595j\60628\STX\14393\SI\NULg\10255$\\e" - }, - RichField - { richFieldType = "\1029823a\992503\STX`ZQ\3265nu\1044545\DLE>wv&\983255\NUL\134239$\194707\CANK\rCG", - richFieldValue = "N\12980V)$F\172321\1084828" - }, - RichField {richFieldType = "\1042524\&25\3526", richFieldValue = "\USo\FS\129442\1067574:`"} - ] - } + mkRichInfoAssocList + [ RichField + { richFieldType = "%\STX-\171033]\SUB\57566\179175\EOT+4\120243\FS\v;\ESC#]{\ACK\DLEM\97282*\RS", + richFieldValue = "\1022279\1107009\1084199\&24\ETB\1028868y7h\96665" + }, + RichField + { richFieldType = "[[eF\"\1098044J~d\SYN`B\b\147962[\ESC\163775\169568\nP\154510!'\156206j", + richFieldValue = "\DC1\181881)<%4$?\46231:Xc\61592pN\CANu\186478\178675\126240\&6p" + }, + RichField + { richFieldType = "\SUB;I\120501},\ETBE\DC4K]\917957\SUBV-\aP\GS\NAKN\51773\DC1\SI6\DEL<\NULM", + richFieldValue = "Xx`P6f\1105829\&3<\160986\RS&\1027838yf\DC4\ACK\138690Zb" + }, + RichField + { richFieldType = "2&\DC2wG\EM\1083654i\24941\67352\n|\DC2,67", + richFieldValue = "\STXv\156834|O\63507(\EM\"{z$8\ETXo\162424t?\1049897=R\ENQ" + }, + RichField + { richFieldType = "F\54906\fY\r\1090121\RS`j$\987238\&4", + richFieldValue = "\b\1073003jp\159698}r\997738'\9253-Cu\184695)\v\NAK" + }, + RichField + { richFieldType = "\992519\&1g*\1032393\v\26731\n\1097356 \5419\GS\1015851\&6", + richFieldValue = "kW3!x\DC1e\DLE\180330\1024546\1002152h\144848)w" + }, + RichField + { richFieldType = "Xg\1112937ij\DC2", + richFieldValue = + "'\1061876+\35224gV\1014259\1040820&\1044056\27427\FS--ye\158934+\131504\GS@Z \158204C\16508uY" + }, + RichField + { richFieldType = "\r", + richFieldValue = "\190972\31407\&8@\183341Lg\142518%\RSL\59211\50191\120188\1037109\&9YbVAZzSI\125002g" + }, + RichField + { richFieldType = "U0$\42642", + richFieldValue = "xT\1084716\aRy4?0\STX\121242\20097\GS\98528c>Oa\110999" + }, + RichField + { richFieldType = "\40064I{DR\ETB\1008634\SOH\\4?hV\1070561\SUB+GS\155446Gy\25478-iX=i<[", + richFieldValue = "\\&\66360y&\1024194) l\1009781\993852\tQqS`ZT`\1069831Di#Ea\1076361a\989306q" + }, + RichField {richFieldType = "@", richFieldValue = "\f\SUB\SO3\"\GS\998339\DC2#q\NAK"}, + RichField + { richFieldType = "\119131\n\SOTb7\DC2\7131u\1018453\t54\985924\1109041\ntp0i", + richFieldValue = "\FSe\1047813\EM<6=\RS\"U83\1035385a\ETBI[?\STX\v\1004740\59035s78>>" + }, + RichField {richFieldType = "i\20224=", richFieldValue = "\US\58796bnE\156085\155507\&9;@\1030069v"}, + RichField + { richFieldType = "\NUL\EM^t\DLEP^+/\54036N\178634\ETXH\160143\1103847\SUB\SO?xfC\133011zZ\1062666\49732", + richFieldValue = " \1014695\987898\NAKprv\1009646\180617\US2j_\1055693\17674\n}>6\FS\25406g?X\ETX" + }, + RichField + { richFieldType = "F ]QW\1114078\37987\1020224dEZ\1056088xqD\SYN50y\fU\b}N", + richFieldValue = "\36531\&7\8787b,\1031595j\60628\STX\14393\SI\NULg\10255$\\e" + }, + RichField + { richFieldType = "\1029823a\992503\STX`ZQ\3265nu\1044545\DLE>wv&\983255\NUL\134239$\194707\CANK\rCG", + richFieldValue = "N\12980V)$F\172321\1084828" + }, + RichField {richFieldType = "\1042524\&25\3526", richFieldValue = "\USo\FS\129442\1067574:`"} + ] testObject_RichInfoAssocList_user_18 :: RichInfoAssocList testObject_RichInfoAssocList_user_18 = - RichInfoAssocList - { unRichInfoAssocList = - [ RichField - { richFieldType = - "L<\186477\163586\11004'Da\1081342DB\1029274\DC1\100728u}!%g\174312`d\EOT\r5\1004363\v\8710\1109576", - richFieldValue = - "\22192\1037799p\STX\FS\1067474\v#\19332s'\1086200\1106461\178090\f\1100455)\142729\10966\187741\ETBs\95831 \132527\1073794M\ru(" - }, - RichField - { richFieldType = "R/\GS\1057103v{\1022626t5\173636\331\1107831)\NAK\1096345", - richFieldValue = "D\ETXb\EOT3\1106708\&6\DC1\1069851\1047601" - }, - RichField - { richFieldType = "\49246 2\27702^z}\\\1076963\GS\GSlk(Jb\DC1P\158643D\1077633\&2\1041396(\1040155\&8 \DC3^", - richFieldValue = "\SUBl\8673El=\EM\CAN\53814" - }, - RichField - { richFieldType = - "\1060368R6m \SOHqNn\1023530\EOT\DC4. module Test.Wire.API.Golden.Generated.RichInfoMapAndList_user where -import GHC.Exts (IsList (fromList)) -import Wire.API.User.RichInfo (RichField (RichField, richFieldType, richFieldValue), RichInfoMapAndList (..)) +import Wire.API.User.RichInfo (RichField (RichField, richFieldType, richFieldValue), RichInfoMapAndList (..), mkRichInfoMapAndList) testObject_RichInfoMapAndList_user_1 :: RichInfoMapAndList testObject_RichInfoMapAndList_user_1 = - RichInfoMapAndList - { richInfoMap = - fromList - [ ("\r\EOT-\1027344\132677g\51390\177008(d|\1020377[\DC4", ""), - ( "\DC1f\28550\1078890qj\183448\t\1054443C\DC2V\24519ZnY", - "\DC4\58409|\1067617g\"]#S\95247\DC2\SYN/[\SI\59274H\52762\120353\1024435K+\176372S\138337N\1069051" - ), - ("\DC4\148086<8g\ACK", "\a\1029966\1075110\191375P'[\1079123'\SYN>\\\1013784\EOT\57961"), - ( "\EM)\142171R\63132\1101329@_z,l", - "'\fS?\DLEk'\1084074\DELa />|Fk\SO\1079075x\983605\1032313K\1107277\29483kp\38343" - ), - ("\FS\FSPXw\33268&\NAK\27507Kr\50572\&7", "(e=z\"\178691pLmg\1027675}2j\165223OA\1000797_q\DC1\1008864"), - ( "\"{^\ETB\DC2\CAN>\174235\NUL\49449w\DC3e4\STX\SI\\`\nJ\ENQ[m\14485vd", - "\USW[\760A+h}\1011578zQ\51735\128295\ETX" - ), - (")\EOTdQ\985392\1063326\1049404\1090403\&6_\167322.|\176523_", "I"), - ("4 X", "\ETBW\1005903m\1012077\FSXA\185451N`\1028930B\1004479"), - ( "Fl\170211\SI*uBgcwKo\b\NAK\184082\SOH\187476\r%\188549\&4~'\NULilE\1022528", - "\ETX\ACK\RS*\1052117\1002981\&8\1040461_\GS\1069714\6066H\1095762Jmw\SUB,A" - ), - ("k7\1112800e)\DEL[*\1025387\169659\CAN", "\ETX\fZS\NUL\DEL\CAN \194647^"), - ("P.\ACK\22701=\36639A\168932|c", "Q\983856\165599h\1088153}~\a?:Xq2q3\1361"), - ("t\1717\1015694U\189831/o$\fc", "\a\59273\&1\12942\1053396H]#\986844\135653\STX*LYqs["), - ( "XN\RS\ACK<(4\97236k1ON\999401\186725]\STX\136667\157264d\SUB\8094", - "n\998069\126643\&0y{\188179zH\n\DC1Cs\ENQ" - ), - ("\96434e\DEL", "O\2113p"), - ("\156884\12840'5q<\178248", "@\1106532M\50269m\\\189498a1B\3886[S#=,.|S0\NULj\r%"), - ( "\1023907\aS!\154358\&0:", - "(]\1052314sJ\DC1\1037662\1059212\59724C\190354\&9\SO\1107665\\\EOTWu\1029094J\6803\1080372x\f." - ), - ("\1101303\19525\ESC_\1083068\&5\FS", "\1113659\t%b\180632\FS\8793B#\RS\190167\1028742\ENQ") - ], - richInfoAssocList = - [ RichField - { richFieldType = "\DLE\1025518A\RS\DC4nUXi<\128195S\FS\1005668\6739", - richFieldValue = "\1035571\b`+|+eu\23981(Z\186019D\1028214\1015577\&6Y\DEL\"U" - }, - RichField - { richFieldType = - "\28705UVd\146470e&\1044374!P\60067\ENQ\70448\SOH\1047197\&8\157873jZd\1067565\1028925\997058", - richFieldValue = - "\DC4\1096824\DC2&\1070187\v'\DC3aM\17345\US\165296\SYN \r\ESC\"\SI\47365\ETXoEhQ\ESC\1002938f\ESC\1037898" - }, - RichField - { richFieldType = "\983787hk\1078924\1037397Etb?+\f,)d4\999135gM!\989834\9737qJ", - richFieldValue = "f@SKbEo>@i\66330~$\ESC\53435\1106699\SOH{`2B\1030374" - }, - RichField - { richFieldType = "M\62113e\96191\997145\36092n\44231\ENQ\47764v\1053822C\999391D.P\19299\68478\991411HS@" - }, - RichField {richFieldType = "D\DEL1o", richFieldValue = "\SYN\DC4\RS\1028505C?"}, - RichField - { richFieldType = "\NULp\1103876\ETB}8\DEL#\1104464i)\SO7J\1094446E^~\1086789*h>\1060646\r+l2", - richFieldValue = "HV\DC3M\ACK\SYNZ\"\1020372\nFs\DC1-\n;" - }, - RichField - { richFieldType = "T\FS\1005668\6739", + richFieldValue = "\1035571\b`+|+eu\23981(Z\186019D\1028214\1015577\&6Y\DEL\"U" + }, + RichField + { richFieldType = + "\28705UVd\146470e&\1044374!P\60067\ENQ\70448\SOH\1047197\&8\157873jZd\1067565\1028925\997058", + richFieldValue = + "\DC4\1096824\DC2&\1070187\v'\DC3aM\17345\US\165296\SYN \r\ESC\"\SI\47365\ETXoEhQ\ESC\1002938f\ESC\1037898" + }, + RichField + { richFieldType = "\983787hk\1078924\1037397Etb?+\f,)d4\999135gM!\989834\9737qJ", + richFieldValue = "f@SKbEo>@i\66330~$\ESC\53435\1106699\SOH{`2B\1030374" + }, + RichField + { richFieldType = "M\62113e\96191\997145\36092n\44231\ENQ\47764v\1053822C\999391D.P\19299\68478\991411HS@" + }, + RichField {richFieldType = "D\DEL1o", richFieldValue = "\SYN\DC4\RS\1028505C?"}, + RichField + { richFieldType = "\NULp\1103876\ETB}8\DEL#\1104464i)\SO7J\1094446E^~\1086789*h>\1060646\r+l2", + richFieldValue = "HV\DC3M\ACK\SYNZ\"\1020372\nFs\DC1-\n;" + }, + RichField + { richFieldType = "T\1060709\SOH\1024519\&6\150331\1064434\983600zj5\1020200]\30039o" - ), - ("%\"hn%'Ls^\"Ej", "M\145285\&2h6\""), - (".r\NULASiNn", "@(A)\158438\1039824\"^\RS\153092nT )\NUL\136003go%7i\1021480"), - ("1Dj\DC2n\74494\DEL$#\a\ETB", "\SUB&\DC4\10781\ETXP\f["), - ( "98\nJ\176662s\ACK\SIG\57736\1028516", - "^\42880\167708\133306<1y:D\157231\EOTG\ENQ^\120231+\94324 \21330\SI\162748y" - ), - (">hI\STXs\aK3_\NULfO", "\r+"), - (">\33141!]\1050626A7~\1050406<5Qom\rn\1098028ZKZHL\v", "rh\1089466\194951\1013243\1007763j"), - ("cB)#", "\CAN:AjO\DC1\ETBc#{\r\DEL\492X\NUL\37340"), - ("K\bN\SYN\170192\&4\ACKi", "m\ETB~\1066084\1099683\ENQ\1051199"), - ("Mc\US\1088313J;", "V*IL\STX\9060W\CAN\SOfL(xbD\1095599Au@(U;"), - ("TI\1099712l8\r\f", "Bxe\DC2\1004042}L1\DEL#Z"), - ( "T\157570+A:\STX\FS\DC4@\1088081\1011374ri\\\185696\DC1A\"5\DEL\1076k\1074026\1021933q", - "u\ni\1027707\n=yf!V\RS\134243\1105451iq" - ), - ( "U}\1060635;Q\1054239\&4\RS=\13874w", - "<9\987997\DC2\ETB\172739\34051\1027611U\1000940f\138407>\988127\1022180\US" - ), - ( "W\US\RS/\58721\94746zPM\139597\&6\a\39956\NUL\vA\1033790\&2\169481\"I", - "q\1050092\1089565\3404}C~l\997188\SOg?\41244]l5\r\SOHbr\1095249tMk" - ), - ("\43991\\~\ETB+/A\ETX", "T\12606V\1103784Tcb\"\DEL\DC3\1028869"), - ("\83374~K\168125\&1[\ETB\1022301\ESCAx\DC1_r`p>?\74396\998441K_\1086915WqQzW9", "C\1061136.~\\^1)\26116T"), - ("\96772*", "4\NAKU\17943W\DC2ea\99552\SOH\992891\1078365\SYN\137088\9775\62016"), - ( "\162552\"^>:tx\1050599\1065772\69977\&2*\ESCL\nd;n%}", - "!\1089182\\j\1070298\145738(3\12859\\tytD\284V\78186NU\US`Q\95330I\ETXCI\ACK\165900" - ), - ("\177141Ly\989538\ETB}\135536ZH\SO\1040094\155314o}\f\1084906w\FSf3\DC2]J\SUB\SYN", "xi\1005583^\SOHX\FS"), - ("\184688qB\ETB\DC1\"\991311\1092587+\8522\USL", "r\1049699\61728\EM^-\70289J\DC4fY>\ap s\SOz"), - ("\1004294", "\ENQ\EOTB\1107876\FS\1011360'3p9\1094076\ESCl\34791\a\SOH\1072226w"), - ("\1020747OH6", "ml\1036052\97233\1111356\153702'"), - ( "\1021699e\1038505q?vY\175539R\27964U\ACK>5rr\RS\ETB[\131335\139139P\f\SYN\r?\78705", - "\SOH\1027571Q-\SO\DELb(rT\1099049" - ), - ( "\1029599\vh\SUB\GSY\NAK\142498c\177003t~\1047416L\ETX\tEH&\1049285yT y\ETBS\DLE", - "N~F\24384Z<\ENQ\1060768a8Y" - ) - ], - richInfoAssocList = - [ RichField - { richFieldType = "v\1049163vq\138760F\161731W\1083734\r8\29264.C;", - richFieldValue = "\"\EOThc1K\30246" - }, - RichField - { richFieldType = "v\47754\r\v\DC2k511}Xp\1058564\187282q507\ETX3", - richFieldValue = "\DC2\1099825\US\DC4b\52763\EMT\ETXE\bE\66848\EM\ETB\SO\1071731" - }, - RichField - { richFieldType = "Cr\US\141552\54986\16964x\997072\1044606t\n\16745z; F\184220r\151313\151309-\SOH", - richFieldValue = "\1027732\1113624\GSD\1053194rN\1091428N\1047827\25358;|q7" - }, - RichField - { richFieldType = "kzXo[1\RSI\t\986353T\a\DLE\1028560U\188623\SOo\rJ\1213b\1026797\990632K~", - richFieldValue = "\ETB\ETBc\185617LY\DC3\STX\1035095\95040Q oEo" - }, - RichField - { richFieldType = "\ESC\1042653\69709\NUL\NAK\fc\1075705\1045034Q%\DC4ID\605YLlMRu", - richFieldValue = "\EOT\16552+_\\1\SYN\ENQ\95636GyIl&\DLEk\NAK\1109582.Vy\ETB\19162(8" - }, - RichField - { richFieldType = "5^s\44680\43077\1094978\ETX_\DLE\NUL\NAK\49852\19166V <", - richFieldValue = "\134869E\FS\\Oy9M\NAKbK" - }, - RichField - { richFieldType = "\1203\v\"j\GSE\SYNYVm\141839\DC2\\{\ah\1057173\134711", - richFieldValue = - "qg\SOH\175454\154798.:Sa\985531\&1\ENQs5!\48353\&1:&z7x\111146\1003333\f\US\45791\1066900\1059251" - }, - RichField - { richFieldType = "N\STX\1097188\a\1002511e\157855Aw", - richFieldValue = "?W\1086682\997092\&4;\131126)\DC3-Z?\FSeUjw\175237h" - }, - RichField - { richFieldType = "\SO\147377\1613\ETX\143260\1065343\&1up\DC4\bW_P,mu", - richFieldValue = "\1092122T/I+8Q\25328\&6m\1079511\94749;\1020886;5\1020429E\1021611|\t\t\71712\CAN" - }, - RichField - { richFieldType = "ow\1037062\ESCLe`\ETX-\DLEen*\7912!\1046844\1002090\1048552\1004821[D4{\SOH\EOT\EOTH6", - richFieldValue = - "U+\24310\SYNa\998483m\\,n\DC4D\139849\&5\100485mY\986584\SOH0\NAK\STX$]-=\995943\DLE\EOT", - "\DC4!\1019690\138674i%$m?\48724K=\184479Z,\1092674" - ), - ( "\SOH[z\DC4\n&:15\t\1035689\30739\n\170466&\1075249w\1037270z$K\1039936\DLEB\991933/=\1001737\&0", - "\US\DC2y\54642Vh\RSx\42879m\147018L\SOH\1057776/#\133396" - ), - ( "\EM,Ky\an-N\EMb\43760", - "G$O^\1021021\144603w6\1093784\DLE\13779\SOH\1067406C\15160d\24616\NAKln|!o\64905;\DLE[\169381J" - ), - ("51\1080609&->", "\992690\38139H\2487\1054005y2\t\EOTp\a2\182032\1034377Gm})"), - ( "\\\GS|\DC3hy\139452\DC3\21784W\NUL\GSXHq\ETBD\DC1I\SYN\1063233\rK0b\25332\1055376\RS", - "}o\26866\"\GS\1019475-`!\156911QIn\1055097\&7uI\SI\EM\US\94072F" - ), - ( "`\2589Q8\15072W%\1050166U\1064919\&9", - "\CANU\120173>\STXJcZ\STX\GSt\RSb\SOH\ETB\1074358\52221*\DLE\123604b\GST\3513\59817" - ), - ("B5\172538u\1084781\SI=h\f\b\n?pv,\ETX\ACKN4\143402", "-\1042068\185433\1025442vY\SI\1103("), - ( "k\GS0*\DC4\USG\70325?p\SYNa:&\DLEvN\GSt\SUB/B,\1065709z_W", - "I\f\1092940\&9g\ETB]\r\162816\32545-X7\41077U=K\988807,\EM\1015494$=\999086\FS" - ), - ("L\ENQ\1084856", "\ETX\1002509y"), - ( "n4\128915\19213K1\ETX7\2423\1103031\1047665PE\DC2\NULCU\STX\DC4\1074147\1071387\1039210\672\&4i~b", - "rc\DC2\1112746\DLE\1097373?\DC4\917551D\32439k\1057859\1077680Y\1096345\983223hK\172740\992509|\1104742\STX@\SYN\RSb\1111824" - ), - ("Y\DEL", "=\1059355\1095788(|\67272xb\135230\DLE\1085545u*\1076101]1\145602\US\1107488\65452\46177"), - ("{*\f", "|S|=\v"), - ( "\165633\SUBoP\10206@p\ETX!\176361\DEL\SYN$1\1021342\DLE [\131860\64780<\1057929\998740\164495\28367Q\NAK", - "\ETX\1008801\48743pC9\146555N\1049688\30274\&7-#\DC4\1108575" - ), - ( "\996651`$C\1033243+\EM8(m_t\52980<*%\SUB\1021526\1039234[\NAK!\1014068'\1052160", - "\SUB#z.\1080449\STX\EM\n" - ) - ], - richInfoAssocList = - [ RichField - { richFieldType = "B\1100836?w\1131{\185475i#?~}x\DC3\r\USc4\95821C", - richFieldValue = "[!h\52548\23411Nz\r\998793\1070715\153058ibz?" - }, - RichField - { richFieldType = "-\DC4x\1072167\1071702\1001928", - richFieldValue = "\139251\ACK\ESC\1068809HB\1098861\na\159921=>e\b" - }, - RichField {richFieldType = "x", richFieldValue = ":v\12213@U-\STX_Op;Y\t@\1101077I2[\v\166807"}, - RichField - { richFieldType = "&\n\17455gg\94039\SOH\NULZu\DEL\DC3\1005498\ENQl4yv`n\40755\a`\r4\41011`:", - richFieldValue = - "\DEL7YA\SO\DC2kv\42911\19464\179440\16088\1079584:\903#*pm7\34123\SI\SUB\1038299\24981u\ENQ!\NAK" - }, - RichField - { richFieldType = "C\SOH\74163\127251'lT\169297`\179213!I\48221\1107718TK\174395b)\1056902\r", - richFieldValue = "\ACK\156361H" - }, - RichField - { richFieldType = "\1047629o\NUL\t\998215%f\n><\no`+\997254v\"Y\1042326", - richFieldValue = "\USx\SOH\68079\1079044\ESC\1001016?\1085130\60126\SO,\ENQ\1024324p\FS/\52943w", - richFieldValue = "D5\1081664\129572Q\1029923*@\1050341G\DC3\1103345\151403\26256" - }, - RichField - { richFieldType = "\160638g", - richFieldValue = "y\987196\ENQ\153254\SO\49670\&5]\SYN=j\SIVv$}!\1014078?e\17957q" - } - ] - } + mkRichInfoMapAndList + [ RichField + { richFieldType = "B\1100836?w\1131{\185475i#?~}x\DC3\r\USc4\95821C", + richFieldValue = "[!h\52548\23411Nz\r\998793\1070715\153058ibz?" + }, + RichField + { richFieldType = "-\DC4x\1072167\1071702\1001928", + richFieldValue = "\139251\ACK\ESC\1068809HB\1098861\na\159921=>e\b" + }, + RichField {richFieldType = "x", richFieldValue = ":v\12213@U-\STX_Op;Y\t@\1101077I2[\v\166807"}, + RichField + { richFieldType = "&\n\17455gg\94039\SOH\NULZu\DEL\DC3\1005498\ENQl4yv`n\40755\a`\r4\41011`:", + richFieldValue = + "\DEL7YA\SO\DC2kv\42911\19464\179440\16088\1079584:\903#*pm7\34123\SI\SUB\1038299\24981u\ENQ!\NAK" + }, + RichField + { richFieldType = "C\SOH\74163\127251'lT\169297`\179213!I\48221\1107718TK\174395b)\1056902\r", + richFieldValue = "\ACK\156361H" + }, + RichField + { richFieldType = "\1047629o\NUL\t\998215%f\n><\no`+\997254v\"Y\1042326", + richFieldValue = "\USx\SOH\68079\1079044\ESC\1001016?\1085130\60126\SO,\ENQ\1024324p\FS/\52943w", + richFieldValue = "D5\1081664\129572Q\1029923*@\1050341G\DC3\1103345\151403\26256" + }, + RichField + { richFieldType = "\160638g", + richFieldValue = "y\987196\ENQ\153254\SO\49670\&5]\SYN=j\SIVv$}!\1014078?e\17957q" + } + ] testObject_RichInfoMapAndList_user_4 :: RichInfoMapAndList testObject_RichInfoMapAndList_user_4 = - RichInfoMapAndList - { richInfoMap = - fromList - [ ("!B\1071043(\1046230^", "o|~2V\8316-\12106>\DLE\rh\r\151511\148325^so\137986\1009802"), - ( "=[3kw\1089151\3425\1084229V\141022]\"h\94355K= V\az7\150776x\\\178967\SO\1006917\t,", - "P\110781,\DLE\994481\&8\1067195S\22736\1034878Ja2<9i\SO\NUL]\1088388\DC2\180157" - ), - ("\75044\CAN RS\NUL\STX\996303_\vubE\NAK:x:U6dj\ve\1036386MS+V\ENQX", "M$.\1003659d\rB{Y"), - ( "\131171\SUB\NUL\SOHo=U\1036682Cf\174535\1112672\1086669\DELlf\34736\DC4X3>Sdb\1077202", - "[=h{H\"\1076873\46124\&3jd@\1087950{" - ) - ], - richInfoAssocList = - [ RichField - { richFieldType = "\987942\147791`Z\23807b", - richFieldValue = "$\NUL]J\ETB\ETBLg\1014833\160465\1036902\&96I/2K" - }, - RichField - { richFieldType = "v*:\12646t\ETX\DEL\DC4*\EM\985293\128174\111229\137078\992210", - richFieldValue = "@\SOx\139548B\1092218_ I\DC3\t\DC4\16425\DC1%" - }, - RichField - { richFieldType = "\DC2*1A:)\134970\r}q7~\95100\NUL#Ze!\1108733\DEL\6413\v}(", - richFieldValue = "p\29286\35927K\ETX\ETBDu\131704FAE\917966]-M\NUL" - }, - RichField - { richFieldType = "A\993024\154927<},\USzf}K8+\144607\148584N\1010701zI\51456o\37507A\92321\DLE\156647\US", - richFieldValue = - "~\1099787Y\1111583\51220>X\1091654\152044\DC4\CAN`\DEL\ESC\164425\DLE\"45\NUL\ACKz\EM\1068301\RS" - }, - RichField - { richFieldType = "\b\1004306\1089704L9=.r\65784)/\SOHPB.fr=Kh\24622I\1095737Y\23042l\1062366~U", - richFieldValue = "\DEL" - }, - RichField {richFieldType = "", richFieldValue = "\171417\1113813A"}, - RichField - { richFieldType = "\1067266m\DC4\990224w\"\ETB6_", - richFieldValue = "\EM\EOT\1087675y\NAK\31702fr\180439\143940\1076041*Nq\DC1x.:]0\NUL" - }, - RichField - { richFieldType = - "R>\46518\63305)\bd$\\nH\1082857\185930\181424\FS|\167720-\1072367 \DLEC\1019450\&0\DC1\1047631UP~", - richFieldValue = "\FSZB\18643\134281\"D;\RSaG\1075507Pr\1015475CI\1063206\ETX" - }, - RichField - { richFieldType = ".XV\987830\162631\NAK\EMo\54497\vq\1034154WB\989134\1045982(\ESC\983345B\1031387*", - richFieldValue = "LJ\984449'\DC2M|(\990807XS\EM!i04" - }, - RichField - { richFieldType = "?-\SUB\1070019\174290\ACKD.&y2=\NUL\1093985M\1072534\43477+\r+\f", - richFieldValue = "\150583\176077\ENQ9\994880\t" - }, - RichField - { richFieldType = "\1027457\b(k\NAK]", - richFieldValue = - "Q\987304\995175Kf\FS\ETX\177309^\GS\EOT\1049360<\168778\140181\987603Hb@r\SI0N;\148934kX>" - }, - RichField - { richFieldType = "\160115\ENQ+\f:\ACK<", - richFieldValue = "x;9?Q(d6\SYN\141622&\998166s\DELmp\tkDn\SO\984047\SUB\SOD" - } - ] - } + mkRichInfoMapAndList + [ RichField + { richFieldType = "\987942\147791`Z\23807b", + richFieldValue = "$\NUL]J\ETB\ETBLg\1014833\160465\1036902\&96I/2K" + }, + RichField + { richFieldType = "v*:\12646t\ETX\DEL\DC4*\EM\985293\128174\111229\137078\992210", + richFieldValue = "@\SOx\139548B\1092218_ I\DC3\t\DC4\16425\DC1%" + }, + RichField + { richFieldType = "\DC2*1A:)\134970\r}q7~\95100\NUL#Ze!\1108733\DEL\6413\v}(", + richFieldValue = "p\29286\35927K\ETX\ETBDu\131704FAE\917966]-M\NUL" + }, + RichField + { richFieldType = "A\993024\154927<},\USzf}K8+\144607\148584N\1010701zI\51456o\37507A\92321\DLE\156647\US", + richFieldValue = + "~\1099787Y\1111583\51220>X\1091654\152044\DC4\CAN`\DEL\ESC\164425\DLE\"45\NUL\ACKz\EM\1068301\RS" + }, + RichField + { richFieldType = "\b\1004306\1089704L9=.r\65784)/\SOHPB.fr=Kh\24622I\1095737Y\23042l\1062366~U", + richFieldValue = "\DEL" + }, + RichField {richFieldType = "", richFieldValue = "\171417\1113813A"}, + RichField + { richFieldType = "\1067266m\DC4\990224w\"\ETB6_", + richFieldValue = "\EM\EOT\1087675y\NAK\31702fr\180439\143940\1076041*Nq\DC1x.:]0\NUL" + }, + RichField + { richFieldType = + "R>\46518\63305)\bd$\\nH\1082857\185930\181424\FS|\167720-\1072367 \DLEC\1019450\&0\DC1\1047631UP~", + richFieldValue = "\FSZB\18643\134281\"D;\RSaG\1075507Pr\1015475CI\1063206\ETX" + }, + RichField + { richFieldType = ".XV\987830\162631\NAK\EMo\54497\vq\1034154WB\989134\1045982(\ESC\983345B\1031387*", + richFieldValue = "LJ\984449'\DC2M|(\990807XS\EM!i04" + }, + RichField + { richFieldType = "?-\SUB\1070019\174290\ACKD.&y2=\NUL\1093985M\1072534\43477+\r+\f", + richFieldValue = "\150583\176077\ENQ9\994880\t" + }, + RichField + { richFieldType = "\1027457\b(k\NAK]", + richFieldValue = + "Q\987304\995175Kf\FS\ETX\177309^\GS\EOT\1049360<\168778\140181\987603Hb@r\SI0N;\148934kX>" + }, + RichField + { richFieldType = "\160115\ENQ+\f:\ACK<", + richFieldValue = "x;9?Q(d6\SYN\141622&\998166s\DELmp\tkDn\SO\984047\SUB\SOD" + } + ] testObject_RichInfoMapAndList_user_5 :: RichInfoMapAndList testObject_RichInfoMapAndList_user_5 = - RichInfoMapAndList - { richInfoMap = - fromList - [ ( "\SUB=3%w\1011617\99879 u~\1028041t\64133y+-\1009569Q[\1044634", - "O'(\NUL\1077813\ETX'08\97370b\51950ya\a\996702\1039882c\1053793\SUB\STX\10893\46842\SUB\EOTl" - ), - ( "#\FSmPU]\26394g\95117U\fWMoHJG>7b\EOT\48986\1056824\SO\EOT{Y\ENQ$", - "\1097552zI\140419\987722Dp\170986\DC4'g\ab_VC+0v\ac\RS\1108789y\SI\SOHK](U" - ), - ("2\185555^", "\30694\\\1006114Uw\EOTu3\152196\&2Kn"), - ( "mL\NAK[\162072\111106\DEL\23644\7866\133562K\ESC\1020965C\ACKws\39440}z\ETX\SOH\EOT\1058134\19670\DC3", - "\SI8t#\ESCr5\GS\b\SOHAJj\48050rQnkU\1072170o\7527(/<\ESC\187964z\1103687\&7" - ), - ( "nz\128256\a\166004/;'I\985259]\119938(\SYNin@45\DC2", - "\153998\CAN\ESC\143590\r\1110571\&8\158341\59577\&8\SOH\GS6l\ty\SOH\1078906\GS!2T0H\f\ENQ>\181756OmK\SUBF@\1832\178698e\DC3P\aJ\186483M\SYN\1086254]6\57491" - ), - ("\50089", "\11992\GS6\n\128243zv5t\25183\1081926\180495m\DC1\ACK9\180332\r\983614"), - ("\153659w\DEL\989887!\SO7U\t|7\169534a\95808\181171", "\SOH\1096987\1021324*Q\fHH6"), - ("\189188Z\1078061\&7Vo\71862\1063403}", "\NULP\a\164102\33757\1029041\1011812\1025156\CANY_.Y\DELO"), - ("\1096032\97635G\a:\13696$+\GS|", "fs5)\27616;\v\DELr#\a6&\EOT\ACK\GS\1695y\CAN") - ], - richInfoAssocList = [] - } + mkRichInfoMapAndList + [] testObject_RichInfoMapAndList_user_6 :: RichInfoMapAndList testObject_RichInfoMapAndList_user_6 = - RichInfoMapAndList - { richInfoMap = - fromList - [ ("\a\176690E\1017778\1103374];\ETB&A(& \165355\60311\1012427p\985415\SI\188034\DC3Ak}\ESC.-\"'", "\r"), - ("\v8\67075\STX", "\1083399x4\nam@\48393\fd'\25202\&4g%ngl\\g3d\21789\DLE.\1050581a"), - ("\CAN", "\SOS\61865\988723\1101769\72252\n-s"), - ("0\ENQ\"u\RSS%", "\"\ETB\998898\ETBsI\1113419\990022\ESC\t\EOTwA\FS?RUi\1060951_\DC44\27969/\1113617"), - ("K\"rO", "\v\FS\ETB\EMb\156408s\171987\SI?\1098788\&2\")\36126)"), - ("Q\RS.\1012674\1102164\986191\DEL\a\DEL\ETBFEj\DC2\1022184?j >Cv82vY~ mqy", "l>rV\DEL\ETBYz\83318pJF\SI|,"), - ("X\DC4\1011458\1052511\148563?A\99070\43007\68322@\158252\a\1023501N@62\EOTr#d\1102274b\DLE", "\1062082t7"), - ( "\189342\1036382y\999704--DG.D", - "t}l\46821B\SYN9\DC3D\1113382T\1108830!K|\ENQ|:KU\EM\1105198@\73749+\ESC\SO\29306" - ), - ( "\988901\&8\r!\24330R[\DC3G\17751\SYN\SOH\SI?>LPKE\r\21128\ETB\1067860", - "\1050442@)R2I\1096562\174002\999586m6n8\177225R\183296\163443\&9J1\190770\983764\986340\SOHLRw\SYN\1050284" - ), - ( "\1038100\1066346\&0\29703\1097218\1006964\983165ib\\RI\156345Bb4\ETB\1098848&bTVv\SI\68806t\43546\1085334\&9\DC3", - "\1057783\23147\1053386H\1028525\DC2\94911\&6HE5\1038476\ETB\95433\1099384\7983" - ) - ], - richInfoAssocList = - [ RichField {richFieldType = "", richFieldValue = "a\EOT\US\990379th\174671\1004957"}, - RichField - { richFieldType = "\1084720\&1\111239[\\y", - richFieldValue = "\nq{A\SYN\1104064\8053(}\ESC\1087325K2K\b\DC1Cit\173313" - }, - RichField - { richFieldType = "cf|\SYN{\ETBd\1034470\1074120JoLS\1011229S\SO|\156132|eE<", - richFieldValue = "\ETX\1069228\ESC\74770\46177\1043093i\DC4.d" - }, - RichField {richFieldType = "\1023997\1106991", richFieldValue = "z\54313\SOH9[\ESC9f4\2209"}, - RichField - { richFieldType = - "^#\1072101\57352!\SOB\ACK Q\1066051\1000366O\t\167759X@\GS\33915L\DC1g\ENQU\CAN\1016249R|", - richFieldValue = "\141801\1113010Y,\1022133\984371\1110036\100637" - }, - RichField - { richFieldType = "{\998053\13016\1005789 \985019", - richFieldValue = "TH`\1064567\1015273\ESC\DC2\60656" - }, - RichField - { richFieldType = "gIcTc\CAN;b\18097\DLE~\t\986477mWU~_)avv", - richFieldValue = "r\SOHb\1033353:\1098734\161297\35845%\1030189o]\16288\1037928h]N{\SYN3H&\73834x\DC4" - }, - RichField - { richFieldType = "$\EM\94651_\119998[\a1(\139256\62509\DC3\SOH", - richFieldValue = - "&\CAN\1023849'\179633f!\1056824BF\NAK\141841b\161257P\52739h\1067768%\3657c\2275\1076613(" - } - ] - } + mkRichInfoMapAndList + [ RichField {richFieldType = "", richFieldValue = "a\EOT\US\990379th\174671\1004957"}, + RichField + { richFieldType = "\1084720\&1\111239[\\y", + richFieldValue = "\nq{A\SYN\1104064\8053(}\ESC\1087325K2K\b\DC1Cit\173313" + }, + RichField + { richFieldType = "cf|\SYN{\ETBd\1034470\1074120JoLS\1011229S\SO|\156132|eE<", + richFieldValue = "\ETX\1069228\ESC\74770\46177\1043093i\DC4.d" + }, + RichField {richFieldType = "\1023997\1106991", richFieldValue = "z\54313\SOH9[\ESC9f4\2209"}, + RichField + { richFieldType = + "^#\1072101\57352!\SOB\ACK Q\1066051\1000366O\t\167759X@\GS\33915L\DC1g\ENQU\CAN\1016249R|", + richFieldValue = "\141801\1113010Y,\1022133\984371\1110036\100637" + }, + RichField + { richFieldType = "{\998053\13016\1005789 \985019", + richFieldValue = "TH`\1064567\1015273\ESC\DC2\60656" + }, + RichField + { richFieldType = "gIcTc\CAN;b\18097\DLE~\t\986477mWU~_)avv", + richFieldValue = "r\SOHb\1033353:\1098734\161297\35845%\1030189o]\16288\1037928h]N{\SYN3H&\73834x\DC4" + }, + RichField + { richFieldType = "$\EM\94651_\119998[\a1(\139256\62509\DC3\SOH", + richFieldValue = + "&\CAN\1023849'\179633f!\1056824BF\NAK\141841b\161257P\52739h\1067768%\3657c\2275\1076613(" + } + ] testObject_RichInfoMapAndList_user_7 :: RichInfoMapAndList testObject_RichInfoMapAndList_user_7 = - RichInfoMapAndList - { richInfoMap = - fromList - [ ("\ENQJy\58686\46921acIXK4\ACK\153028", "yk_\998162"), - ( "\v\STXj,$\1004659(\ENQ\992342\179735I8\22559\39519\EM\RS\138941F", - "q\52986\STXd\47044p\35044\SYN\1100089[\176474\1073824tl\1024631hF?" - ), - ("\DC2\"\SYN\NAK)\95970\154328\DC3#Yf3\f", "0&UI+\1085405O\68888Hl\"P\FS\CANX"), - ( "\GS\1024731-TdC/\\\NULomf/\65096\12221\141012_*\ETX\1014476\49440", - "\36414*\DEL\129605\1066701G\ETX'\182921~\160253KOI\EM0\983070_'\ETB\42323\917826\68073:Q=9U" - ), - ("4\DC2\r\1049659\DLE", "\DC1B\r\r\EOTB\61644\184587\21115\&8\1046686NR'\9945S%\DELy@o\ESCPG"), - ("=b\60170@\DC46Z/m[", "vF\25441J\1025545\ETB\DC46F\1010187\"\CAN4tB\EM\fRhbt`H\EMH+\1048366\995903"), - ("fM1_e%", "\f\990983\24597\ENQ\DC1\1108890\1086336\1039220K/y"), - ("p\fj\13862u\n\rr\38028hL4\DC4\42079ph\DLEF-", "\1096142\&69u~\\04\48676\SUB9\ETBp"), - ("u\157281%\1039198\a[!\DLE\190722\t:M%", "b\148497jb\1025904\v~y\ESC"), - ("YL\1033543\r", ""), - ( "}p*\EM1n\1035188\STXI\120023\1083881Z\19021m", - "\r\ESC\ESC\f!\1032505<\61397\1020151\ETXk\62979\1014647h\68440g\NUL Y\55251o" - ), - ( "\DEL\1097952|\ACK.\\VO\t\bO", - "\f @\FS\157089\1085972\EOTxU\NAK\1064654C^O\ESC4\ETX\DC3a6c\a-\FS\1019123\&7e\166420" - ), - ( "\42819f&\NUL\1044603\145954\156779~q\f\f)M0\25163D&tu\a\v", - "BH\f'\41294}a\STX\SOJ=V'\153541\1108488t!9\185173.\1096543\SO" - ), - ( "\134249;\NAKSOm\64823b\SUBBq\SYN\t\\\119908\\\1063965\DLEx \1034768", - "5v\DC3!\28952+P\12898\96310\NUL\132902" - ), - ("\143939cz\151072(0\ETB/\RSiKwut\RS\EOT}\1048670\b\f\1005845\n", "#"), - ( "\173347$\1013271#E\171209(\1032692N['\148001o~wL\19715\ESC r:7\11128dmA", - "{M\164240rud`\1008412]v\67072\1090405\1091224]\US\EOT(\ETXAah\135204Z.\DC2\SYN " - ), - ("\1007835C.IE\CAN", "mI%*O\1050793>!;D4`h\DLET_v\1051579\&4e."), - ("\1031846\&8i-m", "{GUBA&\1014120+\ACKR&\ESCSsDVk1"), - ("\1064339B->", "Q\151071K\163816\1094737\138798\1016820g"), - ("\1105263U", "\\u\r\21997\74078\1094141\1098949sWJ#\136200d\ETBe.\am\1092241tz<\a") - ], - richInfoAssocList = - [ RichField - { richFieldType = "yVr\1070553'\1069999\178919[\70436W!\179079\121209x'!d", - richFieldValue = "\1066404" - }, - RichField - { richFieldType = "\167907\98319", - richFieldValue = "\983580\EOT\ETX\1081304N\DC1=\DEL\170497\1045717\DEL!K\GS}" - }, - RichField - { richFieldType = "C\5689?L\EOT\n\1017425\r3\997957", - richFieldValue = "\44277\152011\1037822\15380mr1\RS\135378@\ESC \152867BCm1\DC1Pw\1095940Vs\\" - }, - RichField - { richFieldType = "\EM2&\GS\65457c9-\SYN\b-Z\38199\ENQl>", - richFieldValue = "W>\ENQ-\na=,jm\1070873\FS\1050317D\185060M" - }, - RichField - { richFieldType = "_\175447\1039978zK\r}", - richFieldValue = "p4\1051406&oh\DC4X\995132&o\59772HE;'eNj\nI@" - }, - RichField - { richFieldType = "\ACK\SOHT\1084069\1100918\f\FSOr,\99101Kh\5381\47691\833*r\ETBYo)L$\SIdGH", - richFieldValue = "!\36363Wg\\\42303$\148610<6pb!\ETX\1072329BH\DC3\1085976:+\EM\STXF\CAN=\NUL" - }, - RichField {richFieldType = "W\f7|%", richFieldValue = "6\ETX\DLEXq\43873\ENQ"}, - RichField {richFieldType = "\1054196\&4f", richFieldValue = "$\21287X{};c\CAN\176923R{"}, - RichField - { richFieldType = "\CAN1=\1112874t\1064394\54291c\NAK;\33800P\173520%\1022737\128040Ug\181182@o\\ao\DC2\FS/", - richFieldValue = "4\168384\135625\97942\ESC\160766<>d~H\NAKVQ" - }, - RichField - { richFieldType = "\167692\ETX\DLE\46872\996241;,cn$W^60\25496i\ESC?f\1027656\4631Qnf6\1088314@?", - richFieldValue = "\1068831\NAKS\v\1034582~\1036986 \154074\1079904!\1017472\SO\NUL\148458NJ6$H" - }, - RichField - { richFieldType = "\ACK,bOfoZ*+*\127773nd4\ENQ\179237V]\92570\&3", - richFieldValue = "\ESC,\DC2\1048312W]Y\ESCE\1009012vDiw\156939\aw\23869\RS\27634\1058290\fD\tUY\1054152Y" - }, - RichField - { richFieldType = "\149138\ETXI\EOT", - richFieldValue = "\1085030\45494O\NAKwa\SUB\1064114\147901k.p\ETX" - }, - RichField - { richFieldType = "+\ESCA9z\1042385E\DC4\138580|Jk\54852\SO\1111039s;~yPY\1013727)\fw)", - richFieldValue = "\ESCl\7678\1065306\169339\18038\f\EOT?szC\185520u\CAN\DC4\NUL\131789I\142165" - }, - RichField - { richFieldType = "tK1R\119669 \1003469\1010598\SOH", - richFieldValue = "\984258\azmw\rJ\42327u\SOc9\GS\STX\1085970\1045411" - }, - RichField - { richFieldType = "Wb\20169U\EOT+7\164348\1059589\NUL\FS4\1031161]eM\53509=\27826\6673\b\\4\FS\1088938", - richFieldValue = "\1098170\151564\990266~sg\1076582?\177687w\RS\177697\178277>7" - }, - RichField - { richFieldType = "~2+\1075449qp)\185719\DEL&\1380\fp\ACKGG\65734U~", - "\DC3\SUB\DC27\DC1S\EM\145842\FS\1103663\FS\ACK\169296n\1042453x,H\1069717ZFrrU\n" - ), - ("=\SYNbD\155035`8>\1032487'\1009948", "\\[\EOT\"\tg*~\ETB\148396{\SYN2%7_X\38235\DC3bC\niE"), - ( "A\984792<\ETBu(ZbM\2326\186992UeS!\1107326<\SOH;@\DC4\STX+fwF\SOa\1052278", - "\1087471\&0\DLE4\a\140290(k\ac\127282\18274-\1021422W\132842v\EOT\v&5J" - ), - ("p\1033750AclBh\t\FStf\1075770", "\ACK\178575\t1F\t\5310"), - ("Xpr3&D\1079765\129368^\136014d\EOT\ESC{?\STXOd\36589\v\ETB\n\1049596,", "\DLE,[q\DC1B\1014186\92380"), - ("yi\DC1:\"\57429v\32129b)\DC4.@E{\189972\1032385\171339YO", "`_h\167346"), - ("\164042\164600\DEL_\41466\ESC^p", "B@\vE\n\r]P\STX"), - ("\1075545\1009037\fU:", "Q%:t\DC2\ENQ(\2810:\NULj\41149\&8r>\DC2kmu\95110"), - ( "\1101735\6627$\40648@\1061550\&7hQ8\164683*\EOT-'I\GS\150556\US^?Oe\STX\42442j", - "\153585\t\119634^oG\DC3T\ETB+\SO\DC4g\1082103O<\983519n,mcPi2%= " - ) - ], - richInfoAssocList = - [ RichField {richFieldType = "\f&3\4306$ur\177822oQ\1020175o\EOT", richFieldValue = "~\ETB\1084126\1113613LR"}, - RichField - { richFieldType = "D\SUB\"\95144d\STX\NUL", - richFieldValue = - "\r\DC2\ESC9\32611C\96044\DC1H\151316\96727\ETB\991002wZ\1067986\16822\138867\SOH}x>Fd\SO&\4911" - }, - RichField - { richFieldType = "\1081957\129553\v9\ACKyXg\1110443NU\ENQ\67721\RS\66779\&4e6\1017278\a$\95933~", - richFieldValue = "E/V+~p\1087990\DC3\11405a\60204\ETX\78290\v\f\1025599A[n6^N\t\59898\&7" - }, - RichField - { richFieldType = "CV\DEL\1026446/\DC4C\1027356EB*\1073139r\1024961\b\1030783\989999\151414m5\144580i", - richFieldValue = "\NAKIk\DC4" - }, - RichField - { richFieldType = "1=D=\NULv\183554jD\ENQO(", - richFieldValue = "\vAlLMb\CANvvn\DC3\ESCM\188913X`\168429" - }, - RichField - { richFieldType = "3\NUL\158775\SOH\STX\1071447`\144149P\USKEV\1104776\&4U\30610Ox", - richFieldValue = - "}83i\174615\1088090\1108364\NAK\1058962\144833\&6h\b\139235I\1058230S\DC4\DC3OW%_\DC2*\139154" - } - ] - } + mkRichInfoMapAndList + [ RichField {richFieldType = "\f&3\4306$ur\177822oQ\1020175o\EOT", richFieldValue = "~\ETB\1084126\1113613LR"}, + RichField + { richFieldType = "D\SUB\"\95144d\STX\NUL", + richFieldValue = + "\r\DC2\ESC9\32611C\96044\DC1H\151316\96727\ETB\991002wZ\1067986\16822\138867\SOH}x>Fd\SO&\4911" + }, + RichField + { richFieldType = "\1081957\129553\v9\ACKyXg\1110443NU\ENQ\67721\RS\66779\&4e6\1017278\a$\95933~", + richFieldValue = "E/V+~p\1087990\DC3\11405a\60204\ETX\78290\v\f\1025599A[n6^N\t\59898\&7" + }, + RichField + { richFieldType = "CV\DEL\1026446/\DC4C\1027356EB*\1073139r\1024961\b\1030783\989999\151414m5\144580i", + richFieldValue = "\NAKIk\DC4" + }, + RichField + { richFieldType = "1=D=\NULv\183554jD\ENQO(", + richFieldValue = "\vAlLMb\CANvvn\DC3\ESCM\188913X`\168429" + }, + RichField + { richFieldType = "3\NUL\158775\SOH\STX\1071447`\144149P\USKEV\1104776\&4U\30610Ox", + richFieldValue = + "}83i\174615\1088090\1108364\NAK\1058962\144833\&6h\b\139235I\1058230S\DC4\DC3OW%_\DC2*\139154" + } + ] testObject_RichInfoMapAndList_user_9 :: RichInfoMapAndList testObject_RichInfoMapAndList_user_9 = - RichInfoMapAndList - { richInfoMap = - fromList - [ ( "\DC1C=D\1092975\&6m\183322\1030244^\1094152]\1113682I]x\n\SI\ESC\ESCt$\US\NULiX\DLE\SUB\1024319", - "H\NUL4\tE\DEL(\1097719[\159865l\ETXGm\ETX0y\1038520]\146730\1096471)\DC3z?" - ), - ("\NAK\1080970R\78608s", "\DC2\f\178260\&4\1100188\US\r\DC3\165138x"), - (" \189377\1100428b", "^L!\181405?~i^\DC2W\ETBg\986734\1101323*\72331\1014492\ETB\"8\1073966j"), - ( "55K\40405\1008412\r\17921\1060113\1091673\1009671\t\983367R", - "*H\168094\bg\1073008$oU!9qDd;\4720;z\146960R\1001826" - ), - ( ";`\62882)O\1097338\15981\1108054D(4l\1068400w\b25", - "\1016965\EOTo\NUL\1025588\1013620$\16383\1092882DH\1075666\1087589\tk(\CAN\ENQ1M\1104067\173309\ETXcJ'" - ), - ( "H\47124\1038678\1089458%\1069920\43588H\ESC;]\1005211\ENQ\177765\\x", - "T\24061\1050025\GS\185345mA8XI\ENQ" - ), - ( "Md6DS\1102384\983103#\SYN9e\US(\\\1024729L{\139901\1075502\DC4\98402\USp\168330`v\41799\&8\NAK", - "B8S\985354;Tc\DC4\34011\37027\983124\1059709\NULhp\\+\992960]p1|M9RD\176534n-\CAN" - ), - ("w\15907\46077\SI\1026142S&\1113616\180599n;\7438po\b\ACK\1073265]I.8\1041840Nd\1102809\f\ETBU\aA", "\SO>"), - ( "}S{;\17158j|\1074873\1020995", - "\n1\58224+\166151\1016174!Ix\1032921L\ETX\2637\178561z?\37010\&5\DC4\v\"U%=\64279e\31156U" - ), - ( "\163183\EM*\1054724\\t\164022K\171461x\9054\1040150\24867\&5\1093083\RS\1019810\6424", - "nSq`\t\vr\RSQ\"Qj\USyE\171450\&58e2\DC3:D\DC1\163636Un\GS" - ), - ( "\184513\v\CAN\1100721\5529H\12836\EOT<\\\996700\1092557W(Y\NUL\1107019", - "\tb\DLEA\17694;\19219S\23988\1046617\46792%\1010606!/\1095332k\1100060" - ), - ( "\190207)\1023504is\171644\36126\ACKjJ*{p\1062831\&1\163252zm6g^\176808\68056", - "=y=\FS\186577K\RS\GSy8\DLE" - ), - ( "\1049369wz\1046030\22352\SO\1048558\EM+oqC\173089^a[l\1020681Z\119990\&7&\RS\DC4r}", - "Ihel\CAN\DC4\37046\1012506\f2^*h`u\ACK\FSu\171153\1016971\DC4" - ) - ], - richInfoAssocList = - [ RichField - { richFieldType = - "\1051215e4\RS\23439h^x^\EM\61905v\ETX+XJ\134982[X\1092473\EOT\1077911'\DLEK\1093610\155900", - richFieldValue = "T5\11971\ETB\1047874](}{\ETX\1043337'\1081171Mq5\1020468\SUB\ENQ`s\46654\DC2Zw" - }, - RichField - { richFieldType = "^:;\CAN\FSy4", - richFieldValue = "\1059457(0\DC2\ETX3\34133U\178634\&2\1068820\3182F+=pd\rp\1109245\28693o" - }, - RichField {richFieldType = "", richFieldValue = "6cP\DEL\6080R"}, - RichField {richFieldType = "?\1047538~d\DC3;U\1106640P\995958zJ*{*T", richFieldValue = ")|\DC3\fK"}, - RichField - { richFieldType = "\1015119<^\1999\ESC\184113lIdb\1072838\DC1^t\DC2\174936\1100963\182884Pb", - richFieldValue = "\ETXd-\188647\RS\180191 z);],nC\1022457\1068377\180238D\999368\SYN\r2\FSD" - }, - RichField - { richFieldType = "\CAN\60004\a\DC3H[s\ACK93", - richFieldValue = "\1041236\32361H\NAK\1096623\129058K\1075562\DC3(\SYN\181142{X\FS\189569wV\1034882" - }, - RichField - { richFieldType = "$\36819T\1105580nf\SOHT\133740{z\1026264Goz\RS_@[V\EM\1031481\&8C6D", - richFieldValue = - "F\DC3\73440=k\DC4\990834\GS\1060856i\163960\&1\1062637J\98269m'P\1027260plO\188080\1055753" - }, - RichField - { richFieldType = "\DC4v-\STX\EOT?\EOTQ[0\146988mnFN\t/>\ETX\1113899V\1000937B\ACKF\175446", - richFieldValue = "o\ETB?}7H\146313Z\168011\&7\984607%4\173083\3879\167358" - }, - RichField - { richFieldType = "\FS@$'\7020LR\1058824w~o\1007673'\b", - richFieldValue = "Ms\1025378\1034881B\1022931M" - }, - RichField {richFieldType = "m9d5:O.4\1101624\DC3m", richFieldValue = "V\r"}, - RichField - { richFieldType = "4fJ%*\US}Y\1046694\ACKV\1012548\DC3O\1062399\ESC2:{H*c\1005890\189579z\t\1021171W", - richFieldValue = "G\171123\1090504" - }, - RichField - { richFieldType = "2\1023994\b\"f}+ \ENQv\r\1030394\ETX]F@\1069254\&0R\16066", - richFieldValue = ",\ACKR\1053242!g\186623" - }, - RichField - { richFieldType = - "C\1086563}\"j2\138736\vWi\1050956\61878\2267\1033370\SIDn\121030\1081299\1112031\20632\&9\a\a\153143A\SYN\57533", - richFieldValue = "&,61\SOHC\986476uj>_" - }, - RichField - { richFieldType = "\150181", - richFieldValue = "\DC2I\27369\DC1&T\159506x\1044600i\ENQ\19979\159274\8229\32065ZoH~P{4" - }, - RichField - { richFieldType = "K\v`=7NH\t\48484\1045014\EOTH", - richFieldValue = "^_\\\\*\153688\177860\ESC\a\1031904\1040165AW\ACK'" - }, - RichField - { richFieldType = "RxS\CAN}\ENQi5\40088*Z\1038420\1026632", - richFieldValue = "{%\ETXIEz\DEL\EM$O\DEL9\21968 \1034484RLt\131300\t\162365C\ETB\1021346[" - } - ] - } + mkRichInfoMapAndList + [ RichField + { richFieldType = + "\1051215e4\RS\23439h^x^\EM\61905v\ETX+XJ\134982[X\1092473\EOT\1077911'\DLEK\1093610\155900", + richFieldValue = "T5\11971\ETB\1047874](}{\ETX\1043337'\1081171Mq5\1020468\SUB\ENQ`s\46654\DC2Zw" + }, + RichField + { richFieldType = "^:;\CAN\FSy4", + richFieldValue = "\1059457(0\DC2\ETX3\34133U\178634\&2\1068820\3182F+=pd\rp\1109245\28693o" + }, + RichField {richFieldType = "", richFieldValue = "6cP\DEL\6080R"}, + RichField {richFieldType = "?\1047538~d\DC3;U\1106640P\995958zJ*{*T", richFieldValue = ")|\DC3\fK"}, + RichField + { richFieldType = "\1015119<^\1999\ESC\184113lIdb\1072838\DC1^t\DC2\174936\1100963\182884Pb", + richFieldValue = "\ETXd-\188647\RS\180191 z);],nC\1022457\1068377\180238D\999368\SYN\r2\FSD" + }, + RichField + { richFieldType = "\CAN\60004\a\DC3H[s\ACK93", + richFieldValue = "\1041236\32361H\NAK\1096623\129058K\1075562\DC3(\SYN\181142{X\FS\189569wV\1034882" + }, + RichField + { richFieldType = "$\36819T\1105580nf\SOHT\133740{z\1026264Goz\RS_@[V\EM\1031481\&8C6D", + richFieldValue = + "F\DC3\73440=k\DC4\990834\GS\1060856i\163960\&1\1062637J\98269m'P\1027260plO\188080\1055753" + }, + RichField + { richFieldType = "\DC4v-\STX\EOT?\EOTQ[0\146988mnFN\t/>\ETX\1113899V\1000937B\ACKF\175446", + richFieldValue = "o\ETB?}7H\146313Z\168011\&7\984607%4\173083\3879\167358" + }, + RichField + { richFieldType = "\FS@$'\7020LR\1058824w~o\1007673'\b", + richFieldValue = "Ms\1025378\1034881B\1022931M" + }, + RichField {richFieldType = "m9d5:O.4\1101624\DC3m", richFieldValue = "V\r"}, + RichField + { richFieldType = "4fJ%*\US}Y\1046694\ACKV\1012548\DC3O\1062399\ESC2:{H*c\1005890\189579z\t\1021171W", + richFieldValue = "G\171123\1090504" + }, + RichField + { richFieldType = "2\1023994\b\"f}+ \ENQv\r\1030394\ETX]F@\1069254\&0R\16066", + richFieldValue = ",\ACKR\1053242!g\186623" + }, + RichField + { richFieldType = + "C\1086563}\"j2\138736\vWi\1050956\61878\2267\1033370\SIDn\121030\1081299\1112031\20632\&9\a\a\153143A\SYN\57533", + richFieldValue = "&,61\SOHC\986476uj>_" + }, + RichField + { richFieldType = "\150181", + richFieldValue = "\DC2I\27369\DC1&T\159506x\1044600i\ENQ\19979\159274\8229\32065ZoH~P{4" + }, + RichField + { richFieldType = "K\v`=7NH\t\48484\1045014\EOTH", + richFieldValue = "^_\\\\*\153688\177860\ESC\a\1031904\1040165AW\ACK'" + }, + RichField + { richFieldType = "RxS\CAN}\ENQi5\40088*Z\1038420\1026632", + richFieldValue = "{%\ETXIEz\DEL\EM$O\DEL9\21968 \1034484RLt\131300\t\162365C\ETB\1021346[" + } + ] testObject_RichInfoMapAndList_user_10 :: RichInfoMapAndList testObject_RichInfoMapAndList_user_10 = - RichInfoMapAndList - { richInfoMap = - fromList - [ ("\rw\52584f\DLE\98073\1089144\1041363{4\137629*\146352\121258H\US\995063%\EOTH\991375", "\DC1\1020499\STX"), - ("\ETBD\1073349\SUB!\131245\1056613\1012908z", "\"e\26354q\t\1043638C\179332\50826qd$H\ACKn\SUB&s%5"), - ( "\CAN\1095837+\988206\&5\17296h\n\1031439@\10137\SOHX\GSH\46038E", - "0\NUL,@\121173\69854\SID}\f!MLXPZ5H\1090104Aa-\190975L\153407" - ), - ("&\1003117G$Dh\1110276;b\STX-~\158859W\174383\1100999\137868I\DLEi4\1055984", "A \159575<"), - ( "`;\SI]\31840\1024538!67:O_\STX", - "\vl\24815\r\ESC\989873\&6](\1067224Ps\ENQ\GSy\148469\SO\1089601\a\1076f\DLE\24031w\\" - ), - ( "Kt\17489\SOHoT\993262x2)^" - ), - ( "M)\167132piIg\49115<\1058710!\1022340\DLE\1060344kV_m5\8227\&6", - "e8{S\ETX/\92379\985844\SUB'\DELQ_\186813>\1077258K\DLE\66822r\171348\1062036" - ), - ("Rs\5156s\49023A1\184182}\RS\16047rNA$\1025919\SI", "0\EOTd98X\EOT7"), - ("\DEL#N?\1087521\19433\ETX\ETXZ\1045059WPs\GS(A", "|L2\DC4Iuf,?\a\DC4\51799S'\STX\1024742b\3779"), - ("\131510Vb\DEL\179551y>\EOT\1100761\STX\1098928nQY\1093746\998555,XY\1067157\1006253", "") - ], - richInfoAssocList = - [ RichField - { richFieldType = "\162562\98041\GS7\CAN'\v]U\EOT{rs0'", - richFieldValue = "'/\136814\1032804LL\USv\121440_W\73866\12178e" - }, - RichField - { richFieldType = "\99860\n\GSr\ESC,>{\1103403l#9*\au\EM\1075299\NAK", - richFieldValue = "H\1105517\DLE;\1044506`|;G\CAN2LD\128169l*" - }, - RichField - { richFieldType = ">\ESC\1036493\1079877\1091428\1055465l\ETB", - richFieldValue = "J\EM\v\1051091\CAN?\v\SYNH5Rcb\149915" - }, - RichField - { richFieldType = "K\1081792\1068788w/\191158d \EMs\37229\SOHw\1014069\1063075\&5Z\35772m\1058616LQ}:r\GS", - richFieldValue = "\1053421`oi" - }, - RichField - { richFieldType = "\bN/\1006005:3\1087462%[\1061611B\516{\no\68053\EM`%D(\"\EM\168355\1063458\1065708", - richFieldValue = "\50897"), - ("O\ETB'Vj':\ESC'\SO\NAK\6382\SO\CAN\nQ\1107745\STX\EM\51052;Jx", "}\EOT!\RS\ETBMyk\1074940\146115`"), - ("si\158818\\Z96?\aF}\b\83444\r=C\37107\44897\vx_", "a\GS\181693"), - ( "VR:v;ZqL\183938l\USn\992515\1061218\161309\66717M\132632", - "\GShu\23833l\1108324\131688?1\42858>\DC2D\1038180\1091974" - ), - ("}\DC4\1053586I\SOY\1031277", "ld\DEL\SIx&\1008012\42453\986710Mg(\1066044\aa"), - ("\26634{\49212\v" - ), - ("\136652 \1024340fN?`\1111185M8+\DC2Ai@\ACKh\f", "0\DC4v\5573\fU\990977WV\991145c\97698=\SO\EM%\149365"), - ("\1070976_\CAN\9468\"9\SUB\34276@\DC3|.\ETX02!{8*7\EM\158828q~t\151776", "@^Zb\1027800^K\55182\DELT0T~@x") - ], - richInfoAssocList = - [ RichField - { richFieldType = "\ETB\1028921\CAN", - richFieldValue = "\1102929\44209\1112970\175634Ih\63283Wi\1012582\DLE\190837Y\ENQ/\a2w\989014" - }, - RichField - { richFieldType = - "\176000\1100835H\SYN2V\1039249&\92476*\t_M%\191397\CAN;\1074124S\SYN4\STX^\USk\1088603,!98", - richFieldValue = - "\NUL`r\DLEY\1102587\1034451\&4\166294@\1084921\&1zCYPqi\1006156\SI\58745p\995662\1043262\SOH\1112751~" - }, - RichField - { richFieldType = "iJ>\1028036f\175431\SUB\45400\ETB\EMG\993617\1056285\"\ENQ", - richFieldValue = "H\1017260g8\DC3\f8p\67122\150163\1007636rj\170640LA\CANq\996681EG\1091126\USgF\1086605\1073305\95139<\1101082\DC4\14223\31755do:\nZ@*@K\1008021\1047329a/\b\190930" - }, - RichField - { richFieldType = "zu\14791X\EM\1026999m\166071\"o\\G\165311aJ\SUB", - richFieldValue = "gR\ACK[Il*\141972,\DC37sb\ETB\1045231\58013zSo6\t\13600\83082z$\GS\DC4\42606%\ENQ" - }, - RichField - { richFieldType = "\EM\SYN", - richFieldValue = "\1021376Yq<&8\SYNb\120405\USOi\SOH1/8\1017260\10473\SUB\DC1:\NUL3" - }, - RichField - { richFieldType = - "\147712-K4[6^/\181634tLt\SYN\129186\1019826\175957\20283\1041885'\38284\&3\1085802\1035352", - richFieldValue = - "\b\140598&\1058279ww\DEL\26686m\16482r\13860]\1038937M\CAN\1028432\SOH\a3Z=\1106760\191074B!\SUB\1093109f\54706" - }, - RichField - { richFieldType = "\ACK\144056,R\b\STX(", - richFieldValue = "&42\40054\aSXk\42616$GT\1046779\&6\1034064\1067204\rY=\1985\GS\174373" - }, - RichField - { richFieldType = "E&(#ZwW\SOH\1057331\&80\r&.N]H\1110033/$\"\US\61428\40791\&9\n\FSAd", - richFieldValue = "2. n\DC4bHjg\83293b" - }, - RichField - { richFieldType = "sbSx1\1062630>92|\1070703\v|\DEL)\EOT\DLEM\b2k_", - richFieldValue = "T\1074925R6\1059631K\STX`\EOT8KCK\172584\1067031" - }, - RichField - { richFieldType = "\EMXr_svft\\i\98504\1005552\62119\189306\135519|l@c#q\52137p\\", - richFieldValue = "W#q\7135\1106012\20928" - }, - RichField - { richFieldType = "\ENQsI~jB\1071425z\989923\STX\SO\1039847\ETBq4M4\1114035\a]8\EOTZ\1099283j", - richFieldValue = "#\49940\\:zs\SOH5K\1044726C\SOH=\"\146107\1045637\SI\1069084\23493" - }, - RichField - { richFieldType = - "=\27551Y\134547\DC42(=;\DC1V\35005 \150797\1019078\181134Zp\r\1013314\1056249\&4F\1068630\DC4", - richFieldValue = "\194849\6614" - }, - RichField - { richFieldType = "?f|\156180psj\1005905]y>\1111801\1037872-\6502", - richFieldValue = "|Wa_K\1091452\172742" - }, - RichField - { richFieldType = "\b\1108066\&7b\66357Z(m7\RS\30522p]E^-m\EOT.\USq);\149286y\137949(\US", - richFieldValue = "\DLE\SYN+he\FSx\998260\"\GS\DC2P5<\RS\21259\18135+" - }, - RichField - { richFieldType = "|\tKli\\\98809\143023\37329d\n!\153054HO\1096707\&5\GSu\DC4+\1089025I\GS|\ENQ\US", - richFieldValue = "JU\1000244O\ETB\CAN\185069\133322^G]5\996307" - }, - RichField {richFieldType = "x_H3J\1074422\EMg\1100163", richFieldValue = "\18360Q>(>F,\ACK5"} - ] - } + mkRichInfoMapAndList + [ RichField + { richFieldType = "\ETB\1028921\CAN", + richFieldValue = "\1102929\44209\1112970\175634Ih\63283Wi\1012582\DLE\190837Y\ENQ/\a2w\989014" + }, + RichField + { richFieldType = + "\176000\1100835H\SYN2V\1039249&\92476*\t_M%\191397\CAN;\1074124S\SYN4\STX^\USk\1088603,!98", + richFieldValue = + "\NUL`r\DLEY\1102587\1034451\&4\166294@\1084921\&1zCYPqi\1006156\SI\58745p\995662\1043262\SOH\1112751~" + }, + RichField + { richFieldType = "iJ>\1028036f\175431\SUB\45400\ETB\EMG\993617\1056285\"\ENQ", + richFieldValue = "H\1017260g8\DC3\f8p\67122\150163\1007636rj\170640LA\CANq\996681EG\1091126\USgF\1086605\1073305\95139<\1101082\DC4\14223\31755do:\nZ@*@K\1008021\1047329a/\b\190930" + }, + RichField + { richFieldType = "zu\14791X\EM\1026999m\166071\"o\\G\165311aJ\SUB", + richFieldValue = "gR\ACK[Il*\141972,\DC37sb\ETB\1045231\58013zSo6\t\13600\83082z$\GS\DC4\42606%\ENQ" + }, + RichField + { richFieldType = "\EM\SYN", + richFieldValue = "\1021376Yq<&8\SYNb\120405\USOi\SOH1/8\1017260\10473\SUB\DC1:\NUL3" + }, + RichField + { richFieldType = + "\147712-K4[6^/\181634tLt\SYN\129186\1019826\175957\20283\1041885'\38284\&3\1085802\1035352", + richFieldValue = + "\b\140598&\1058279ww\DEL\26686m\16482r\13860]\1038937M\CAN\1028432\SOH\a3Z=\1106760\191074B!\SUB\1093109f\54706" + }, + RichField + { richFieldType = "\ACK\144056,R\b\STX(", + richFieldValue = "&42\40054\aSXk\42616$GT\1046779\&6\1034064\1067204\rY=\1985\GS\174373" + }, + RichField + { richFieldType = "E&(#ZwW\SOH\1057331\&80\r&.N]H\1110033/$\"\US\61428\40791\&9\n\FSAd", + richFieldValue = "2. n\DC4bHjg\83293b" + }, + RichField + { richFieldType = "sbSx1\1062630>92|\1070703\v|\DEL)\EOT\DLEM\b2k_", + richFieldValue = "T\1074925R6\1059631K\STX`\EOT8KCK\172584\1067031" + }, + RichField + { richFieldType = "\EMXr_svft\\i\98504\1005552\62119\189306\135519|l@c#q\52137p\\", + richFieldValue = "W#q\7135\1106012\20928" + }, + RichField + { richFieldType = "\ENQsI~jB\1071425z\989923\STX\SO\1039847\ETBq4M4\1114035\a]8\EOTZ\1099283j", + richFieldValue = "#\49940\\:zs\SOH5K\1044726C\SOH=\"\146107\1045637\SI\1069084\23493" + }, + RichField + { richFieldType = + "=\27551Y\134547\DC42(=;\DC1V\35005 \150797\1019078\181134Zp\r\1013314\1056249\&4F\1068630\DC4", + richFieldValue = "\194849\6614" + }, + RichField + { richFieldType = "?f|\156180psj\1005905]y>\1111801\1037872-\6502", + richFieldValue = "|Wa_K\1091452\172742" + }, + RichField + { richFieldType = "\b\1108066\&7b\66357Z(m7\RS\30522p]E^-m\EOT.\USq);\149286y\137949(\US", + richFieldValue = "\DLE\SYN+he\FSx\998260\"\GS\DC2P5<\RS\21259\18135+" + }, + RichField + { richFieldType = "|\tKli\\\98809\143023\37329d\n!\153054HO\1096707\&5\GSu\DC4+\1089025I\GS|\ENQ\US", + richFieldValue = "JU\1000244O\ETB\CAN\185069\133322^G]5\996307" + }, + RichField {richFieldType = "x_H3J\1074422\EMg\1100163", richFieldValue = "\18360Q>(>F,\ACK5"} + ] testObject_RichInfoMapAndList_user_12 :: RichInfoMapAndList testObject_RichInfoMapAndList_user_12 = - RichInfoMapAndList - { richInfoMap = - fromList - [ ("", "\1083885;)XGD\EOT/Qr$Yg\SOHA+d_\SI+\SUBI,%{\ETX<'\15371;"), - ("\r\SOHU\ENQ\EOT\1044851\ETB\US~\SYNC\147655!8\v\25144\989691\FSN@\38109S8{:\64824e", "U;rKHG+9"), - ( "\EM\a`<*?\GS#\1091963/5\DC3\52627V\NUL\nBi\US\US\54687\v\179155HP\5825\1039168\64310\SOH0", - "f7]\DC2\NAKV\SO\&HT\43387$P" - ), - ("\RS\154364DC\FSD\153881I)6ik", "\4974PA\47701r\ETX\1083541\&2U\t q\170204(|\4549fS\DC3A"), - ("7V\ETBZ)\996365", "_H\NAKc\41046G2W9\48972+*"), - ( "9*\1003630}~\EM\1098880,^+Nrw'\EOTe\FS`\77834", - "\1003373\DEL\183653J\189391\1111867\1005029\139975_\163529pGuO7<\992034I\FS" - ), - ( "I\f\US\t\120640k]\1069451Ml*\1083757\988925\a,lt}", - "^[\1015878\NUL[g~U\by\SUBX\GSW\a\1061261\\_\ETBpK\118973" - ), - ("qv'Ip\b \138554}\149834mU\184356", "O\1011066D1\170767h\DLE\SOH\16293\28331\b=!\ENQ\SOH\178629!F\42679"), - ("vy\ETX\NAK\"\191310%g\180332\1103310\1108066i7", "H*o\15751y3!r'w\13669%Y0\vUO\48125g"), - ( "\28107/\v/\SO]\183248,\"\165116\DEL\1087134.y\32199g\t\167779I\EOT_9\1082603\v\1044571/", - "\13049\15893\8595>d6\1077580;\DC3n\ETX" - ), - ( "\169732 \998174nCx-t\RS;", - "T\988657F\DLE\1009453'7r\65241!HF\13064\991049\ESC\tt\136962\166561$\GS\1055415\SYN\1005820\ESC,\1006985\1032653" - ), - ("\998574)r\DLEr", "\ETX4M\US>\NUL`y4\DC2\EOT/MJ5\189674T\GS"), - ( "\1033775\180149x1(~W\DC4\23052\ESC]m\GS\DC3\NAKA\ENQRm\SO\ENQ\SIC\f\174718:]\DLE\SO", - "\1086701\993831(.Vi]\1078519VQ\1040785fi\SUBh@.\RS\ETX7ij\"U\183007L\983338" - ), - ("\1038329", "N\SOHD+\43990Y\1112880QY\62836\&1M7\142119\ETX\147825W\144580p|\170597"), - ("\EOTs\52539\1077694 \"u>\EOT\994271\&2a\ACK+\1004972c\ESC", "\1084717\SUB"), - ( ")j\78068\&9$\SOHXxjZ\162124\&70\991754\EOT*@..\999293", - "\t\f\1100922j\EOT\GS\1047725re\FS\t o\ESCEx\SUB\1051517\ENQ\EOTT\38752@\b_L<\EOT", "B(H\ESCTU\EM\ESC"), - ("\\O^f#", "m\GS\1055674PBv~Pc\ENQ\SIvg\164765\984585UP\1009054[" - ), - ( "e\1025340D\f7\SUB\DC1x=W)0R?xAw[K\DC1\DC17j", - "\NAKum\t\141085pI|7\a[\22735\EOTF's\1089186\&2\1017228\t\1018515Eu\64063\1086975" - ), - ("JV|\1107491FR(k\1019650Kr\1043818\52718\1051850#/\45280#6W/\CANpk}\EOT@\1068656n~", "SH5Ou_\r\ACK82j"), - ("k&", "7U\7602\n8CI2fjtH"), - ("O\"l\\\31242a0 .15\ETX", "v"), - ("P\58446\EM)\n/\NUL1O", "m\ENQ\EMP\b^\GSN\1039476us(\v}\1027386\DC1zd\1072241|\DC49\10104va[@\EMO"), - ("~AE\ESC\74334\DC2U\SOH4\SI\180994\1048429", "\f\NAK\1098683\DEL\99154I\47358\127363\b\987227Ly)[W$\ACK\1014220\STX`\SYN\990507I*" - ) - ], - richInfoAssocList = - [ RichField - { richFieldType = "\144214\990892:\t3R@\110991/5Vw\ESC0\1041520\SUB\DEL7\1068267]", - richFieldValue = "\15315@o\1096740\DC3\36714\35767\135717g\1028134k\39645\73677\a\ACK" - }, - RichField - { richFieldType = "hR\176524\12076\144026\31596\DC2z\169100\bK\30206\42248\99703gM\ACK\1090014|V\bx", - richFieldValue = "\1039687\1032408\CAN\999226\CAN\1089837G^\ACKx|K\ESC-\f\ff\182989\74813[" - }, - RichField {richFieldType = "\b\DC2", richFieldValue = "D\")`\1100740\FSw^\123148"}, - RichField - { richFieldType = "\ETX\SYN`\166434;\CANJ\"s>s\nN-&\1043736>ZMK\SYN\5254b\61001\21825", - richFieldValue = - "i\RS\1086619\100983_\ESCb\181127\&2C\52608KKqLhT\1094458,\v\6592\ETBW\33260\1014248\1113697" - }, - RichField - { richFieldType = "FL\120196\1083118\EM\17816\1084691\rk\EOT\DC2MF\17587\&1\rYZ\t\1026268\SOH", - richFieldValue = "cw8|\t)" - }, - RichField - { richFieldType = "\1023291\US\ESC\b\1015980\DC1", - richFieldValue = "/o\DC1\169272!B\1036120\1086667\NULt~=" - }, - RichField - { richFieldType = "-i", - richFieldValue = "9_7\1023908!\166072\b'\1025226\SYNN(N\a]\190228\&9A\97383s\DELm[0" - }, - RichField - { richFieldType = "4g\1017341\163912>\akK\34590\SI\SUB[W??!b", - richFieldValue = "\134756\US\DC3aD\\\1078083\1098680>.U\v\DC2IV\DLEh%\ETB\1005105?7\1091140\"\n" - }, - RichField - { richFieldType = "\68222#\100903\1040659\132882\1091894\&1\1077651\&5p\1010876\1030836\28275", - richFieldValue = "\RSP\180743\53861v\ETByfj\11804z~6&\SUBs;Pz0" - }, - RichField {richFieldType = "", richFieldValue = "TBA6)r<"}, - RichField {richFieldType = ",B\153638(s\9287eh\1061894", richFieldValue = "\"\DC1P@n."}, - RichField - { richFieldType = "l5\38719\FS8\1038694\63311", - richFieldValue = "\5410\DC2&{\ETB\49907o`\25430\EMK\SI6j5L+\1100295BtM<" - }, - RichField - { richFieldType = "/\ENQ\b`y\r0C\SI~f>j\DC48q g=vwx\SO\GS \2837\155289", - richFieldValue = "\157997VXV`\\'jT\1039191o@h]\ETX\SOH\"\NAK\SOm" - }, - RichField - { richFieldType = "\NULf\121161`vc", - richFieldValue = - "\1032756\158917\1044293v!\vS.g\ACKV\\*k\8879p\989859|\DLEr@$\GS\CAN>\1070214(\1028886F\611" - }, - RichField - { richFieldType = "_<\1071884OO", - richFieldValue = "\1046328CE\ESC\DLE\NUL7\1035361\ACK\ESCM\NAK:~\47545\154480/" - }, - RichField - { richFieldType = - "\160591\1052097\ENQ%\FS\1105685\988838uZ.\68041\t\EMf\990882uoe!\74827\&1\DELli\159673#8\1028659_", - richFieldValue = "Hs\1003980cZ]\94294\1066192*\1047989\SYNk\153579\&4\181276\DC1\ETBxL`jh$\62298\FSR~" - }, - RichField - { richFieldType = "\1039447*k\999532\96108", - richFieldValue = "\1073251\&9p\STXp\toB\45207F'\145543#lG6e\147192P" - }, - RichField - { richFieldType = "0\NUL\1085225\v", - richFieldValue = "x\ENQ\ENQ\94808\STXF\1094085/tuVf&1\30683\GS\182054O\163705\1102758" - }, - RichField - { richFieldType = ";\1084450i\1020423\&3\28119\10711\1105270\&5MG:G", - richFieldValue = "\41834\989824\119216\1087060\DC2d\140650\&8A\32082f\1000962[^4-<\137587" - } - ] - } + mkRichInfoMapAndList + [ RichField + { richFieldType = "\144214\990892:\t3R@\110991/5Vw\ESC0\1041520\SUB\DEL7\1068267]", + richFieldValue = "\15315@o\1096740\DC3\36714\35767\135717g\1028134k\39645\73677\a\ACK" + }, + RichField + { richFieldType = "hR\176524\12076\144026\31596\DC2z\169100\bK\30206\42248\99703gM\ACK\1090014|V\bx", + richFieldValue = "\1039687\1032408\CAN\999226\CAN\1089837G^\ACKx|K\ESC-\f\ff\182989\74813[" + }, + RichField {richFieldType = "\b\DC2", richFieldValue = "D\")`\1100740\FSw^\123148"}, + RichField + { richFieldType = "\ETX\SYN`\166434;\CANJ\"s>s\nN-&\1043736>ZMK\SYN\5254b\61001\21825", + richFieldValue = + "i\RS\1086619\100983_\ESCb\181127\&2C\52608KKqLhT\1094458,\v\6592\ETBW\33260\1014248\1113697" + }, + RichField + { richFieldType = "FL\120196\1083118\EM\17816\1084691\rk\EOT\DC2MF\17587\&1\rYZ\t\1026268\SOH", + richFieldValue = "cw8|\t)" + }, + RichField + { richFieldType = "\1023291\US\ESC\b\1015980\DC1", + richFieldValue = "/o\DC1\169272!B\1036120\1086667\NULt~=" + }, + RichField + { richFieldType = "-i", + richFieldValue = "9_7\1023908!\166072\b'\1025226\SYNN(N\a]\190228\&9A\97383s\DELm[0" + }, + RichField + { richFieldType = "4g\1017341\163912>\akK\34590\SI\SUB[W??!b", + richFieldValue = "\134756\US\DC3aD\\\1078083\1098680>.U\v\DC2IV\DLEh%\ETB\1005105?7\1091140\"\n" + }, + RichField + { richFieldType = "\68222#\100903\1040659\132882\1091894\&1\1077651\&5p\1010876\1030836\28275", + richFieldValue = "\RSP\180743\53861v\ETByfj\11804z~6&\SUBs;Pz0" + }, + RichField {richFieldType = "", richFieldValue = "TBA6)r<"}, + RichField {richFieldType = ",B\153638(s\9287eh\1061894", richFieldValue = "\"\DC1P@n."}, + RichField + { richFieldType = "l5\38719\FS8\1038694\63311", + richFieldValue = "\5410\DC2&{\ETB\49907o`\25430\EMK\SI6j5L+\1100295BtM<" + }, + RichField + { richFieldType = "/\ENQ\b`y\r0C\SI~f>j\DC48q g=vwx\SO\GS \2837\155289", + richFieldValue = "\157997VXV`\\'jT\1039191o@h]\ETX\SOH\"\NAK\SOm" + }, + RichField + { richFieldType = "\NULf\121161`vc", + richFieldValue = + "\1032756\158917\1044293v!\vS.g\ACKV\\*k\8879p\989859|\DLEr@$\GS\CAN>\1070214(\1028886F\611" + }, + RichField + { richFieldType = "_<\1071884OO", + richFieldValue = "\1046328CE\ESC\DLE\NUL7\1035361\ACK\ESCM\NAK:~\47545\154480/" + }, + RichField + { richFieldType = + "\160591\1052097\ENQ%\FS\1105685\988838uZ.\68041\t\EMf\990882uoe!\74827\&1\DELli\159673#8\1028659_", + richFieldValue = "Hs\1003980cZ]\94294\1066192*\1047989\SYNk\153579\&4\181276\DC1\ETBxL`jh$\62298\FSR~" + }, + RichField + { richFieldType = "\1039447*k\999532\96108", + richFieldValue = "\1073251\&9p\STXp\toB\45207F'\145543#lG6e\147192P" + }, + RichField + { richFieldType = "0\NUL\1085225\v", + richFieldValue = "x\ENQ\ENQ\94808\STXF\1094085/tuVf&1\30683\GS\182054O\163705\1102758" + }, + RichField + { richFieldType = ";\1084450i\1020423\&3\28119\10711\1105270\&5MG:G", + richFieldValue = "\41834\989824\119216\1087060\DC2d\140650\&8A\32082f\1000962[^4-<\137587" + } + ] testObject_RichInfoMapAndList_user_14 :: RichInfoMapAndList testObject_RichInfoMapAndList_user_14 = - RichInfoMapAndList - { richInfoMap = - fromList - [ ("\NUL\1082393\125007", "& [\r\bC\GS\SUB]F\vp\SUB>d"), - ("\ENQ<\b^\fO", "X\988837\DLE#\NULs$\1109898\99145\SI"), - ( "\ACK\USF;a\1082803\CANx\SYNQ\1090014G/EF\t", - "[\188400v\US\1031852\&5&\10847\1106936}\1052044&;IGz\991468\&8\1102456#\1030654" - ), - ("\t\1048784i\SO\RS@R\SI>[\n#\144703\19029qQ&\18741T.", "O\bT\28125}Z3\\Cvd"), - ("\ft^\8269_\21073\100236d\139398\1077518%", "\1088549\nLGSY7\1049971;N\v\146751\EM"), - ("\DC2j\132323i\SYN\SUBUAalz2\167120\DC2hK\7131", "\67608+\1045280G\150216\61784IaHb0$\DC3Y0)uJO-l\1104528"), - ( "\ESC\1101448\&6\171913e\183690\195004I}\22976\RS\FS\983472F\GS", - "\SYNo\37455\74015xMem2r\62398?t\DC1l\137407^\1091374VjG\EOT\94440[;\47281\EM_\83171" - ), - ( "-+\aNS\STXdY\EM\ACK\EOT\1063327er#<<\24188i\1018098r\ENQ\1113752grq\166403\ACK", - "UE\1093061\52110\DC3\1068965\1095906\&9\1099743T\1060117\GS\1035947\12484\7047z\95939`*\62770\1106332HO$o\1005006!\998704\a" - ), - ( "0\100094U5\DC2\FSZMM=\17099", - "\1022381_\1108029yw\1054070Z\1004585q%\DC1]\DC1\1005926\ETX\DC1\172839{\63240hsb\1016547n\1011894\SI\GS\1035251\SO" - ), - ( ":DO\1017993\SOH\STX,u\1020244\993921W\SOHH\SYN\NULag\1100256\1093001", - "zFb]K\1005183\NULzLQ?\DC3W,&i\178150`\158756U\147609WMLZ\40372|" - ), - ( "D7\164081\ETB\63247\GSV\GSg\ESC\1074695_(4zO\136481#h\144679\&8l\1008616\ETB3\1014949P\1073879\DLEr", - "]\1008036\3366T\GSXq*@\DEL\97187hx\27918*\SYN\152513\\\SYN^\24746^\USTBTv" - ), - ( "f\SOH@\ACK\FS9\\WXL*S\\{\f0\b\EOT", - "G`\1011098\r?\190371MJ\1082645\1031612f\b\ESCM!jqqn\178384\ACK9\162041<\SYN]t\ENQ" - ), - ("v", "\SUBc\40121jl\r\EOT\ETXF\1104671~JS(Y\EOT\1061324\991171\&3l\EM4\US\SO\DC1n\63759"), - ("x_\FS", "!S\CAN6\8862o&\72298\1081201"), - ("z'~9\72329:2\1032892\10316>", "\181659F\179970\ETX\1020426\1026286we\SI\42102\&2#"), - ("\3996\1015755Jd\188871\"\38364X\f\a\48655\vg\CAN\\", "\CANG\SOH\STX\v\39075M\72123\US\36582:A(C"), - ( "\1009408b=eD\1033353\ACK\GS\EMmK\ETX\1070152\r\ACK\1109001\DEL-", - "\ETBEz\10437IEd\59407.a\1072547bS 6f#\DLE\34513'\SYN\34614" - ), - ("\1014107y(\t", "\RS\aw\1094711:") - ], - richInfoAssocList = - [ RichField - { richFieldType = "K\52903H\FS\DLEtG\DEL{z\SIw1\SYNI\1056437\RS\1031465=&\22919j<\DC307_r", - richFieldValue = "Sw\986997\1026171\986718(" - }, - RichField - { richFieldType = ": )L!G\1047454xZ\175423\&9\988080\32956PO1RK\1047208^", - richFieldValue = "vpm)P\149135\US\1051891-\1056191<\21894\b\SYNn" - }, - RichField - { richFieldType = "\FSq\998229r\179676{\177296\162536\1028488K\1024411*g[\38366\CAN", - richFieldValue = "\DC3B" - }, - RichField - { richFieldType = "H\987148\r5\988059\1080917\54459\1017608\&7\147785\1050619", - richFieldValue = "Q\42909\&0\\l\NUL\ACK\r\165524\54595\ETX" - }, - RichField - { richFieldType = ".Z\DC3zn}\DC4", - richFieldValue = "\996576\1052202wQ]i\ETBS\USkh$\RS\CAN\ETX8\DC3\998922R[\NULE\1106599>+0Zg" - }, - RichField - { richFieldType = "\EMq%*Bq\181414q*\1002073e\DC2\DLE\SOkBv\60269\SYN", - richFieldValue = "\169996\53249\DC3eYmQ8HmG\1086764\174684N\v\187675" - } - ] - } + mkRichInfoMapAndList + [ RichField + { richFieldType = "K\52903H\FS\DLEtG\DEL{z\SIw1\SYNI\1056437\RS\1031465=&\22919j<\DC307_r", + richFieldValue = "Sw\986997\1026171\986718(" + }, + RichField + { richFieldType = ": )L!G\1047454xZ\175423\&9\988080\32956PO1RK\1047208^", + richFieldValue = "vpm)P\149135\US\1051891-\1056191<\21894\b\SYNn" + }, + RichField + { richFieldType = "\FSq\998229r\179676{\177296\162536\1028488K\1024411*g[\38366\CAN", + richFieldValue = "\DC3B" + }, + RichField + { richFieldType = "H\987148\r5\988059\1080917\54459\1017608\&7\147785\1050619", + richFieldValue = "Q\42909\&0\\l\NUL\ACK\r\165524\54595\ETX" + }, + RichField + { richFieldType = ".Z\DC3zn}\DC4", + richFieldValue = "\996576\1052202wQ]i\ETBS\USkh$\RS\CAN\ETX8\DC3\998922R[\NULE\1106599>+0Zg" + }, + RichField + { richFieldType = "\EMq%*Bq\181414q*\1002073e\DC2\DLE\SOkBv\60269\SYN", + richFieldValue = "\169996\53249\DC3eYmQ8HmG\1086764\174684N\v\187675" + } + ] testObject_RichInfoMapAndList_user_15 :: RichInfoMapAndList testObject_RichInfoMapAndList_user_15 = - RichInfoMapAndList - { richInfoMap = - fromList - [ ("", "\DC4"), - ("\NUL\1057819WB\EOT\DLEMC\141364e\990542,z\SI\1036133-h\1103943IF\ETX\CANW\v\988478F", "l\34637cS`"), - ( "\SOH<", - "\NAK4\1064992k\DC18I\RS\1030304\1086350'D\21077u\1079886RZ\1027148$\ENQ+\SUBL\1006588\&9Z\1006378\118986.\1037041\a\RS", - richFieldValue = "[" - }, - RichField {richFieldType = "\28961\SO$\a3\143275\&5\ETB\EM\ENQ", richFieldValue = "8q\67174L\181850\CAN"}, - RichField - { richFieldType = "\3458\59549\131936\43944\1104609t%y-V\SUB\CAN\988529}5\69853\1039669\&0U+ \54119", - richFieldValue = "\ETB\ACK\1112015I\1048758\&5\ns\158753_\ETB\139786i\SYN\40743" - }, - RichField {richFieldType = "\1105836bY\1050983A\NAK", richFieldValue = "^zj,\r\NUL}\1012251\ESC$c #L"}, - RichField {richFieldType = "bhAL[v/CW\r.^KU\ACK.HnO\98377\ETBnDg\fqZ\n", richFieldValue = "|9!"}, - RichField - { richFieldType = "\141470\"\FS6y}\983601A0b\190660[", - richFieldValue = "\t9\134490\93823/o\121429j\7003Z\8214D~F" - }, - RichField - { richFieldType = "\183401\1081375@\118913\1107441\38458\b\n\SO\ESC\t,/\1087911\179850C", - richFieldValue = "4\vBv\38077\1078263\ESCZ\rj" - }, - RichField - { richFieldType = "x\985536RA\RSNXCq\1102293\1024657\RS\v\174745}nf$C\2790=R\1094438\FSl\DC2\SYN'\"\NAK", - richFieldValue = "\8630y\SOH" - }, - RichField {richFieldType = "\ACK\t\630", richFieldValue = "Wcc_\1054323"}, - RichField - { richFieldType = "\184881\f\54680U\1087560q\ENQ<\58381\165094", - richFieldValue = "`VP\995756)\1062055\t;" - }, - RichField - { richFieldType = "\163932\RS\52818&:Xel\NUL\1069902B0\1064177iU\GS y\NUL1b)\26274z", - richFieldValue = "I\1025262\US\1020586\&7\ETB\\\189419\US\1048857Y8E\GSI\68803\GS\tl\1031973\SUB" - }, - RichField - { richFieldType = "? *\STX\GS\1112062\DLET\STXNT/Nl.0\f\144462Z\SO\ACKu\1001651?\ETX\1097797z\54846\175717", - richFieldValue = "\NAKDV>xR\881\NULH2\DEL\1065983\EM&\EM\ETBl-$\DC33aD2-" - }, - RichField - { richFieldType = "5\153763\DC3[k\1045029*\SOo\45761", - richFieldValue = "\34143}\NUL%H\190775\25598\ff\983191\RSaF" - }, - RichField - { richFieldType = "\29867`m\1067056i6\1000447a\1012620\35257\1108194_\159481R.R\NAK?", - richFieldValue = "\US5\1103421\CANc\SUB\bv7\172463\ACK\NAK\1076743" - }, - RichField - { richFieldType = "U\48801h\1055013\1060780S\DC4;;\SYNk\1109419\ETB\aS=7\998263\RS>\1110390 ", - richFieldValue = "\1109696\1009189V\59582\FS\SUB\66800\vl%\990479XU<\166131TB\DC2\100710`\1076175v0\t" - }, - RichField - { richFieldType = "0\"\190724\EOT", - richFieldValue = "r\\\DLE\64678\n\CAN}UJ\ETB\190237|':B1F\24493o!v4\nGU\1075621n<\129044" - }, - RichField - { richFieldType = - "\EM<-\DC4N6,\r\74283\179078\f\99483\95412G\20190{%\1003460\US\DC38\1088944B:e#\31220]w\70434", - richFieldValue = " \SOH\164748.\1063201n4\19211g\72721\fR\r~!" - }, - RichField {richFieldType = " ['\1094304\1070786", richFieldValue = "\176261&Q\38869b"}, - RichField - { richFieldType = "?e\NUL\DELq\1004968\ESC`\DC2{\157694[\f6:\SUBY\1041318,\988159&\NUL\NAK", - richFieldValue = "`u\SOH\DELf0l_\GS4R\12327!\36169\&6\49032\&3BI\32971" - }, - RichField {richFieldType = "", richFieldValue = "*8\DC1f7\166415E\SO&"}, - RichField - { richFieldType = - "\SI9ML1\165737 !\991263\RS\1028494\f{\1040644\NAK\1101048zw\ETB9I\1046115\1073127\NAK\140330", - richFieldValue = "p\ETX" - }, - RichField - { richFieldType = "`>\163380\95458\1015758\1069997\1007247fB\DC2Q\DC3Y\43538>", - richFieldValue = "jE\177777'l" - }, - RichField - { richFieldType = "\15976\171996I\996698l#\"T\1101174N:\rPK\CAN\ESC\1044372\SUBh#It(e\136510\1024672", - richFieldValue = "yL\1068780L\DLEfK\1020376\DC1I~yv|" - }, - RichField {richFieldType = "\v\FSeauk\1093956\1036139\999689w", richFieldValue = "MH "}, - RichField - { richFieldType = "\SOJ\a'D", - richFieldValue = "z\ETBPqjO\n\142187ma-w\60549VCy\1012968\DLE\DLE, #\SYN\36826_\111106" - }, - RichField - { richFieldType = "s\1090643\1038321\&5\SOH\\\182862", - richFieldValue = "\rn\181960V7$g\69944\1080659,\1035695\US\RS[\1073423\1025592.\CANY\49214\27776\SUB" - }, - RichField - { richFieldType = "q)4j\1103006?Q8a\547if!zA\EM\1071476\153677", - richFieldValue = "\aP\148706pW\131762" - }, - RichField {richFieldType = "B-8d\SO", richFieldValue = "NzDk:@T5\DC1\CANjmg2V"}, - RichField {richFieldType = "\EM\b\11025\97556w\1089038", richFieldValue = "'\RS"} - ] - } + mkRichInfoMapAndList + [ RichField + { richFieldType = + "\995749\1048848\8234\1062560%\132419Y|\29511%5&\1044202A\r4>\1006378\118986.\1037041\a\RS", + richFieldValue = "[" + }, + RichField {richFieldType = "\28961\SO$\a3\143275\&5\ETB\EM\ENQ", richFieldValue = "8q\67174L\181850\CAN"}, + RichField + { richFieldType = "\3458\59549\131936\43944\1104609t%y-V\SUB\CAN\988529}5\69853\1039669\&0U+ \54119", + richFieldValue = "\ETB\ACK\1112015I\1048758\&5\ns\158753_\ETB\139786i\SYN\40743" + }, + RichField {richFieldType = "\1105836bY\1050983A\NAK", richFieldValue = "^zj,\r\NUL}\1012251\ESC$c #L"}, + RichField {richFieldType = "bhAL[v/CW\r.^KU\ACK.HnO\98377\ETBnDg\fqZ\n", richFieldValue = "|9!"}, + RichField + { richFieldType = "\141470\"\FS6y}\983601A0b\190660[", + richFieldValue = "\t9\134490\93823/o\121429j\7003Z\8214D~F" + }, + RichField + { richFieldType = "\183401\1081375@\118913\1107441\38458\b\n\SO\ESC\t,/\1087911\179850C", + richFieldValue = "4\vBv\38077\1078263\ESCZ\rj" + }, + RichField + { richFieldType = "x\985536RA\RSNXCq\1102293\1024657\RS\v\174745}nf$C\2790=R\1094438\FSl\DC2\SYN'\"\NAK", + richFieldValue = "\8630y\SOH" + }, + RichField {richFieldType = "\ACK\t\630", richFieldValue = "Wcc_\1054323"}, + RichField + { richFieldType = "\184881\f\54680U\1087560q\ENQ<\58381\165094", + richFieldValue = "`VP\995756)\1062055\t;" + }, + RichField + { richFieldType = "\163932\RS\52818&:Xel\NUL\1069902B0\1064177iU\GS y\NUL1b)\26274z", + richFieldValue = "I\1025262\US\1020586\&7\ETB\\\189419\US\1048857Y8E\GSI\68803\GS\tl\1031973\SUB" + }, + RichField + { richFieldType = "? *\STX\GS\1112062\DLET\STXNT/Nl.0\f\144462Z\SO\ACKu\1001651?\ETX\1097797z\54846\175717", + richFieldValue = "\NAKDV>xR\881\NULH2\DEL\1065983\EM&\EM\ETBl-$\DC33aD2-" + }, + RichField + { richFieldType = "5\153763\DC3[k\1045029*\SOo\45761", + richFieldValue = "\34143}\NUL%H\190775\25598\ff\983191\RSaF" + }, + RichField + { richFieldType = "\29867`m\1067056i6\1000447a\1012620\35257\1108194_\159481R.R\NAK?", + richFieldValue = "\US5\1103421\CANc\SUB\bv7\172463\ACK\NAK\1076743" + }, + RichField + { richFieldType = "U\48801h\1055013\1060780S\DC4;;\SYNk\1109419\ETB\aS=7\998263\RS>\1110390 ", + richFieldValue = "\1109696\1009189V\59582\FS\SUB\66800\vl%\990479XU<\166131TB\DC2\100710`\1076175v0\t" + }, + RichField + { richFieldType = "0\"\190724\EOT", + richFieldValue = "r\\\DLE\64678\n\CAN}UJ\ETB\190237|':B1F\24493o!v4\nGU\1075621n<\129044" + }, + RichField + { richFieldType = + "\EM<-\DC4N6,\r\74283\179078\f\99483\95412G\20190{%\1003460\US\DC38\1088944B:e#\31220]w\70434", + richFieldValue = " \SOH\164748.\1063201n4\19211g\72721\fR\r~!" + }, + RichField {richFieldType = " ['\1094304\1070786", richFieldValue = "\176261&Q\38869b"}, + RichField + { richFieldType = "?e\NUL\DELq\1004968\ESC`\DC2{\157694[\f6:\SUBY\1041318,\988159&\NUL\NAK", + richFieldValue = "`u\SOH\DELf0l_\GS4R\12327!\36169\&6\49032\&3BI\32971" + }, + RichField {richFieldType = "", richFieldValue = "*8\DC1f7\166415E\SO&"}, + RichField + { richFieldType = + "\SI9ML1\165737 !\991263\RS\1028494\f{\1040644\NAK\1101048zw\ETB9I\1046115\1073127\NAK\140330", + richFieldValue = "p\ETX" + }, + RichField + { richFieldType = "`>\163380\95458\1015758\1069997\1007247fB\DC2Q\DC3Y\43538>", + richFieldValue = "jE\177777'l" + }, + RichField + { richFieldType = "\15976\171996I\996698l#\"T\1101174N:\rPK\CAN\ESC\1044372\SUBh#It(e\136510\1024672", + richFieldValue = "yL\1068780L\DLEfK\1020376\DC1I~yv|" + }, + RichField {richFieldType = "\v\FSeauk\1093956\1036139\999689w", richFieldValue = "MH "}, + RichField + { richFieldType = "\SOJ\a'D", + richFieldValue = "z\ETBPqjO\n\142187ma-w\60549VCy\1012968\DLE\DLE, #\SYN\36826_\111106" + }, + RichField + { richFieldType = "s\1090643\1038321\&5\SOH\\\182862", + richFieldValue = "\rn\181960V7$g\69944\1080659,\1035695\US\RS[\1073423\1025592.\CANY\49214\27776\SUB" + }, + RichField + { richFieldType = "q)4j\1103006?Q8a\547if!zA\EM\1071476\153677", + richFieldValue = "\aP\148706pW\131762" + }, + RichField {richFieldType = "B-8d\SO", richFieldValue = "NzDk:@T5\DC1\CANjmg2V"}, + RichField {richFieldType = "\EM\b\11025\97556w\1089038", richFieldValue = "'\RS"} + ] testObject_RichInfoMapAndList_user_16 :: RichInfoMapAndList testObject_RichInfoMapAndList_user_16 = - RichInfoMapAndList - { richInfoMap = - fromList - [ ("", "Edpv\1079851y^{[\171826\13409\EMf\CAN44\1030570\1026304\1031822"), - ("\ETXdC\186183\v\US\995837", "M\"f\170016q\993083D\RS>\SI\139633"), - ("\t9$]\133075\&4jn\EM\RS?\RS", "pE\n\151261a+-\DC3\1015608*,yzB\DC3\12073=\ENQ"), - ("\SOPT", "6^#i=a\SYN\EOT"), - ( "\DC2\34543\3629\11826\55270_\146199\1078774\t\ETX4EG\141370Lm\160185\1001292\1103843\39405\EOT\65759?", - "\24092!\SOW\DC1\FS\1108236!E6\NAKj\1027929t\178233Ko5pwx\CANT" - ), - ("\NAK(\1112481\1019249L^\1011131-\174853~", ":\r\r\29120\27608T\STX\GS2/s\1105953"), - (")4n\994673ZN2", "\FS\1045159Wq\fqZ\FS\DELJA\NAK\rB?f<\"\DC30M|\EOT"), - ("b\1079860F;", "N\1015915&;\1106564z\1031345{\1105744C\ESC#\v\GS\1019897VG"), - ( "c\74383dVzM\SYN\n%a\135559CT;y\1102231}\148773mT\1016284S\DC2g", - "(T\NAK\FS/BG\NULAqn\1101035.jJ^I\135547\&8DX\1072386m" - ), - ( "Gs\1099524\&41\ESC\1083948\995852\11657\160171fj\rd\176716\ACK\SOH8qj\63461\"<\DC2\70870|\987273", - richFieldValue = "\1084288\CANuS\987579w\1086865\ACK/\132561\99700\SO\DEL2q\DC4;h\1009002\ETB;O?\1078358" - }, - RichField - { richFieldType = "\DC1q\985613Yz\1021125n\1042087\tn\36234P\182769\&9", - richFieldValue = "\137890\NAK\30301\26919Vx#\STX\ACK*\1102033\SYN 06" - }, - RichField - { richFieldType = "\62103\50514\DC2>\"\1091637ON\USG\1012210GC\DC3@0\v\SYN\rA3:\ENQ*", - richFieldValue = "\1106757\39230\10824\ACKSUu\1023269z\51098" - }, - RichField - { richFieldType = "8e\1092079\1031572\&04\992184r\tK\164968p\FS/\5783", - richFieldValue = "Lp*J\CANS/\22624\EOT\1083845" - }, - RichField - { richFieldType = "\1055848,{3\137156\&1\1055068\1104006\r\"?hGYO\1045951t\167966\&4\60717{\SYN@", - richFieldValue = "x5\1063811o" - }, - RichField {richFieldType = "\160962\ESC\25354{\1056421", richFieldValue = "Z\52932\rq)D\DC2z\53197]@t%]\SI"}, - RichField {richFieldType = "\1100879\SUBq\a\SIBs", richFieldValue = "Q"}, - RichField - { richFieldType = "\184578\&2,Y\1065717$h5\26854-B\EMx)\SOH*I\46496O;\\b", - richFieldValue = "\165993\&3mGW\22642l\47820\64261\f\145314.=" - }, - RichField - { richFieldType = "\1112019\2879=\1083112\&4v\t\141212TB", - richFieldValue = "&\ESC~\DELs\1080928\46596*y\ETXzL@~\a9D\163584" - }, - RichField - { richFieldType = "q\1020779r\1069479\&8h\fk\DC3K9\127941\1004987", - richFieldValue = "\vH\1094278\SUB\ETX$\SI+\74222\46277z\1096064`>\1070494S\SOH_qo" - }, - RichField - { richFieldType = "\4043&@\DC4}\1028923\\~5\142816*\66698]\ESCZ\158429", - richFieldValue = "22g\EOTj*\145560\&9\ENQ7a:" - }, - RichField - { richFieldType = "\1038424LT#\189806\&5O\1051638\a7PC" - } - ] - } + mkRichInfoMapAndList + [ RichField + { richFieldType = "w~vmF\1086840\ETB'\1047873.dr\1082295\DLE\EOT\24862-\f`\GS\b%\1640\ACK", + richFieldValue = + "`Rl\37684\164599\20141K\EM\SYN^\ETB\1043760\983175Vn\1024439\EOTG\1030425x\32432F\168193?ps\1033933\ESC" + }, + RichField + { richFieldType = "8<_\1041436\DLE+\NAK\1089233j\1107743H\1018361nl\v\NULC@\24372k]\GS%9\128744", + richFieldValue = "g8+" + }, + RichField + { richFieldType = "8\993712y\ESC\SUB11l\182001\1030.(\1071348\28433Vv#", + richFieldValue = "L[2\100432r,\ETB `9\ETB\1001122<\16482\GS\SOLT#\189806\&5O\1051638\a7PC" + } + ] testObject_RichInfoMapAndList_user_17 :: RichInfoMapAndList -testObject_RichInfoMapAndList_user_17 = - RichInfoMapAndList - { richInfoMap = fromList [], - richInfoAssocList = - [ RichField - { richFieldType = "\1090953D\40727j\ENQHMgz\1027766(r", - richFieldValue = "(7D\1053300\1059143\DLEFP\DEL%Y\176020,}\NAK\NAK" - }, - RichField - { richFieldType = "ybx\SOH6\NAK+o\\d%\DC4@@", - richFieldValue = "|\SO\b&\"\47463\986920j\150535`l\1075178~\STX%zl\RSp\1062377\11320\&4\1037502\n\39880y-" - }, - RichField - { richFieldType = "0\DC4s\1009478\1078374\64673T\r\NULS\3720\189327\1031607S,", - richFieldValue = "\ETX\STXa" - }, - RichField - { richFieldType = "6\v\DC1.@p\SYN\12157\&7 m2nm\1093812\&1\1040947\996555\110974\ETB-\1099786E\1057283/", - richFieldValue = "\1069491\ACK[S\STX\1004943fIBz\1068155\DLE[d-" - }, - RichField - { richFieldType = "YbO\t\ETB\72824dY\43796\v\r\1110538\1018639\f(\83178q\95503\174672\ENQ\147011\1021002p", - richFieldValue = ")R\DEL\997474." - }, - RichField {richFieldType = "\74615t#T", richFieldValue = "\1029105>G{9"}, - RichField - { richFieldType = "q \63979\1032341\"\1108625c\EOT>\1094516'B\987613\97049\95210\1073699\EOT4\FS\DC2:ew", - richFieldValue = "\b!\990134\31454\1017613Mi*'M\7385]\45188\18138\SYN%\100239\US:\RSg(]6,1\25362\95467hX" - }, - RichField {richFieldType = "\168989lB~53k\32174\165028", richFieldValue = "&l\1058556\&0"}, - RichField - { richFieldType = "p`\47891\92215O7^\t{D\ACKA", - richFieldValue = "U\1084470X\FSi\213\fU|7K5\ESCm \1024526?\1058254Z\1096290\157117D!,\n" - }, - RichField - { richFieldType = - "\\\171898\ENQ\DC3\1096965l\EM2\DEL\SIj\1077069\\\1038930v3v*\US~-dM\1039922e\DLE\GS\1090187", - richFieldValue = "\DC4N\74064`Pp\f\140943|9K\n`Io\1001516\30610\\j,\996690B4:).uY>\v" - }, - RichField - { richFieldType = "z\175084\1089700Y\1005940Y9qM$ b", - richFieldValue = "\DC3V\DEL}\RS\181695%\1112683Y\ESCH.eJZ;sZ?c\187383\SOH\GS\STX=V" - }, - RichField - { richFieldType = "22\153981!<$R\1088477\vE\170101\1098195 _c\1052675", - richFieldValue = "\1111943\152105/lb\184015(]\1006529\74367G)9\119002`A\1006048s\DC1O\1070544[Z" - }, - RichField - { richFieldType = "\1006267v\SUB\1052321", - richFieldValue = - "Cs\167806\1095876\SO\1077563\DC1dA\164787\tt\10692iSU=\r\1074323\SO\134296\1016705Z\1108703@\120844\&231" - }, - RichField - { richFieldType = "bu\1057564\US\1026897E\57436\1095896\63950x\NUL\SOrRw\a", - richFieldValue = "\1101143F\1026278<\DLE\NAK5/\SYNIlgX\168558KE." - }, - RichField - { richFieldType = "\131896@\63319o\1562^M\1058227!\f],\ACK\"4", - richFieldValue = ";yG<.D\33414k0X^\1048522\ENQ!\1065059z\DLE\EM>I$W$" - }, - RichField - { richFieldType = "#K\57723\1096142\DC2e\NULt(u\ACK}q\1083604c(i\1004230J\9122a$Z<", - richFieldValue = "P|M6t0 \61626\ETB\EOT\48311p-N\RSEd\EMn\"{\1060945/\195047*u1" - }, - RichField - { richFieldType = ",\DC15\991051\182213\59706\RSk*\72259S\1066769\ro$,2\179381*S]\1008705^", - richFieldValue = ")0\SYN\GSCG\DC2\1059387j\37029%\ETB\1060066" - }, - RichField - { richFieldType = "#\1054266\ETXg\SOH\f\ENQ>\1101152,&\1097994\168271\EMh\v.\GS\1028940", - richFieldValue = - "\53208@\61446\NULo0\1011692\1023006\1012583}\1004797\1060559\14562\GSw\ESC,\21816%/\ACK\SOH" - }, - RichField - { richFieldType = "\ENQu\FSp\1018870\1022766$\nt6\985766\1103201Y}\DLE\DLE\1100056,", - richFieldValue = "\9641\f" - }, - RichField {richFieldType = "G7t\CANc", richFieldValue = "~*\rm"}, - RichField - { richFieldType = ">-E[?l\1073421\DC3h\ETXA$u{p|-W97u\ETBf\DEL\SYN", - richFieldValue = "#\SOH\1098268/9\1031294E\1018H\DC2P\DLE" - }, - RichField - { richFieldType = "\n\1039925&3\25504~\b[\DC4o8\1086024\72236\22054}\1001673\1037232-\n", - richFieldValue = "=\ESC;>\190739E\274\b\998682p\1088718\&9\92883,\SYNF\985328\1062747$" - }, - RichField {richFieldType = "\162652\10294*2\1091056\1014630\SI\v:", richFieldValue = "B\1053466J;"}, - RichField - { richFieldType = "s\95540(\1015062\DEL\111108\USi\1005579Io\128443q1%l/\DLE1e\ETX", - richFieldValue = "\DC3\DC2\41300\32840M4ri4K=zA" - }, - RichField {richFieldType = "j\DC2\NAK8a_", richFieldValue = "g<\1076586\&2FV\EOT=[!{U`"}, - RichField - { richFieldType = "\1084565p-\DLE\DC3\148118\ACK\1082810|\NULe}yY", - richFieldValue = "\154920L+j$\1022935}{\48899\t_=\78748\12474\51335[\CAN\n\174421i\68386Y)\994901" - }, - RichField - { richFieldType = "Z\1082637;}3\FS", - richFieldValue = "\NUL\71042\1106151\993695@\1029866\SI@\141690@" - } - ] - } + mkRichInfoMapAndList + [ RichField + { richFieldType = + "o\"\178223@}\99710C\1106153{!)\1002306\t,\1033045Q,l\1020558\1036716\1108657\\N\25862Cq\r\SOHQ", + richFieldValue = "\5504:\RSJN\10911C9JoA)i^\ENQ]vZ=\1109172p\1097743K\EM\174447nb\NAK\1075183" + }, + RichField {richFieldType = "^\1103871\999833`", richFieldValue = "\DC2\FSMl"}, + RichField + { richFieldType = "{\GSuHh1\61732c", + richFieldValue = "wwMX@\DLEt\NUL\1079935\DLE\DC4'/Qb\1070573\1036579\986281B\SUBz" + }, + RichField + { richFieldType = "\1030795)\1097546A+r\92611\&0fHG\49259iH\EM\1038612\rl%u'\v\1062649\t9\156142Ud\157566", + richFieldValue = "\1107556\&0\54765\1075079\21584\1012248A\185804dF\DC2g\DC3a\NAK|\b" + }, + RichField + { richFieldType = "x\177159s", + richFieldValue = "\n\bG\144915\SO\EM\ENQ5%\78710\&6Gz!Wj/i\DC1qk\DEL\1086561U\1023058" + }, + RichField + { richFieldType = + "/`\145454/}\30770\118940\1012827Qr\1064113>p\1018870\1022766$\nt6\985766\1103201Y}\DLE\DLE\1100056,", + richFieldValue = "\9641\f" + }, + RichField {richFieldType = "G7t\CANc", richFieldValue = "~*\rm"}, + RichField + { richFieldType = ">-E[?l\1073421\DC3h\ETXA$u{p|-W97u\ETBf\DEL\SYN", + richFieldValue = "#\SOH\1098268/9\1031294E\1018H\DC2P\DLE" + }, + RichField + { richFieldType = "\n\1039925&3\25504~\b[\DC4o8\1086024\72236\22054}\1001673\1037232-\n", + richFieldValue = "=\ESC;>\190739E\274\b\998682p\1088718\&9\92883,\SYNF\985328\1062747$" + }, + RichField {richFieldType = "\162652\10294*2\1091056\1014630\SI\v:", richFieldValue = "B\1053466J;"}, + RichField + { richFieldType = "s\95540(\1015062\DEL\111108\USi\1005579Io\128443q1%l/\DLE1e\ETX", + richFieldValue = "\DC3\DC2\41300\32840M4ri4K=zA" + }, + RichField {richFieldType = "j\DC2\NAK8a_", richFieldValue = "g<\1076586\&2FV\EOT=[!{U`"}, + RichField + { richFieldType = "\1084565p-\DLE\DC3\148118\ACK\1082810|\NULe}yY", + richFieldValue = "\154920L+j$\1022935}{\48899\t_=\78748\12474\51335[\CAN\n\174421i\68386Y)\994901" + }, + RichField + { richFieldType = "Z\1082637;}3\FS", + richFieldValue = "\NUL\71042\1106151\993695@\1029866\SI@\141690@" + } + ] testObject_RichInfoMapAndList_user_19 :: RichInfoMapAndList testObject_RichInfoMapAndList_user_19 = - RichInfoMapAndList - { richInfoMap = - fromList - [ ("\r\"\40366T|l0$\DC3", "\5498q\DC1\ACK&\29304\12388p\157147\DLE\FSY"), - ("P2\b\ENQ1&\1031947\a\14670\RS\1014494_q,-u\159609_u\ESC2\74221;k\CAN", "GJ\1094026"), - ( "\134208K\1079221P.7\1063368s|\ESCUv\DC4w\92892\SOB/\RS\82989/[T\SYNYF\169867", - "\f\NUL\160767E\US47(\n\DEL" - ) - ], - richInfoAssocList = - [ RichField - { richFieldType = "l%\35922\ACK\DC4b\82954\119943\EM$\1011647\&5~f\37664H", - richFieldValue = - "d\34056\1074598)A\18354k@\SUB\1097784<\1054362\132080I\1003614\DC1}:\SYN\1085924\994398$\v\EM\DC2&OMW" - }, - RichField - { richFieldType = "\DC3\DC2\1026333vS\t\NUL\DC4\1073519<\EM\539\DLE<\NULxR\SUBU\FSx\SYN\\JtiN?&\1092138", - richFieldValue = "\1000631\1058954x\23412\&3\n\18517\1040637\20472\r0e\DLE\1029504" - } - ] - } + mkRichInfoMapAndList + [ RichField + { richFieldType = "l%\35922\ACK\DC4b\82954\119943\EM$\1011647\&5~f\37664H", + richFieldValue = + "d\34056\1074598)A\18354k@\SUB\1097784<\1054362\132080I\1003614\DC1}:\SYN\1085924\994398$\v\EM\DC2&OMW" + }, + RichField + { richFieldType = "\DC3\DC2\1026333vS\t\NUL\DC4\1073519<\EM\539\DLE<\NULxR\SUBU\FSx\SYN\\JtiN?&\1092138", + richFieldValue = "\1000631\1058954x\23412\&3\n\18517\1040637\20472\r0e\DLE\1029504" + } + ] testObject_RichInfoMapAndList_user_20 :: RichInfoMapAndList testObject_RichInfoMapAndList_user_20 = - RichInfoMapAndList - { richInfoMap = - fromList - [ ( "y\6786=o\134067\ETB8Cs)\148070@\DLE", - "\DEL\SO\32445\v\95243D\1091410\DC2\120264B*\ACK2\v\FSM\1090696kR*V" - ), - ( "}\1000267\96390&\ESC\CAN\1020984\156934\21982z%\GSq\27039", - "\1075992\1033547'84\RSn\1093281\991341\67725d\US\141549\163960|\1076063:w\NUL-\EOT\72417\ETX" - ), - ("\157707Bf\\\986805=\CANYq\68144`", "\RSo\EOTBPSc") - ], - richInfoAssocList = - [ RichField - { richFieldType = "\1096287>MS\1016913\tZ\r(#\34261=\1043593+d\1037003\172367", - richFieldValue = "V\ETX\1092439\SO\51629r\ACKa" - }, - RichField - { richFieldType = "^\1038705\&3d\36922uw\ENQ\ENQM\133620E\41063[\1057882\31216\NUL\27221p\167589", - richFieldValue = "T<\3000\"\fz\US\b" - }, - RichField - { richFieldType = "\31180x\153686\SOH", - richFieldValue = "\155629\a\v\917963\&5]\9869\"\SOHu\53229\182172\vv-" - }, - RichField - { richFieldType = "\1017151\"}i]\SOH\NAK7\150559\DC3\STX\ENQX\vGN\DLE\STX", - richFieldValue = "EhJ@{x\47415\r\156838O\r$HD1\162267\DEL\1031055\DC3\1063259\996904\1005457\11712}\STX" - }, - RichField - { richFieldType = "\63701H\992630;", - richFieldValue = "BtVr\101034\151593\1045068\&5;FN<\DC3\171261\n\1072952'Ag" - }, - RichField - { richFieldType = - "T\1039030a\1023056O'\990348\165374y+7\1109358H\a\162292D?\FSN)\SUBVG\164918\158175\SUB)\1074222\52531", - richFieldValue = "\DC4-4\1051423y.\EMQlz\DC2s\1001688\1104524^\ETB^\n\ENQ\39083[" - }, - RichField {richFieldType = "", richFieldValue = "}\US_SE\169920^\36244i\SYN0"}, - RichField - { richFieldType = "LE\1025429Y\138000\50613\43161\171048`", - richFieldValue = "]\ETX\1070967X\fT\176943\USy\34949\fR" - }, - RichField - { richFieldType = "\STX\987935", - richFieldValue = "\DC3\1038953\1070912\ETXa\182022\SO/\156255\177800=z\ACK,\145929\1028281%2\ACK\DLE*\SO" - }, - RichField - { richFieldType = "W#@WNS\1083779\121093\USv4H", - richFieldValue = "Y%\ESC\1081275\RS\SYNf@\US{\60103\ENQ\ESCiM\1099834ii_" - }, - RichField - { richFieldType = "a\48924xp\999083M\FS\40103:\53958\51616l\USG\1060492", - richFieldValue = ";cnns\98880\1007446Wx<#\1023480@\1096493\SYN\1102198K\1054189M,\1098496G\5736F\16303':s" - }, - RichField {richFieldType = "a:XV\16574Z\1101931c:J\178991#\1008335|maO)FD:b", richFieldValue = "3Ly?\ESC"}, - RichField - { richFieldType = "\1013988;\31159\35380Ed\SOGn\1026021!\SOH/4\157407\186370\&7f}\DC1rZ\rs\48680Nh\"\111114k\2311\37338\1052055as\62033$|7\1023374A\990573\1015545" - } - ] - } + mkRichInfoAssocList + [ RichField + { richFieldType = ">NN\184215\RS[N@x\STX\1044432X\1036744\NUL\r)w\1066544\ESCu\fg\61700\160192@\DC1", + richFieldValue = "N\r\t\1006657\33991\97459\995407" + }, + RichField {richFieldType = "\18052;", richFieldValue = "\184918\68001\30896 \US\EMp\DC1\SOHr\1066536"}, + RichField + { richFieldType = "\1025988\ACK\1045120i\139213;=/3\1087376\"U", + richFieldValue = "\ETBK\SUB\SUB\SO:\1027091y\SOH\173945]`\58105\ETXe\DC1O:\159156h~akL\NULu\999959t" + }, + RichField + { richFieldType = "\1110994\1037410\ETBJ\1022016K\1061472K\161981ct\132829B\992158\1107226\148096\&2", + richFieldValue = "\DC4\164340\&8,\61665*\1019296&JP\bpzN\73861a\n\DLE{\DEL& Z+/i\96649" + }, + RichField + { richFieldType = "\23507\111040\101002]7\165650\1104101;\1014368L[)3\SI\vfZ=[", + richFieldValue = + "^\ETXq(P\STX_\137162k\1080450i\153078\983225'\DC4\ENQ\DC12J\SI\1071012i\1073773\1008155" + }, + RichField {richFieldType = "\137399\1082136\\\NULhOWZZ\48526(t", richFieldValue = "}8\ETX|n1\12176"}, + RichField + { richFieldType = "{\188409=", + richFieldValue = "^\1001460_\STX\CAN_\25489\CAN\ESCp#BS~\1109647#\SI" + }, + RichField + { richFieldType = + "\53139O\RS$7[J\1016551\&7W\61439b\171218\DC4\1007833\997544\EOT){2)\t\62610\DC1\1065678qG\1054082\997682", + richFieldValue = "\18445\&3>\"sn\1072416\&4" + }, + RichField + { richFieldType = + "J\1096579[gHH\rjs\DC1%h\996332\ACK\161759}rh\183657\STX6\ENQ\994477_\US\DC3-.\CAN\57462", + richFieldValue = + "V\173325~\a\144121h\tq\t[S\1013480\FSDa\STXN4\99669\152357\24029\&0\1099787o\60898~\145739" + }, + RichField + { richFieldType = "]|:\184436`\16885\1054533A\RS6", + richFieldValue = "0R\5037\1104789\986919CrX\5130oA;K\148428\1089410A" + }, + RichField + { richFieldType = "-\ETB\136638kI\1084383", + richFieldValue = "\a\RSN B\a\1006274\177369\GSoc*%" + }, + RichField {richFieldType = "\\Y\fr\ETX\SI", richFieldValue = "4\1043727M6J"}, + RichField + { richFieldType = ".\FS%N5=`\EM\ETX\1042853\DC4t3@\178711Oz.\DEL\1058566\40011\&0IG\tdk>-\1093087", + richFieldValue = "8U\RSJ6uNV_\v" + }, + RichField + { richFieldType = "(7j\1113940\57870S.,_", + richFieldValue = + "\139990C~\36700&=\1093292\NUL\1093495Va<\99224\78597!\776\1055220zK\7834~\\\42673\170534\EM;a\101078)\63284" + }, + RichField + { richFieldType = + "\137386Q\"[\1094790\ESC\1080088[{\1012551\EOT\153991\ETB\65105\&5Cl\EOT\SOH\63159\1033642ZA\1087819R,\28980/\136301\1021968", + richFieldValue = "K\133182" + }, + RichField + { richFieldType = "\ETX\ETXW\DC3\NAK\1112125=U\1030033\1057159\n\984643Fd\33768'\a\RS3\a,\NAK#\NAK", + richFieldValue = "\ESC\US\1093980\155242" + }, + RichField + { richFieldType = "3#u\157205\67212zf'G\US\SON\39399\1038358\1061837\145791n", + richFieldValue = "J<~ \13084?1\SOh\r\1113196\SO9s\1036192\65759a\1090172\153198\DC14\132642CNI|" + }, + RichField {richFieldType = "^3\59726\1021500&", richFieldValue = "4/S\fC\1092592\998665J\"|\SIHy\FS"}, + RichField + { richFieldType = "\t@\96065\7066Pt\989465\1015135ql.\DC2\132219-\US\149402un=\GSmM\v\SOHR", + richFieldValue = "\19317TQ^(HF'\157407\186370\&7f}\DC1rZ\rs\48680Nh\"\111114k\2311\37338\1052055as\62033$|7\1023374A\990573\1015545" + } + ] } testObject_RichInfo_user_5 :: RichInfo testObject_RichInfo_user_5 = RichInfo { unRichInfo = - RichInfoAssocList - { unRichInfoAssocList = - [ RichField - { richFieldType = "\6820\t\b]\1056536\USx\ESC\178974jk\129614/X\DELiyg\US\t\1077298", - richFieldValue = "oR+o\43203\&7e\1099830\&6MA\ENQ3Y\1089962W~J" - }, - RichField - { richFieldType = "+\1068744\172657BQ4\1020089bZ>?\1099625?\NUL a\92434|K\1039090>5kR", - richFieldValue = "\SIbs2`\DLEMD&\1070231}RUx\FSi\DC2\ENQSjt6\166010\1057829\NAKV\t\EM" - }, - RichField - { richFieldType = "", - richFieldValue = - "\1110695\1097480Tq\16015\156907\USM\1067573vr>\RS\992825r\194921~Ho4\178423Fpq\1066729y]^" - }, - RichField - { richFieldType = "\29745\1000303U\US\n\1111538\r ", - richFieldValue = "@\805cl\SOH/\97433\1039371n\1097054" - }, - RichField - { richFieldType = "\37590\131324`", - richFieldValue = "\8967\nv\EOT\10967\RS\82995y&jy5F \1049295G\1040173+\156573\fu\SOM\98366\&0\ESC" - } - ] - } + mkRichInfoAssocList + [ RichField + { richFieldType = "\6820\t\b]\1056536\USx\ESC\178974jk\129614/X\DELiyg\US\t\1077298", + richFieldValue = "oR+o\43203\&7e\1099830\&6MA\ENQ3Y\1089962W~J" + }, + RichField + { richFieldType = "+\1068744\172657BQ4\1020089bZ>?\1099625?\NUL a\92434|K\1039090>5kR", + richFieldValue = "\SIbs2`\DLEMD&\1070231}RUx\FSi\DC2\ENQSjt6\166010\1057829\NAKV\t\EM" + }, + RichField + { richFieldType = "", + richFieldValue = + "\1110695\1097480Tq\16015\156907\USM\1067573vr>\RS\992825r\194921~Ho4\178423Fpq\1066729y]^" + }, + RichField + { richFieldType = "\29745\1000303U\US\n\1111538\r ", + richFieldValue = "@\805cl\SOH/\97433\1039371n\1097054" + }, + RichField + { richFieldType = "\37590\131324`", + richFieldValue = "\8967\nv\EOT\10967\RS\82995y&jy5F \1049295G\1040173+\156573\fu\SOM\98366\&0\ESC" + } + ] } testObject_RichInfo_user_6 :: RichInfo testObject_RichInfo_user_6 = RichInfo { unRichInfo = - RichInfoAssocList - { unRichInfoAssocList = - [ RichField - { richFieldType = "\\\43009\SOH\133826tV", - richFieldValue = "\ESC\184321/\1076982ZA\54627\1029646\DC3IE\64065{\ACKpV\48701k" - }, - RichField {richFieldType = "[0\DLE\172396", richFieldValue = "L,5tm9\EM"}, - RichField - { richFieldType = - "(\1056899\&94\1068984\SYN/\1090403\DC1@s\1024296\1029175\1099709:{\SOH\"K\ESCX\12540Fs\1081566\1032508", - richFieldValue = "AL\n\42405\128525\EMO1}\DEL\18075\rO#.gxE" - }, - RichField - { richFieldType = "\190199\44619k\1060713\SIdzA45\"j\62171\25208b$\ACK8Fg{UQ.", - richFieldValue = - "!3\CANV\FS\r(*'\1046479\1072827\1111092z=\1033680\7976\DLE\1089119-\SYNt\DC3\1084330b\STX\ETXV\SOH" - }, - RichField - { richFieldType = "\RS", - richFieldValue = - ">{I\48810$\189299\128703\191362\SYN\SI\183475x\63481Og2\GSv0\1006696Ih\SYNP\148138m]\61394r" - }, - RichField - { richFieldType = "=P\1059943xO4\15200n\FS\1032310U\1043187pnHu{\152121;\1029448", - richFieldValue = "-\1092750\&3w(n\7300\190533>\SI\FSO\67319\&05~\f" - }, - RichField - { richFieldType = "co\GSP\1088511B\1009528,&\52920\986643\ACK$kap", - richFieldValue = - "d\SOH\991613\11391\ACKD\1100648z/\DEL\NAKK\30183\1077152\ENQ-\EOT\SYN\DELy\DC1\NUL#\USlT" - }, - RichField - { richFieldType = ")\r\ACK\GS\1043890\&3f\ENQ\1041726U`\SYN\34924,\SUB'\NULB", - richFieldValue = ";\FS\126223\USD" - }, - RichField - { richFieldType = "\vAA9\n\DC16)h;\42048\1012586Qj{d\33864%\1004205c\RS\1038376\\\99811O\DC1,a", - richFieldValue = "\"xaCQ;\37852C^\USwm\179289(N\1065173\&6 +\DC2\USX;" - }, - RichField - { richFieldType = "O\CAN)p\149374W\ESCa\1041977\169728\NAK", - richFieldValue = "\EOT\1042388r:[G\GS]\SO6B\1019567\141536#W\DC2\158237\68627\ETX\1050656,\DC2\ESC" - }, - RichField - { richFieldType = "Pn\ESCA\ACKbc\134214hv\"M\185501\33235\29556\v'C", - richFieldValue = "]-f_\ETB" - }, - RichField - { richFieldType = "\1102745D\1008540:\SI\DC4f\27021\1079064|@", - richFieldValue = "Ka\f\NUL2y\983919u\1061024wh\DC1\\\1086719\1064224\v6Y" - }, - RichField - { richFieldType = "\1056530\&6.\1018673<\120773\998464l\41416\DC1", - richFieldValue = "\1109906\99906\CAN\1087700\1094984\ve\176866\1034268\ENQd" - }, - RichField - { richFieldType = "\GS\160173T~+\DC1\171828\1078883p\12312_\r(\1015242\USP\EM#X\169561\126241\27018", - richFieldValue = "\SI\154350\1003041\&4S" - }, - RichField - { richFieldType = "\1098164\t\127100\r", - richFieldValue = "8U\15253\&2A\1029816/J\aD57\1087174\SYNdC\181524\n\19313l\ACK\DC2=" - }, - RichField - { richFieldType = "CK%\136674\21597[\1053416,}cMJU/@\1068826\40545", - richFieldValue = ")\SI1q\ENQ" - }, - RichField - { richFieldType = "wm\STX\165315\ETB\a6\1014425G8\1053002f\121073\SUB\1039792m\DC1Y\v)9x~>Q\n", - richFieldValue = "=21yL\b\"\168592,\1034030\DC2\b\60830\r\134463\USm hf}iU\155381\SUB\b}3I" - }, - RichField - { richFieldType = "\NAK >\SUB\SOhem=,1\CAN\STX\166471\&8", - richFieldValue = "{\DC2T_\ESC(JaC7|\EOTYKi\DC3\ESC:l,\167224" - } - ] - } + mkRichInfoAssocList + [ RichField + { richFieldType = "\\\43009\SOH\133826tV", + richFieldValue = "\ESC\184321/\1076982ZA\54627\1029646\DC3IE\64065{\ACKpV\48701k" + }, + RichField {richFieldType = "[0\DLE\172396", richFieldValue = "L,5tm9\EM"}, + RichField + { richFieldType = + "(\1056899\&94\1068984\SYN/\1090403\DC1@s\1024296\1029175\1099709:{\SOH\"K\ESCX\12540Fs\1081566\1032508", + richFieldValue = "AL\n\42405\128525\EMO1}\DEL\18075\rO#.gxE" + }, + RichField + { richFieldType = "\190199\44619k\1060713\SIdzA45\"j\62171\25208b$\ACK8Fg{UQ.", + richFieldValue = + "!3\CANV\FS\r(*'\1046479\1072827\1111092z=\1033680\7976\DLE\1089119-\SYNt\DC3\1084330b\STX\ETXV\SOH" + }, + RichField + { richFieldType = "\RS", + richFieldValue = + ">{I\48810$\189299\128703\191362\SYN\SI\183475x\63481Og2\GSv0\1006696Ih\SYNP\148138m]\61394r" + }, + RichField + { richFieldType = "=P\1059943xO4\15200n\FS\1032310U\1043187pnHu{\152121;\1029448", + richFieldValue = "-\1092750\&3w(n\7300\190533>\SI\FSO\67319\&05~\f" + }, + RichField + { richFieldType = "co\GSP\1088511B\1009528,&\52920\986643\ACK$kap", + richFieldValue = + "d\SOH\991613\11391\ACKD\1100648z/\DEL\NAKK\30183\1077152\ENQ-\EOT\SYN\DELy\DC1\NUL#\USlT" + }, + RichField + { richFieldType = ")\r\ACK\GS\1043890\&3f\ENQ\1041726U`\SYN\34924,\SUB'\NULB", + richFieldValue = ";\FS\126223\USD" + }, + RichField + { richFieldType = "\vAA9\n\DC16)h;\42048\1012586Qj{d\33864%\1004205c\RS\1038376\\\99811O\DC1,a", + richFieldValue = "\"xaCQ;\37852C^\USwm\179289(N\1065173\&6 +\DC2\USX;" + }, + RichField + { richFieldType = "O\CAN)p\149374W\ESCa\1041977\169728\NAK", + richFieldValue = "\EOT\1042388r:[G\GS]\SO6B\1019567\141536#W\DC2\158237\68627\ETX\1050656,\DC2\ESC" + }, + RichField + { richFieldType = "Pn\ESCA\ACKbc\134214hv\"M\185501\33235\29556\v'C", + richFieldValue = "]-f_\ETB" + }, + RichField + { richFieldType = "\1102745D\1008540:\SI\DC4f\27021\1079064|@", + richFieldValue = "Ka\f\NUL2y\983919u\1061024wh\DC1\\\1086719\1064224\v6Y" + }, + RichField + { richFieldType = "\1056530\&6.\1018673<\120773\998464l\41416\DC1", + richFieldValue = "\1109906\99906\CAN\1087700\1094984\ve\176866\1034268\ENQd" + }, + RichField + { richFieldType = "\GS\160173T~+\DC1\171828\1078883p\12312_\r(\1015242\USP\EM#X\169561\126241\27018", + richFieldValue = "\SI\154350\1003041\&4S" + }, + RichField + { richFieldType = "\1098164\t\127100\r", + richFieldValue = "8U\15253\&2A\1029816/J\aD57\1087174\SYNdC\181524\n\19313l\ACK\DC2=" + }, + RichField + { richFieldType = "CK%\136674\21597[\1053416,}cMJU/@\1068826\40545", + richFieldValue = ")\SI1q\ENQ" + }, + RichField + { richFieldType = "wm\STX\165315\ETB\a6\1014425G8\1053002f\121073\SUB\1039792m\DC1Y\v)9x~>Q\n", + richFieldValue = "=21yL\b\"\168592,\1034030\DC2\b\60830\r\134463\USm hf}iU\155381\SUB\b}3I" + }, + RichField + { richFieldType = "\NAK >\SUB\SOhem=,1\CAN\STX\166471\&8", + richFieldValue = "{\DC2T_\ESC(JaC7|\EOTYKi\DC3\ESC:l,\167224" + } + ] } testObject_RichInfo_user_7 :: RichInfo testObject_RichInfo_user_7 = RichInfo { unRichInfo = - RichInfoAssocList - { unRichInfoAssocList = - [ RichField - { richFieldType = "xNP\1049100z\CANs2\987661", - richFieldValue = - "[#ok\FSR\v.@Al\1064744\154659\&0]\1089611*4$0u<\173498\59461\66810\STXS\SYNc\51629" - }, - RichField {richFieldType = "\995507\US1>c", richFieldValue = "Ly\FS3bG9\1043657H\20460g>(\DC4"}, - RichField - { richFieldType = "%f\61759\DC4\n\1058224C\1062392m\f\ETBqUa\EOTC", - richFieldValue = "3rXe#Hlq=z\176833*;|\1014731" - }, - RichField - { richFieldType = ")\160204.\DEL{\996888t_\STX\1092919E\137060\a 8?", - richFieldValue = "W\169422&\1026034\n^\176216ME\CAN\ETX\1090011f\1110687\48242fsL\38118" - }, - RichField {richFieldType = "\DELL4", richFieldValue = "V\f+{x\1006327\121401Uew$at"}, - RichField - { richFieldType = "7\FS\SOHr\a\62100\917588\22363a4", - richFieldValue = "'\EMa1\40150\DC1S*z]\139187:&M" - }, - RichField {richFieldType = "\NULGo\65772\&3\10817\1021570", richFieldValue = "H\1013025I\60747L_"}, - RichField {richFieldType = "", richFieldValue = "\13196\1007995\DC4\tx\178421d|q\DC1t:0"}, - RichField - { richFieldType = - "b<\1092750\GS\68040\DC4\1086388\1103364/\1067257:\51893)U\5505\175390\SOH\162803\GSp", - richFieldValue = "@9\b\t\r,^\1082496\844\985421\SOHBL2=\180250S%\NUL" - }, - RichField - { richFieldType = "+", - richFieldValue = "X\FS$\1106188\22234e\DC3$X1VI\\\169355`\165248z\EM^\v\SO\1074392aq\1001898H" - }, - RichField - { richFieldType = "fWu\SOH\1113202\NAK\STXQVk\180684_g\NULlAK\154794M,b\99737\1095059", - richFieldValue = "o6!M\DLE\1089465\19837\STX[\189720\993500\74187\191020[\1080325\r\144524\64614Y" - }, - RichField - { richFieldType = "\SOHo\RS\35961-(\1102197)f\ETB\995930S\1020981k", - richFieldValue = "NO#r\995433]\ETX4hX}\1040553\NUL\10166\SI\US\CAN\152188\&1\DLE\DC2I=y" - }, - RichField - { richFieldType = "8\50898\&8Mh<\" G[-W]\RS\DEL%\160175\1021098a\a3\NUL\169094\72791\SYN", - richFieldValue = "\993468\1041193_\SO\49981B^" - }, - RichField - { richFieldType = "Vx\SOH\24511{\1072255le^\FSp\1052403\97860\38253Z\177575\ENQ]}?\189892n\ETB", - richFieldValue = "\5244\983510C\SI:<\36686\&0nN\ba\21143\DC4c(m9)\ESC }>\"|\CANk`\f" - }, - RichField {richFieldType = "\39899\1019692", richFieldValue = "\1017708"} - ] - } + mkRichInfoAssocList + [ RichField + { richFieldType = "xNP\1049100z\CANs2\987661", + richFieldValue = + "[#ok\FSR\v.@Al\1064744\154659\&0]\1089611*4$0u<\173498\59461\66810\STXS\SYNc\51629" + }, + RichField {richFieldType = "\995507\US1>c", richFieldValue = "Ly\FS3bG9\1043657H\20460g>(\DC4"}, + RichField + { richFieldType = "%f\61759\DC4\n\1058224C\1062392m\f\ETBqUa\EOTC", + richFieldValue = "3rXe#Hlq=z\176833*;|\1014731" + }, + RichField + { richFieldType = ")\160204.\DEL{\996888t_\STX\1092919E\137060\a 8?", + richFieldValue = "W\169422&\1026034\n^\176216ME\CAN\ETX\1090011f\1110687\48242fsL\38118" + }, + RichField {richFieldType = "\DELL4", richFieldValue = "V\f+{x\1006327\121401Uew$at"}, + RichField + { richFieldType = "7\FS\SOHr\a\62100\917588\22363a4", + richFieldValue = "'\EMa1\40150\DC1S*z]\139187:&M" + }, + RichField {richFieldType = "\NULGo\65772\&3\10817\1021570", richFieldValue = "H\1013025I\60747L_"}, + RichField {richFieldType = "", richFieldValue = "\13196\1007995\DC4\tx\178421d|q\DC1t:0"}, + RichField + { richFieldType = + "b<\1092750\GS\68040\DC4\1086388\1103364/\1067257:\51893)U\5505\175390\SOH\162803\GSp", + richFieldValue = "@9\b\t\r,^\1082496\844\985421\SOHBL2=\180250S%\NUL" + }, + RichField + { richFieldType = "+", + richFieldValue = "X\FS$\1106188\22234e\DC3$X1VI\\\169355`\165248z\EM^\v\SO\1074392aq\1001898H" + }, + RichField + { richFieldType = "fWu\SOH\1113202\NAK\STXQVk\180684_g\NULlAK\154794M,b\99737\1095059", + richFieldValue = "o6!M\DLE\1089465\19837\STX[\189720\993500\74187\191020[\1080325\r\144524\64614Y" + }, + RichField + { richFieldType = "\SOHo\RS\35961-(\1102197)f\ETB\995930S\1020981k", + richFieldValue = "NO#r\995433]\ETX4hX}\1040553\NUL\10166\SI\US\CAN\152188\&1\DLE\DC2I=y" + }, + RichField + { richFieldType = "8\50898\&8Mh<\" G[-W]\RS\DEL%\160175\1021098a\a3\NUL\169094\72791\SYN", + richFieldValue = "\993468\1041193_\SO\49981B^" + }, + RichField + { richFieldType = "Vx\SOH\24511{\1072255le^\FSp\1052403\97860\38253Z\177575\ENQ]}?\189892n\ETB", + richFieldValue = "\5244\983510C\SI:<\36686\&0nN\ba\21143\DC4c(m9)\ESC }>\"|\CANk`\f" + }, + RichField {richFieldType = "\39899\1019692", richFieldValue = "\1017708"} + ] } testObject_RichInfo_user_8 :: RichInfo testObject_RichInfo_user_8 = RichInfo { unRichInfo = - RichInfoAssocList - { unRichInfoAssocList = - [ RichField - { richFieldType = "\996744\1040115\147468k#3\rq\CAN", - richFieldValue = "Y\nz'\186344gm\172323ambJ\992129\v\"\aSo)oD\f\ETB" - }, - RichField - { richFieldType = - "yxP?wI\24757O\1351QO%\DC3\131814\ETBE\75036\1066295\155581:\1032172\1025380\b\STX\989849\SOH\11090\92397\"\12866", - richFieldValue = "H\DELqg\b\94447\23996S\EOT\176015\155222L\1084850" - }, - RichField - { richFieldType = "\\\78873n", - richFieldValue = "~\FS\v4\1079307zS\SO(2-Ud\1070675\v\fq\"z\STX" - } - ] - } + mkRichInfoAssocList + [ RichField + { richFieldType = "\996744\1040115\147468k#3\rq\CAN", + richFieldValue = "Y\nz'\186344gm\172323ambJ\992129\v\"\aSo)oD\f\ETB" + }, + RichField + { richFieldType = + "yxP?wI\24757O\1351QO%\DC3\131814\ETBE\75036\1066295\155581:\1032172\1025380\b\STX\989849\SOH\11090\92397\"\12866", + richFieldValue = "H\DELqg\b\94447\23996S\EOT\176015\155222L\1084850" + }, + RichField + { richFieldType = "\\\78873n", + richFieldValue = "~\FS\v4\1079307zS\SO(2-Ud\1070675\v\fq\"z\STX" + } + ] } testObject_RichInfo_user_9 :: RichInfo testObject_RichInfo_user_9 = RichInfo { unRichInfo = - RichInfoAssocList - { unRichInfoAssocList = - [ RichField - { richFieldType = "dG\DC42\51806>+\ENQJ\nxE", - richFieldValue = "b\GS\61321\1083098\a\96353\&5\ACKr;jN\22592\DC4\17664\ETX" - }, - RichField - { richFieldType = "^8OeZneC", - richFieldValue = "\SOD\a\989682\1042575H\19797\1094384\1062105Eh\995364G\DC2mp\30208" - }, - RichField - { richFieldType = "z\59319k\78088\132108s`AJ\8069=R\"AD\EM\ark_\175232\&1\au!\151517$", - richFieldValue = "&\171354:\SOH\\@\f\1086433\47766C\39740\&8*\1068287\\y<" - }, - RichField - { richFieldType = "\EMK9\DC4'`zu~\\\177586X+\DC1\136898\ETX\DLE*0\n\194804", - richFieldValue = "y" - }, - RichField - { richFieldType = "\172791?", - richFieldValue = "\93843\EM\STX\SOH\NAKT\994262\24112`\1103632\v" - }, - RichField - { richFieldType = "\DELEt\SIz)\DC1\NAK|mp\1108553\ACK\20179\997087\DC1v\164126\SOH\58965]\STX", - richFieldValue = "euR\EOT\133332KC\t\SUB\23119\140712\74009M\GS\ACKP0\1074111o\"j\60195" - }, - RichField - { richFieldType = "\STX\1068428)T\124990\"6", - richFieldValue = "\984541\163078bIB@\SYN\DC25\54902\FS\EM\ESCy\t\21520b" - }, - RichField - { richFieldType = "\ETX\58455\1012497B", - richFieldValue = "\ESCnd\NAK\ESC;Ch\49479d @\US\FS\1088714}17Hb=x\1103297\10289\ETB" - }, - RichField - { richFieldType = "!i", - richFieldValue = "-j\176648,\24865\SYN#\ACK\1066770G\1100549\DLE\15747\NUL" - }, - RichField - { richFieldType = - "\870\SI4\172785\rN*\RSuG\DEL\DC3\STXf\n\ESC\155932\ETX\DC4\1093311\83220\1003038W\1025832", - richFieldValue = "\ENQ3M\42564\1100947\fk\180860\CAN\129409b>e\STX X\63642KB\21649{1" - }, - RichField {richFieldType = "T\DLE\SI9\1050714\GSs\NAK\NAK", richFieldValue = ".\r\5027P\EMs\991431"}, - RichField - { richFieldType = - "\USE\t3\NAK$\1024518X\1073745\67685\21705\1060555\&4\ESC=QU\SYN%#\1073993%hT\EOT\1031319", - richFieldValue = "\RSZm3" - }, - RichField {richFieldType = "E\28759\SO", richFieldValue = "\1054689\EOT"}, - RichField - { richFieldType = "I\182277z\177877$\SIGf&>\DEL'\1064172}/Y\1061779?\1041416\71840\1036110\23841\SO\8255\\=\33718I\99375`~7" - }, - RichField - { richFieldType = "JL\1075555'\STXN\NULi\"8%`\ESCmBk74^\168234j\FS\181808\SUBG`ZW\FS", - richFieldValue = "+IkzzeG:&\b\EMl\NAK\60543" - }, - RichField - { richFieldType = "\1369\164654\&4:\148996t\59418\&9\59097\&7", - richFieldValue = "CS)\48559_\r" - } - ] - } + mkRichInfoAssocList + [ RichField + { richFieldType = "dG\DC42\51806>+\ENQJ\nxE", + richFieldValue = "b\GS\61321\1083098\a\96353\&5\ACKr;jN\22592\DC4\17664\ETX" + }, + RichField + { richFieldType = "^8OeZneC", + richFieldValue = "\SOD\a\989682\1042575H\19797\1094384\1062105Eh\995364G\DC2mp\30208" + }, + RichField + { richFieldType = "z\59319k\78088\132108s`AJ\8069=R\"AD\EM\ark_\175232\&1\au!\151517$", + richFieldValue = "&\171354:\SOH\\@\f\1086433\47766C\39740\&8*\1068287\\y<" + }, + RichField + { richFieldType = "\EMK9\DC4'`zu~\\\177586X+\DC1\136898\ETX\DLE*0\n\194804", + richFieldValue = "y" + }, + RichField + { richFieldType = "\172791?", + richFieldValue = "\93843\EM\STX\SOH\NAKT\994262\24112`\1103632\v" + }, + RichField + { richFieldType = "\DELEt\SIz)\DC1\NAK|mp\1108553\ACK\20179\997087\DC1v\164126\SOH\58965]\STX", + richFieldValue = "euR\EOT\133332KC\t\SUB\23119\140712\74009M\GS\ACKP0\1074111o\"j\60195" + }, + RichField + { richFieldType = "\STX\1068428)T\124990\"6", + richFieldValue = "\984541\163078bIB@\SYN\DC25\54902\FS\EM\ESCy\t\21520b" + }, + RichField + { richFieldType = "\ETX\58455\1012497B", + richFieldValue = "\ESCnd\NAK\ESC;Ch\49479d @\US\FS\1088714}17Hb=x\1103297\10289\ETB" + }, + RichField + { richFieldType = "!i", + richFieldValue = "-j\176648,\24865\SYN#\ACK\1066770G\1100549\DLE\15747\NUL" + }, + RichField + { richFieldType = + "\870\SI4\172785\rN*\RSuG\DEL\DC3\STXf\n\ESC\155932\ETX\DC4\1093311\83220\1003038W\1025832", + richFieldValue = "\ENQ3M\42564\1100947\fk\180860\CAN\129409b>e\STX X\63642KB\21649{1" + }, + RichField {richFieldType = "T\DLE\SI9\1050714\GSs\NAK\NAK", richFieldValue = ".\r\5027P\EMs\991431"}, + RichField + { richFieldType = + "\USE\t3\NAK$\1024518X\1073745\67685\21705\1060555\&4\ESC=QU\SYN%#\1073993%hT\EOT\1031319", + richFieldValue = "\RSZm3" + }, + RichField {richFieldType = "E\28759\SO", richFieldValue = "\1054689\EOT"}, + RichField + { richFieldType = "I\182277z\177877$\SIGf&>\DEL'\1064172}/Y\1061779?\1041416\71840\1036110\23841\SO\8255\\=\33718I\99375`~7" + }, + RichField + { richFieldType = "JL\1075555'\STXN\NULi\"8%`\ESCmBk74^\168234j\FS\181808\SUBG`ZW\FS", + richFieldValue = "+IkzzeG:&\b\EMl\NAK\60543" + }, + RichField + { richFieldType = "\1369\164654\&4:\148996t\59418\&9\59097\&7", + richFieldValue = "CS)\48559_\r" + } + ] } testObject_RichInfo_user_10 :: RichInfo testObject_RichInfo_user_10 = RichInfo { unRichInfo = - RichInfoAssocList - { unRichInfoAssocList = - [ RichField - { richFieldType = "\SOPX\1027633_f\rw,S6\DC1\nF\STXO\DC2\SUB+\ESC\166811\1104425\STX1\19418", - richFieldValue = "\33494aEIuIc\5245(p9p" - }, - RichField - { richFieldType = - "\40295\CAN 1\GSn\RS!X\SUB\153582\59295DXM\STXks\1095401\1081096\RS\1016479\SI\CAN|\NAKB", - richFieldValue = "@\NUL\20896!#}" - }, - RichField - { richFieldType = - "\1080518\132546\1104035r\1011309\NAK@\DC4Oh\EOT\60905\\\r\983916;E\1145\SUBgM3\DC3\188575\131886", - richFieldValue = "\CAN_\46754\64756{" - }, - RichField - { richFieldType = "N8]@W\1005031\1044578", - richFieldValue = "(}qXz\SYN\v\135879\185617A$*\1012653q\100033xz\tv@" - }, - RichField - { richFieldType = "\129176\1106421\1042142'~\1037209\1084768Lyj", - richFieldValue = "g8\1060434\ENQj]m\170801\SYN\SUB\STX\t\140983\&5" - }, - RichField - { richFieldType = "*<\1103682\FS\1024394\&4\1095255\163632UZ\20204Wv", - richFieldValue = "u)Cp\1007443u<@\ETXcs-J5\1041579'\ETX}0\DC2E\984152\US\52983.\r0\160508" - }, - RichField - { richFieldType = "]", - richFieldValue = "~}9\DLEZG\142993d\1054746h\172268\15548g\188284\&0)6\DC2=\181714\&3" - }, - RichField {richFieldType = "F\149516", richFieldValue = "LJY2?\1017439\FS\NAK\1005028\1045714\1002574"}, - RichField - { richFieldType = "\GS#\1075143\58503YAcS^", - richFieldValue = "\171511\&6qK+P\SI\EOTq\83131*C\1029137t\1070148\96495P\t\985260Z\r\1037341" - }, - RichField {richFieldType = ":ba", richFieldValue = ";"}, - RichField {richFieldType = "\v\DC1\DEL\FSr", richFieldValue = "/\DC3\1005753\f\26465o\STXk\1090533/>"}, - RichField - { richFieldType = "8;", - richFieldValue = "5\a\NAK\146167\STX\\\f\NAKG\992570\SUB\21373\ETB\48770Qj.\33305\113793u!D;\166930" - }, - RichField {richFieldType = "VnHyJ5zPsL\1036871\1010307\156099\1096637\ETX\n\30862" - }, - RichField - { richFieldType = "\RS\1083417\GS(\1025144=\USo($V9Cj*\GS>M\4403#\SYN/", - richFieldValue = "e\r\1000228\1007131NyA \4739b\1069467'\GS\1107548:" - }, - RichField - { richFieldType = - "B1>\ETB:\162105r\1031637\19430h\b\\dq\1061655K\146453\158772\DC3Y?\\ \995746\NUL\48071\1046242[\v#", - richFieldValue = "\SUB=\NULItaqMR\29680u\120358" - }, - RichField {richFieldType = "\4181", richFieldValue = "\1003269y\ENQ\1079409qU"}, - RichField - { richFieldType = "Yz\DC1C'1\1087781\43049\"U+i\\\1064196I\SUBw", - richFieldValue = "uz4\188775K\1009032\ETB\164781OI" - }, - RichField - { richFieldType = "p^\1036228f\DC2\1058801\1076288?h\1065533\1002307\SUB@\f\EM\1012893\936", - richFieldValue = "~\US\1037681\989399\SIFX[\917929\165326\154483L|`\1095268&" - }, - RichField {richFieldType = "\t\1097932f\986554hU\1028149Rdk3\ACKP\ENQAu2,D", richFieldValue = "7\98067"}, - RichField - { richFieldType = "Ud=\22968\1109413oJ:\1005775P\1064835", - richFieldValue = "U\ENQ\ETX\SUB\nz\b^\1083316!\r\1001089\1098359\t" - }, - RichField - { richFieldType = "\NAKSp\DC3U%t\41605S\ENQ$", - richFieldValue = ",j.\DC2r\SUB\ACK\"\SYN\1020624'2<\f\37077\99687=4" - }, - RichField {richFieldType = "\DC3Il4", richFieldValue = "\FS\DC39W\n:\999550\&13\62323\&0\ENQ,]2X\62000"}, - RichField - { richFieldType = "N\v1\132939\52614r\NUL\1110615\50555\1094310e\139052)u\990450\1022995\17425FF", - richFieldValue = "\1015477\8070G\NUL\US'xQ\DC1jc\83340\9630&\SUB)f\bM\1029846" - }, - RichField {richFieldType = "\DEL~\SIjHN^0\187078\132217\ENQ\174399\SYN;-8U", richFieldValue = "\30972"}, - RichField - { richFieldType = "3*\45297\FS`(u\184681\EMZ\179715=\RS", - richFieldValue = "K\1055335\993384q\984657li " - }, - RichField - { richFieldType = "]J\1112371O\SOud>8\ACK\tX9", - richFieldValue = - "\DC1\1079759\&6\185422\ACK\"\145409Z)\28995,W\ENQ=\1034030\1095464II\EOTL\136311@0\1012257\ETX\1015906W!" - }, - RichField - { richFieldType = "sk&6@t\1104003\&9\1067181\DC2\1070908\59777\1054421\ESC\DC3\985203\CAN'\SUB7a", - richFieldValue = "\94461\1049112rT\FS$R'|\GSBD2\174166\ETXA\182983\182818N\182682" - } - ] - } + mkRichInfoAssocList + [ RichField + { richFieldType = "\1014091\1093623.n[\"I\38788\1105100\31720\95800D\nk\40479Xl\SIKNV\DC3\66017\&6s", + richFieldValue = + "e\1084965PG@4\1015833\DC4A<\r{\1112398{V*\DC1\f\DEL\179428\DC2\CAN\1012291U+\31781" + }, + RichField + { richFieldType = "\181679\33025P\19610\&9/\t7\1061431!\FS5\20975M\98454\blB\fvr", + richFieldValue = + "\1071654\&07\1104094w,;7\a\1054443\SOH\1112898TAM\r`\DC1:\1031521\191112\101080F}\ESC\127986\EMf\1035128r" + }, + RichField + { richFieldType = "\ENQ`Ws\ESCG\SOH\\\\9lR8\37341$\b*\NUL. \SI\DC4", + richFieldValue = "y\1004237\1005188L[\DC1" + }, + RichField + { richFieldType = "mM#", + richFieldValue = "\136822\34377\1098535e\DC3+\990454[\ACK\1091108'\180365h\1017300" + }, + RichField + { richFieldType = "\STXKms_\147875\1013676\DLE\1065323\&0\1055030\fK=\\!'\DC1", + richFieldValue = "4%\SIGO\aJw,\152681Tg\US\1110016\RS5[\18050\EOT!\1050271G\1010373:\1000335N" + }, + RichField + { richFieldType = "T7a)3\EM\180358\r", + richFieldValue = + "\917Wn|(u\DC2:ua\137861\&7\1068934QCS\r>PsL\1036871\1010307\156099\1096637\ETX\n\30862" + }, + RichField + { richFieldType = "\RS\1083417\GS(\1025144=\USo($V9Cj*\GS>M\4403#\SYN/", + richFieldValue = "e\r\1000228\1007131NyA \4739b\1069467'\GS\1107548:" + }, + RichField + { richFieldType = + "B1>\ETB:\162105r\1031637\19430h\b\\dq\1061655K\146453\158772\DC3Y?\\ \995746\NUL\48071\1046242[\v#", + richFieldValue = "\SUB=\NULItaqMR\29680u\120358" + }, + RichField {richFieldType = "\4181", richFieldValue = "\1003269y\ENQ\1079409qU"}, + RichField + { richFieldType = "Yz\DC1C'1\1087781\43049\"U+i\\\1064196I\SUBw", + richFieldValue = "uz4\188775K\1009032\ETB\164781OI" + }, + RichField + { richFieldType = "p^\1036228f\DC2\1058801\1076288?h\1065533\1002307\SUB@\f\EM\1012893\936", + richFieldValue = "~\US\1037681\989399\SIFX[\917929\165326\154483L|`\1095268&" + }, + RichField {richFieldType = "\t\1097932f\986554hU\1028149Rdk3\ACKP\ENQAu2,D", richFieldValue = "7\98067"}, + RichField + { richFieldType = "Ud=\22968\1109413oJ:\1005775P\1064835", + richFieldValue = "U\ENQ\ETX\SUB\nz\b^\1083316!\r\1001089\1098359\t" + }, + RichField + { richFieldType = "\NAKSp\DC3U%t\41605S\ENQ$", + richFieldValue = ",j.\DC2r\SUB\ACK\"\SYN\1020624'2<\f\37077\99687=4" + }, + RichField {richFieldType = "\DC3Il4", richFieldValue = "\FS\DC39W\n:\999550\&13\62323\&0\ENQ,]2X\62000"}, + RichField + { richFieldType = "N\v1\132939\52614r\NUL\1110615\50555\1094310e\139052)u\990450\1022995\17425FF", + richFieldValue = "\1015477\8070G\NUL\US'xQ\DC1jc\83340\9630&\SUB)f\bM\1029846" + }, + RichField {richFieldType = "\DEL~\SIjHN^0\187078\132217\ENQ\174399\SYN;-8U", richFieldValue = "\30972"}, + RichField + { richFieldType = "3*\45297\FS`(u\184681\EMZ\179715=\RS", + richFieldValue = "K\1055335\993384q\984657li " + }, + RichField + { richFieldType = "]J\1112371O\SOud>8\ACK\tX9", + richFieldValue = + "\DC1\1079759\&6\185422\ACK\"\145409Z)\28995,W\ENQ=\1034030\1095464II\EOTL\136311@0\1012257\ETX\1015906W!" + }, + RichField + { richFieldType = "sk&6@t\1104003\&9\1067181\DC2\1070908\59777\1054421\ESC\DC3\985203\CAN'\SUB7a", + richFieldValue = "\94461\1049112rT\FS$R'|\GSBD2\174166\ETXA\182983\182818N\182682" + } + ] } testObject_RichInfo_user_15 :: RichInfo testObject_RichInfo_user_15 = RichInfo { unRichInfo = - RichInfoAssocList - { unRichInfoAssocList = - [ RichField - { richFieldType = "M\22765#\44551`C\1063368\SUB\1107863v@d\DC1\1091936\1018613QL'4>", - richFieldValue = "\\hON#Tb'\995992\49679wE" - }, - RichField - { richFieldType = "\187503,\1028350~\175782<,v\1004238\1067608", - richFieldValue = "\DLE\1081424?\5595\DC1" - }, - RichField - { richFieldType = "y\1022706B\14933", - richFieldValue = "<\1023925\RS-\n\GS'\1065221%z\DLE\SUB,\DLEtSpS\1873" - }, - RichField - { richFieldType = - ";t\SUBj\1025376F\DC3i\1043475\989585=\ACK`d\1051011\95787,D\171062\6190\GS\DEL\166764", - richFieldValue = - "\ETBsg\132399(Ji\134995\&4\59968L\25249\DLExG\33813\1110833!\EMIeo%sDJ\119361%\162905\&8" - }, - RichField - { richFieldType = "`\"\ENQ't\1043002\19452:\ENQ\29189F\DC4[KO%\168573\STX\ESC8\7536%s", - richFieldValue = "\1010742\EM_)\1021042\83239~W:\1037825u" - }, - RichField - { richFieldType = - "-W\EOTc\145999DP|\1049982\985494\ETX\ETX/\DLEKr\39316\\\DLE\190923|\6119\148147\SOH\b\1072322", - richFieldValue = " \ETB\t\fkR!\DLE" - }, - RichField - { richFieldType = "X^?U04\RS4\DC2w.{GyR\1037425i5\ACKu*\ENQ\DLE\54931f\US", - richFieldValue = "xbF\NUL\1045664V-Jd0\NAK>x_\153552\27674\nKz\STX!\ETX" - }, - RichField - { richFieldType = "2\1113191\99658P(9\22865\133057\ENQ)\FS\991058\30747\&4\1024412T\187968\&8yQvP;\r", - richFieldValue = "1\SUB;n\1013014\tl\26611\EM_-C\1014755Q6]}Y\1073009\EMzq" - }, - RichField - { richFieldType = - "'sB %\NUL\1037909d\58470i\10510\1014574\&9\25013'=\rC\182308\1092760\158838\127489\1071968*", - richFieldValue = "0v\156492\DC37\41322" - }, - RichField - { richFieldType = "!,dHU\97824\RS0usQt}\1093012\&5\96594{^\v", - richFieldValue = "\NAK&\1108383\\\\\vJ\EM\GS&tBvv>Rgq\152376ZlPy\\" - }, - RichField {richFieldType = "\EOT", richFieldValue = ">nSp\ESCq\DC2\r\SYNe\DC2SToL]iq\t>\1054318Y)"}, - RichField {richFieldType = "\ETBV\153348&\ACKN\1045624", richFieldValue = "p\1094345cX\ESC<\19181"}, - RichField - { richFieldType = - "\167658N\157255?%\b\1015267\46013\1082579?\DC1\1061799\189782)@\998920\1055016\SOH\EOT\1111749\24879\\&>`", - richFieldValue = "%X/\36896Bi\DEL%:\14950}g)c\1074443\ESC\USY9\1048060" - }, - RichField - { richFieldType = "91!\1008309@l\"\987793G\ETX\EOT{\1048654\1084773yaJ", - richFieldValue = ".3w4u,Y@\SOH\161059A\1039579\133439t\16191\"i\994375n\"%\1069886\28684\&2\1007817" - }, - RichField - { richFieldType = "\DC4b\aX\1038114\SUB\1007573", - richFieldValue = "V B\1060869$HHl\1022141\1094970\165064\1095191o\1036107,~\EOTp(E\173404\&6r2\RSC`" - }, - RichField - { richFieldType = - "a\v\1099093LsE\1034580\1057375GD'\1084459a\1000511\153844`G\EM]\EOT\GS`3i\SUB\99366\DELK", - richFieldValue = "\EOTRnwnF\1047075;5\nDK\70353KHT(\FSX" - }, - RichField - { richFieldType = "\147030\DEL\1101478\t\1001903Tu\1089835h3M8\1107128\1073609\&6\57804", - richFieldValue = "WoQ\ESCa\74567F\DLE\GSmH9\1056959k\1086972\1017942\1058932H" - }, - RichField - { richFieldType = "\1073266~!\1008925\1055373D\1094218\ENQ\166383\&2r", - richFieldValue = - "\177259\\R\DC1*A\1075870\&7/\SI\1021476\SUBiRI|\by\NAKe\1018825S\1052646OL'\1050007\58728\1067493*" - }, - RichField {richFieldType = "-\16392", richFieldValue = "\1092654\DC1H\1039884\ACK1>_'"}, - RichField - { richFieldType = "", - richFieldValue = "xL\SO\1018503(\ENQ\tY\DC4\NULF\1072796[\53750\tU`twpU\ETX7\1003036!w\7002" - }, - RichField - { richFieldType = "BP8i3\182727@[g\189023\&3\94681OHq\CAN7", - richFieldValue = "x&\33758\EOTiKb6t\1020639" - }, - RichField - { richFieldType = "D\NULq\157482|.\NUL\984337'\92184mkCiG\NAK:\a\vv's\999704\&0(\a\vV", - richFieldValue = "\US\39041=\b\DC1,E" - }, - RichField {richFieldType = "t\STX", richFieldValue = "\991125\&7n\173760\DC1\23641x"}, - RichField - { richFieldType = "Z\1072137\RS\1044160\FSq\NULE\US+\1109478B\"\\Y72t``", + richFieldValue = "%X/\36896Bi\DEL%:\14950}g)c\1074443\ESC\USY9\1048060" + }, + RichField + { richFieldType = "91!\1008309@l\"\987793G\ETX\EOT{\1048654\1084773yaJ", + richFieldValue = ".3w4u,Y@\SOH\161059A\1039579\133439t\16191\"i\994375n\"%\1069886\28684\&2\1007817" + }, + RichField + { richFieldType = "\DC4b\aX\1038114\SUB\1007573", + richFieldValue = "V B\1060869$HHl\1022141\1094970\165064\1095191o\1036107,~\EOTp(E\173404\&6r2\RSC`" + }, + RichField + { richFieldType = + "a\v\1099093LsE\1034580\1057375GD'\1084459a\1000511\153844`G\EM]\EOT\GS`3i\SUB\99366\DELK", + richFieldValue = "\EOTRnwnF\1047075;5\nDK\70353KHT(\FSX" + }, + RichField + { richFieldType = "\147030\DEL\1101478\t\1001903Tu\1089835h3M8\1107128\1073609\&6\57804", + richFieldValue = "WoQ\ESCa\74567F\DLE\GSmH9\1056959k\1086972\1017942\1058932H" + }, + RichField + { richFieldType = "\1073266~!\1008925\1055373D\1094218\ENQ\166383\&2r", + richFieldValue = + "\177259\\R\DC1*A\1075870\&7/\SI\1021476\SUBiRI|\by\NAKe\1018825S\1052646OL'\1050007\58728\1067493*" + }, + RichField {richFieldType = "-\16392", richFieldValue = "\1092654\DC1H\1039884\ACK1>_'"}, + RichField + { richFieldType = "", + richFieldValue = "xL\SO\1018503(\ENQ\tY\DC4\NULF\1072796[\53750\tU`twpU\ETX7\1003036!w\7002" + }, + RichField + { richFieldType = "BP8i3\182727@[g\189023\&3\94681OHq\CAN7", + richFieldValue = "x&\33758\EOTiKb6t\1020639" + }, + RichField + { richFieldType = "D\NULq\157482|.\NUL\984337'\92184mkCiG\NAK:\a\vv's\999704\&0(\a\vV", + richFieldValue = "\US\39041=\b\DC1,E" + }, + RichField {richFieldType = "t\STX", richFieldValue = "\991125\&7n\173760\DC1\23641x"}, + RichField + { richFieldType = "Z\1072137\RS\1044160\FSq\NULE\US+\1109478B\"\\Y72t`\1018049\DC2]uc\991321\f\1112290rG\1099982#R\48740\US", - richFieldValue = "\1087955\FS\136741t" - }, - RichField - { richFieldType = - "{0J;\67715ul\63242C*\995153\SUB.>YK\DC4@Ul\120572;Om\60727\1098276,\137724U\1008404", - richFieldValue = "\51050\SO\ETX\5115t\1086970\SUB\SO8'=" - }, - RichField {richFieldType = "l", richFieldValue = "\66293\1029785\62768&\ETB\177091"}, - RichField {richFieldType = "\v", richFieldValue = "\1071316 \185590\&9\29560\NUL\22699\1028840Q$"} - ] - } + mkRichInfoAssocList + [ RichField + { richFieldType = + "\1054470\&5t?\EOT\1053854#*c\1091846\EOT}\1038823\1044110u\1006349 i \48467x\1096767} ;\bp9;", + richFieldValue = "\EMVIp\181302IDO~%6vK\EML\1079134\GSj\\" + }, + RichField + { richFieldType = "\DC1D&)5EOo\DC1\EM\rYArK`w^qG\50491\ETX\US@\179685\STX\SI2\v\SOH", + richFieldValue = "d\917840D\EOT\167848w_\1036766\47041\1009030P5\b\177667JTw\vv;\SO`v^{\DEL1\ETXH" + }, + RichField + { richFieldType = "}w*dioz%w\1064804zJ\142392)\1018264Yr2L\SUBAQQ.rsH/", + richFieldValue = "\t\\\998353\180134\51421r`\140532-a%\v" + }, + RichField + { richFieldType = "O\DC3\DC2\v\1046476sFHe\4676G'Z[k\1075454\r?\1054610", + richFieldValue = "6)(%\EMU\1019343\EM0(E4Y%\1020801\EOTi\152951\DC2\148950}/|" + }, + RichField + { richFieldType = + "\15075u\1015306\NULNbb\989204\EMdJO\"w\v\1054768\145723\50491\&4#\EM1T\RSj\1020307\191099\41818\DC4", + richFieldValue = "D\1067141," + }, + RichField + { richFieldType = "/{t\189366*\98392/QO\1107750u\DC4\DLE[\SI\DEL44J\STX", + richFieldValue = "\17533>\r\fZR\FSp\148269\1043328" + }, + RichField + { richFieldType = "Q\145717d\DC1\aj\SOHz\142682\ETBx%dC\ngaY\SYN\172017\34647", + richFieldValue = "K{8\156875$I8Y%\1038236\54891\991952\1019539]\"rp\US\ACKK\USu\DC3\1017206" + }, + RichField + { richFieldType = "\FSk\48451\SI\1106066\1110636P\1087784\1092086@h\1070850{", + richFieldValue = "\179436L\32074;\NAK\1105345\&4%\NUL2\ACK,wg'\58725\1074593]\STX" + }, + RichField {richFieldType = "\DC2", richFieldValue = "\SOwC\US\SIQ\EOT\1030459\SO0\ETX,\CAN=\ENQ\DELPj"}, + RichField + { richFieldType = "Y@\r?\83020!b,:,\1091216]DY\161662\155283\58191\ENQ9\NULm(aQ)", + richFieldValue = "((\1100937\STX\DC3\26702\ETXX\987003(*A@1?\137411\&7" + }, + RichField + { richFieldType = "pd6\EM\53969Y\1032073\&8\30883vY\1039206\917942\1055059\"u\DLE", + richFieldValue = + "* \US\1025699)\US\1029686\b\EOT(\1103647\61832*\53415\SUB(\f)S`\NULG\1104420&\1014109\172081" + }, + RichField {richFieldType = "\v\US\65149\83292z\1079256\65560\SOH", richFieldValue = "PA"}, + RichField + { richFieldType = + "\ESC\SOH(\142886M\1049171\NAK>\1018049\DC2]uc\991321\f\1112290rG\1099982#R\48740\US", + richFieldValue = "\1087955\FS\136741t" + }, + RichField + { richFieldType = + "{0J;\67715ul\63242C*\995153\SUB.>YK\DC4@Ul\120572;Om\60727\1098276,\137724U\1008404", + richFieldValue = "\51050\SO\ETX\5115t\1086970\SUB\SO8'=" + }, + RichField {richFieldType = "l", richFieldValue = "\66293\1029785\62768&\ETB\177091"}, + RichField {richFieldType = "\v", richFieldValue = "\1071316 \185590\&9\29560\NUL\22699\1028840Q$"} + ] } diff --git a/libs/wire-api/test/unit/Test/Wire/API/User/RichInfo.hs b/libs/wire-api/test/unit/Test/Wire/API/User/RichInfo.hs index 42420bb0939..a8c2e78842f 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/User/RichInfo.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/User/RichInfo.hs @@ -23,11 +23,12 @@ module Test.Wire.API.User.RichInfo where import Data.Aeson import Data.Aeson.QQ import Data.Aeson.Types as Aeson -import qualified Data.Map as Map import Imports +import Test.QuickCheck import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck +import qualified Web.Scim.Schema.Common as Scim import Wire.API.User.RichInfo tests :: TestTree @@ -41,16 +42,16 @@ testRichInfo = "RichInfoMapAndList to RichInfoAssocList" [ check "map comes in alpha order, at the end of the assoc list" - (RichInfoMapAndList (Map.fromList [("c", "3"), ("a", "1")]) [RichField "b" "2"]) - (RichInfoAssocList [RichField "b" "2", RichField "a" "1", RichField "c" "3"]), + (mkRichInfoMapAndList [RichField "b" "2", RichField "c" "3", RichField "a" "1"]) + (mkRichInfoAssocList [RichField "b" "2", RichField "c" "3", RichField "a" "1"]), check "map overwrites assoc list" - (RichInfoMapAndList (Map.singleton "a" "b") [RichField "a" "c"]) - (RichInfoAssocList [RichField "a" "b"]), + (mkRichInfoMapAndList [RichField "a" "c"]) + (mkRichInfoAssocList [RichField "a" "c"]), check "treats RichField keys case-insensitively" - (RichInfoMapAndList (Map.singleton "a" "b") [RichField "A" "c", RichField "B" "b"]) - (RichInfoAssocList [RichField "a" "b", RichField "B" "b"]) + (mkRichInfoMapAndList [RichField "A" "c", RichField "B" "b"]) + (mkRichInfoAssocList [RichField "a" "c", RichField "b" "b"]) ], testProperty "RichInfoAssocList <-> RichInfoMapAndList roundtrip" $ \riAssocList -> do toRichInfoAssocList (fromRichInfoAssocList riAssocList) === riAssocList, @@ -70,7 +71,7 @@ testRichInfo = } } }|] - assertEqual "RichInfoMapAndList" (Aeson.Success $ RichInfoMapAndList mempty mempty) $ fromJSON inputJSON, + assertEqual "RichInfoMapAndList" (Aeson.Success $ mkRichInfoMapAndList mempty) $ fromJSON inputJSON, testCase "Old RichInfoMapAndList" $ do let inputJSON = [aesonQQ|{ @@ -81,7 +82,7 @@ testRichInfo = } } }|] - assertEqual "RichInfoMapAndList" (Aeson.Success $ RichInfoMapAndList mempty [RichField "foo" "bar"]) $ fromJSON inputJSON, + assertEqual "RichInfoMapAndList" (Aeson.Success $ mkRichInfoMapAndList [RichField "foo" "bar"]) $ fromJSON inputJSON, testCase "case insensitive 'richinfo'" $ do let inputJSON = [aesonQQ|{ @@ -92,7 +93,7 @@ testRichInfo = } } }|] - assertEqual "RichInfoMapAndList" (Aeson.Success $ RichInfoMapAndList mempty [RichField "foo" "bar"]) $ fromJSON inputJSON, + assertEqual "RichInfoMapAndList" (Aeson.Success $ mkRichInfoMapAndList [RichField "foo" "bar"]) $ fromJSON inputJSON, testCase "RichInfoMapAndList as only assoc list" $ do let inputJSON = [aesonQQ|{ @@ -100,7 +101,7 @@ testRichInfo = "richinfo": [{"type": "foo", "value": "bar"}] } }|] - assertEqual "RichInfoMapAndList" (Aeson.Success $ RichInfoMapAndList mempty [RichField "foo" "bar"]) $ fromJSON inputJSON, + assertEqual "RichInfoMapAndList" (Aeson.Success $ mkRichInfoMapAndList [RichField "foo" "bar"]) $ fromJSON inputJSON, testCase "RichInfoMapAndList Map" $ do let inputJSON = [aesonQQ|{ @@ -114,15 +115,14 @@ testRichInfo = } } }|] - assertEqual "RichInfoMapAndList" (Aeson.Success $ RichInfoMapAndList (Map.singleton "bar" "baz") [RichField "foo" "bar"]) $ fromJSON inputJSON, + assertEqual "RichInfoMapAndList" (Aeson.Success $ mkRichInfoMapAndList [RichField "foo" "bar", RichField "bar" "baz"]) $ fromJSON inputJSON, testCase "Without Old RichInfoMapAndList" $ do let inputJSON = [aesonQQ|{ "urn:ietf:params:scim:schemas:extension:wire:1.0:User" : { - "bar": "baz" } }|] - assertEqual "RichInfoMapAndList" (Aeson.Success $ RichInfoMapAndList (Map.singleton "bar" "baz") []) $ fromJSON inputJSON, + assertEqual "RichInfoMapAndList" (Aeson.Success $ mkRichInfoMapAndList []) $ fromJSON inputJSON, testCase "wrong version" $ do let inputJSON = [aesonQQ|{ @@ -147,6 +147,27 @@ testRichInfo = } } }|] - assertEqual "RichInfoMapAndList" (Aeson.Success $ RichInfoMapAndList mempty [RichField "foo" "bar"]) $ fromJSON inputJSON + assertEqual "RichInfoMapAndList" (Aeson.Success $ mkRichInfoMapAndList [RichField "foo" "bar"]) $ fromJSON inputJSON ] ] + <> moreRichInfoNormalizationTests + +moreRichInfoNormalizationTests :: [TestTree] +moreRichInfoNormalizationTests = + [ testGroup + "'toRichInfoAssocList', 'fromRichInfoAssocList'" + [ testCase "works (counter-example of earlier bug)" $ do + let x = mkRichInfoMapAndList [RichField "A" "b", RichField "a" "x"] + y = (fromRichInfoAssocList . toRichInfoAssocList) x + assertEqual mempty (toRichInfoAssocList x) (toRichInfoAssocList y), + testProperty "works (property)" $ \(someAssocs :: RichInfoAssocList) -> + (jsonroundtrip someAssocs) === someAssocs + .&&. (toRichInfoAssocList . fromRichInfoAssocList $ someAssocs) === someAssocs + .&&. (toRichInfoAssocList . jsonroundtrip . fromRichInfoAssocList $ someAssocs) === someAssocs + ] + ] + where + jsonroundtrip :: forall a. (ToJSON a, FromJSON a) => a -> a + jsonroundtrip = unsafeParse . Scim.jsonLower . Aeson.toJSON + where + unsafeParse = either (error . show) id . Aeson.parseEither Aeson.parseJSON diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 3e06a63f39a..104753d4209 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: db0e289b12b344457a40dfe813de29c63bb9e236a45c4407a0f521833fd8cdbe +-- hash: ec0f1e0e3e31d5771b93db6b6ee37ad444f98c3213696e98bbedbb4b1bb56c8c name: wire-api version: 0.1.0 @@ -436,10 +436,12 @@ test-suite wire-api-tests , base , bytestring , bytestring-conversion + , case-insensitive , cassava , containers >=0.5 , currency-codes , directory + , hscim , imports , iso3166-country-codes , iso639 diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 28e5dd8807e..03b736de31c 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -556,18 +556,18 @@ updateRichInfoH (uid ::: _ ::: req) = do updateRichInfo :: UserId -> RichInfoUpdate -> Handler () updateRichInfo uid rup = do - let RichInfoAssocList richInfo = normalizeRichInfoAssocList . riuRichInfo $ rup + let (unRichInfoAssocList -> richInfo) = normalizeRichInfoAssocList . riuRichInfo $ rup maxSize <- setRichInfoLimit <$> view settings - when (richInfoSize (RichInfo (RichInfoAssocList richInfo)) > maxSize) $ throwStd tooLargeRichInfo + when (richInfoSize (RichInfo (mkRichInfoAssocList richInfo)) > maxSize) $ throwStd tooLargeRichInfo -- FUTUREWORK: send an event -- Intra.onUserEvent uid (Just conn) (richInfoUpdate uid ri) - lift $ Data.updateRichInfo uid (RichInfoAssocList richInfo) + lift $ Data.updateRichInfo uid (mkRichInfoAssocList richInfo) getRichInfoH :: UserId -> Handler Response getRichInfoH uid = json <$> getRichInfo uid getRichInfo :: UserId -> Handler RichInfo -getRichInfo uid = RichInfo . fromMaybe emptyRichInfoAssocList <$> lift (API.lookupRichInfo uid) +getRichInfo uid = RichInfo . fromMaybe mempty <$> lift (API.lookupRichInfo uid) getRichInfoMultiH :: List UserId -> Handler Response getRichInfoMultiH uids = json <$> getRichInfoMulti (List.fromList uids) diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index c3f5b129e22..7d607552c0b 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -814,7 +814,7 @@ getRichInfo self user = do (Just t1, Just t2) | t1 == t2 -> pure () _ -> throwStd insufficientTeamPermissions -- Query rich info - fromMaybe Public.emptyRichInfoAssocList <$> lift (API.lookupRichInfo user) + fromMaybe mempty <$> lift (API.lookupRichInfo user) getClientPrekeys :: UserId -> ClientId -> Handler [Public.PrekeyId] getClientPrekeys usr clt = lift (API.lookupPrekeyIds usr clt) diff --git a/services/brig/test/integration/API/User/RichInfo.hs b/services/brig/test/integration/API/User/RichInfo.hs index d2facf6849e..b00993d2058 100644 --- a/services/brig/test/integration/API/User/RichInfo.hs +++ b/services/brig/test/integration/API/User/RichInfo.hs @@ -45,7 +45,7 @@ tests _cl _at conf p b _c g = [ test p "there is default empty rich info" $ testDefaultRichInfo b g, test p "missing fields in an update are deleted" $ testDeleteMissingFieldsInUpdates b g, test p "fields with empty strings are deleted" $ testDeleteEmptyFields b g, - test p "duplicate field names are forbidden" $ testForbidDuplicateFieldNames b, + test p "duplicate field names are silently nubbed (first entry wins)" $ testDedupeDuplicateFieldNames b, test p "exceeding rich info size limit is forbidden" $ testRichInfoSizeLimit b conf, test p "non-team members don't have rich info" $ testNonTeamMembersDoNotHaveRichInfo b, test p "non-members / other membes / guests cannot see rich info" $ testGuestsCannotSeeRichInfo b @@ -63,7 +63,7 @@ testDefaultRichInfo brig galley = do liftIO $ assertEqual "rich info is not empty, or not present" - (Right (RichInfoAssocList mempty)) + (Right (mkRichInfoAssocList mempty)) richInfo testDeleteMissingFieldsInUpdates :: Brig -> Galley -> Http () @@ -72,12 +72,12 @@ testDeleteMissingFieldsInUpdates brig galley = do member1 <- userId <$> createTeamMember brig galley owner tid Team.noPermissions member2 <- userId <$> createTeamMember brig galley owner tid Team.noPermissions let superset = - RichInfoAssocList + mkRichInfoAssocList [ RichField "department" "blue", RichField "relevance" "meh" ] subset = - RichInfoAssocList + mkRichInfoAssocList [ RichField "relevance" "meh" ] putRichInfo brig member2 superset !!! const 200 === statusCode @@ -91,33 +91,39 @@ testDeleteEmptyFields brig galley = do member1 <- userId <$> createTeamMember brig galley owner tid Team.noPermissions member2 <- userId <$> createTeamMember brig galley owner tid Team.noPermissions let withEmpty = - RichInfoAssocList + mkRichInfoAssocList [ RichField "department" "" ] putRichInfo brig member2 withEmpty !!! const 200 === statusCode withoutEmpty <- getRichInfo brig member1 member2 - liftIO $ assertEqual "dangling rich info fields" (Right emptyRichInfoAssocList) withoutEmpty + liftIO $ assertEqual "dangling rich info fields" (Right mempty) withoutEmpty -testForbidDuplicateFieldNames :: Brig -> Http () -testForbidDuplicateFieldNames brig = do +testDedupeDuplicateFieldNames :: Brig -> Http () +testDedupeDuplicateFieldNames brig = do (owner, _) <- createUserWithTeam brig - let bad = - RichInfoAssocList - [ RichField "department" "blue", - RichField "department" "green" + let dupes = + mkRichInfoAssocList + [ RichField "dePartment" "blue", + RichField "Department" "green" + ] + deduped = + mkRichInfoAssocList + [ RichField "departMent" "blue" ] - putRichInfo brig owner bad !!! const 400 === statusCode + putRichInfo brig owner dupes !!! const 200 === statusCode + ri <- getRichInfo brig owner owner + liftIO $ assertEqual "duplicate rich info fields" (Right deduped) ri testRichInfoSizeLimit :: HasCallStack => Brig -> Opt.Opts -> Http () testRichInfoSizeLimit brig conf = do let maxSize :: Int = setRichInfoLimit $ optSettings conf (owner, _) <- createUserWithTeam brig let bad1 = - RichInfoAssocList + mkRichInfoAssocList [ RichField "department" (Text.replicate (fromIntegral maxSize) "#") ] bad2 = - RichInfoAssocList $ + mkRichInfoAssocList $ [0 .. ((maxSize `div` 2))] <&> \i -> RichField (CI.mk $ Text.pack $ show i) "#" putRichInfo brig owner bad1 !!! const 413 === statusCode diff --git a/services/spar/src/Spar/Scim/Types.hs b/services/spar/src/Spar/Scim/Types.hs index ae02076998d..78d21665256 100644 --- a/services/spar/src/Spar/Scim/Types.hs +++ b/services/spar/src/Spar/Scim/Types.hs @@ -41,7 +41,12 @@ module Spar.Scim.Types where import Brig.Types.Intra (AccountStatus (..)) +import Control.Lens (view) import Imports +import qualified Web.Scim.Schema.Common as Scim +import qualified Web.Scim.Schema.User as Scim.User +import Wire.API.User.RichInfo (RichInfo (..), normalizeRichInfoAssocList) +import Wire.API.User.Scim (ScimUserExtra (..), SparTag, sueRichInfo) -- TODO: move these somewhere else? scimActiveFlagFromAccountStatus :: AccountStatus -> Bool @@ -78,3 +83,17 @@ scimActiveFlagToAccountStatus oldstatus = \case Deleted -> Deleted -- this shouldn't happen, but it's harmless if it does. Ephemeral -> Ephemeral PendingInvitation -> PendingInvitation -- (do not activate: see 'scimActiveFlagFromAccountStatus') + +normalizeLikeStored :: Scim.User.User SparTag -> Scim.User.User SparTag +normalizeLikeStored usr = + usr + { Scim.User.extra = tweakExtra $ Scim.User.extra usr, + Scim.User.active = tweakActive $ Scim.User.active usr, + Scim.User.phoneNumbers = [] + } + where + tweakExtra :: ScimUserExtra -> ScimUserExtra + tweakExtra = ScimUserExtra . RichInfo . normalizeRichInfoAssocList . unRichInfo . view sueRichInfo + + tweakActive :: Maybe Scim.ScimBool -> Maybe Scim.ScimBool + tweakActive = fmap Scim.ScimBool . maybe (Just True) Just . fmap Scim.unScimBool diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 2d1d922d8c4..bd245409b9f 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -68,6 +68,7 @@ import qualified SAML2.WebSSO as SAML import Spar.App (GetUserResult (..), Spar, getUserIdByScimExternalId, getUserIdByUref, liftSem, sparCtxOpts, validateEmailIfExists, wrapMonadClientSem) import qualified Spar.Intra.BrigApp as Brig import Spar.Scim.Auth () +import Spar.Scim.Types (normalizeLikeStored) import qualified Spar.Scim.Types as ST import Spar.Sem.BrigAccess as BrigAccess import Spar.Sem.GalleyAccess (GalleyAccess) @@ -782,7 +783,7 @@ synthesizeStoredUser' uid veid dname handle richInfo accStatus createdAt lastUpd ST._vsuActive = ST.scimActiveFlagFromAccountStatus accStatus } - pure $ toScimStoredUser' createdAt lastUpdatedAt baseuri uid scimUser + pure $ toScimStoredUser' createdAt lastUpdatedAt baseuri uid (normalizeLikeStored scimUser) synthesizeScimUser :: ST.ValidScimUser -> Scim.User ST.SparTag synthesizeScimUser info = diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index fa424629192..4f89898b79d 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -62,6 +62,7 @@ import qualified SAML2.WebSSO.Test.MockResponse as SAML import Spar.App (liftSem) import qualified Spar.Intra.BrigApp as Intra import Spar.Scim +import Spar.Scim.Types (normalizeLikeStored) import qualified Spar.Scim.User as SU import qualified Spar.Sem.BrigAccess as BrigAccess import qualified Spar.Sem.SAMLUserStore as SAMLUserStore @@ -555,10 +556,10 @@ testLocation = do testRichInfo :: TestSpar () testRichInfo = do - let richInfo = RichInfo (RichInfoAssocList [RichField "Platforms" "OpenBSD; Plan9"]) - richInfoOverwritten = RichInfo (RichInfoAssocList [RichField "Platforms" "Windows10"]) - richInfoPatchedMap = RichInfo (RichInfoAssocList [RichField "Platforms" "Arch, BTW"]) - richInfoPatchedList = RichInfo (RichInfoAssocList [RichField "Platforms" "none"]) + let richInfo = RichInfo (mkRichInfoAssocList [RichField "Platforms" "OpenBSD; Plan9"]) + richInfoOverwritten = RichInfo (mkRichInfoAssocList [RichField "Platforms" "Windows10"]) + richInfoPatchedMap = RichInfo (mkRichInfoAssocList [RichField "Platforms" "Arch, BTW"]) + richInfoPatchedList = RichInfo (mkRichInfoAssocList [RichField "Platforms" "none"]) (Aeson.Success patchOpMap) = fromJSON [aesonQQ|{ @@ -807,8 +808,9 @@ testFindProvisionedUser = do user <- randomScimUser (tok, (_, _, _)) <- registerIdPAndScimToken storedUser <- createUser tok user - users <- listUsers tok (Just (filterBy "userName" (Scim.User.userName user))) - liftIO $ users `shouldBe` [storedUser] + [storedUser'] <- listUsers tok (Just (filterBy "userName" (Scim.User.userName user))) + liftIO $ storedUser' `shouldBe` storedUser + liftIO $ Scim.value (Scim.thing storedUser') `shouldBe` normalizeLikeStored user {Scim.User.emails = [] {- only after validation -}} let Just externalId = Scim.User.externalId user users' <- listUsers tok (Just (filterBy "externalId" externalId)) liftIO $ users' `shouldBe` [storedUser] diff --git a/services/spar/test-integration/Util/Scim.hs b/services/spar/test-integration/Util/Scim.hs index 4f332e98855..854ba7dd4fa 100644 --- a/services/spar/test-integration/Util/Scim.hs +++ b/services/spar/test-integration/Util/Scim.hs @@ -116,7 +116,7 @@ randomScimUserWithSubjectAndRichInfo :: RichInfo -> m (Scim.User.User SparTag, SAML.UnqualifiedNameID) randomScimUserWithSubjectAndRichInfo richInfo = do - suffix <- cs <$> replicateM 7 (getRandomR ('0', '9')) + suffix <- cs <$> replicateM 20 (getRandomR ('a', 'z')) emails <- getRandomR (0, 3) >>= \n -> replicateM n randomScimEmail phones <- getRandomR (0, 3) >>= \n -> replicateM n randomScimPhone -- Related, but non-trivial to re-use here: 'nextSubject' diff --git a/services/spar/test/Test/Spar/ScimSpec.hs b/services/spar/test/Test/Spar/ScimSpec.hs index 6725aa00754..3eddfe3d129 100644 --- a/services/spar/test/Test/Spar/ScimSpec.hs +++ b/services/spar/test/Test/Spar/ScimSpec.hs @@ -9,7 +9,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -{-# OPTIONS_GHC -Wno-orphans #-} -- This file is part of the Wire Server implementation. -- @@ -30,8 +29,8 @@ module Test.Spar.ScimSpec where -import Brig.Types.Test.Arbitrary -import Data.Aeson (eitherDecode', encode, parseJSON) +import Control.Lens (view) +import Data.Aeson import Data.Aeson.QQ (aesonQQ) import qualified Data.Aeson.Types as Aeson import Data.Id @@ -41,6 +40,7 @@ import Imports import Network.URI (parseURI) import qualified SAML2.WebSSO as SAML import Spar.Scim +import Spar.Scim.Types (normalizeLikeStored) import Test.Hspec import Test.QuickCheck import URI.ByteString @@ -50,9 +50,8 @@ import qualified Web.Scim.Schema.Common as Scim import qualified Web.Scim.Schema.Meta as Scim import Web.Scim.Schema.PatchOp (Op (Remove), Operation (..), PatchOp (..), Path (NormalPath), applyOperation) import qualified Web.Scim.Schema.ResourceType as ScimR -import Web.Scim.Schema.Schema (Schema (CustomSchema)) -import qualified Web.Scim.Schema.Schema as Scim -import qualified Web.Scim.Schema.User as Scim +import Web.Scim.Schema.Schema as Scim +import Web.Scim.Schema.User as Scim import qualified Web.Scim.Schema.User.Name as ScimN import Wire.API.User.RichInfo @@ -123,6 +122,7 @@ spec = describe "toScimStoredUser'" $ do it "roundtrips" . property $ do \(sue :: ScimUserExtra) -> eitherDecode' (encode sue) `shouldBe` Right sue + describe "ScimUserExtra" $ do describe "Patchable" $ do it "can add to rich info map" $ do @@ -137,7 +137,7 @@ spec = describe "toScimStoredUser'" $ do }|] let (Aeson.Success (PatchOp [operation])) = Aeson.parse (parseJSON @(PatchOp SparTag)) operationJSON applyOperation (ScimUserExtra mempty) operation - `shouldBe` (Right (ScimUserExtra (RichInfo (RichInfoAssocList [RichField "newAttr" "newValue"])))) + `shouldBe` (Right (ScimUserExtra (RichInfo (mkRichInfoAssocList [RichField "newAttr" "newValue"])))) it "can replace in rich info map" $ do let operationJSON = [aesonQQ|{ @@ -149,8 +149,8 @@ spec = describe "toScimStoredUser'" $ do }] }|] let (Aeson.Success (PatchOp [operation])) = Aeson.parse (parseJSON @(PatchOp SparTag)) operationJSON - applyOperation (ScimUserExtra (RichInfo (RichInfoAssocList [RichField "oldAttr" "oldValue"]))) operation - `shouldBe` (Right (ScimUserExtra (RichInfo (RichInfoAssocList [RichField "oldAttr" "newValue"])))) + applyOperation (ScimUserExtra (RichInfo (mkRichInfoAssocList [RichField "oldAttr" "oldValue"]))) operation + `shouldBe` (Right (ScimUserExtra (RichInfo (mkRichInfoAssocList [RichField "oldAttr" "newValue"])))) it "treats rich info map case insensitively" $ do let operationJSON = [aesonQQ|{ @@ -162,8 +162,8 @@ spec = describe "toScimStoredUser'" $ do }] }|] let (Aeson.Success (PatchOp [operation])) = Aeson.parse (parseJSON @(PatchOp SparTag)) operationJSON - applyOperation (ScimUserExtra (RichInfo (RichInfoAssocList [RichField "oldAttr" "oldValue"]))) operation - `shouldBe` (Right (ScimUserExtra (RichInfo (RichInfoAssocList [RichField "oldAttr" "newValue"])))) + applyOperation (ScimUserExtra (RichInfo (mkRichInfoAssocList [RichField "oldAttr" "oldValue"]))) operation + `shouldBe` (Right (ScimUserExtra (RichInfo (mkRichInfoAssocList [RichField "oldAttr" "newValue"])))) it "can remove from rich info map" $ do let operationJSON = [aesonQQ|{ @@ -174,7 +174,7 @@ spec = describe "toScimStoredUser'" $ do }] }|] let (Aeson.Success (PatchOp [operation])) = Aeson.parse (parseJSON @(PatchOp SparTag)) operationJSON - applyOperation (ScimUserExtra (RichInfo (RichInfoAssocList [RichField "oldAttr" "oldValue"]))) operation + applyOperation (ScimUserExtra (RichInfo (mkRichInfoAssocList [RichField "oldAttr" "oldValue"]))) operation `shouldBe` (Right (ScimUserExtra mempty)) it "adds new fields to rich info assoc list at the end" $ do let operationJSON = @@ -187,8 +187,8 @@ spec = describe "toScimStoredUser'" $ do }] }|] let (Aeson.Success (PatchOp [operation])) = Aeson.parse (parseJSON @(PatchOp SparTag)) operationJSON - applyOperation (ScimUserExtra (RichInfo (RichInfoAssocList [RichField "oldAttr" "oldValue"]))) operation - `shouldBe` (Right (ScimUserExtra (RichInfo (RichInfoAssocList [RichField "oldAttr" "oldValue", RichField "newAttr" "newValue"])))) + applyOperation (ScimUserExtra (RichInfo (mkRichInfoAssocList [RichField "oldAttr" "oldValue"]))) operation + `shouldBe` (Right (ScimUserExtra (RichInfo (mkRichInfoAssocList [RichField "oldAttr" "oldValue", RichField "newAttr" "newValue"])))) it "can replace in rich info assoc list while maintaining order" $ do let operationJSON = [aesonQQ|{ @@ -210,8 +210,8 @@ spec = describe "toScimStoredUser'" $ do RichField "secondAttr" "newSecondVal", RichField "thirdAttr" "thirdVal" ] - applyOperation (ScimUserExtra (RichInfo (RichInfoAssocList origAssocList))) operation - `shouldBe` (Right (ScimUserExtra (RichInfo (RichInfoAssocList expectedAssocList)))) + applyOperation (ScimUserExtra (RichInfo (mkRichInfoAssocList origAssocList))) operation + `shouldBe` (Right (ScimUserExtra (RichInfo (mkRichInfoAssocList expectedAssocList)))) it "can remove from rich info assoc list" $ do let operationJSON = [aesonQQ|{ @@ -222,13 +222,13 @@ spec = describe "toScimStoredUser'" $ do }] }|] let (Aeson.Success (PatchOp [operation])) = Aeson.parse (parseJSON @(PatchOp SparTag)) operationJSON - applyOperation (ScimUserExtra (RichInfo (RichInfoAssocList [RichField "oldAttr" "oldValue"]))) operation + applyOperation (ScimUserExtra (RichInfo (mkRichInfoAssocList [RichField "oldAttr" "oldValue"]))) operation `shouldBe` (Right (ScimUserExtra mempty)) it "throws error if asked to patch an recognized schema" $ do let schema = Just (CustomSchema "wrong-schema") path = Just (NormalPath (AttrPath schema "oldAttr" Nothing)) operation = Operation Remove path Nothing - isLeft (applyOperation (ScimUserExtra (RichInfo (RichInfoAssocList [RichField "oldAttr" "oldValue"]))) operation) + isLeft (applyOperation (ScimUserExtra (RichInfo (mkRichInfoAssocList [RichField "oldAttr" "oldValue"]))) operation) `shouldBe` True it "treats rich info assoc list case insensitively" $ do let operationJSON = @@ -251,8 +251,22 @@ spec = describe "toScimStoredUser'" $ do RichField "secondAttr" "newSecondVal", RichField "thirdAttr" "thirdVal" ] - applyOperation (ScimUserExtra (RichInfo (RichInfoAssocList origAssocList))) operation - `shouldBe` (Right (ScimUserExtra (RichInfo (RichInfoAssocList expectedAssocList)))) + applyOperation (ScimUserExtra (RichInfo (mkRichInfoAssocList origAssocList))) operation + `shouldBe` (Right (ScimUserExtra (RichInfo (mkRichInfoAssocList expectedAssocList)))) + + describe "normalization" $ do + let usr :: User SparTag + usr = User {schemas = [PatchOp20, CustomSchema "asdf", ResourceType20, CustomSchema "", CustomSchema "", Group20, ServiceProviderConfig20], userName = ">/nP6S3|)RBmeJ/'PqYzRr\96446F\42072HS_izq", externalId = Just "nZ\179219)DZ\13375\\v", name = Nothing, displayName = Just "`b++0RD Ty~ z/S`Z\\\"bDE-\13666\&32>%<\189311", nickName = Nothing, profileUrl = Nothing, title = Nothing, userType = Nothing, preferredLanguage = Nothing, locale = Nothing, active = Just (Scim.ScimBool True), password = Nothing, emails = [], phoneNumbers = [], ims = [], photos = [], addresses = [], entitlements = [], roles = [], x509Certificates = [], extra = ScimUserExtra {_sueRichInfo = RichInfo {unRichInfo = assocs}}} + + assocs :: RichInfoAssocList + assocs = mkRichInfoAssocList [RichField {richFieldType = "0-plIe\176041Sdu]\129492ouXy*]j\49123`jDNJ:N%\32939\&6\183443\\>HSi\6502q,\28951wZ].\11331w`", richFieldValue = "C ny6Nx0f&b\121034\29092r"}, RichField {richFieldType = "[&c;VP9\42304Q.I\43963OS\83057}G ]\175364xYLqO\156677q*ZBtZ`vKc", richFieldValue = "+FEv\28180"}, RichField {richFieldType = "}121@^z{", richFieldValue = "{KZQqjqs Py%ETB>;y1}\142167\181794\164475p"}, RichField {richFieldType = "\48098\&2#-p\68080\&9\37971|\190007K|m(", richFieldValue = ":j7\83424lQ\19571\188281*[)D8\50056\9019n\189416\100233]*!={FX|/!!&my]+8\175071\135759\&0\13316K'(\14120\172092w,2"}, RichField {richFieldType = "\50520MX>\\kQcBz\169538\147873\\\177286FqS!GW]#\20027_n", richFieldValue = "53\190108.?%t[ &9=hd9t:}Q@yj#w~B\164946B# fs!\39091}eEP"}, RichField {richFieldType = "sE7hmj\164437:", richFieldValue = "ns\"EJftf6~g5U\"&tt\20456@]M"}, RichField {richFieldType = "\172698p\41097sHk \37897X0Io\8286OU\173780\18370h\46873&GAOpuQU+T)]rC\5068WCA\68875(-\175596'", richFieldValue = "lRiP"}] + + describe "'normalizeLikeStored'" $ do + it "works (counter-example of earlier bug)" $ do + let f = length . unRichInfoAssocList . unRichInfo . view sueRichInfo . Scim.extra + f (normalizeLikeStored usr) `shouldBe` f usr + normalizeLikeStored usr `shouldBe` usr -instance Arbitrary ScimUserExtra where - arbitrary = ScimUserExtra <$> arbitrary + it "keeps (already normalized) user record intact (property)" . property $ + \(usr' :: Scim.User SparTag) -> counterexample (show usr') $ do + normalizeLikeStored usr' `shouldBe` usr' From 3aab0a4d7c232bedc7963f7be4737e84e68cc012 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 28 Sep 2021 11:55:14 +0200 Subject: [PATCH 58/72] Federation: support read receipts (#1801) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Refactor member adding code This is a pretty invasive refactoring of code dealing with members of conversations, especially in `Galley.Data`. Here is a summary of changes: - Introduced a `UserList` type, representing a list of users partitioned into locals and remotes. - Removed many of the convenience functions to add members to a conversation. The default admin role functionality is now implemented using a `ToUserRole` type class. - Event creation for adding members or creating conversations is now done outside the `Data` module. This will make it possible to unify the event creation and propagation logic across many conversation endpoints. - Many functions operating on lists have been generalised to `Foldable`, so they can work uniformly with `UserList`s and normal lists. - The `ConvSizeChecked` newtype was broken, because the `Functor` instance would allow to break the invariant encoded by the type. This is now fixed, and the type can now wrap an arbitrary `Foldable`. - Similar changes have been applied to `ConvMemberAddSizeChecked`. - Support for creating managed conversations has been dropped * Separate self and other member update logic * Remove IsMemberUpdate type class This further separates the self member update code path from the other member update. There was really no reason to have them together in the first place. * ensureOtherMember now takes a conversation * Add receipt mode action and unify other actions The core of the unified interface is the `updateLocalConversation` function, which performs an update and notifies local and remote users. **Note**: the remove member update is a bit special, because it was implemented using checked exceptions. To make it compatible with the other updates, checked exceptions are not currently used, although they are still present in some type signatures. To make the unification possible, a number of other changes were necessary: - Removed checked add member wrapper. This wasn't either safe (because it didn't encompass all the necessary size checks) nor necessary (because the checks were already performed by `ensureMemberLimit`). - Aligned conversation update RPC to endpoint interface. The generalised RPC interface is not necessary for now (it can always be regeneralised later if needed), and making it the same as the public interface simplifies some things. - Added some general code to deal with local and remote members uniformly. This simplifies many functions that can operate on both local and remote members. For example member removal, which is also used for leaving a remote conversation. * Add CHANGELOG entries * Update golden tests * Add receipt mode update propagation tests * Fix renaming of non-group conversations * Fix check for leave action A leave action is a special case of a member remove action, but it has a different "tag", so now `conversationActionTag` takes the originating user as an extra argument, and retuns a `LeaveConversation` tag for `ConversationActionRemoveMember` actions that remove the originating user. This also fixes legalhold-related failures when non-consenting users are removed after legal hold is enabled. * Remove managed conversation tests Creating managed conversations is not supported anymore * Return 204 for trivial join action * Create managed conversations by hand in tests * Use for instead of pattern matching Co-authored-by: Marko Dimjašević --- .../5-internal/member-update-refactoring | 3 + changelog.d/6-federation/fed-receipt-mode | 1 + libs/types-common/src/Data/Qualified.hs | 12 +- .../Federation/Golden/ConversationUpdate.hs | 6 +- .../testObject_ConversationUpdate1.json | 9 +- .../testObject_ConversationUpdate2.json | 16 +- .../src/Wire/API/Conversation/Action.hs | 33 +- .../src/Wire/API/Routes/Public/Galley.hs | 2 - services/galley/galley.cabal | 3 +- services/galley/src/Galley/API/Create.hs | 128 ++-- services/galley/src/Galley/API/Federation.hs | 29 +- services/galley/src/Galley/API/Internal.hs | 23 +- services/galley/src/Galley/API/LegalHold.hs | 13 +- services/galley/src/Galley/API/Teams.hs | 9 +- services/galley/src/Galley/API/Update.hs | 712 ++++++++---------- services/galley/src/Galley/API/Util.hs | 287 ++++--- services/galley/src/Galley/Data.hs | 358 +++++---- services/galley/src/Galley/Data/Services.hs | 6 + services/galley/src/Galley/Types/UserList.hs | 44 ++ services/galley/src/Galley/Validation.hs | 27 +- services/galley/test/integration/API.hs | 49 +- .../galley/test/integration/API/Federation.hs | 49 +- services/galley/test/integration/API/Roles.hs | 4 +- services/galley/test/integration/API/Teams.hs | 43 +- services/galley/test/integration/API/Util.hs | 40 +- 25 files changed, 977 insertions(+), 929 deletions(-) create mode 100644 changelog.d/5-internal/member-update-refactoring create mode 100644 changelog.d/6-federation/fed-receipt-mode create mode 100644 services/galley/src/Galley/Types/UserList.hs diff --git a/changelog.d/5-internal/member-update-refactoring b/changelog.d/5-internal/member-update-refactoring new file mode 100644 index 00000000000..7356fde95b4 --- /dev/null +++ b/changelog.d/5-internal/member-update-refactoring @@ -0,0 +1,3 @@ +Refactored a few functions dealing with conversation updates, in an attempt to +make the conversation update code paths more uniform, and also reduce special +cases for local and remote objects. diff --git a/changelog.d/6-federation/fed-receipt-mode b/changelog.d/6-federation/fed-receipt-mode new file mode 100644 index 00000000000..ef5ba52aba7 --- /dev/null +++ b/changelog.d/6-federation/fed-receipt-mode @@ -0,0 +1 @@ +Notify remote users when a conversation receipt mode is updated diff --git a/libs/types-common/src/Data/Qualified.hs b/libs/types-common/src/Data/Qualified.hs index 4e47a40534c..6a01d6d10ac 100644 --- a/libs/types-common/src/Data/Qualified.hs +++ b/libs/types-common/src/Data/Qualified.hs @@ -27,6 +27,7 @@ module Data.Qualified toLocal, lUnqualified, lDomain, + qualifyAs, foldQualified, renderQualifiedId, partitionRemoteOrLocalIds, @@ -59,7 +60,7 @@ data Qualified a = Qualified { qUnqualified :: a, qDomain :: Domain } - deriving stock (Eq, Ord, Show, Generic, Functor) + deriving stock (Eq, Ord, Show, Generic, Functor, Foldable, Traversable) -- | A type to differentiate between generally Qualified values, and values -- where it is known if they are coming from a Remote backend or not. @@ -84,6 +85,11 @@ lUnqualified = qUnqualified . unTagged lDomain :: Local a -> Domain lDomain = qDomain . unTagged +-- | Convert an unqualified value to a qualified one, with the same tag as the +-- given tagged qualified value. +qualifyAs :: Tagged t (Qualified x) -> a -> Tagged t (Qualified a) +qualifyAs (Tagged q) x = Tagged (q $> x) + foldQualified :: Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b foldQualified loc f g q | lDomain loc == qDomain q = @@ -108,13 +114,13 @@ partitionRemoteOrLocalIds' :: Foldable f => Domain -> f (Qualified a) -> ([Remot partitionRemoteOrLocalIds' localDomain xs = first (fmap toRemote) $ partitionRemoteOrLocalIds localDomain xs -- | Index a list of qualified values by domain -partitionQualified :: [Qualified a] -> Map Domain [a] +partitionQualified :: Foldable f => f (Qualified a) -> Map Domain [a] partitionQualified = foldr add mempty where add :: Qualified a -> Map Domain [a] -> Map Domain [a] add (Qualified x domain) = Map.insertWith (<>) domain [x] -partitionRemote :: [Remote a] -> [(Domain, [a])] +partitionRemote :: (Functor f, Foldable f) => f (Remote a) -> [(Domain, [a])] partitionRemote remotes = Map.assocs $ partitionQualified (unTagged <$> remotes) ---------------------------------------------------------------------- diff --git a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs index bf9dcfb1a9e..1535c7c458e 100644 --- a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationUpdate.hs @@ -28,7 +28,7 @@ import Data.Qualified (Qualified (Qualified)) import qualified Data.UUID as UUID import Imports import Wire.API.Conversation.Action -import Wire.API.Conversation.Role (roleNameWireAdmin, roleNameWireMember) +import Wire.API.Conversation.Role (roleNameWireAdmin) import Wire.API.Federation.API.Galley (ConversationUpdate (..)) qAlice, qBob :: Qualified UserId @@ -56,7 +56,7 @@ testObject_ConversationUpdate1 = cuConvId = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000006")), cuAlreadyPresentUsers = [], - cuAction = ConversationActionAddMembers ((qAlice, roleNameWireMember) :| [(qBob, roleNameWireAdmin)]) + cuAction = ConversationActionAddMembers (qAlice :| [qBob]) roleNameWireAdmin } testObject_ConversationUpdate2 :: ConversationUpdate @@ -70,5 +70,5 @@ testObject_ConversationUpdate2 = cuConvId = Id (fromJust (UUID.fromString "00000000-0000-0000-0000-000100000006")), cuAlreadyPresentUsers = [chad, dee], - cuAction = ConversationActionRemoveMembers (qAlice :| [qBob]) + cuAction = ConversationActionRemoveMember (qAlice) } diff --git a/libs/wire-api-federation/test/golden/testObject_ConversationUpdate1.json b/libs/wire-api-federation/test/golden/testObject_ConversationUpdate1.json index a753b72004b..da957a74577 100644 --- a/libs/wire-api-federation/test/golden/testObject_ConversationUpdate1.json +++ b/libs/wire-api-federation/test/golden/testObject_ConversationUpdate1.json @@ -13,15 +13,12 @@ "domain": "golden.example.com", "id": "00000000-0000-0000-0000-000100004007" }, - "wire_member" - ], - [ { "domain": "golden2.example.com", "id": "00000000-0000-0000-0000-000100005007" - }, - "wire_admin" - ] + } + ], + "wire_admin" ] }, "conv_id": "00000000-0000-0000-0000-000100000006" diff --git a/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2.json b/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2.json index 5b28f42cc45..3a0490a2535 100644 --- a/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2.json +++ b/libs/wire-api-federation/test/golden/testObject_ConversationUpdate2.json @@ -9,17 +9,11 @@ ], "time": "1864-04-12T12:22:43.673Z", "action": { - "tag": "ConversationActionRemoveMembers", - "contents": [ - { - "domain": "golden.example.com", - "id": "00000000-0000-0000-0000-000100004007" - }, - { - "domain": "golden2.example.com", - "id": "00000000-0000-0000-0000-000100005007" - } - ] + "tag": "ConversationActionRemoveMember", + "contents": { + "domain": "golden.example.com", + "id": "00000000-0000-0000-0000-000100004007" + } }, "conv_id": "00000000-0000-0000-0000-000100000006" } \ No newline at end of file diff --git a/libs/wire-api/src/Wire/API/Conversation/Action.hs b/libs/wire-api/src/Wire/API/Conversation/Action.hs index 27358e01b88..0cd526ae2d2 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Action.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Action.hs @@ -18,6 +18,7 @@ module Wire.API.Conversation.Action ( ConversationAction (..), conversationActionToEvent, + conversationActionTag, ) where @@ -36,11 +37,12 @@ import Wire.API.Util.Aeson (CustomEncoded (..)) -- | An update to a conversation, including addition and removal of members. -- Used to send notifications to users and to remote backends. data ConversationAction - = ConversationActionAddMembers (NonEmpty (Qualified UserId, RoleName)) - | ConversationActionRemoveMembers (NonEmpty (Qualified UserId)) + = ConversationActionAddMembers (NonEmpty (Qualified UserId)) RoleName + | ConversationActionRemoveMember (Qualified UserId) | ConversationActionRename ConversationRename | ConversationActionMessageTimerUpdate ConversationMessageTimerUpdate - | ConversationActionMemberUpdate MemberUpdateData + | ConversationActionReceiptModeUpdate ConversationReceiptModeUpdate + | ConversationActionMemberUpdate (Qualified UserId) OtherMemberUpdate deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform ConversationAction) deriving (ToJSON, FromJSON) via (CustomEncoded ConversationAction) @@ -51,15 +53,28 @@ conversationActionToEvent :: Qualified ConvId -> ConversationAction -> Event -conversationActionToEvent now quid qcnv (ConversationActionAddMembers newMembers) = +conversationActionToEvent now quid qcnv (ConversationActionAddMembers newMembers role) = Event MemberJoin qcnv quid now $ - EdMembersJoin $ SimpleMembers (map (uncurry SimpleMember) . toList $ newMembers) -conversationActionToEvent now quid qcnv (ConversationActionRemoveMembers removedMembers) = + EdMembersJoin $ SimpleMembers (map (`SimpleMember` role) (toList newMembers)) +conversationActionToEvent now quid qcnv (ConversationActionRemoveMember removedMember) = Event MemberLeave qcnv quid now $ - EdMembersLeave . QualifiedUserIdList . toList $ removedMembers + EdMembersLeave (QualifiedUserIdList [removedMember]) conversationActionToEvent now quid qcnv (ConversationActionRename rename) = Event ConvRename qcnv quid now (EdConvRename rename) conversationActionToEvent now quid qcnv (ConversationActionMessageTimerUpdate update) = Event ConvMessageTimerUpdate qcnv quid now (EdConvMessageTimerUpdate update) -conversationActionToEvent now quid qcnv (ConversationActionMemberUpdate update) = - Event MemberStateUpdate qcnv quid now (EdMemberUpdate update) +conversationActionToEvent now quid qcnv (ConversationActionReceiptModeUpdate update) = + Event ConvReceiptModeUpdate qcnv quid now (EdConvReceiptModeUpdate update) +conversationActionToEvent now quid qcnv (ConversationActionMemberUpdate target (OtherMemberUpdate role)) = + let update = MemberUpdateData target Nothing Nothing Nothing Nothing Nothing Nothing role + in Event MemberStateUpdate qcnv quid now (EdMemberUpdate update) + +conversationActionTag :: Qualified UserId -> ConversationAction -> Action +conversationActionTag _ (ConversationActionAddMembers _ _) = AddConversationMember +conversationActionTag qusr (ConversationActionRemoveMember victim) + | qusr == victim = LeaveConversation + | otherwise = RemoveConversationMember +conversationActionTag _ (ConversationActionRename _) = ModifyConversationName +conversationActionTag _ (ConversationActionMessageTimerUpdate _) = ModifyConversationMessageTimer +conversationActionTag _ (ConversationActionReceiptModeUpdate _) = ModifyConversationReceiptMode +conversationActionTag _ (ConversationActionMemberUpdate _ _) = ModifyOtherConversationMember 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 6a513292754..eb48fa4e6fb 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -452,7 +452,6 @@ data Api routes = Api :- Summary "Update self membership properties (deprecated)" :> Description "Use `/conversations/:domain/:conv/self` instead." :> CanThrow ConvNotFound - :> CanThrow ConvAccessDenied :> ZUser :> ZConn :> "conversations" @@ -469,7 +468,6 @@ data Api routes = Api :- Summary "Update self membership properties" :> Description "**Note**: at least one field has to be provided." :> CanThrow ConvNotFound - :> CanThrow ConvAccessDenied :> ZUser :> ZConn :> "conversations" diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 5122ed04e07..b81f555bb6a 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 0341ec52f506f40a39b7329c4eeccdccf25bcffc81318f535602bfc17e655f58 +-- hash: 0f1a6ec2e6bf117e21a1b8da6d851d6a5a60cd553c803a079a07aedefbcf0233 name: galley version: 0.83.0 @@ -67,6 +67,7 @@ library Galley.Queue Galley.Run Galley.Types.Clients + Galley.Types.UserList Galley.Validation Main other-modules: diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs index 12242fdfec9..9c1f82c3519 100644 --- a/services/galley/src/Galley/API/Create.hs +++ b/services/galley/src/Galley/API/Create.hs @@ -29,9 +29,10 @@ import Control.Monad.Catch import Data.Id import Data.List1 (list1) import Data.Misc (FutureWork (FutureWork)) -import Data.Qualified (Qualified (..), Remote, partitionRemoteOrLocalIds') +import Data.Qualified import Data.Range import qualified Data.Set as Set +import Data.Tagged import Data.Time import qualified Data.UUID.Tagged as U import Galley.API.Error @@ -41,7 +42,8 @@ import Galley.App import qualified Galley.Data as Data import Galley.Intra.Push import Galley.Types -import Galley.Types.Teams (ListType (..), Perm (..), TeamBinding (Binding), notTeamMember, teamMembers, userId) +import Galley.Types.Teams (ListType (..), Perm (..), TeamBinding (Binding), notTeamMember) +import Galley.Types.UserList import Galley.Validation import Imports hiding ((\\)) import Network.HTTP.Types @@ -93,25 +95,24 @@ ensureNoLegalholdConflicts remotes locals = do -- | A helper for creating a regular (non-team) group conversation. createRegularGroupConv :: UserId -> ConnId -> NewConvUnmanaged -> Galley ConversationResponse createRegularGroupConv zusr zcon (NewConvUnmanaged body) = do - localDomain <- viewFederationDomain + lusr <- qualifyLocal zusr name <- rangeCheckedMaybe (newConvName body) let unqualifiedUserIds = newConvUsers body qualifiedUserIds = newConvQualifiedUsers body - let allUsers = map (`Qualified` localDomain) unqualifiedUserIds <> qualifiedUserIds + allUsers = + toUserList lusr $ + map (unTagged . qualifyAs lusr) unqualifiedUserIds <> qualifiedUserIds checkedUsers <- checkedConvSize allUsers - let checkedPartitionedUsers = partitionRemoteOrLocalIds' localDomain <$> checkedUsers - let (remotes, locals) = fromConvSize checkedPartitionedUsers - ensureConnected zusr locals - checkRemoteUsersExist remotes - ensureNoLegalholdConflicts remotes locals + ensureConnected zusr (ulLocals allUsers) + checkRemoteUsersExist (ulRemotes allUsers) + ensureNoLegalholdConflicts (ulRemotes allUsers) (ulLocals allUsers) c <- Data.createConversation - localDomain - zusr + lusr name (access body) (accessRole body) - checkedPartitionedUsers + checkedUsers (newConvTeam body) (newConvMessageTimer body) (newConvReceiptMode body) @@ -120,59 +121,47 @@ createRegularGroupConv zusr zcon (NewConvUnmanaged body) = do conversationCreated zusr c -- | A helper for creating a team group conversation, used by the endpoint --- handlers above. Allows both unmanaged and managed conversations. +-- handlers above. Only supports unmanaged conversations. createTeamGroupConv :: UserId -> ConnId -> Public.ConvTeamInfo -> Public.NewConv -> Galley ConversationResponse createTeamGroupConv zusr zcon tinfo body = do - localDomain <- viewFederationDomain + lusr <- qualifyLocal zusr name <- rangeCheckedMaybe (newConvName body) let unqualifiedUserIds = newConvUsers body qualifiedUserIds = newConvQualifiedUsers body - allUserIds = map (`Qualified` localDomain) unqualifiedUserIds <> qualifiedUserIds - let convTeam = cnvTeamId tinfo + allUsers = + toUserList lusr $ + map (unTagged . qualifyAs lusr) unqualifiedUserIds <> qualifiedUserIds + convTeam = cnvTeamId tinfo + zusrMembership <- Data.teamMember convTeam zusr void $ permissionCheck CreateConversation zusrMembership - checkedUsers <- checkedConvSize allUserIds - let checkedPartitionedUsers = partitionRemoteOrLocalIds' localDomain <$> checkedUsers - (remotes, localUserIds) = fromConvSize checkedPartitionedUsers - convLocalMemberships <- mapM (Data.teamMember convTeam) localUserIds - ensureAccessRole (accessRole body) (zip localUserIds convLocalMemberships) - checkedPartitionedUsersManaged <- - if cnvManaged tinfo - then do - -- ConvMaxSize MUST be < than hardlimit so the conv size check is enough - maybeAllMembers <- Data.teamMembersForFanout convTeam - let otherConvMems = filter (/= zusr) $ map (view userId) $ (maybeAllMembers ^. teamMembers) - checkedLocalUsers <- checkedConvSize otherConvMems - -- NOTE: Team members are local, therefore there are no remote users in - -- this case - pure (fmap ([],) checkedLocalUsers) - else do - -- In teams we don't have 1:1 conversations, only regular conversations. We want - -- users without the 'AddRemoveConvMember' permission to still be able to create - -- regular conversations, therefore we check for 'AddRemoveConvMember' only if - -- there are going to be more than two users in the conversation. - -- FUTUREWORK: We keep this permission around because not doing so will break backwards - -- compatibility in the sense that the team role 'partners' would be able to create group - -- conversations (which they should not be able to). - -- Not sure at the moment how to best solve this but it is unlikely - -- we can ever get rid of the team permission model anyway - the only thing I can - -- think of is that 'partners' can create convs but not be admins... - when (length allUserIds > 1) $ do - void $ permissionCheck DoNotUseDeprecatedAddRemoveConvMember zusrMembership - -- Team members are always considered to be connected, so we only check - -- 'ensureConnected' for non-team-members. - ensureConnectedToLocals zusr (notTeamMember localUserIds (catMaybes convLocalMemberships)) - pure checkedPartitionedUsers - checkRemoteUsersExist remotes - ensureNoLegalholdConflicts remotes localUserIds + checkedUsers <- checkedConvSize allUsers + convLocalMemberships <- mapM (Data.teamMember convTeam) (ulLocals allUsers) + ensureAccessRole (accessRole body) (zip (ulLocals allUsers) convLocalMemberships) + -- In teams we don't have 1:1 conversations, only regular conversations. We want + -- users without the 'AddRemoveConvMember' permission to still be able to create + -- regular conversations, therefore we check for 'AddRemoveConvMember' only if + -- there are going to be more than two users in the conversation. + -- FUTUREWORK: We keep this permission around because not doing so will break backwards + -- compatibility in the sense that the team role 'partners' would be able to create group + -- conversations (which they should not be able to). + -- Not sure at the moment how to best solve this but it is unlikely + -- we can ever get rid of the team permission model anyway - the only thing I can + -- think of is that 'partners' can create convs but not be admins... + when (length allUsers > 1) $ do + void $ permissionCheck DoNotUseDeprecatedAddRemoveConvMember zusrMembership + -- Team members are always considered to be connected, so we only check + -- 'ensureConnected' for non-team-members. + ensureConnectedToLocals zusr (notTeamMember (ulLocals allUsers) (catMaybes convLocalMemberships)) + checkRemoteUsersExist (ulRemotes allUsers) + ensureNoLegalholdConflicts (ulRemotes allUsers) (ulLocals allUsers) conv <- Data.createConversation - localDomain - zusr + lusr name (access body) (accessRole body) - checkedPartitionedUsersManaged + checkedUsers (newConvTeam body) (newConvMessageTimer body) (newConvReceiptMode body) @@ -187,16 +176,17 @@ createTeamGroupConv zusr zcon tinfo body = do createSelfConversation :: UserId -> Galley ConversationResponse createSelfConversation zusr = do + lusr <- qualifyLocal zusr c <- Data.conversation (Id . toUUID $ zusr) - maybe create (conversationExisted zusr) c + maybe (create lusr) (conversationExisted zusr) c where - create = do - localDomain <- viewFederationDomain - c <- Data.createSelfConversation localDomain zusr Nothing + create lusr = do + c <- Data.createSelfConversation lusr Nothing conversationCreated zusr c createOne2OneConversation :: UserId -> ConnId -> NewConvUnmanaged -> Galley ConversationResponse createOne2OneConversation zusr zcon (NewConvUnmanaged j) = do + lusr <- qualifyLocal zusr otherUserId <- head . fromRange <$> (rangeChecked (newConvUsers j) :: Galley (Range 1 1 [UserId])) (x, y) <- toUUIDs zusr otherUserId when (x == y) $ @@ -211,7 +201,7 @@ createOne2OneConversation zusr zcon (NewConvUnmanaged j) = do ensureConnected zusr [otherUserId] n <- rangeCheckedMaybe (newConvName j) c <- Data.conversation (Data.one2OneConvId x y) - maybe (create x y n $ newConvTeam j) (conversationExisted zusr) c + maybe (create lusr x y n $ newConvTeam j) (conversationExisted zusr) c where verifyMembership tid u = do membership <- Data.teamMember tid u @@ -226,9 +216,8 @@ createOne2OneConversation zusr zcon (NewConvUnmanaged j) = do verifyMembership tid y Just _ -> throwM nonBindingTeam Nothing -> throwM teamNotFound - create x y n tinfo = do - localDomain <- viewFederationDomain - c <- Data.createOne2OneConversation localDomain x y n (cnvTeamId <$> tinfo) + create lusr x y n tinfo = do + c <- Data.createOne2OneConversation lusr x y n (cnvTeamId <$> tinfo) notifyCreatedConversation Nothing zusr (Just zcon) c conversationCreated zusr c @@ -239,14 +228,17 @@ createConnectConversationH (usr ::: conn ::: req) = do createConnectConversation :: UserId -> Maybe ConnId -> Connect -> Galley ConversationResponse createConnectConversation usr conn j = do + lusr <- qualifyLocal usr (x, y) <- toUUIDs usr (cRecipient j) n <- rangeCheckedMaybe (cName j) conv <- Data.conversation (Data.one2OneConvId x y) - maybe (create x y n) (update n) conv + maybe (create lusr x y n) (update n) conv where - create x y n = do - localDomain <- viewFederationDomain - (c, e) <- Data.createConnectConversation localDomain x y n j + create lusr x y n = do + c <- Data.createConnectConversation lusr x y n + now <- liftIO getCurrentTime + let lcid = qualifyAs lusr (Data.convId c) + e = Event ConvConnect (unTagged lcid) (unTagged lusr) now (EdConnect j) notifyCreatedConversation Nothing usr conn c for_ (newPushLocal ListComplete usr (ConvEvent e) (recipient <$> Data.convLocalMembers c)) $ \p -> push1 $ @@ -255,7 +247,6 @@ createConnectConversation usr conn j = do & pushConn .~ conn conversationCreated usr c update n conv = do - localDomain <- viewFederationDomain let mems = Data.convLocalMembers conv in conversationExisted usr =<< if @@ -263,8 +254,9 @@ createConnectConversation usr conn j = do -- we already were in the conversation, maybe also other connect n conv | otherwise -> do - now <- liftIO getCurrentTime - mm <- snd <$> Data.addMember localDomain now (Data.convId conv) usr + lcid <- qualifyLocal (Data.convId conv) + lusr <- qualifyLocal usr + mm <- Data.addMember lcid lusr let conv' = conv { Data.convLocalMembers = Data.convLocalMembers conv <> toList mm diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 9d9d0c20d7f..81cebef0159 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -18,7 +18,7 @@ module Galley.API.Federation where import Control.Lens (itraversed, (<.>)) import Control.Monad.Catch (throwM) -import Control.Monad.Except (runExceptT) +import Control.Monad.Trans.Maybe (runMaybeT) import Data.ByteString.Conversion (toByteString') import Data.Containers.ListUtils (nubOrd) import Data.Domain @@ -35,7 +35,7 @@ import Galley.API.Error (invalidPayload) import qualified Galley.API.Mapping as Mapping import Galley.API.Message (MessageMetadata (..), UserType (..), postQualifiedOtrMessage, sendLocalMessages) import qualified Galley.API.Update as API -import Galley.API.Util (fromNewRemoteConversation, pushConversationEvent, viewFederationDomain) +import Galley.API.Util import Galley.App (Galley) import qualified Galley.Data as Data import Galley.Types.Conversations.Members (LocalMember (..), defMemberStatus) @@ -61,6 +61,7 @@ import Wire.API.Federation.API.Galley RemoteMessage (..), ) import qualified Wire.API.Federation.API.Galley as FederationAPIGalley +import Wire.API.Routes.Public.Galley.Responses (RemoveFromConversationError (..)) import Wire.API.ServantProto (FromProto (..)) import Wire.API.User.Client (userClientMap) @@ -130,17 +131,18 @@ onConversationUpdated requestingDomain cu = do -- updated, we do **not** add them to the list of targets, because we have no -- way to make sure that they are actually supposed to receive that notification. extraTargets <- case cuAction cu of - ConversationActionAddMembers toAdd -> do - let localUsers = getLocalUsers localDomain (fmap fst toAdd) + ConversationActionAddMembers toAdd _ -> do + let localUsers = getLocalUsers localDomain toAdd Data.addLocalMembersToRemoteConv qconvId localUsers pure localUsers - ConversationActionRemoveMembers toRemove -> do - let localUsers = getLocalUsers localDomain toRemove + ConversationActionRemoveMember toRemove -> do + let localUsers = getLocalUsers localDomain (pure toRemove) Data.removeLocalMembersFromRemoteConv qconvId localUsers pure [] ConversationActionRename _ -> pure [] ConversationActionMessageTimerUpdate _ -> pure [] - ConversationActionMemberUpdate _ -> pure [] + ConversationActionMemberUpdate _ _ -> pure [] + ConversationActionReceiptModeUpdate _ -> pure [] -- Send notifications let event = conversationActionToEvent (cuTime cu) (cuOrigUserId cu) qconvId (cuAction cu) @@ -159,14 +161,23 @@ onConversationUpdated requestingDomain cu = do -- FUTUREWORK: support bots? pushConversationEvent Nothing event targets [] +-- FUTUREWORK: actually return errors as part of the response instead of throwing 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 + lcnv <- qualifyLocal (lcConvId lc) + fmap + ( LeaveConversationResponse + . maybe (Left RemoveFromConversationErrorUnchanged) Right + ) + . runMaybeT + . void + . API.updateLocalConversation lcnv leaver Nothing + . ConversationActionRemoveMember + $ leaver -- FUTUREWORK: report errors to the originating backend -- FUTUREWORK: error handling for missing / mismatched clients diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 39b39dd8a51..6bfd6a00385 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -35,6 +35,7 @@ import Data.List1 (maybeList1) import Data.Qualified (Local, Qualified (..), Remote, lUnqualified, partitionRemoteOrLocalIds') import Data.Range import Data.String.Conversions (cs) +import Data.Time import GHC.TypeLits (AppendSymbol) import qualified Galley.API.Clients as Clients import qualified Galley.API.Create as Create @@ -56,7 +57,7 @@ import qualified Galley.Queue as Q import Galley.Types import Galley.Types.Bot (AddBot, RemoveBot) import Galley.Types.Bot.Service -import Galley.Types.Teams +import Galley.Types.Teams hiding (MemberLeave) import Galley.Types.Teams.Intra import Galley.Types.Teams.SearchVisibility import Imports hiding (head) @@ -478,12 +479,15 @@ rmUser user conn = do ConnectConv -> Data.removeMember user (Data.convId c) >> return Nothing RegularConv | user `isMember` Data.convLocalMembers c -> do - e <- - Data.removeLocalMembersFromLocalConv - localDomain - c - (Qualified user localDomain) - (pure user) + Data.removeLocalMembersFromLocalConv (Data.convId c) (pure user) + now <- liftIO getCurrentTime + let e = + Event + MemberLeave + (Qualified (Data.convId c) localDomain) + (Qualified user localDomain) + now + (EdMembersLeave (QualifiedUserIdList [Qualified user localDomain])) return $ Intra.newPushLocal ListComplete user (Intra.ConvEvent e) (Intra.recipient <$> Data.convLocalMembers c) <&> set Intra.pushConn conn @@ -494,8 +498,9 @@ rmUser user conn = do Intra.push leaveRemoteConversations :: Foldable t => Local UserId -> t (Remote ConvId) -> Galley () - leaveRemoteConversations (unTagged -> qusr) cids = - for_ cids $ \(Tagged cid) -> Update.removeMember qusr Nothing cid qusr + leaveRemoteConversations lusr cids = + for_ cids $ \cid -> + Update.removeMemberFromRemoteConv cid lusr Nothing (unTagged lusr) deleteLoop :: Galley () deleteLoop = do diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 5a4bd6d8c3b..d4ea7c3ed78 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -46,11 +46,11 @@ 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 Data.Tagged import Galley.API.Error import Galley.API.Query (iterateConversations) -import Galley.API.Update (removeMember) +import Galley.API.Update (removeMemberFromLocalConv) import Galley.API.Util import Galley.App import qualified Galley.Data as Data @@ -487,7 +487,6 @@ 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 @@ -504,13 +503,15 @@ handleGroupConvPolicyConflicts uid hypotheticalLHStatus = mems uidsLHStatus - let qconv = Data.convId conv `Qualified` localDomain + lcnv <- qualifyLocal (Data.convId conv) if any ((== ConsentGiven) . consentGiven . snd) (filter ((== roleNameWireAdmin) . lmConvRoleName . fst) membersAndLHStatus) then do for_ (filter ((== ConsentNotGiven) . consentGiven . snd) membersAndLHStatus) $ \(memberNoConsent, _) -> do - removeMember (lmId memberNoConsent `Qualified` localDomain) Nothing qconv (Qualified (lmId memberNoConsent) localDomain) + lusr <- qualifyLocal (lmId memberNoConsent) + removeMemberFromLocalConv lcnv lusr Nothing (unTagged lusr) else do for_ (filter (userLHEnabled . snd) membersAndLHStatus) $ \(legalholder, _) -> do - removeMember (lmId legalholder `Qualified` localDomain) Nothing qconv (Qualified (lmId legalholder) localDomain) + lusr <- qualifyLocal (lmId legalholder) + removeMemberFromLocalConv lcnv lusr Nothing (unTagged lusr) diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index c756c38ea41..330aa44c940 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -768,7 +768,7 @@ deleteTeamConversation zusr zcon tid cid = do let qconvId = Qualified cid localDomain qusr = Qualified zusr localDomain (bots, cmems) <- localBotsAndUsers <$> Data.members cid - ensureActionAllowedThrowing Roles.DeleteConversation =<< getSelfMemberFromLocalsLegacy zusr cmems + ensureActionAllowed 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 @@ -899,9 +899,10 @@ addTeamMemberInternal tid origin originConn (view ntmNewTeamMember -> new) memLi Data.addTeamMember tid new cc <- filter (view managedConversation) <$> Data.teamConversations tid now <- liftIO getCurrentTime - localDomain <- viewFederationDomain - for_ cc $ \c -> - Data.addMember localDomain now (c ^. conversationId) (new ^. userId) + for_ cc $ \c -> do + lcid <- qualifyLocal (c ^. conversationId) + luid <- qualifyLocal (new ^. userId) + Data.addMember lcid luid let e = newEvent MemberJoin tid now & eventData ?~ EdMemberJoin (new ^. userId) push1 $ newPushLocal1 (memList ^. teamMemberListType) (new ^. userId) (TeamEvent e) (recipients origin new) & pushConn .~ originConn APITeamQueue.pushTeamEvent tid e diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 4c537c5eba3..a89e7dc32c2 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -34,6 +34,7 @@ module Galley.API.Update updateLocalConversationMessageTimer, updateConversationMessageTimerUnqualified, updateConversationMessageTimer, + updateLocalConversation, -- * Managing Members addMembersH, @@ -42,10 +43,10 @@ module Galley.API.Update updateSelfMember, updateOtherMember, updateOtherMemberUnqualified, - removeMember, removeMemberQualified, removeMemberUnqualified, removeMemberFromLocalConv, + removeMemberFromRemoteConv, -- * Talking postProteusMessage, @@ -64,18 +65,15 @@ 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 Control.Monad.Trans.Maybe 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.List.NonEmpty (NonEmpty (..), nonEmpty) import Data.List1 import qualified Data.Map.Strict as Map import Data.Misc (FutureWork (FutureWork)) @@ -104,6 +102,7 @@ import Galley.Types.Clients (Clients) import qualified Galley.Types.Clients as Clients import Galley.Types.Conversations.Roles (Action (..), RoleName, roleNameWireMember) import Galley.Types.Teams hiding (Event, EventData (..), EventType (..), self) +import Galley.Types.UserList import Galley.Validation import Gundeck.Types.Push.V2 (RecipientClients (..)) import Imports @@ -112,14 +111,12 @@ import Network.Wai import Network.Wai.Predicate hiding (and, failure, setStatus, _1, _2) import Network.Wai.Utilities import UnliftIO (pooledForConcurrentlyN) -import Wire.API.Conversation (InviteQualified (invQRoleName)) import qualified Wire.API.Conversation as Public -import Wire.API.Conversation.Action (ConversationAction (..), conversationActionToEvent) +import Wire.API.Conversation.Action import qualified Wire.API.Conversation.Code as Public import Wire.API.Conversation.Role (roleNameWireAdmin) import Wire.API.ErrorDescription ( CodeNotFound, - ConvMemberNotFound, ConvNotFound, MissingLegalholdConsent, UnknownClient, @@ -200,7 +197,7 @@ updateConversationAccess usr zcon cnv update = do -- The conversation has to be a group conversation ensureGroupConvThrowing conv self <- getSelfMemberFromLocalsLegacy usr users - ensureActionAllowedThrowing ModifyConversationAccess self + ensureActionAllowed ModifyConversationAccess self -- Team conversations incur another round of checks case Data.convTeam conv of Just tid -> checkTeamConv tid self @@ -231,7 +228,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 - ensureActionAllowedThrowing RemoveConversationMember self + ensureActionAllowed RemoveConversationMember self uncheckedUpdateConversationAccess :: ConversationAccessUpdate -> @@ -282,15 +279,15 @@ uncheckedUpdateConversationAccess body usr zcon conv (currentAccess, targetAcces let removedUsers = map lmId users \\ map lmId newUsers removedBots = map botMemId bots \\ map botMemId newBots mapM_ (deleteBot cnv) removedBots - case removedUsers of - [] -> return () - x : xs -> do - -- FUTUREWORK: deal with remote members, too, see removeMembers (Jira SQCORE-903) - 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 - void . forkIO $ void $ External.deliver (newBots `zip` repeat e) + for_ (nonEmpty removedUsers) $ \victims -> do + -- FUTUREWORK: deal with remote members, too, see updateLocalConversation (Jira SQCORE-903) + Data.removeLocalMembersFromLocalConv cnv victims + let qvictims = QualifiedUserIdList . map (`Qualified` localDomain) . toList $ victims + let e = Event MemberLeave qcnv qusr now (EdMembersLeave qvictims) + -- 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 + void . forkIO $ void $ External.deliver (newBots `zip` repeat e) -- Return the event pure accessEvent where @@ -306,10 +303,13 @@ updateConversationReceiptMode :: Public.ConversationReceiptModeUpdate -> Galley (UpdateResult Event) updateConversationReceiptMode usr zcon qcnv update = do - localDomain <- viewFederationDomain - if qDomain qcnv == localDomain - then updateConversationReceiptModeUnqualified usr zcon (qUnqualified qcnv) update - else throwM federationNotImplemented + lusr <- qualifyLocal usr + let doUpdate = + foldQualified + lusr + updateLocalConversationReceiptMode + updateRemoteConversationReceiptMode + doUpdate qcnv lusr zcon update updateConversationReceiptModeUnqualified :: UserId -> @@ -317,24 +317,29 @@ updateConversationReceiptModeUnqualified :: ConvId -> Public.ConversationReceiptModeUpdate -> Galley (UpdateResult Event) -updateConversationReceiptModeUnqualified usr zcon cnv receiptModeUpdate@(Public.ConversationReceiptModeUpdate target) = do - localDomain <- viewFederationDomain - let qcnv = Qualified cnv localDomain - qusr = Qualified usr localDomain - (bots, users) <- localBotsAndUsers <$> Data.members cnv - ensureActionAllowedThrowing ModifyConversationReceiptMode =<< getSelfMemberFromLocalsLegacy usr users - current <- Data.lookupReceiptMode cnv - if current == Just target - then pure Unchanged - else Updated <$> update qcnv qusr users bots - where - update qcnv qusr users bots = do - -- Update Cassandra & send an event - Data.updateConversationReceiptMode cnv target - now <- liftIO getCurrentTime - let receiptEvent = Event ConvReceiptModeUpdate qcnv qusr now (EdConvReceiptModeUpdate receiptModeUpdate) - pushConversationEvent (Just zcon) receiptEvent (map lmId users) bots - pure receiptEvent +updateConversationReceiptModeUnqualified usr zcon cnv update = do + lusr <- qualifyLocal usr + lcnv <- qualifyLocal cnv + updateLocalConversationReceiptMode lcnv lusr zcon update + +updateLocalConversationReceiptMode :: + Local ConvId -> + Local UserId -> + ConnId -> + Public.ConversationReceiptModeUpdate -> + Galley (UpdateResult Event) +updateLocalConversationReceiptMode lcnv lusr con update = + getUpdateResult $ + updateLocalConversation lcnv (unTagged lusr) (Just con) $ + ConversationActionReceiptModeUpdate update + +updateRemoteConversationReceiptMode :: + Remote ConvId -> + Local UserId -> + ConnId -> + Public.ConversationReceiptModeUpdate -> + Galley (UpdateResult Event) +updateRemoteConversationReceiptMode _ _ _ _ = throwM federationNotImplemented updateConversationMessageTimerUnqualified :: UserId -> @@ -366,29 +371,75 @@ updateLocalConversationMessageTimer :: Local ConvId -> Public.ConversationMessageTimerUpdate -> Galley (UpdateResult Event) -updateLocalConversationMessageTimer lusr zcon lcnv update = do +updateLocalConversationMessageTimer lusr con lcnv update = + getUpdateResult $ + updateLocalConversation lcnv (unTagged lusr) (Just con) $ + ConversationActionMessageTimerUpdate update + +-- | Update a local conversation, and notify all local and remote members. +updateLocalConversation :: + Local ConvId -> + Qualified UserId -> + Maybe ConnId -> + ConversationAction -> + MaybeT Galley Event +updateLocalConversation lcnv qusr con action = do + -- retrieve conversation (conv, self) <- - getConversationAndMemberWithError - (errorDescriptionTypeToWai @ConvNotFound) - (lUnqualified lusr) - (lUnqualified lcnv) + lift $ + getConversationAndMemberWithError + (errorDescriptionTypeToWai @ConvNotFound) + qusr + (lUnqualified lcnv) -- perform checks - ensureActionAllowedThrowing ModifyConversationMessageTimer self - ensureGroupConvThrowing conv + lift $ ensureConversationActionAllowed action conv self - let currentTimer = Data.convMessageTimer conv - if currentTimer == cupMessageTimer update - then pure Unchanged - else - Updated <$> do - -- perform update - Data.updateConversationMessageTimer (lUnqualified lcnv) (cupMessageTimer update) + -- perform action + (extraTargets, action') <- performAction qusr conv action - -- send notifications - let action = ConversationActionMessageTimerUpdate update - let targets = convTargets conv - notifyConversationMetadataUpdate (unTagged lusr) zcon lcnv targets action + -- send notifications to both local and remote users + lift $ + notifyConversationMetadataUpdate + qusr + con + lcnv + (convTargets conv <> extraTargets) + action' + +getUpdateResult :: Functor m => MaybeT m a -> m (UpdateResult a) +getUpdateResult = fmap (maybe Unchanged Updated) . runMaybeT + +-- | Perform a conversation action, and return extra notification targets and +-- an updated action. +performAction :: + Qualified UserId -> + Data.Conversation -> + ConversationAction -> + MaybeT Galley (NotificationTargets, ConversationAction) +performAction qusr conv action = case action of + ConversationActionAddMembers members role -> + performAddMemberAction qusr conv members role + ConversationActionRemoveMember member -> do + performRemoveMemberAction conv member + pure (mempty, action) + ConversationActionRename rename -> lift $ do + cn <- rangeChecked (cupName rename) + Data.updateConversation (Data.convId conv) cn + pure (mempty, action) + ConversationActionMessageTimerUpdate update -> do + guard $ Data.convMessageTimer conv /= cupMessageTimer update + lift $ Data.updateConversationMessageTimer (Data.convId conv) (cupMessageTimer update) + pure (mempty, action) + ConversationActionReceiptModeUpdate update -> do + guard $ Data.convReceiptMode conv /= Just (cruReceiptMode update) + lift $ Data.updateConversationReceiptMode (Data.convId conv) (cruReceiptMode update) + pure (mempty, action) + ConversationActionMemberUpdate target update -> lift $ do + lcnv <- qualifyLocal (Data.convId conv) + void $ ensureOtherMember lcnv target conv + Data.updateOtherMemberLocalConv lcnv target update + pure (mempty, action) addCodeH :: UserId ::: ConnId ::: ConvId -> Galley Response addCodeH (usr ::: zcon ::: cnv) = @@ -499,16 +550,26 @@ joinConversationById zusr zcon cnv = joinConversation :: UserId -> ConnId -> ConvId -> Access -> Galley (UpdateResult Event) joinConversation zusr zcon cnv access = do + lusr <- qualifyLocal zusr + lcnv <- qualifyLocal cnv conv <- ensureConversationAccess zusr cnv access - let newUsers = filter (notIsMember conv) [zusr] + ensureGroupConvThrowing conv -- FUTUREWORK: remote users? - ensureMemberLimit (toList $ Data.convLocalMembers conv) newUsers [] - -- 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 = localBotsAndUsers (Data.convLocalMembers conv) - let rMems = Data.convRemoteMembers conv - addToConversation mems rMems (zusr, roleNameWireMember) zcon ((,roleNameWireMember) <$> newUsers) [] conv + ensureMemberLimit (toList $ Data.convLocalMembers conv) [zusr] + getUpdateResult $ 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 users = filter (notIsConvMember lusr conv) [zusr] + (extraTargets, action) <- + addMembersToLocalConversation lcnv (UserList users []) roleNameWireMember + lift $ + notifyConversationMetadataUpdate + (unTagged lusr) + (Just zcon) + lcnv + (convTargets conv <> extraTargets) + action addMembersH :: UserId ::: ConnId ::: ConvId ::: JsonRequest Public.Invite -> Galley Response addMembersH (zusr ::: zcon ::: cid ::: req) = do @@ -517,47 +578,54 @@ addMembersH (zusr ::: zcon ::: cid ::: req) = do let qInvite = Public.InviteQualified (flip Qualified domain <$> toNonEmpty u) r handleUpdateResult <$> addMembers zusr zcon cid qInvite -addMembers :: UserId -> ConnId -> ConvId -> Public.InviteQualified -> Galley (UpdateResult Event) -addMembers zusr zcon convId invite = do - conv <- Data.conversation convId >>= ifNothing (errorDescriptionTypeToWai @ConvNotFound) - let mems = localBotsAndUsers (Data.convLocalMembers conv) - let rMems = Data.convRemoteMembers conv - self <- getSelfMemberFromLocalsLegacy zusr (snd mems) - ensureActionAllowedThrowing AddConversationMember self - let invitedUsers = toList $ Public.invQUsers invite - domain <- viewFederationDomain - let (invitedRemotes, invitedLocals) = partitionRemoteOrLocalIds' domain invitedUsers - let newLocals = filter (notIsMember conv) invitedLocals - let newRemotes = filter (notIsMember' conv) invitedRemotes - ensureMemberLimit (toList $ Data.convLocalMembers conv) newLocals newRemotes - ensureAccess conv InviteAccess - ensureConvRoleNotElevated self (invQRoleName invite) - checkLocals conv (Data.convTeam conv) newLocals - checkRemoteUsersExist newRemotes - checkLHPolicyConflictsLocal conv newLocals - checkLHPolicyConflictsRemote (FutureWork newRemotes) - addToConversation mems rMems (zusr, lmConvRoleName self) zcon (withRoles newLocals) (withRoles newRemotes) conv +-- | Add users to a conversation without performing any checks. Return extra +-- notification targets and the action performed. +addMembersToLocalConversation :: + Local ConvId -> + UserList UserId -> + RoleName -> + MaybeT Galley (NotificationTargets, ConversationAction) +addMembersToLocalConversation lcnv users role = do + (lmems, rmems) <- lift $ Data.addMembers lcnv (fmap (,role) users) + neUsers <- maybe mzero pure . nonEmpty . ulAll lcnv $ users + let action = ConversationActionAddMembers neUsers role + pure (ntFromMembers lmems rmems, action) + +performAddMemberAction :: + Qualified UserId -> + Data.Conversation -> + NonEmpty (Qualified UserId) -> + RoleName -> + MaybeT Galley (NotificationTargets, ConversationAction) +performAddMemberAction qusr conv invited role = do + lcnv <- lift $ qualifyLocal (Data.convId conv) + let newMembers = ulNewMembers lcnv conv . toUserList lcnv $ invited + lift $ do + ensureMemberLimit (toList (Data.convLocalMembers conv)) newMembers + ensureAccess conv InviteAccess + checkLocals lcnv (Data.convTeam conv) (ulLocals newMembers) + checkRemoteUsersExist (ulRemotes newMembers) + checkLHPolicyConflictsLocal lcnv (ulLocals newMembers) + checkLHPolicyConflictsRemote (FutureWork (ulRemotes newMembers)) + addMembersToLocalConversation lcnv newMembers role 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 + checkLocals :: Local ConvId -> Maybe TeamId -> [UserId] -> Galley () + checkLocals lcnv (Just tid) newUsers = do tms <- Data.teamMembersLimited tid newUsers let userMembershipMap = map (\u -> (u, find (userIsMember u) tms)) newUsers ensureAccessRole (Data.convAccessRole conv) userMembershipMap - tcv <- Data.teamConversation tid convId + tcv <- Data.teamConversation tid (lUnqualified lcnv) when (maybe True (view managedConversation) tcv) $ throwM noAddToManaged - ensureConnectedOrSameTeam zusr newUsers - checkLocals conv Nothing newUsers = do + ensureConnectedOrSameTeam qusr newUsers + checkLocals _ Nothing newUsers = do ensureAccessRole (Data.convAccessRole conv) (zip newUsers $ repeat Nothing) - ensureConnectedOrSameTeam zusr newUsers + ensureConnectedOrSameTeam qusr newUsers - checkLHPolicyConflictsLocal :: Data.Conversation -> [UserId] -> Galley () - checkLHPolicyConflictsLocal conv newUsers = do + checkLHPolicyConflictsLocal :: Local ConvId -> [UserId] -> Galley () + checkLHPolicyConflictsLocal lcnv newUsers = do let convUsers = Data.convLocalMembers conv allNewUsersGaveConsent <- allLegalholdConsentGiven newUsers @@ -581,55 +649,70 @@ addMembers zusr zcon convId invite = do ) convUsersLHStatus then do - localDomain <- viewFederationDomain for_ convUsersLHStatus $ \(mem, status) -> - when (consentGiven status == ConsentNotGiven) $ - let qvictim = Qualified (lmId mem) localDomain - in void $ - removeMember (lmId mem `Qualified` localDomain) Nothing (Data.convId conv `Qualified` localDomain) qvictim + when (consentGiven status == ConsentNotGiven) $ do + qvictim <- unTagged <$> qualifyLocal (lmId mem) + void . runMaybeT $ + updateLocalConversation lcnv qvictim Nothing $ + ConversationActionRemoveMember qvictim else throwErrorDescriptionType @MissingLegalholdConsent checkLHPolicyConflictsRemote :: FutureWork 'LegalholdPlusFederationNotImplemented [Remote UserId] -> Galley () checkLHPolicyConflictsRemote _remotes = pure () +addMembers :: UserId -> ConnId -> ConvId -> Public.InviteQualified -> Galley (UpdateResult Event) +addMembers zusr zcon cnv (Public.InviteQualified users role) = do + lusr <- qualifyLocal zusr + lcnv <- qualifyLocal cnv + getUpdateResult $ + updateLocalConversation lcnv (unTagged lusr) (Just zcon) $ + ConversationActionAddMembers users role + updateSelfMember :: UserId -> ConnId -> Qualified ConvId -> Public.MemberUpdate -> Galley () updateSelfMember zusr zcon qcnv update = do - localDomain <- viewFederationDomain - if qDomain qcnv == localDomain - then updateLocalSelfMember zusr zcon (toLocal qcnv) update - else updateRemoteSelfMember zusr zcon (toRemote qcnv) update + lusr <- qualifyLocal zusr + exists <- foldQualified lusr checkLocalMembership checkRemoteMembership qcnv lusr + unless exists (throwErrorDescriptionType @ConvNotFound) + Data.updateSelfMember lusr qcnv lusr update + now <- liftIO getCurrentTime + let e = Event MemberStateUpdate qcnv (unTagged lusr) now (EdMemberUpdate (updateData lusr)) + pushConversationEvent (Just zcon) e [zusr] [] + where + checkLocalMembership lcnv lusr = + isMember (lUnqualified lusr) + <$> Data.members (lUnqualified lcnv) + checkRemoteMembership rcnv lusr = + isJust . Map.lookup rcnv + <$> Data.remoteConversationStatus (lUnqualified lusr) [rcnv] + updateData luid = + MemberUpdateData + { misTarget = unTagged luid, + misOtrMutedStatus = mupOtrMuteStatus update, + misOtrMutedRef = mupOtrMuteRef update, + misOtrArchived = mupOtrArchive update, + misOtrArchivedRef = mupOtrArchiveRef update, + misHidden = mupHidden update, + misHiddenRef = mupHiddenRef update, + misConvRoleName = Nothing + } updateUnqualifiedSelfMember :: UserId -> ConnId -> ConvId -> Public.MemberUpdate -> Galley () -updateUnqualifiedSelfMember zusr zcon cid update = do - localDomain <- viewFederationDomain - updateLocalSelfMember zusr zcon (toLocal (Qualified cid localDomain)) update - -updateLocalSelfMember :: UserId -> ConnId -> Local ConvId -> Public.MemberUpdate -> Galley () -updateLocalSelfMember zusr zcon (Tagged qcid) update = do - -- FUTUREWORK: no need to fetch the whole conversation here: the - -- getConversationAndCheckMembership function results in 3 queries (for the - -- conversation metadata, remote members and local members respectively), but - -- only one is really needed (local members). - conv <- getConversationAndCheckMembership zusr (qUnqualified qcid) - m <- getSelfMemberFromLocalsLegacy zusr (Data.convLocalMembers conv) - luid <- qualifyLocal zusr - let targets = NotificationTargets [lmId m] [] [] - processUpdateMemberEvent luid zcon qcid targets luid update - -updateRemoteSelfMember :: +updateUnqualifiedSelfMember zusr zcon cnv update = do + lcnv <- qualifyLocal cnv + updateSelfMember zusr zcon (unTagged lcnv) update + +updateOtherMemberUnqualified :: UserId -> ConnId -> - Remote ConvId -> - Public.MemberUpdate -> + ConvId -> + UserId -> + Public.OtherMemberUpdate -> Galley () -updateRemoteSelfMember zusr zcon rcid update = do - statusMap <- Data.remoteConversationStatus zusr [rcid] - case Map.lookup rcid statusMap of - Nothing -> throwErrorDescriptionType @ConvMemberNotFound - Just _ -> do - luid <- qualifyLocal zusr - let targets = NotificationTargets [zusr] [] [] - processUpdateMemberEvent luid zcon (unTagged rcid) targets luid update +updateOtherMemberUnqualified zusr zcon cnv victim update = do + lusr <- qualifyLocal zusr + lcnv <- qualifyLocal cnv + lvictim <- qualifyLocal victim + updateOtherMemberLocalConv lcnv lusr zcon (unTagged lvictim) update updateOtherMember :: UserId -> @@ -638,81 +721,38 @@ updateOtherMember :: Qualified UserId -> Public.OtherMemberUpdate -> Galley () -updateOtherMember zusr zcon qcid qvictim update = do +updateOtherMember zusr zcon qcnv qvictim update = do lusr <- qualifyLocal zusr - foldQualified - lusr - (\lcid -> updateOtherMemberLocalConv lusr zcon lcid qvictim update) - (\_ -> throwM federationNotImplemented) - qcid + let doUpdate = foldQualified lusr updateOtherMemberLocalConv updateOtherMemberRemoteConv + doUpdate qcnv lusr zcon qvictim update -updateOtherMemberUnqualified :: - UserId -> +updateOtherMemberLocalConv :: + Local ConvId -> + Local UserId -> ConnId -> - ConvId -> - UserId -> + Qualified UserId -> Public.OtherMemberUpdate -> Galley () -updateOtherMemberUnqualified zusr zcon cnv victim update = do - lusr <- qualifyLocal zusr - lcnv <- qualifyLocal cnv - lvictim <- qualifyLocal victim - updateOtherMemberLocalConv lusr zcon lcnv (unTagged lvictim) update +updateOtherMemberLocalConv lcnv lusr con qvictim update = void . getUpdateResult $ do + when (unTagged lusr == qvictim) $ + throwM invalidTargetUserOp + updateLocalConversation lcnv (unTagged lusr) (Just con) $ + ConversationActionMemberUpdate qvictim update -updateOtherMemberLocalConv :: +updateOtherMemberRemoteConv :: + Remote ConvId -> Local UserId -> ConnId -> - Local ConvId -> Qualified UserId -> Public.OtherMemberUpdate -> Galley () -updateOtherMemberLocalConv luid zcon lcid qvictim update = do - when (unTagged luid == qvictim) $ - throwM invalidTargetUserOp - (conv, self) <- - getConversationAndMemberWithError - (errorDescriptionTypeToWai @ConvNotFound) - (lUnqualified luid) - (lUnqualified lcid) - ensureActionAllowedThrowing ModifyOtherConversationMember self - void $ ensureOtherMember luid qvictim (Data.convLocalMembers conv) (Data.convRemoteMembers conv) - processUpdateMemberEvent luid zcon (unTagged lcid) (convTargets conv) qvictim update - --- | 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 +updateOtherMemberRemoteConv _ _ _ _ _ = throwM federationNotImplemented 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) +removeMemberUnqualified zusr con cnv victim = do + lcnv <- qualifyLocal cnv + lvictim <- qualifyLocal victim + removeMemberQualified zusr con (unTagged lcnv) (unTagged lvictim) removeMemberQualified :: UserId -> @@ -720,88 +760,57 @@ removeMemberQualified :: Qualified ConvId -> Qualified UserId -> Galley RemoveFromConversationResponse -removeMemberQualified zusr zcon conv victim = do - localDomain <- viewFederationDomain - removeMember (Qualified zusr localDomain) (Just zcon) conv victim +removeMemberQualified zusr con qcnv victim = do + lusr <- qualifyLocal zusr + foldQualified lusr removeMemberFromLocalConv removeMemberFromRemoteConv qcnv lusr (Just con) victim + +removeMemberFromRemoteConv :: + Remote ConvId -> + Local UserId -> + Maybe ConnId -> + Qualified UserId -> + Galley RemoveFromConversationResponse +removeMemberFromRemoteConv (unTagged -> qcnv) lusr _ victim + | unTagged lusr == victim = + do + let lc = FederatedGalley.LeaveConversationRequest (qUnqualified qcnv) (qUnqualified victim) + let rpc = + FederatedGalley.leaveConversation + FederatedGalley.clientRoutes + (qDomain victim) + lc + t <- liftIO getCurrentTime + let successEvent = + Event MemberLeave qcnv (unTagged lusr) t $ + EdMembersLeave (QualifiedUserIdList [victim]) + mapRight (const successEvent) . FederatedGalley.leaveResponse <$> runFederated (qDomain qcnv) rpc + | otherwise = pure . Left $ RemoveFromConversationErrorRemovalNotAllowed + +performRemoveMemberAction :: + Data.Conversation -> + Qualified UserId -> + MaybeT Galley () +performRemoveMemberAction conv victim = do + loc <- qualifyLocal () + guard $ isConvMember loc conv victim + let removeLocal u c = Data.removeLocalMembersFromLocalConv c (pure (lUnqualified u)) + removeRemote u c = Data.removeRemoteMembersFromLocalConv c (pure u) + lift $ foldQualified loc removeLocal removeRemote victim (Data.convId conv) -- | Remove a member from a local conversation. removeMemberFromLocalConv :: - -- | The remover - Qualified UserId -> - -- | Optional connection ID + Local ConvId -> + Local UserId -> 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 lmConvRoleName <$> getSelfMemberFromLocals removerUid locals - else rmConvRoleName <$> getSelfMemberFromRemotes (toRemote remover) (Data.convRemoteMembers conv) - - generalConvChecks localDomain removerRole conv - - 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 = ConversationActionRemoveMembers $ pure qvictim - lift $ notifyRemoteAboutConvUpdate remover convId (evtTime event) action existingRemotes - - pure event - where - 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 + Galley RemoveFromConversationResponse +removeMemberFromLocalConv lcnv lusr con victim = + -- FUTUREWORK: actually return errors as part of the response instead of throwing + fmap (maybe (Left RemoveFromConversationErrorUnchanged) Right) + . runMaybeT + . updateLocalConversation lcnv (unTagged lusr) con + . ConversationActionRemoveMember + $ victim -- OTR @@ -982,7 +991,7 @@ updateLocalConversationName :: updateLocalConversationName lusr zcon lcnv convRename = do alive <- Data.isConvAlive (lUnqualified lcnv) if alive - then Just <$> updateLiveLocalConversationName lusr zcon lcnv convRename + then updateLiveLocalConversationName lusr zcon lcnv convRename else Nothing <$ Data.deleteConversation (lUnqualified lcnv) updateLiveLocalConversationName :: @@ -990,31 +999,15 @@ updateLiveLocalConversationName :: ConnId -> Local ConvId -> Public.ConversationRename -> - Galley Public.Event -updateLiveLocalConversationName lusr zcon lcnv convRename = do - -- get local members and bots - (bots, lusers) <- localBotsAndUsers <$> Data.members (lUnqualified lcnv) - - -- perform update - ensureActionAllowedThrowing ModifyConversationName - =<< getSelfMemberFromLocalsLegacy (lUnqualified lusr) lusers - cn <- rangeChecked (cupName convRename) - Data.updateConversation (lUnqualified lcnv) cn - - -- send notifications - rusers <- Data.lookupRemoteMembers (lUnqualified lcnv) - let targets = - NotificationTargets - { ntLocals = map lmId lusers, - ntRemotes = map rmId rusers, - ntBots = bots - } - let action = ConversationActionRename convRename - notifyConversationMetadataUpdate (unTagged lusr) zcon lcnv targets action + Galley (Maybe Public.Event) +updateLiveLocalConversationName lusr con lcnv rename = + runMaybeT $ + updateLocalConversation lcnv (unTagged lusr) (Just con) $ + ConversationActionRename rename notifyConversationMetadataUpdate :: Qualified UserId -> - ConnId -> + Maybe ConnId -> Local ConvId -> NotificationTargets -> ConversationAction -> @@ -1025,7 +1018,7 @@ notifyConversationMetadataUpdate quid con (Tagged qcnv) targets action = do let e = conversationActionToEvent now quid qcnv action -- notify remote participants - let rusersByDomain = partitionRemote (ntRemotes targets) + let rusersByDomain = partitionRemote (toList (ntRemotes targets)) void . pooledForConcurrentlyN 8 rusersByDomain $ \(domain, uids) -> do let req = FederatedGalley.ConversationUpdate now quid (qUnqualified qcnv) uids action rpc = @@ -1036,7 +1029,7 @@ notifyConversationMetadataUpdate quid con (Tagged qcnv) targets action = do runFederatedGalley domain rpc -- notify local participants and bots - pushConversationEvent (Just con) e (ntLocals targets) (ntBots targets) $> e + pushConversationEvent con e (ntLocals targets) (ntBots targets) $> e isTypingH :: UserId ::: ConnId ::: ConvId ::: JsonRequest Public.TypingData -> Galley Response isTypingH (zusr ::: zcon ::: cnv ::: req) = do @@ -1078,28 +1071,28 @@ addBotH (zusr ::: zcon ::: req) = do addBot :: UserId -> ConnId -> AddBot -> Galley Event addBot zusr zcon b = do - localDomain <- viewFederationDomain - let qusr = Qualified zusr localDomain + lusr <- qualifyLocal zusr c <- Data.conversation (b ^. addBotConv) >>= ifNothing (errorDescriptionTypeToWai @ConvNotFound) -- Check some preconditions on adding bots to a conversation for_ (Data.convTeam c) $ teamConvChecks (b ^. addBotConv) - (bots, users) <- regularConvChecks c + (bots, users) <- regularConvChecks lusr c t <- liftIO getCurrentTime Data.updateClient True (botUserId (b ^. addBotId)) (b ^. addBotClient) - (e, bm) <- Data.addBotMember qusr (b ^. addBotService) (b ^. addBotId) (b ^. addBotConv) t + (e, bm) <- Data.addBotMember (unTagged lusr) (b ^. addBotService) (b ^. addBotId) (b ^. addBotConv) t for_ (newPushLocal ListComplete zusr (ConvEvent e) (recipient <$> users)) $ \p -> push1 $ p & pushConn ?~ zcon void . forkIO $ void $ External.deliver ((bm : bots) `zip` repeat e) pure e where - regularConvChecks c = do + regularConvChecks lusr c = do let (bots, users) = localBotsAndUsers (Data.convLocalMembers c) unless (zusr `isMember` users) $ throwErrorDescriptionType @ConvNotFound ensureGroupConvThrowing c - ensureActionAllowedThrowing AddConversationMember =<< getSelfMemberFromLocalsLegacy zusr users - unless (any ((== b ^. addBotId) . botMemId) bots) $ - ensureMemberLimit (toList $ Data.convLocalMembers c) [botUserId (b ^. addBotId)] [] + ensureActionAllowed AddConversationMember =<< getSelfMemberFromLocalsLegacy zusr users + unless (any ((== b ^. addBotId) . botMemId) bots) $ do + let botId = qualifyAs lusr (botUserId (b ^. addBotId)) + ensureMemberLimit (toList $ Data.convLocalMembers c) [unTagged botId] return (bots, users) teamConvChecks cid tid = do tcv <- Data.teamConversation tid cid @@ -1136,117 +1129,18 @@ rmBot zusr zcon b = do ------------------------------------------------------------------------------- -- Helpers -addToConversation :: - -- | The existing bots and local users in the conversation - ([BotMember], [LocalMember]) -> - -- | The existing remote users - [RemoteMember] -> - -- | The originating user and their role - (UserId, RoleName) -> - -- | The connection ID of the originating user - ConnId -> - -- | New local users to be added and their roles - [(UserId, RoleName)] -> - -- | New remote users to be added and their roles - [(Remote UserId, RoleName)] -> - -- | The conversation to modify - Data.Conversation -> - Galley (UpdateResult Event) -addToConversation _ _ _ _ [] [] _ = pure Unchanged -addToConversation (bots, existingLocals) existingRemotes (usr, usrRole) conn newLocals newRemotes c = do - ensureGroupConvThrowing c - mems <- checkedMemberAddSize newLocals newRemotes - now <- liftIO getCurrentTime - localDomain <- viewFederationDomain - (e, lmm, rmm) <- Data.addMembersWithRole localDomain now (Data.convId c) (usr, usrRole) mems - let newMembersWithRoles = - ((flip Qualified localDomain . lmId &&& lmConvRoleName) <$> lmm) - <> ((unTagged . rmId &&& rmConvRoleName) <$> rmm) - case newMembersWithRoles of - [] -> - pure () - (x : xs) -> do - let action = ConversationActionAddMembers (x :| xs) - qusr = Qualified usr localDomain - notifyRemoteAboutConvUpdate qusr (convId c) now action (rmId <$> existingRemotes <> rmm) - let localsToNotify = nubOrd . fmap lmId $ existingLocals <> lmm - pushConversationEvent (Just conn) e localsToNotify bots - pure $ Updated e - -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 +ensureMemberLimit :: Foldable f => [LocalMember] -> f a -> Galley () +ensureMemberLimit old new = do o <- view options let maxSize = fromIntegral (o ^. optSettings . setMaxConvSize) - when (length old + length newLocals + length newRemotes > maxSize) $ + when (length old + length new > maxSize) $ throwM tooManyMembers -notIsMember :: Data.Conversation -> UserId -> Bool -notIsMember cc u = not $ isMember u (Data.convLocalMembers cc) - -notIsMember' :: Data.Conversation -> Remote UserId -> Bool -notIsMember' cc u = not $ isRemoteMember u (Data.convRemoteMembers cc) - ensureConvMember :: [LocalMember] -> UserId -> Galley () ensureConvMember users usr = unless (usr `isMember` users) $ throwErrorDescriptionType @ConvNotFound --- | Update a member of a conversation and propagate events. --- --- Note: the victim is assumed to be a member of the conversation. -processUpdateMemberEvent :: - ( IsNotificationTarget uid, - Data.IsMemberUpdate mu uid - ) => - -- | Originating user - Local UserId -> - -- | Connection ID for the originating user - ConnId -> - -- | Conversation whose members are being updated - Qualified ConvId -> - -- | Recipients of the notification - NotificationTargets -> - -- | User being updated - uid -> - -- | Update structure - mu -> - Galley () -processUpdateMemberEvent lusr zcon qcid targets victim update = do - up <- - foldQualified - lusr - Data.updateMember - Data.updateMemberRemoteConv - qcid - victim - update - void $ - notifyConversationMetadataUpdate - (unTagged lusr) - zcon - (toLocal qcid) - (ntAdd lusr victim targets) - (ConversationActionMemberUpdate up) - ------------------------------------------------------------------------------- -- OtrRecipients Validation diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 86d1799f4c8..4eaa39b1f7c 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -52,7 +52,8 @@ import Galley.Options (optSettings, setFeatureFlags, setFederationDomain) import Galley.Types import Galley.Types.Conversations.Members (localMemberToOther, remoteMemberToOther) import Galley.Types.Conversations.Roles -import Galley.Types.Teams hiding (Event) +import Galley.Types.Teams hiding (Event, MemberJoin, self) +import Galley.Types.UserList import Imports import Network.HTTP.Types import Network.Wai @@ -60,7 +61,7 @@ import Network.Wai.Predicate hiding (Error) import Network.Wai.Utilities import UnliftIO (concurrently) import qualified Wire.API.Conversation as Public -import Wire.API.Conversation.Action (ConversationAction (..)) +import Wire.API.Conversation.Action (ConversationAction (..), conversationActionTag) import Wire.API.ErrorDescription import qualified Wire.API.Federation.API.Brig as FederatedBrig import Wire.API.Federation.API.Galley as FederatedGalley @@ -88,16 +89,18 @@ ensureAccessRole role users = case role of -- -- Team members are always considered connected, so we only check 'ensureConnected' -- for non-team-members of the _given_ user -ensureConnectedOrSameTeam :: UserId -> [UserId] -> Galley () +ensureConnectedOrSameTeam :: Qualified UserId -> [UserId] -> Galley () ensureConnectedOrSameTeam _ [] = pure () -ensureConnectedOrSameTeam u uids = do - uTeams <- Data.userTeams u - -- We collect all the relevant uids from same teams as the origin user - sameTeamUids <- forM uTeams $ \team -> - fmap (view userId) <$> Data.teamMembersLimited team uids - -- Do not check connections for users that are on the same team +ensureConnectedOrSameTeam (Qualified u domain) uids = do -- FUTUREWORK(federation, #1262): handle remote users (can't be part of the same team, just check connections) - ensureConnected u (uids \\ join sameTeamUids) + localDomain <- viewFederationDomain + when (localDomain == domain) $ do + uTeams <- Data.userTeams u + -- We collect all the relevant uids from same teams as the origin user + sameTeamUids <- forM uTeams $ \team -> + fmap (view userId) <$> Data.teamMembersLimited team uids + -- Do not check connections for users that are on the same team + ensureConnected u (uids \\ join sameTeamUids) -- | Check that the user is connected to everybody else. -- @@ -125,41 +128,51 @@ 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. -ensureActionAllowedThrowing :: Action -> LocalMember -> Galley () -ensureActionAllowedThrowing action mem = - case ensureActionAllowed action (lmConvRoleName 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 +-- is permitted. If the user does not have the given permission, throw +-- 'operationDenied'. +ensureActionAllowed :: IsConvMember mem => Action -> mem -> Galley () +ensureActionAllowed action self = case isActionAllowed action (convMemberRole self) of + Just True -> pure () + Just False -> throwErrorDescription (actionDenied action) + -- Actually, this will "never" happen due to the + -- fact that there can be no custom roles at the moment + Nothing -> throwM (badRequest "Custom roles not supported") + +-- | Comprehensive permission check, taking action-specific logic into account. +ensureConversationActionAllowed :: + IsConvMember mem => + ConversationAction -> + Data.Conversation -> + mem -> + Galley () +ensureConversationActionAllowed action conv self = do + loc <- qualifyLocal () + let tag = conversationActionTag (convMemberId loc self) action + -- general action check + ensureActionAllowed tag self + -- check if it is a group conversation (except for rename actions) + when (tag /= ModifyConversationName) $ + ensureGroupConvThrowing conv + -- extra action-specific checks + case action of + ConversationActionAddMembers _ role -> ensureConvRoleNotElevated self role + _ -> pure () + +ensureGroupConvThrowing :: Data.Conversation -> Galley () +ensureGroupConvThrowing conv = case Data.convType conv of + SelfConv -> throwM invalidSelfOp + One2OneConv -> throwM invalidOne2OneOp + ConnectConv -> throwM invalidConnectOp + _ -> pure () -- | Ensure that the set of actions provided are not "greater" than the user's -- own. This is used to ensure users cannot "elevate" allowed actions -- This function needs to be review when custom roles are introduced since only -- custom roles can cause `roleNameToActions` to return a Nothing -ensureConvRoleNotElevated :: LocalMember -> RoleName -> Galley () +ensureConvRoleNotElevated :: IsConvMember mem => mem -> RoleName -> Galley () ensureConvRoleNotElevated origMember targetRole = do - case (roleNameToActions targetRole, roleNameToActions (lmConvRoleName origMember)) of + case (roleNameToActions targetRole, roleNameToActions (convMemberRole origMember)) of (Just targetActions, Just memberActions) -> unless (Set.isSubsetOf targetActions memberActions) $ throwM invalidActions @@ -203,14 +216,14 @@ permissionCheckTeamConv zusr cnv perm = -- | Try to accept a 1-1 conversation, promoting connect conversations as appropriate. acceptOne2One :: UserId -> Data.Conversation -> Maybe ConnId -> Galley Data.Conversation acceptOne2One usr conv conn = do - localDomain <- viewFederationDomain + lusr <- qualifyLocal usr + lcid <- qualifyLocal cid case Data.convType conv of One2OneConv -> if usr `isMember` mems then return conv else do - now <- liftIO getCurrentTime - mm <- snd <$> Data.addMember localDomain now cid usr + mm <- Data.addMember lcid lusr return $ conv {Data.convLocalMembers = mems <> toList mm} ConnectConv -> case mems of [_, _] | usr `isMember` mems -> promote @@ -219,7 +232,8 @@ acceptOne2One usr conv conn = do when (length mems > 2) $ throwM badConvState now <- liftIO getCurrentTime - (e, mm) <- Data.addMember localDomain now cid usr + mm <- Data.addMember lcid lusr + let e = memberJoinEvent lusr (unTagged lcid) now mm [] conv' <- if isJust (find ((usr /=) . lmId) mems) then promote else pure conv let mems' = mems <> toList mm for_ (newPushLocal ListComplete usr (ConvEvent e) (recipient <$> mems')) $ \p -> @@ -237,6 +251,20 @@ acceptOne2One usr conv conn = do "Connect conversation with more than 2 members: " <> LT.pack (show cid) +memberJoinEvent :: + Local UserId -> + Qualified ConvId -> + UTCTime -> + [LocalMember] -> + [RemoteMember] -> + Event +memberJoinEvent lorig qconv t lmems rmems = + Event MemberJoin qconv (unTagged lorig) t $ + EdMembersJoin (SimpleMembers (map localToSimple lmems <> map remoteToSimple rmems)) + where + localToSimple u = SimpleMember (unTagged (qualifyAs lorig (lmId u))) (lmConvRoleName u) + remoteToSimple u = SimpleMember (unTagged (rmId u)) (rmConvRoleName u) + isBot :: LocalMember -> Bool isBot = isJust . lmService @@ -246,6 +274,54 @@ isMember u = isJust . find ((u ==) . lmId) isRemoteMember :: Foldable m => Remote UserId -> m RemoteMember -> Bool isRemoteMember u = isJust . find ((u ==) . rmId) +class IsConvMember mem => IsConvMemberId uid mem | uid -> mem where + getConvMember :: Local x -> Data.Conversation -> uid -> Maybe mem + + isConvMember :: Local x -> Data.Conversation -> uid -> Bool + isConvMember loc conv = isJust . getConvMember loc conv + + notIsConvMember :: Local x -> Data.Conversation -> uid -> Bool + notIsConvMember loc conv = not . isConvMember loc conv + +instance IsConvMemberId UserId LocalMember where + getConvMember _ conv u = find ((u ==) . lmId) (Data.convLocalMembers conv) + +instance IsConvMemberId (Local UserId) LocalMember where + getConvMember loc conv = getConvMember loc conv . lUnqualified + +instance IsConvMemberId (Remote UserId) RemoteMember where + getConvMember _ conv u = find ((u ==) . rmId) (Data.convRemoteMembers conv) + +instance IsConvMemberId (Qualified UserId) (Either LocalMember RemoteMember) where + getConvMember loc conv = + foldQualified + loc + (fmap Left . getConvMember loc conv) + (fmap Right . getConvMember loc conv) + +class IsConvMember mem where + convMemberRole :: mem -> RoleName + convMemberId :: Local x -> mem -> Qualified UserId + +instance IsConvMember LocalMember where + convMemberRole = lmConvRoleName + convMemberId loc mem = unTagged (qualifyAs loc (lmId mem)) + +instance IsConvMember RemoteMember where + convMemberRole = rmConvRoleName + convMemberId _ = unTagged . rmId + +instance IsConvMember (Either LocalMember RemoteMember) where + convMemberRole = either convMemberRole convMemberRole + convMemberId loc = either (convMemberId loc) (convMemberId loc) + +-- | Remove users that are already present in the conversation. +ulNewMembers :: Local x -> Data.Conversation -> UserList UserId -> UserList UserId +ulNewMembers loc conv (UserList locals remotes) = + UserList + (filter (notIsConvMember loc conv) locals) + (filter (notIsConvMember loc conv) remotes) + -- | This is an ad-hoc class to update notification targets based on the type -- of the user id. Local user IDs get added to the local targets, remote user IDs -- to remote targets, and qualified user IDs get added to the appropriate list @@ -254,30 +330,44 @@ class IsNotificationTarget uid where ntAdd :: Local x -> uid -> NotificationTargets -> NotificationTargets data NotificationTargets = NotificationTargets - { ntLocals :: [UserId], - ntRemotes :: [Remote UserId], - ntBots :: [BotMember] + { ntLocals :: Set UserId, + ntRemotes :: Set (Remote UserId), + ntBots :: Set BotMember } +instance Semigroup NotificationTargets where + NotificationTargets locals1 remotes1 bots1 + <> NotificationTargets locals2 remotes2 bots2 = + NotificationTargets + (locals1 <> locals2) + (remotes1 <> remotes2) + (bots1 <> bots2) + +instance Monoid NotificationTargets where + mempty = NotificationTargets mempty mempty mempty + instance IsNotificationTarget (Local UserId) where - ntAdd _ (Tagged (Qualified uid _)) nt = - nt {ntLocals = uid : filter (/= uid) (ntLocals nt)} + ntAdd _ luid nt = + nt {ntLocals = Set.insert (lUnqualified luid) (ntLocals nt)} instance IsNotificationTarget (Remote UserId) where - ntAdd _ ruid nt = nt {ntRemotes = ruid : filter (/= ruid) (ntRemotes nt)} + ntAdd _ ruid nt = nt {ntRemotes = Set.insert ruid (ntRemotes nt)} instance IsNotificationTarget (Qualified UserId) where ntAdd loc = foldQualified loc (ntAdd loc) (ntAdd loc) -convTargets :: Data.Conversation -> NotificationTargets -convTargets conv = case localBotsAndUsers (Data.convLocalMembers conv) of +ntFromMembers :: [LocalMember] -> [RemoteMember] -> NotificationTargets +ntFromMembers lmems rusers = case localBotsAndUsers lmems of (bots, lusers) -> NotificationTargets - { ntLocals = map lmId lusers, - ntRemotes = map rmId (Data.convRemoteMembers conv), - ntBots = bots + { ntLocals = Set.fromList (map lmId lusers), + ntRemotes = Set.fromList (map rmId rusers), + ntBots = Set.fromList bots } +convTargets :: Data.Conversation -> NotificationTargets +convTargets conv = ntFromMembers (Data.convLocalMembers conv) (Data.convRemoteMembers conv) + localBotsAndUsers :: Foldable f => f LocalMember -> ([BotMember], [LocalMember]) localBotsAndUsers = foldMap botOrUser where @@ -331,13 +421,12 @@ getSelfMemberFromLocalsLegacy usr lmems = ensureOtherMember :: Local a -> Qualified UserId -> - [LocalMember] -> - [RemoteMember] -> + Data.Conversation -> Galley (Either LocalMember RemoteMember) -ensureOtherMember loc quid locals remotes = +ensureOtherMember loc quid conv = maybe (throwErrorDescriptionType @ConvMemberNotFound) pure $ - (Left <$> find ((== quid) . (`Qualified` lDomain loc) . lmId) locals) - <|> (Right <$> find ((== quid) . unTagged . rmId) remotes) + (Left <$> find ((== quid) . (`Qualified` lDomain loc) . lmId) (Data.convLocalMembers conv)) + <|> (Right <$> find ((== quid) . unTagged . rmId) (Data.convRemoteMembers conv)) -- | Note that we use 2 nearly identical functions but slightly different -- semantics; when using `getSelfMemberQualified`, if that user is _not_ part of @@ -385,6 +474,20 @@ getRemoteMember :: ExceptT e m RemoteMember getRemoteMember = getMember rmId +getQualifiedMember :: + Monad m => + Local x -> + e -> + Qualified UserId -> + Data.Conversation -> + ExceptT e m (Either LocalMember RemoteMember) +getQualifiedMember loc e qusr conv = + foldQualified + loc + (\lusr -> Left <$> getLocalMember e (lUnqualified lusr) (Data.convLocalMembers conv)) + (\rusr -> Right <$> getRemoteMember e rusr (Data.convRemoteMembers conv)) + qusr + getMember :: (Foldable t, Eq userId, Monad m) => -- | A projection from a member type to its user ID @@ -399,23 +502,29 @@ getMember :: getMember p ex u = hoistEither . note ex . find ((u ==) . p) getConversationAndCheckMembership :: UserId -> ConvId -> Galley Data.Conversation -getConversationAndCheckMembership uid = - fmap fst - . getConversationAndMemberWithError (errorDescriptionTypeToWai @ConvAccessDenied) uid +getConversationAndCheckMembership uid cnv = do + (conv, _) <- + getConversationAndMemberWithError + (errorDescriptionTypeToWai @ConvAccessDenied) + uid + cnv + pure conv getConversationAndMemberWithError :: + IsConvMemberId uid mem => Error -> - UserId -> + uid -> ConvId -> - Galley (Data.Conversation, LocalMember) -getConversationAndMemberWithError ex zusr convId = do + Galley (Data.Conversation, mem) +getConversationAndMemberWithError ex usr convId = do c <- Data.conversation convId >>= ifNothing (errorDescriptionTypeToWai @ConvNotFound) when (DataTypes.isConvDeleted c) $ do Data.deleteConversation convId throwErrorDescriptionType @ConvNotFound + loc <- qualifyLocal () member <- - eitherM throwM pure . runExceptT $ - getLocalMember ex zusr (Data.convLocalMembers c) + either throwM pure . note ex $ + getConvMember loc c usr pure (c, member) -- | Deletion requires a permission check, but also a 'Role' comparison: @@ -436,12 +545,12 @@ canDeleteMember deleter deletee getRole mem = fromMaybe RoleMember $ permissionsRole $ mem ^. permissions -- | Send an event to local users and bots -pushConversationEvent :: Maybe ConnId -> Event -> [UserId] -> [BotMember] -> Galley () +pushConversationEvent :: Foldable f => Maybe ConnId -> Event -> f UserId -> f BotMember -> Galley () pushConversationEvent conn e users bots = do localDomain <- viewFederationDomain - for_ (newConversationEventPush localDomain e users) $ \p -> + for_ (newConversationEventPush localDomain e (toList users)) $ \p -> push1 $ p & set pushConn conn - void . forkIO $ void $ External.deliver (bots `zip` repeat e) + void . forkIO $ void $ External.deliver (toList bots `zip` repeat e) verifyReusableCode :: ConversationCode -> Galley DataTypes.Code verifyReusableCode convCode = do @@ -474,13 +583,11 @@ viewFederationDomain = view (options . optSettings . setFederationDomain) qualifyLocal :: MonadReader Env m => a -> m (Local a) qualifyLocal a = fmap (toLocal . Qualified a) viewFederationDomain -checkRemoteUsersExist :: [Remote UserId] -> Galley () +checkRemoteUsersExist :: (Functor f, Foldable f) => f (Remote UserId) -> Galley () checkRemoteUsersExist = -- FUTUREWORK: pooledForConcurrentlyN_ instead of sequential checks per domain traverse_ (uncurry checkRemotesFor) - . Map.assocs - . partitionQualified - . map unTagged + . partitionRemote checkRemotesFor :: Domain -> [UserId] -> Galley () checkRemotesFor domain uids = do @@ -628,40 +735,6 @@ registerRemoteConversationMemberships now localDomain c = do let rpc = FederatedGalley.onConversationCreated FederatedGalley.clientRoutes localDomain rc runFederated domain rpc --- | 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 - ConversationAction -> - -- | Remote members that need to be notified - [Remote UserId] -> - Galley () -notifyRemoteAboutConvUpdate origUser convId time action remotesToNotify = do - localDomain <- viewFederationDomain - let mkUpdate oth = ConversationUpdate time origUser convId oth action - traverse_ (uncurry (notificationRPC localDomain . mkUpdate) . swap) - . Map.assocs - . partitionQualified - . nubOrd - . map unTagged - $ remotesToNotify - where - notificationRPC :: Domain -> ConversationUpdate -> Domain -> Galley () - notificationRPC sendingDomain cu receivingDomain = do - let rpc = - FederatedGalley.onConversationUpdated - FederatedGalley.clientRoutes - sendingDomain - cu - runFederated receivingDomain rpc - -------------------------------------------------------------------------------- -- Legalhold diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index d2e97f046ee..eed0dcbb6fc 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -81,7 +81,7 @@ module Galley.Data -- * Conversation Members addMember, - addMembersWithRole, + addMembers, addLocalMembersToRemoteConv, member, members, @@ -90,7 +90,14 @@ module Galley.Data removeLocalMembersFromLocalConv, removeRemoteMembersFromLocalConv, removeLocalMembersFromRemoteConv, - IsMemberUpdate (..), + updateSelfMember, + updateSelfMemberLocalConv, + updateSelfMemberRemoteConv, + updateOtherMember, + updateOtherMemberLocalConv, + updateOtherMemberRemoteConv, + ToUserRole (..), + toQualifiedUserRole, filterRemoteConvMembers, -- * Conversation Codes @@ -116,7 +123,7 @@ where import Brig.Types.Code import Cassandra hiding (Tagged) import Cassandra.Util -import Control.Arrow (first, second) +import Control.Arrow (second) import Control.Exception (ErrorCall (ErrorCall)) import Control.Lens hiding ((<|)) import Control.Monad.Catch (MonadThrow, throwM) @@ -129,7 +136,6 @@ 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 import Data.Misc (Milliseconds) import qualified Data.Monoid @@ -137,7 +143,6 @@ import Data.Qualified import Data.Range import qualified Data.Set as Set import Data.Tagged -import Data.Time.Clock import qualified Data.UUID.Tagged as U import Data.UUID.V4 (nextRandom) import Galley.App @@ -153,6 +158,7 @@ import Galley.Types.Conversations.Members import Galley.Types.Conversations.Roles import Galley.Types.Teams hiding (Event, EventType (..), teamConversations, teamMembers) import Galley.Types.Teams.Intra +import Galley.Types.UserList import Galley.Validation import Imports hiding (Set, max) import System.Logger.Class (MonadLogger) @@ -621,21 +627,21 @@ conversationsRemote usr = do createConversation :: MonadClient m => - Domain -> - UserId -> + Local UserId -> Maybe (Range 1 256 Text) -> [Access] -> AccessRole -> - ConvSizeChecked ([Remote UserId], [UserId]) -> + ConvSizeChecked UserList UserId -> Maybe ConvTeamInfo -> -- | Message timer Maybe Milliseconds -> Maybe ReceiptMode -> RoleName -> m Conversation -createConversation localDomain usr name acc role others tinfo mtimer recpt othersConversationRole = do +createConversation lusr name acc role others tinfo mtimer recpt othersConversationRole = do conv <- Id <$> liftIO nextRandom - now <- liftIO getCurrentTime + let lconv = qualifyAs lusr conv + usr = lUnqualified lusr retry x5 $ case tinfo of Nothing -> write Cql.insertConv (params Quorum (conv, RegularConv, usr, Set (toList acc), role, fromRange <$> name, Nothing, mtimer, recpt)) @@ -644,55 +650,51 @@ createConversation localDomain usr name acc role others tinfo mtimer recpt other setConsistency Quorum addPrepQuery Cql.insertConv (conv, RegularConv, usr, Set (toList acc), role, fromRange <$> name, Just (cnvTeamId ti), mtimer, recpt) addPrepQuery Cql.insertTeamConv (cnvTeamId ti, conv, cnvManaged ti) - let (remoteUsers, localUsers) = fromConvSize others - (_, mems, rMems) <- addMembersUncheckedWithRole localDomain now conv (usr, roleNameWireAdmin) (toList $ list1 (usr, roleNameWireAdmin) ((,othersConversationRole) <$> localUsers)) ((,othersConversationRole) <$> remoteUsers) - return $ newConv conv RegularConv usr mems rMems acc role name (cnvTeamId <$> tinfo) mtimer recpt - -createSelfConversation :: MonadClient m => Domain -> UserId -> Maybe (Range 1 256 Text) -> m Conversation -createSelfConversation localDomain usr name = do - let conv = selfConv usr - now <- liftIO getCurrentTime + let newUsers = fmap (,othersConversationRole) (fromConvSize others) + (lmems, rmems) <- addMembers lconv (ulAddLocal (lUnqualified lusr, roleNameWireAdmin) newUsers) + pure $ newConv conv RegularConv usr lmems rmems acc role name (cnvTeamId <$> tinfo) mtimer recpt + +createSelfConversation :: MonadClient m => Local UserId -> Maybe (Range 1 256 Text) -> m Conversation +createSelfConversation lusr name = do + let usr = lUnqualified lusr + conv = selfConv usr + lconv = qualifyAs lusr conv retry x5 $ write Cql.insertConv (params Quorum (conv, SelfConv, usr, privateOnly, privateRole, fromRange <$> name, Nothing, Nothing, Nothing)) - mems <- snd <$> addLocalMembersUnchecked localDomain now conv usr (singleton usr) - return $ newConv conv SelfConv usr (toList mems) [] [PrivateAccess] privateRole name Nothing Nothing Nothing + (lmems, rmems) <- addMembers lconv (UserList [lUnqualified lusr] []) + pure $ newConv conv SelfConv usr lmems rmems [PrivateAccess] privateRole name Nothing Nothing Nothing createConnectConversation :: MonadClient m => - Domain -> + Local x -> U.UUID U.V4 -> U.UUID U.V4 -> Maybe (Range 1 256 Text) -> - Connect -> - m (Conversation, Event) -createConnectConversation localDomain a b name conn = do + m Conversation +createConnectConversation loc a b name = do let conv = one2OneConvId a b - qconv = Qualified conv localDomain + lconv = qualifyAs loc conv a' = Id . U.unpack $ a - qa' = Qualified a' localDomain - now <- liftIO getCurrentTime retry x5 $ write Cql.insertConv (params Quorum (conv, ConnectConv, a', privateOnly, privateRole, fromRange <$> name, Nothing, Nothing, Nothing)) -- We add only one member, second one gets added later, -- when the other user accepts the connection request. - mems <- snd <$> addLocalMembersUnchecked localDomain now conv a' (singleton a') - let e = Event ConvConnect qconv qa' now (EdConnect conn) - let remoteMembers = [] -- FUTUREWORK: federated connections - return (newConv conv ConnectConv a' (toList mems) remoteMembers [PrivateAccess] privateRole name Nothing Nothing Nothing, e) + (lmems, rmems) <- addMembers lconv (UserList [a'] []) + pure $ newConv conv ConnectConv a' lmems rmems [PrivateAccess] privateRole name Nothing Nothing Nothing createOne2OneConversation :: MonadClient m => - Domain -> + Local x -> U.UUID U.V4 -> U.UUID U.V4 -> Maybe (Range 1 256 Text) -> Maybe TeamId -> m Conversation -createOne2OneConversation localDomain a b name ti = do +createOne2OneConversation loc a b name ti = do let conv = one2OneConvId a b + lconv = qualifyAs loc conv a' = Id (U.unpack a) b' = Id (U.unpack b) - now <- liftIO getCurrentTime retry x5 $ case ti of Nothing -> write Cql.insertConv (params Quorum (conv, One2OneConv, a', privateOnly, privateRole, fromRange <$> name, Nothing, Nothing, Nothing)) Just tid -> batch $ do @@ -700,9 +702,9 @@ createOne2OneConversation localDomain a b name ti = do setConsistency Quorum addPrepQuery Cql.insertConv (conv, One2OneConv, a', privateOnly, privateRole, fromRange <$> name, Just tid, Nothing, Nothing) addPrepQuery Cql.insertTeamConv (tid, conv, False) - mems <- snd <$> addLocalMembersUnchecked localDomain now conv a' (list1 a' [b']) - let remoteMembers = [] -- FUTUREWORK: federated one2one - return $ newConv conv One2OneConv a' (toList mems) remoteMembers [PrivateAccess] privateRole name ti Nothing Nothing + -- FUTUREWORK: federated one2one + (lmems, rmems) <- addMembers lconv (UserList [a', b'] []) + pure $ newConv conv One2OneConv a' lmems rmems [PrivateAccess] privateRole name ti Nothing Nothing updateConversation :: MonadClient m => ConvId -> Range 1 256 Text -> m () updateConversation cid name = retry x5 $ write Cql.updateConvName (params Quorum (fromRange name, cid)) @@ -859,28 +861,34 @@ lookupRemoteMembers :: (MonadClient m) => ConvId -> m [RemoteMember] lookupRemoteMembers conv = join <$> remoteMemberLists [conv] -- | Add a member to a local conversation, as an admin. -addMember :: MonadClient m => Domain -> UTCTime -> ConvId -> UserId -> m (Event, [LocalMember]) -addMember localDomain t c u = addLocalMembersUnchecked localDomain t c u (singleton u) +addMember :: MonadClient m => Local ConvId -> Local UserId -> m [LocalMember] +addMember c u = fst <$> addMembers c (UserList [lUnqualified u] []) --- | Add members to a local conversation. -addMembersWithRole :: MonadClient m => Domain -> UTCTime -> ConvId -> (UserId, RoleName) -> ConvMemberAddSizeChecked -> m (Event, [LocalMember], [RemoteMember]) -addMembersWithRole localDomain t c orig mems = addMembersUncheckedWithRole localDomain t c orig (sizeCheckedLocals mems) (sizeCheckedRemotes mems) +class ToUserRole a where + toUserRole :: a -> (UserId, RoleName) --- | Add members to a local conversation, all as admins. --- Please make sure the conversation doesn't exceed the maximum size! -addLocalMembersUnchecked :: MonadClient m => Domain -> UTCTime -> ConvId -> UserId -> List1 UserId -> m (Event, [LocalMember]) -addLocalMembersUnchecked localDomain t conv orig usrs = addLocalMembersUncheckedWithRole localDomain t conv (orig, roleNameWireAdmin) ((,roleNameWireAdmin) <$> usrs) +instance ToUserRole (UserId, RoleName) where + toUserRole = id --- | Add only local members to a local conversation. --- Please make sure the conversation doesn't exceed the maximum size! -addLocalMembersUncheckedWithRole :: MonadClient m => Domain -> UTCTime -> ConvId -> (UserId, RoleName) -> List1 (UserId, RoleName) -> m (Event, [LocalMember]) -addLocalMembersUncheckedWithRole localDomain t conv orig lusers = (\(a, b, _) -> (a, b)) <$> addMembersUncheckedWithRole localDomain t conv orig (toList lusers) [] +instance ToUserRole UserId where + toUserRole uid = (uid, roleNameWireAdmin) + +toQualifiedUserRole :: ToUserRole a => Qualified a -> (Qualified UserId, RoleName) +toQualifiedUserRole = requalify . fmap toUserRole + where + requalify (Qualified (a, role) dom) = (Qualified a dom, role) -- | Add members to a local conversation. -- Conversation is local, so we can add any member to it (including remote ones). +-- When the role is not specified, it defaults to admin. -- Please make sure the conversation doesn't exceed the maximum size! -addMembersUncheckedWithRole :: MonadClient m => Domain -> UTCTime -> ConvId -> (UserId, RoleName) -> [(UserId, RoleName)] -> [(Remote UserId, RoleName)] -> m (Event, [LocalMember], [RemoteMember]) -addMembersUncheckedWithRole localDomain t conv (orig, _origRole) lusrs rusrs = do +addMembers :: + forall m a. + (MonadClient m, ToUserRole a) => + Local ConvId -> + UserList a -> + m ([LocalMember], [RemoteMember]) +addMembers (lUnqualified -> conv) (fmap toUserRole -> UserList lusers rusers) = do -- batch statement with 500 users are known to be above the batch size limit -- and throw "Batch too large" errors. Therefor we chunk requests and insert -- sequentially. (parallelizing would not aid performance as the partition @@ -890,7 +898,7 @@ addMembersUncheckedWithRole localDomain t conv (orig, _origRole) lusrs rusrs = d -- With chunk size of 64: -- [galley] Server warning: Batch for [galley_test.member, galley_test.user] is of size 7040, exceeding specified threshold of 5120 by 1920. -- - for_ (List.chunksOf 32 lusrs) $ \chunk -> do + for_ (List.chunksOf 32 lusers) $ \chunk -> do retry x5 . batch $ do setType BatchLogged setConsistency Quorum @@ -899,24 +907,18 @@ addMembersUncheckedWithRole localDomain t conv (orig, _origRole) lusrs rusrs = d addPrepQuery Cql.insertMember (conv, u, Nothing, Nothing, r) addPrepQuery Cql.insertUserConv (u, conv) - for_ (List.chunksOf 32 rusrs) $ \chunk -> do + for_ (List.chunksOf 32 rusers) $ \chunk -> do retry x5 . batch $ do setType BatchLogged setConsistency Quorum - for_ chunk $ \(u, role) -> do + for_ chunk $ \(unTagged -> Qualified (uid, role) domain) -> do -- User is remote, so we only add it to the member_remote_user -- table, but the reverse mapping has to be done on the remote -- backend; so we assume an additional call to their backend has -- been (or will be) made separately. See Galley.API.Update.addMembers - let remoteUser = qUnqualified (unTagged u) - let remoteDomain = qDomain (unTagged u) - addPrepQuery Cql.insertRemoteMember (conv, remoteDomain, remoteUser, role) - let qconv = Qualified conv localDomain - qorig = Qualified orig localDomain - lmems = map (uncurry SimpleMember . first (`Qualified` localDomain)) lusrs - rmems = map (uncurry SimpleMember . first unTagged) rusrs - e = Event MemberJoin qconv qorig t (EdMembersJoin (SimpleMembers (lmems <> rmems))) - return (e, fmap (uncurry newMemberWithRole) lusrs, fmap (uncurry RemoteMember) rusrs) + addPrepQuery Cql.insertRemoteMember (conv, domain, uid, role) + + pure (map newMemberWithRole lusers, map newRemoteMemberWithRole rusers) -- | Set local users as belonging to a remote conversation. This is invoked by a -- remote galley when users from the current backend are added to conversations @@ -934,100 +936,100 @@ addLocalMembersToRemoteConv qconv users = do Cql.insertUserRemoteConv (u, qDomain qconv, qUnqualified qconv) -class IsMemberUpdate mu uid where - updateMember :: MonadClient m => Local ConvId -> uid -> mu -> m MemberUpdateData - updateMemberRemoteConv :: MonadClient m => Remote ConvId -> uid -> mu -> m MemberUpdateData - -memberUpdateToData :: Qualified UserId -> MemberUpdate -> MemberUpdateData -memberUpdateToData quid mup = - MemberUpdateData - { misTarget = quid, - misOtrMutedStatus = mupOtrMuteStatus mup, - misOtrMutedRef = mupOtrMuteRef mup, - misOtrArchived = mupOtrArchive mup, - misOtrArchivedRef = mupOtrArchiveRef mup, - misHidden = mupHidden mup, - misHiddenRef = mupHiddenRef mup, - misConvRoleName = Nothing - } +updateSelfMember :: + MonadClient m => + Local x -> + Qualified ConvId -> + Local UserId -> + MemberUpdate -> + m () +updateSelfMember loc = foldQualified loc updateSelfMemberLocalConv updateSelfMemberRemoteConv -instance IsMemberUpdate MemberUpdate (Local UserId) where - updateMember lcid luid mup = do - retry x5 . batch $ do - setType BatchUnLogged - setConsistency Quorum - for_ (mupOtrMuteStatus mup) $ \ms -> - addPrepQuery - Cql.updateOtrMemberMutedStatus - (ms, mupOtrMuteRef mup, lUnqualified lcid, lUnqualified luid) - for_ (mupOtrArchive mup) $ \a -> - addPrepQuery - Cql.updateOtrMemberArchived - (a, mupOtrArchiveRef mup, lUnqualified lcid, lUnqualified luid) - for_ (mupHidden mup) $ \h -> - addPrepQuery - Cql.updateMemberHidden - (h, mupHiddenRef mup, lUnqualified lcid, lUnqualified luid) - pure (memberUpdateToData (unTagged luid) mup) - updateMemberRemoteConv (Tagged (Qualified cid domain)) luid mup = do +updateSelfMemberLocalConv :: + MonadClient m => + Local ConvId -> + Local UserId -> + MemberUpdate -> + m () +updateSelfMemberLocalConv lcid luid mup = do + retry x5 . batch $ do + setType BatchUnLogged + setConsistency Quorum + for_ (mupOtrMuteStatus mup) $ \ms -> + addPrepQuery + Cql.updateOtrMemberMutedStatus + (ms, mupOtrMuteRef mup, lUnqualified lcid, lUnqualified luid) + for_ (mupOtrArchive mup) $ \a -> + addPrepQuery + Cql.updateOtrMemberArchived + (a, mupOtrArchiveRef mup, lUnqualified lcid, lUnqualified luid) + for_ (mupHidden mup) $ \h -> + addPrepQuery + Cql.updateMemberHidden + (h, mupHiddenRef mup, lUnqualified lcid, lUnqualified luid) + +updateSelfMemberRemoteConv :: + MonadClient m => + Remote ConvId -> + Local UserId -> + MemberUpdate -> + m () +updateSelfMemberRemoteConv (Tagged (Qualified cid domain)) luid mup = do + retry x5 . batch $ do + setType BatchUnLogged + setConsistency Quorum + for_ (mupOtrMuteStatus mup) $ \ms -> + addPrepQuery + Cql.updateRemoteOtrMemberMutedStatus + (ms, mupOtrMuteRef mup, domain, cid, lUnqualified luid) + for_ (mupOtrArchive mup) $ \a -> + addPrepQuery + Cql.updateRemoteOtrMemberArchived + (a, mupOtrArchiveRef mup, domain, cid, lUnqualified luid) + for_ (mupHidden mup) $ \h -> + addPrepQuery + Cql.updateRemoteMemberHidden + (h, mupHiddenRef mup, domain, cid, lUnqualified luid) + +updateOtherMember :: + MonadClient m => + Local x -> + Qualified ConvId -> + Qualified UserId -> + OtherMemberUpdate -> + m () +updateOtherMember loc = foldQualified loc updateOtherMemberLocalConv updateOtherMemberRemoteConv + +updateOtherMemberLocalConv :: + MonadClient m => + Local ConvId -> + Qualified UserId -> + OtherMemberUpdate -> + m () +updateOtherMemberLocalConv lcid quid omu = + do + let addQuery r + | lDomain lcid == qDomain quid = + addPrepQuery + Cql.updateMemberConvRoleName + (r, lUnqualified lcid, qUnqualified quid) + | otherwise = + addPrepQuery + Cql.updateRemoteMemberConvRoleName + (r, lUnqualified lcid, qDomain quid, qUnqualified quid) retry x5 . batch $ do setType BatchUnLogged setConsistency Quorum - for_ (mupOtrMuteStatus mup) $ \ms -> - addPrepQuery - Cql.updateRemoteOtrMemberMutedStatus - (ms, mupOtrMuteRef mup, domain, cid, lUnqualified luid) - for_ (mupOtrArchive mup) $ \a -> - addPrepQuery - Cql.updateRemoteOtrMemberArchived - (a, mupOtrArchiveRef mup, domain, cid, lUnqualified luid) - for_ (mupHidden mup) $ \h -> - addPrepQuery - Cql.updateRemoteMemberHidden - (h, mupHiddenRef mup, domain, cid, lUnqualified luid) - pure (memberUpdateToData (unTagged luid) mup) - -instance IsMemberUpdate OtherMemberUpdate (Qualified UserId) where - updateMember lcid quid omu = - do - let addQuery r - | lDomain lcid == qDomain quid = - addPrepQuery - Cql.updateMemberConvRoleName - (r, lUnqualified lcid, qUnqualified quid) - | otherwise = - addPrepQuery - Cql.updateRemoteMemberConvRoleName - (r, lUnqualified lcid, qDomain quid, qUnqualified quid) - retry x5 . batch $ do - setType BatchUnLogged - setConsistency Quorum - traverse_ addQuery (omuConvRoleName omu) - pure - MemberUpdateData - { misTarget = quid, - misOtrMutedStatus = Nothing, - misOtrMutedRef = Nothing, - misOtrArchived = Nothing, - misOtrArchivedRef = Nothing, - misHidden = Nothing, - misHiddenRef = Nothing, - misConvRoleName = omuConvRoleName omu - } - - -- FUTUREWORK: https://wearezeta.atlassian.net/browse/SQCORE-887 - updateMemberRemoteConv _ quid _ = - pure - MemberUpdateData - { misTarget = quid, - misOtrMutedStatus = Nothing, - misOtrMutedRef = Nothing, - misOtrArchived = Nothing, - misOtrArchivedRef = Nothing, - misHidden = Nothing, - misHiddenRef = Nothing, - misConvRoleName = Nothing - } + traverse_ addQuery (omuConvRoleName omu) + +-- FUTUREWORK: https://wearezeta.atlassian.net/browse/SQCORE-887 +updateOtherMemberRemoteConv :: + MonadClient m => + Remote ConvId -> + Qualified UserId -> + OtherMemberUpdate -> + m () +updateOtherMemberRemoteConv _ _ _ = pure () -- | Select only the members of a remote conversation from a list of users. -- Return the filtered list and a boolean indicating whether the all the input @@ -1046,41 +1048,28 @@ filterRemoteConvMembers users (Qualified conv dom) = removeLocalMembersFromLocalConv :: MonadClient m => - Domain -> - Conversation -> - Qualified UserId -> + ConvId -> NonEmpty UserId -> - m Event -removeLocalMembersFromLocalConv localDomain conv orig localVictims = do - t <- liftIO getCurrentTime + m () +removeLocalMembersFromLocalConv cnv victims = do 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) + for_ victims $ \victim -> do + addPrepQuery Cql.removeMember (cnv, victim) + addPrepQuery Cql.deleteUserConv (victim, cnv) removeRemoteMembersFromLocalConv :: MonadClient m => - Domain -> - Conversation -> - Qualified UserId -> + ConvId -> NonEmpty (Remote UserId) -> - m Event -removeRemoteMembersFromLocalConv localDomain conv orig remoteVictims = do - t <- liftIO getCurrentTime + m () +removeRemoteMembersFromLocalConv cnv victims = do retry x5 . batch $ do setType BatchLogged setConsistency Quorum - for_ remoteVictims $ \remoteVictim -> do - let rUser = unTagged remoteVictim - addPrepQuery Cql.removeRemoteMember (convId conv, qDomain rUser, qUnqualified rUser) - let qconvId = Qualified (convId conv) localDomain - qualifiedVictims = QualifiedUserIdList . map unTagged . toList $ remoteVictims - return $ Event MemberLeave qconvId orig t (EdMembersLeave qualifiedVictims) + for_ victims $ \(unTagged -> Qualified uid domain) -> + addPrepQuery Cql.removeRemoteMember (cnv, domain, uid) removeLocalMembersFromRemoteConv :: MonadClient m => @@ -1104,10 +1093,10 @@ removeMember usr cnv = retry x5 . batch $ do addPrepQuery Cql.deleteUserConv (usr, cnv) newMember :: UserId -> LocalMember -newMember = flip newMemberWithRole roleNameWireAdmin +newMember u = newMemberWithRole (u, roleNameWireAdmin) -newMemberWithRole :: UserId -> RoleName -> LocalMember -newMemberWithRole u r = +newMemberWithRole :: (UserId, RoleName) -> LocalMember +newMemberWithRole (u, r) = LocalMember { lmId = u, lmService = Nothing, @@ -1115,6 +1104,13 @@ newMemberWithRole u r = lmConvRoleName = r } +newRemoteMemberWithRole :: Remote (UserId, RoleName) -> RemoteMember +newRemoteMemberWithRole ur@(unTagged -> (Qualified (u, r) _)) = + RemoteMember + { rmId = qualifyAs ur u, + rmConvRoleName = r + } + toMemberStatus :: ( -- otr muted Maybe MutedStatus, diff --git a/services/galley/src/Galley/Data/Services.hs b/services/galley/src/Galley/Data/Services.hs index 0b633476bb3..3d4f01108ed 100644 --- a/services/galley/src/Galley/Data/Services.hs +++ b/services/galley/src/Galley/Data/Services.hs @@ -52,6 +52,12 @@ import Imports -- FUTUREWORK(federation): allow remote bots newtype BotMember = BotMember {fromBotMember :: LocalMember} +instance Eq BotMember where + (==) = (==) `on` botMemId + +instance Ord BotMember where + compare = compare `on` botMemId + newBotMember :: LocalMember -> Maybe BotMember newBotMember m = const (BotMember m) <$> lmService m diff --git a/services/galley/src/Galley/Types/UserList.hs b/services/galley/src/Galley/Types/UserList.hs new file mode 100644 index 00000000000..59d31de1558 --- /dev/null +++ b/services/galley/src/Galley/Types/UserList.hs @@ -0,0 +1,44 @@ +-- 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 Galley.Types.UserList + ( UserList (..), + toUserList, + ulAddLocal, + ulAll, + ) +where + +import Data.Qualified +import Data.Tagged +import Imports + +-- | A list of users, partitioned into locals and remotes +data UserList a = UserList + { ulLocals :: [a], + ulRemotes :: [Remote a] + } + deriving (Functor, Foldable, Traversable) + +toUserList :: Foldable f => Local x -> f (Qualified a) -> UserList a +toUserList loc = uncurry (flip UserList) . partitionRemoteOrLocalIds' (lDomain loc) + +ulAddLocal :: a -> UserList a -> UserList a +ulAddLocal x ul = ul {ulLocals = x : ulLocals ul} + +ulAll :: Local x -> UserList a -> [Qualified a] +ulAll loc ul = map (unTagged . qualifyAs loc) (ulLocals ul) <> map unTagged (ulRemotes ul) diff --git a/services/galley/src/Galley/Validation.hs b/services/galley/src/Galley/Validation.hs index 6473a52be4c..ccdd769de58 100644 --- a/services/galley/src/Galley/Validation.hs +++ b/services/galley/src/Galley/Validation.hs @@ -19,24 +19,17 @@ module Galley.Validation ( rangeChecked, rangeCheckedMaybe, fromConvSize, - sizeCheckedLocals, - sizeCheckedRemotes, ConvSizeChecked, - ConvMemberAddSizeChecked, checkedConvSize, - checkedMemberAddSize, ) where import Control.Lens import Control.Monad.Catch -import Data.Id (UserId) -import Data.Qualified (Remote) import Data.Range import Galley.API.Error import Galley.App import Galley.Options -import Galley.Types.Conversations.Roles (RoleName) import Imports rangeChecked :: Within a n m => a -> Galley (Range n m a) @@ -49,29 +42,17 @@ rangeCheckedMaybe (Just a) = Just <$> rangeChecked a {-# INLINE rangeCheckedMaybe #-} -- Between 0 and (setMaxConvSize - 1) -newtype ConvSizeChecked a = ConvSizeChecked {fromConvSize :: a} - deriving (Functor) +newtype ConvSizeChecked f a = ConvSizeChecked {fromConvSize :: f a} + deriving (Functor, Foldable, Traversable) --- Between 1 and setMaxConvSize -data ConvMemberAddSizeChecked = ConvMemberAddSizeChecked {sizeCheckedLocals :: [(UserId, RoleName)], sizeCheckedRemotes :: [(Remote UserId, RoleName)]} - -checkedConvSize :: Bounds a => a -> Galley (ConvSizeChecked a) +checkedConvSize :: Foldable f => f a -> Galley (ConvSizeChecked f a) checkedConvSize x = do o <- view options let minV :: Integer = 0 limit = o ^. optSettings . setMaxConvSize - 1 - if within x minV (fromIntegral limit) + if length x < fromIntegral limit then return (ConvSizeChecked x) else throwErr (errorMsg minV limit "") -checkedMemberAddSize :: [(UserId, RoleName)] -> [(Remote UserId, RoleName)] -> Galley ConvMemberAddSizeChecked -checkedMemberAddSize [] [] = throwErr "List of members (local or remote) to be added must be of at least size 1" -checkedMemberAddSize locals remotes = do - o <- view options - let limit = o ^. optSettings . setMaxConvSize - if length locals + length remotes < fromIntegral limit - then return (ConvMemberAddSizeChecked locals remotes) - else throwErr (errorMsg (1 :: Integer) limit "") - throwErr :: String -> Galley a throwErr = throwM . invalidRange . fromString diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index e670cd4ed22..5d1a1fb1a5e 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -197,6 +197,7 @@ tests s = test s "remote conversation member update (otr hidden)" putRemoteConvMemberHiddenOk, test s "remote conversation member update (everything)" putRemoteConvMemberAllOk, test s "conversation receipt mode update" putReceiptModeOk, + test s "conversation receipt mode update with remote members" putReceiptModeWithRemotesOk, test s "send typing indicators" postTypingIndicators, test s "leave connect conversation" leaveConnectConversation, test s "post conversations/:cnv/otr/message: message delivery and missing clients" postCryptoMessage1, @@ -1322,7 +1323,7 @@ paginateConvListIds = do FederatedGalley.cuOrigUserId = qChad, FederatedGalley.cuConvId = conv, FederatedGalley.cuAlreadyPresentUsers = [], - FederatedGalley.cuAction = ConversationActionAddMembers $ pure (qAlice, roleNameWireMember) + FederatedGalley.cuAction = ConversationActionAddMembers (pure qAlice) roleNameWireMember } FederatedGalley.onConversationUpdated fedGalleyClient chadDomain cu @@ -1337,7 +1338,7 @@ paginateConvListIds = do FederatedGalley.cuOrigUserId = qDee, FederatedGalley.cuConvId = conv, FederatedGalley.cuAlreadyPresentUsers = [], - FederatedGalley.cuAction = ConversationActionAddMembers $ pure (qAlice, roleNameWireMember) + FederatedGalley.cuAction = ConversationActionAddMembers (pure qAlice) roleNameWireMember } FederatedGalley.onConversationUpdated fedGalleyClient deeDomain cu @@ -1380,7 +1381,7 @@ paginateConvListIdsPageEndingAtLocalsAndDomain = do FederatedGalley.cuOrigUserId = qChad, FederatedGalley.cuConvId = conv, FederatedGalley.cuAlreadyPresentUsers = [], - FederatedGalley.cuAction = ConversationActionAddMembers $ pure (qAlice, roleNameWireMember) + FederatedGalley.cuAction = ConversationActionAddMembers (pure qAlice) roleNameWireMember } FederatedGalley.onConversationUpdated fedGalleyClient chadDomain cu @@ -1396,7 +1397,7 @@ paginateConvListIdsPageEndingAtLocalsAndDomain = do FederatedGalley.cuOrigUserId = qDee, FederatedGalley.cuConvId = conv, FederatedGalley.cuAlreadyPresentUsers = [], - FederatedGalley.cuAction = ConversationActionAddMembers $ pure (qAlice, roleNameWireMember) + FederatedGalley.cuAction = ConversationActionAddMembers (pure qAlice) roleNameWireMember } FederatedGalley.onConversationUpdated fedGalleyClient deeDomain cu @@ -2790,7 +2791,7 @@ putRemoteConvMemberOk update = do cuConvId = qUnqualified qconv, cuAlreadyPresentUsers = [], cuAction = - ConversationActionAddMembers (pure (qalice, roleNameWireMember)) + ConversationActionAddMembers (pure qalice) roleNameWireMember } FederatedGalley.onConversationUpdated fedGalleyClient remoteDomain cu @@ -2903,6 +2904,44 @@ putReceiptModeOk = do assertEqual "modes should match" mode 0 _ -> assertFailure "Unexpected event data" +putReceiptModeWithRemotesOk :: TestM () +putReceiptModeWithRemotesOk = do + c <- view tsCannon + let remoteDomain = Domain "alice.example.com" + qalice <- Qualified <$> randomId <*> pure remoteDomain + qbob <- randomQualifiedUser + let bob = qUnqualified qbob + + resp <- postConvWithRemoteUser remoteDomain (mkProfile qalice (Name "Alice")) bob [qalice] + let qconv = decodeQualifiedConvId resp + + opts <- view tsGConf + WS.bracketR c bob $ \wsB -> do + (_, requests) <- + withTempMockFederator opts remoteDomain (const ()) $ + putQualifiedReceiptMode bob qconv (ReceiptMode 43) !!! const 200 === statusCode + + req <- assertOne requests + liftIO $ do + F.domain req @?= domainText remoteDomain + fmap F.component (F.request req) @?= Just F.Galley + fmap F.path (F.request req) @?= Just "/federation/on-conversation-updated" + Just (Right cu) <- pure $ fmap (eitherDecode . LBS.fromStrict . F.body) (F.request req) + FederatedGalley.cuConvId cu @?= qUnqualified qconv + FederatedGalley.cuAction cu + @?= ConversationActionReceiptModeUpdate + (ConversationReceiptModeUpdate (ReceiptMode 43)) + + void . liftIO . WS.assertMatch (5 # Second) wsB $ \n -> do + let e = List1.head (WS.unpackPayload n) + ntfTransient n @?= False + evtConv e @?= qconv + evtType e @?= ConvReceiptModeUpdate + evtFrom e @?= qbob + evtData e + @?= EdConvReceiptModeUpdate + (ConversationReceiptModeUpdate (ReceiptMode 43)) + postTypingIndicators :: TestM () postTypingIndicators = do g <- view tsGalley diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index e1b4065db23..5cc73f77a33 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -71,6 +71,7 @@ tests s = test s "POST /federation/on-conversation-updated : Notify local user about conversation rename" notifyConvRename, test s "POST /federation/on-conversation-updated : Notify local user about message timer update" notifyMessageTimer, test s "POST /federation/on-conversation-updated : Notify local user about member update" notifyMemberUpdate, + test s "POST /federation/on-conversation-updated : Notify local user about receipt mode update" notifyReceiptMode, test s "POST /federation/leave-conversation : Success" leaveConversationSuccess, test s "POST /federation/on-message-sent : Receive a message from another backend" onMessageSent, test s "POST /federation/send-message : Post a message sent from another backend" sendMessage @@ -166,7 +167,7 @@ addLocalUser = do FedGalley.cuConvId = conv, FedGalley.cuAlreadyPresentUsers = [charlie], FedGalley.cuAction = - ConversationActionAddMembers (pure (qalice, roleNameWireMember)) + ConversationActionAddMembers (pure qalice) roleNameWireMember } WS.bracketR2 c alice charlie $ \(wsA, wsC) -> do FedGalley.onConversationUpdated fedGalleyClient remoteDomain cu @@ -205,7 +206,7 @@ removeLocalUser = do FedGalley.cuConvId = conv, FedGalley.cuAlreadyPresentUsers = [], FedGalley.cuAction = - ConversationActionAddMembers (pure (qAlice, roleNameWireMember)) + ConversationActionAddMembers (pure qAlice) roleNameWireMember } cuRemove = FedGalley.ConversationUpdate @@ -214,7 +215,7 @@ removeLocalUser = do FedGalley.cuConvId = conv, FedGalley.cuAlreadyPresentUsers = [alice], FedGalley.cuAction = - ConversationActionRemoveMembers (pure qAlice) + ConversationActionRemoveMember qAlice } WS.bracketR c alice $ \ws -> do @@ -268,26 +269,37 @@ removeRemoteUser = do now <- liftIO getCurrentTime registerRemoteConv qconv qBob (Just "gossip") (Set.fromList [aliceAsOtherMember, deeAsOtherMember, eveAsOtherMember]) - let cuRemove = + + let cuRemove user = FedGalley.ConversationUpdate { FedGalley.cuTime = addUTCTime (secondsToNominalDiffTime 5) now, FedGalley.cuOrigUserId = qBob, FedGalley.cuConvId = conv, FedGalley.cuAlreadyPresentUsers = [alice, charlie, dee], FedGalley.cuAction = - ConversationActionRemoveMembers (qEve :| [qDee, qFlo]) + ConversationActionRemoveMember user } WS.bracketRN c [alice, charlie, dee, flo] $ \[wsA, wsC, wsD, wsF] -> do - FedGalley.onConversationUpdated fedGalleyClient remoteDomain cuRemove - afterRemoval <- listRemoteConvs remoteDomain alice + FedGalley.onConversationUpdated fedGalleyClient remoteDomain (cuRemove qEve) liftIO $ do WS.assertMatchN_ (3 # Second) [wsA, wsD] $ - wsAssertMembersLeave qconv qBob [qDee, qEve, qFlo] - WS.assertNoEvent (1 # Second) [wsC] - WS.assertNoEvent (1 # Second) [wsF] + wsAssertMembersLeave qconv qBob [qEve] + WS.assertNoEvent (1 # Second) [wsC, wsF] + + WS.bracketRN c [alice, charlie, dee, flo] $ \[wsA, wsC, wsD, wsF] -> do + FedGalley.onConversationUpdated fedGalleyClient remoteDomain (cuRemove qDee) liftIO $ do - afterRemoval @?= [qconv] + WS.assertMatchN_ (3 # Second) [wsA, wsD] $ + wsAssertMembersLeave qconv qBob [qDee] + WS.assertNoEvent (1 # Second) [wsC, wsF] + + WS.bracketRN c [alice, charlie, dee, flo] $ \[wsA, wsC, wsD, wsF] -> do + FedGalley.onConversationUpdated fedGalleyClient remoteDomain (cuRemove qFlo) + liftIO $ do + WS.assertMatchN_ (3 # Second) [wsA] $ + wsAssertMembersLeave qconv qBob [qFlo] + WS.assertNoEvent (1 # Second) [wsC, wsF, wsD] notifyUpdate :: [Qualified UserId] -> ConversationAction -> EventType -> EventData -> TestM () notifyUpdate extras action etype edata = do @@ -344,6 +356,15 @@ notifyMessageTimer = do ConvMessageTimerUpdate (EdConvMessageTimerUpdate d) +notifyReceiptMode :: TestM () +notifyReceiptMode = do + let d = ConversationReceiptModeUpdate (ReceiptMode 42) + notifyUpdate + [] + (ConversationActionReceiptModeUpdate d) + ConvReceiptModeUpdate + (EdConvReceiptModeUpdate d) + notifyMemberUpdate :: TestM () notifyMemberUpdate = do qdee <- randomQualifiedUser @@ -360,7 +381,7 @@ notifyMemberUpdate = do } notifyUpdate [qdee] - (ConversationActionMemberUpdate d) + (ConversationActionMemberUpdate qdee (OtherMemberUpdate (Just roleNameWireAdmin))) MemberStateUpdate (EdMemberUpdate d) @@ -407,7 +428,7 @@ addRemoteUser = do FedGalley.cuConvId = qUnqualified qconv, FedGalley.cuAlreadyPresentUsers = (map qUnqualified [qalice, qcharlie]), FedGalley.cuAction = - ConversationActionAddMembers ((qdee, roleNameWireMember) :| [(qeve, roleNameWireMember), (qflo, roleNameWireMember)]) + ConversationActionAddMembers (qdee :| [qeve, qflo]) roleNameWireMember } WS.bracketRN c (map qUnqualified [qalice, qcharlie, qdee, qflo]) $ \[wsA, wsC, wsD, wsF] -> do FedGalley.onConversationUpdated fedGalleyClient bdom cu @@ -502,7 +523,7 @@ onMessageSent = do FedGalley.cuConvId = conv, FedGalley.cuAlreadyPresentUsers = [], FedGalley.cuAction = - ConversationActionAddMembers (pure (qalice, roleNameWireMember)) + ConversationActionAddMembers (pure qalice) roleNameWireMember } FedGalley.onConversationUpdated fedGalleyClient bdom cu diff --git a/services/galley/test/integration/API/Roles.hs b/services/galley/test/integration/API/Roles.hs index 7072998e57d..592fde684f1 100644 --- a/services/galley/test/integration/API/Roles.hs +++ b/services/galley/test/integration/API/Roles.hs @@ -203,7 +203,7 @@ roleUpdateRemoteMember = do Just (Right cu) <- pure $ fmap (eitherDecode . LBS.fromStrict . F.body) (F.request req) F.cuConvId cu @?= qUnqualified qconv F.cuAction cu - @?= ConversationActionMemberUpdate mu + @?= ConversationActionMemberUpdate qcharlie (OtherMemberUpdate (Just roleNameWireMember)) sort (F.cuAlreadyPresentUsers cu) @?= sort [qUnqualified qalice, qUnqualified qcharlie] liftIO . WS.assertMatch_ (5 # Second) wsB $ \n -> do @@ -274,7 +274,7 @@ roleUpdateWithRemotes = do Just (Right cu) <- pure $ fmap (eitherDecode . LBS.fromStrict . F.body) (F.request req) F.cuConvId cu @?= qUnqualified qconv F.cuAction cu - @?= ConversationActionMemberUpdate mu + @?= ConversationActionMemberUpdate qcharlie (OtherMemberUpdate (Just roleNameWireAdmin)) F.cuAlreadyPresentUsers cu @?= [qUnqualified qalice] liftIO . WS.assertMatchN_ (5 # Second) [wsB, wsC] $ \n -> do diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index 41788e75ef4..e1b543d3ef7 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -118,7 +118,6 @@ tests s = test s "add team conversation with role" testAddTeamConvWithRole, test s "add team conversation as partner (fail)" testAddTeamConvAsExternalPartner, test s "add managed conversation through public endpoint (fail)" testAddManagedConv, - test s "add managed team conversation ignores given users" testAddTeamConvWithUsers, -- Queue is emptied here to ensure that lingering events do not affect other tests test s "add team member to conversation without connection" (testAddTeamMemberToConv >> ensureQueueEmpty), test s "update conversation as member" (testUpdateTeamConv RoleMember roleNameWireAdmin), @@ -606,8 +605,8 @@ testRemoveNonBindingTeamMember = do mext3 <- Util.randomUser Util.connectUsers owner (list1 (mem1 ^. userId) [mem2 ^. userId, mext1, mext2, mext3]) tid <- Util.createNonBindingTeam "foo" owner [mem1, mem2] - -- Managed conversation: - void $ Util.createManagedConv owner tid [] (Just "gossip") Nothing Nothing + -- This used to be a managed conversation: + void $ Util.createTeamConv owner tid [] (Just "gossip") Nothing Nothing -- Regular conversation: cid2 <- Util.createTeamConv owner tid [mem1 ^. userId, mem2 ^. userId, mext1] (Just "blaa") Nothing Nothing -- Member external 2 is a guest and not a part of any conversation that mem1 is a part of @@ -809,11 +808,7 @@ testAddTeamConvWithRole = do mem2 <- newTeamMember' p <$> Util.randomUser Util.connectUsers owner (list1 (mem1 ^. userId) [extern, mem2 ^. userId]) tid <- Util.createNonBindingTeam "foo" owner [mem2] - WS.bracketRN c [owner, extern, mem1 ^. userId, mem2 ^. userId] $ \ws@[wsOwner, wsExtern, wsMem1, wsMem2] -> do - -- Managed conversation: - cid1 <- Util.createManagedConv owner tid [] (Just "gossip") Nothing Nothing - checkConvCreateEvent cid1 wsOwner - checkConvCreateEvent cid1 wsMem2 + WS.bracketRN c [owner, extern, mem1 ^. userId, mem2 ^. userId] $ \[wsOwner, wsExtern, wsMem1, wsMem2] -> do -- Regular conversation: cid2 <- Util.createTeamConvWithRole owner tid [extern] (Just "blaa") Nothing Nothing roleNameWireAdmin checkConvCreateEvent cid2 wsOwner @@ -832,21 +827,8 @@ testAddTeamConvWithRole = do checkTeamMemberJoin tid (mem1 ^. userId) wsOwner checkTeamMemberJoin tid (mem1 ^. userId) wsMem1 checkTeamMemberJoin tid (mem1 ^. userId) wsMem2 - -- New team members are added automatically to managed conversations ... - Util.assertConvMember (mem1 ^. userId) cid1 -- ... but not to regular ones. Util.assertNotConvMember (mem1 ^. userId) cid2 - -- Managed team conversations get all team members added implicitly. - cid4 <- Util.createManagedConv owner tid [] (Just "blup") Nothing Nothing - for_ [owner, mem1 ^. userId, mem2 ^. userId] $ \u -> - Util.assertConvMember u cid4 - checkConvCreateEvent cid4 wsOwner - checkConvCreateEvent cid4 wsMem1 - checkConvCreateEvent cid4 wsMem2 - -- Non team members are never added implicitly. - for_ [cid1, cid4] $ - Util.assertNotConvMember extern - WS.assertNoEvent timeout ws testAddTeamConvAsExternalPartner :: TestM () testAddTeamConvAsExternalPartner = do @@ -893,19 +875,6 @@ testAddManagedConv = do ) !!! const 400 === statusCode -testAddTeamConvWithUsers :: TestM () -testAddTeamConvWithUsers = do - owner <- Util.randomUser - extern <- Util.randomUser - Util.connectUsers owner (list1 extern []) - tid <- Util.createNonBindingTeam "foo" owner [] - -- Create managed team conversation and erroneously specify external users. - cid <- Util.createManagedConv owner tid [extern] (Just "gossip") Nothing Nothing - -- External users have been ignored. - Util.assertNotConvMember extern cid - -- Team members are present. - Util.assertConvMember owner cid - testAddTeamMemberToConv :: TestM () testAddTeamMemberToConv = do personalUser <- Util.randomUser @@ -1010,10 +979,11 @@ testDeleteTeam = do let p = Util.symmPermissions [DoNotUseDeprecatedAddRemoveConvMember] member <- newTeamMember' p <$> Util.randomUser extern <- Util.randomUser + let members = [owner, member ^. userId] Util.connectUsers owner (list1 (member ^. userId) [extern]) tid <- Util.createNonBindingTeam "foo" owner [member] cid1 <- Util.createTeamConv owner tid [] (Just "blaa") Nothing Nothing - cid2 <- Util.createManagedConv owner tid [] (Just "blup") Nothing Nothing + cid2 <- Util.createTeamConv owner tid members (Just "blup") Nothing Nothing Util.assertConvMember owner cid2 Util.assertConvMember (member ^. userId) cid2 Util.assertNotConvMember extern cid2 @@ -1196,6 +1166,7 @@ testDeleteTeamConv = do owner <- Util.randomUser let p = Util.symmPermissions [DoNotUseDeprecatedDeleteConversation] member <- newTeamMember' p <$> Util.randomUser + let members = [owner, member ^. userId] extern <- Util.randomUser Util.connectUsers owner (list1 (member ^. userId) [extern]) tid <- Util.createNonBindingTeam "foo" owner [member] @@ -1203,7 +1174,7 @@ testDeleteTeamConv = do let access = ConversationAccessUpdate [InviteAccess, CodeAccess] ActivatedAccessRole putAccessUpdate owner cid1 access !!! const 200 === statusCode code <- decodeConvCodeEvent <$> (postConvCode owner cid1 Util.assertConvMember u cid1 for_ [owner, member ^. userId] $ \u -> Util.assertConvMember u cid2 diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index ec9fbf53e89..860866c4385 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -523,26 +523,6 @@ updateTeamConv zusr convid upd = do . json upd ) --- | See Note [managed conversations] -createManagedConv :: HasCallStack => UserId -> TeamId -> [UserId] -> Maybe Text -> Maybe (Set Access) -> Maybe Milliseconds -> TestM ConvId -createManagedConv u tid us name acc mtimer = do - g <- view tsGalley - let tinfo = ConvTeamInfo tid True - let conv = - NewConvManaged $ - NewConv us [] name (fromMaybe (Set.fromList []) acc) Nothing (Just tinfo) mtimer Nothing roleNameWireAdmin - r <- - post - ( g - . path "i/conversations/managed" - . zUser u - . zConn "conn" - . zType "access" - . json conv - ) - UserId -> Maybe Text -> TeamId -> TestM ResponseLBS createOne2OneTeamConv u1 u2 n tid = do g <- view tsGalley @@ -1033,6 +1013,24 @@ putConversationName u c n = do . json update ) +putQualifiedReceiptMode :: + (MonadIO m, MonadHttp m, HasGalley m, HasCallStack) => + UserId -> + Qualified ConvId -> + ReceiptMode -> + m ResponseLBS +putQualifiedReceiptMode u (Qualified c dom) r = do + g <- viewGalley + let update = ConversationReceiptModeUpdate r + put + ( g + . paths ["conversations", toByteString' dom, toByteString' c, "receipt-mode"] + . zUser u + . zConn "conn" + . zType "access" + . json update + ) + putReceiptMode :: UserId -> ConvId -> ReceiptMode -> TestM ResponseLBS putReceiptMode u c r = do g <- view tsGalley @@ -1432,7 +1430,7 @@ assertRemoveUpdate req qconvId remover alreadyPresentUsers victim = liftIO $ do FederatedGalley.cuOrigUserId cu @?= remover FederatedGalley.cuConvId cu @?= qUnqualified qconvId sort (FederatedGalley.cuAlreadyPresentUsers cu) @?= sort alreadyPresentUsers - FederatedGalley.cuAction cu @?= ConversationActionRemoveMembers (pure victim) + FederatedGalley.cuAction cu @?= ConversationActionRemoveMember victim ------------------------------------------------------------------------------- -- Helpers From eca5001720397087b725f3449a56ec767933edc9 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 28 Sep 2021 12:12:12 +0200 Subject: [PATCH 59/72] Merge http2 grpc fixes (#1809) * Merge http2 grpc fixes We now depend on a fork of http2-grpc-haskell containing fixes for: https://github.com/haskell-grpc-native/http2-grpc-haskell/pull/46 https://github.com/haskell-grpc-native/http2-grpc-haskell/pull/48 as well as the master of http2-client: https://github.com/lucasdicioccio/http2-client * Clarify comment about http2-client fixes Co-authored-by: jschaul --- changelog.d/5-internal/merge-http2-client-fix | 1 + stack.yaml | 13 ++++++--- stack.yaml.lock | 28 +++++++++++-------- 3 files changed, 26 insertions(+), 16 deletions(-) create mode 100644 changelog.d/5-internal/merge-http2-client-fix diff --git a/changelog.d/5-internal/merge-http2-client-fix b/changelog.d/5-internal/merge-http2-client-fix new file mode 100644 index 00000000000..0559d5c7734 --- /dev/null +++ b/changelog.d/5-internal/merge-http2-client-fix @@ -0,0 +1 @@ +Merged http2-client fixes as mentioned in the comments of #1703 diff --git a/stack.yaml b/stack.yaml index 33dd3747547..6a545426778 100644 --- a/stack.yaml +++ b/stack.yaml @@ -220,16 +220,21 @@ extra-deps: - mu-grpc-common-0.4.0.0 - compendium-client-0.2.1.1 # dependencies of mu -- http2-client-0.10.0.0 - http2-grpc-types-0.5.0.0 - http2-grpc-proto3-wire-0.1.0.0 - warp-grpc-0.4.0.1 - proto3-wire-1.2.0 - parameterized-0.5.0.0 -# Fix in PR: https://github.com/haskell-grpc-native/http2-grpc-haskell/pull/48 -- git: https://github.com/akshaymankar/http2-grpc-haskell - commit: 43507d54515cd5870e8f6d1f03b4d23e6cd460e2 +# Unreleased master. +# Needed for https://github.com/lucasdicioccio/http2-client/pull/75 +- git: https://github.com/lucasdicioccio/http2-client + commit: 73f5975e18eda9d071aa5548fcea6b5a51e61769 + +# Fix in PRs: https://github.com/haskell-grpc-native/http2-grpc-haskell/pull/48 +# and https://github.com/haskell-grpc-native/http2-grpc-haskell/pull/46 +- git: https://github.com/wireapp/http2-grpc-haskell + commit: eea98418672626eafbace3181ca34bf44bee91c0 subdirs: - http2-client-grpc diff --git a/stack.yaml.lock b/stack.yaml.lock index 6fc195e0dfe..3564d9533d9 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -719,13 +719,6 @@ packages: sha256: 18996ce535e40483ca2e29397e606aae551552608f96a6a8cc647ce24e24e937 original: hackage: compendium-client-0.2.1.1 -- completed: - hackage: http2-client-0.10.0.0@sha256:85b8771e9e8d4fd0b4327373ebb4a7bc7f9a293e5d7a7dc581ca4153a841da67,2604 - pantry-tree: - size: 853 - sha256: 4731a8ea6bc88cd762a99370f71c4754bcb57806844ee57a45d59e114ab1b5cb - original: - hackage: http2-client-0.10.0.0 - completed: hackage: http2-grpc-types-0.5.0.0@sha256:4d34edc06a48496130f19245817a7cd7ea15c78ac8815570c3795ffc4503cf27,1445 pantry-tree: @@ -761,19 +754,30 @@ packages: sha256: 843aed822e03279edf00a2595dfb22038b306f4f0acd6984bd108024c5102f90 original: hackage: parameterized-0.5.0.0 +- completed: + name: http2-client + version: 0.10.0.1 + git: https://github.com/lucasdicioccio/http2-client + pantry-tree: + size: 1545 + sha256: d0b3ab62eee8ee4c0ddec7a90fea78090815a54884646ddcdc451ff51d7e262a + commit: 73f5975e18eda9d071aa5548fcea6b5a51e61769 + original: + git: https://github.com/lucasdicioccio/http2-client + commit: 73f5975e18eda9d071aa5548fcea6b5a51e61769 - completed: subdir: http2-client-grpc name: http2-client-grpc version: 0.8.0.0 - git: https://github.com/akshaymankar/http2-grpc-haskell + git: https://github.com/wireapp/http2-grpc-haskell pantry-tree: size: 455 - sha256: b5ab96f6ef5bbe3dfef31e08316d54c4793cad71dbd02d5439fddaeea170e103 - commit: 43507d54515cd5870e8f6d1f03b4d23e6cd460e2 + sha256: 5599a7b9b801d669e2063ffd4ab767bb8bbf12d20069de0cbd8862bca78d7e42 + commit: eea98418672626eafbace3181ca34bf44bee91c0 original: subdir: http2-client-grpc - git: https://github.com/akshaymankar/http2-grpc-haskell - commit: 43507d54515cd5870e8f6d1f03b4d23e6cd460e2 + git: https://github.com/wireapp/http2-grpc-haskell + commit: eea98418672626eafbace3181ca34bf44bee91c0 - completed: name: http2 version: 2.0.6 From 2c818976ce1db09376e04e3a08325808b0b2d8ee Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 28 Sep 2021 15:47:24 +0200 Subject: [PATCH 60/72] Servantify access update (#1807) * Servantify updateConversationAccess endpoint * Add qualified endpoint for conversation access Co-authored-by: jschaul --- changelog.d/1-api-changes/deprecate-access | 1 + changelog.d/1-api-changes/qualified-access | 1 + changelog.d/5-internal/servantify-access | 1 + .../wire-api/src/Wire/API/ErrorDescription.hs | 2 + .../src/Wire/API/Routes/Public/Galley.hs | 38 +++++++++++++ services/galley/src/Galley/API/Error.hs | 3 - services/galley/src/Galley/API/Public.hs | 27 +-------- services/galley/src/Galley/API/Update.hs | 56 ++++++++++++++++--- 8 files changed, 93 insertions(+), 36 deletions(-) create mode 100644 changelog.d/1-api-changes/deprecate-access create mode 100644 changelog.d/1-api-changes/qualified-access create mode 100644 changelog.d/5-internal/servantify-access diff --git a/changelog.d/1-api-changes/deprecate-access b/changelog.d/1-api-changes/deprecate-access new file mode 100644 index 00000000000..08737dedb6d --- /dev/null +++ b/changelog.d/1-api-changes/deprecate-access @@ -0,0 +1 @@ +Deprecate `PUT /conversations/:cnv/access` endpoint diff --git a/changelog.d/1-api-changes/qualified-access b/changelog.d/1-api-changes/qualified-access new file mode 100644 index 00000000000..8f973881301 --- /dev/null +++ b/changelog.d/1-api-changes/qualified-access @@ -0,0 +1 @@ +Add qualified endpoint for updating conversation access diff --git a/changelog.d/5-internal/servantify-access b/changelog.d/5-internal/servantify-access new file mode 100644 index 00000000000..e6c4ee8030a --- /dev/null +++ b/changelog.d/5-internal/servantify-access @@ -0,0 +1 @@ +Convert the `PUT /conversations/:cnv/access` endpoint to Servant diff --git a/libs/wire-api/src/Wire/API/ErrorDescription.hs b/libs/wire-api/src/Wire/API/ErrorDescription.hs index 1772d9f55ab..11f28240723 100644 --- a/libs/wire-api/src/Wire/API/ErrorDescription.hs +++ b/libs/wire-api/src/Wire/API/ErrorDescription.hs @@ -307,3 +307,5 @@ type InvalidOpSelfConv = InvalidOp "invalid operation for self conversation" type InvalidOpOne2OneConv = InvalidOp "invalid operation for 1:1 conversations" type InvalidOpConnectConv = InvalidOp "invalid operation for connect conversation" + +type InvalidTargetAccess = InvalidOp "invalid target access" 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 eb48fa4e6fb..d4786e74091 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -439,6 +439,44 @@ data Api routes = Api '[JSON] (UpdateResponses "Receipt mode unchanged" "Receipt mode updated" Event) (UpdateResult Event), + -- This endpoint can lead to the following events being sent: + -- - MemberLeave event to members, if members get removed + -- - ConvAccessUpdate event to members + updateConversationAccessUnqualified :: + routes + :- Summary "Update access modes for a conversation (deprecated)" + :> Description "Use PUT `/conversations/:domain/:cnv/access` instead." + :> ZUser + :> ZConn + :> CanThrow ConvAccessDenied + :> CanThrow ConvNotFound + :> CanThrow (InvalidOp "Invalid operation") + :> "conversations" + :> Capture' '[Description "Conversation ID"] "cnv" ConvId + :> "access" + :> ReqBody '[JSON] ConversationAccessUpdate + :> MultiVerb + 'PUT + '[JSON] + (UpdateResponses "Access unchanged" "Access updated" Event) + (UpdateResult Event), + updateConversationAccess :: + routes + :- Summary "Update access modes for a conversation" + :> ZUser + :> ZConn + :> CanThrow ConvAccessDenied + :> CanThrow ConvNotFound + :> CanThrow (InvalidOp "Invalid operation") + :> "conversations" + :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId + :> "access" + :> ReqBody '[JSON] ConversationAccessUpdate + :> MultiVerb + 'PUT + '[JSON] + (UpdateResponses "Access unchanged" "Access updated" Event) + (UpdateResult Event), getConversationSelfUnqualified :: routes :- Summary "Get self membership properties (deprecated)" diff --git a/services/galley/src/Galley/API/Error.hs b/services/galley/src/Galley/API/Error.hs index 2ab72ddc11d..005b93f32f5 100644 --- a/services/galley/src/Galley/API/Error.hs +++ b/services/galley/src/Galley/API/Error.hs @@ -87,9 +87,6 @@ invalidAccessOp = invalidOp "invalid operation for conversation without 'code' a invalidManagedConvOp :: Error invalidManagedConvOp = invalidOp "invalid operation for managed conversation" -invalidTargetAccess :: Error -invalidTargetAccess = invalidOp "invalid target access" - invalidTargetUserOp :: Error invalidTargetUserOp = invalidOp "invalid target user for the given operation" diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index f3cd9630246..9b863fb3673 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -103,6 +103,9 @@ servantSitemap = GalleyAPI.updateConversationReceiptModeUnqualified = Update.updateConversationReceiptModeUnqualified, GalleyAPI.updateConversationReceiptMode = Update.updateConversationReceiptMode, + GalleyAPI.updateConversationAccessUnqualified = + Update.updateConversationAccessUnqualified, + GalleyAPI.updateConversationAccess = Update.updateConversationAccess, GalleyAPI.getConversationSelfUnqualified = Query.getLocalSelf, GalleyAPI.updateConversationSelfUnqualified = Update.updateUnqualifiedSelfMember, GalleyAPI.updateConversationSelf = Update.updateSelfMember, @@ -641,30 +644,6 @@ sitemap = do errorResponse (Error.errorDescriptionTypeToWai @Error.ConvNotFound) errorResponse Error.invalidAccessOp - -- This endpoint can lead to the following events being sent: - -- - MemberLeave event to members, if members get removed - -- - ConvAccessUpdate event to members - put "/conversations/:cnv/access" (continue Update.updateConversationAccessH) $ - zauthUserId - .&. zauthConnId - .&. capture "cnv" - .&. jsonRequest @Public.ConversationAccessUpdate - document "PUT" "updateConversationAccess" $ do - summary "Update access modes for a conversation" - parameter Path "cnv" bytes' $ - description "Conversation ID" - returns (ref Public.modelEvent) - response 200 "Conversation access updated." end - response 204 "Conversation access unchanged." end - body (ref Public.modelConversationAccessUpdate) $ - description "JSON body" - errorResponse (Error.errorDescriptionTypeToWai @Error.ConvNotFound) - errorResponse (Error.errorDescriptionTypeToWai @Error.ConvAccessDenied) - errorResponse Error.invalidTargetAccess - errorResponse Error.invalidSelfOp - errorResponse Error.invalidOne2OneOp - errorResponse Error.invalidConnectOp - -- This endpoint can lead to the following events being sent: -- - MemberJoin event to members post "/conversations/:cnv/members" (continue Update.addMembersH) $ diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index a89e7dc32c2..ceaaa5aac21 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -28,13 +28,14 @@ module Galley.API.Update getCodeH, updateUnqualifiedConversationName, updateConversationName, - updateConversationAccessH, updateConversationReceiptModeUnqualified, updateConversationReceiptMode, updateLocalConversationMessageTimer, updateConversationMessageTimerUnqualified, updateConversationMessageTimer, updateLocalConversation, + updateConversationAccessUnqualified, + updateConversationAccess, -- * Managing Members addMembersH, @@ -118,6 +119,7 @@ import Wire.API.Conversation.Role (roleNameWireAdmin) import Wire.API.ErrorDescription ( CodeNotFound, ConvNotFound, + InvalidTargetAccess, MissingLegalholdConsent, UnknownClient, mkErrorDescription, @@ -176,20 +178,46 @@ handleUpdateResult = \case Updated ev -> json ev & setStatus status200 Unchanged -> empty & setStatus status204 -updateConversationAccessH :: UserId ::: ConnId ::: ConvId ::: JsonRequest Public.ConversationAccessUpdate -> Galley Response -updateConversationAccessH (usr ::: zcon ::: cnv ::: req) = do - update <- fromJsonBody req - handleUpdateResult <$> updateConversationAccess usr zcon cnv update +updateConversationAccess :: + UserId -> + ConnId -> + Qualified ConvId -> + Public.ConversationAccessUpdate -> + Galley (UpdateResult Event) +updateConversationAccess usr con qcnv update = do + lusr <- qualifyLocal usr + let doUpdate = + foldQualified + lusr + updateLocalConversationAccess + updateRemoteConversationAccess + doUpdate qcnv lusr con update + +updateConversationAccessUnqualified :: + UserId -> + ConnId -> + ConvId -> + Public.ConversationAccessUpdate -> + Galley (UpdateResult Event) +updateConversationAccessUnqualified usr zcon cnv update = do + lusr <- qualifyLocal usr + lcnv <- qualifyLocal cnv + updateLocalConversationAccess lcnv lusr zcon update -updateConversationAccess :: UserId -> ConnId -> ConvId -> Public.ConversationAccessUpdate -> Galley (UpdateResult Event) -updateConversationAccess usr zcon cnv update = do +updateLocalConversationAccess :: + Local ConvId -> + Local UserId -> + ConnId -> + Public.ConversationAccessUpdate -> + Galley (UpdateResult Event) +updateLocalConversationAccess (lUnqualified -> cnv) (lUnqualified -> usr) zcon update = do let targetAccess = Set.fromList (toList (cupAccess update)) targetRole = cupAccessRole update -- 'PrivateAccessRole' is for self-conversations, 1:1 conversations and -- so on; users are not supposed to be able to make other conversations -- have 'PrivateAccessRole' when (PrivateAccess `elem` targetAccess || PrivateAccessRole == targetRole) $ - throwM invalidTargetAccess + throwErrorDescriptionType @InvalidTargetAccess -- The user who initiated access change has to be a conversation member (bots, users) <- localBotsAndUsers <$> Data.members cnv ensureConvMember users usr @@ -201,7 +229,9 @@ updateConversationAccess usr zcon cnv update = do -- Team conversations incur another round of checks case Data.convTeam conv of Just tid -> checkTeamConv tid self - Nothing -> when (targetRole == TeamAccessRole) $ throwM invalidTargetAccess + Nothing -> + when (targetRole == TeamAccessRole) $ + throwErrorDescriptionType @InvalidTargetAccess -- When there is no update to be done, we return 204; otherwise we go -- with 'uncheckedUpdateConversationAccess', which will potentially kick -- out some users and do DB updates. @@ -230,6 +260,14 @@ updateConversationAccess usr zcon cnv update = do -- conversation, so the user must have the necessary permission flag ensureActionAllowed RemoveConversationMember self +updateRemoteConversationAccess :: + Remote ConvId -> + Local UserId -> + ConnId -> + Public.ConversationAccessUpdate -> + Galley (UpdateResult Event) +updateRemoteConversationAccess _ _ _ _ = throwM federationNotImplemented + uncheckedUpdateConversationAccess :: ConversationAccessUpdate -> UserId -> From 428a9e5ecfab124b92b69cd0aae4e13273e9d474 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Tue, 28 Sep 2021 22:45:15 -0700 Subject: [PATCH 61/72] Spar Polysemy: Random effect (#1815) * Random effect * Implement HasCreateUUID via Random * make format --- changelog.d/5-internal/spar-random-effects | 1 + services/spar/spar.cabal | 4 +- services/spar/src/Spar/API.hs | 44 +++++++++++------ services/spar/src/Spar/App.hs | 53 +++++++++++---------- services/spar/src/Spar/Scim.hs | 3 +- services/spar/src/Spar/Scim/Auth.hs | 13 ++--- services/spar/src/Spar/Scim/User.hs | 15 +++--- services/spar/src/Spar/Sem/Random.hs | 13 +++++ services/spar/src/Spar/Sem/Random/IO.hs | 17 +++++++ services/spar/test-integration/Util/Core.hs | 38 ++++++++------- 10 files changed, 130 insertions(+), 71 deletions(-) create mode 100644 changelog.d/5-internal/spar-random-effects create mode 100644 services/spar/src/Spar/Sem/Random.hs create mode 100644 services/spar/src/Spar/Sem/Random/IO.hs diff --git a/changelog.d/5-internal/spar-random-effects b/changelog.d/5-internal/spar-random-effects new file mode 100644 index 00000000000..c2f28fe7a31 --- /dev/null +++ b/changelog.d/5-internal/spar-random-effects @@ -0,0 +1 @@ +Minimizes the MonadIO footprint still in Spar, by creating an effect that can generate random things diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index cf3a787eee1..1849fb59de7 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 9e886413a5108fd6abf098b0c1d23473e27606b12e5a2a36934f2df41cd4c80d +-- hash: 18af2f89c5e85abaed3b0ea0c9ad41d4a4360983b8eba93f626f14b8e3224f8c name: spar version: 0.1 @@ -50,6 +50,8 @@ library Spar.Sem.IdP Spar.Sem.IdP.Cassandra Spar.Sem.IdP.Mem + Spar.Sem.Random + Spar.Sem.Random.IO Spar.Sem.SAMLUserStore Spar.Sem.SAMLUserStore.Cassandra Spar.Sem.ScimExternalIdStore diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index ed4097fc811..3ff22c9d521 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -52,7 +52,6 @@ import Data.String.Conversions import Data.Time import Galley.Types.Teams (HiddenPerm (CreateUpdateDeleteIdp, ReadIdp)) import Imports -import OpenSSL.Random (randBytes) import Polysemy import Polysemy.Error import qualified SAML2.WebSSO as SAML @@ -76,6 +75,8 @@ import qualified Spar.Sem.DefaultSsoCode as DefaultSsoCode import Spar.Sem.GalleyAccess (GalleyAccess) import qualified Spar.Sem.GalleyAccess as GalleyAccess import qualified Spar.Sem.IdP as IdPEffect +import Spar.Sem.Random (Random) +import qualified Spar.Sem.Random as Random import Spar.Sem.SAMLUserStore (SAMLUserStore) import qualified Spar.Sem.SAMLUserStore as SAMLUserStore import Spar.Sem.ScimExternalIdStore (ScimExternalIdStore) @@ -106,6 +107,7 @@ api :: DefaultSsoCode, IdPEffect.IdP, SAMLUserStore, + Random, Error SparError ] r => @@ -129,6 +131,7 @@ apiSSO :: ScimTokenStore, DefaultSsoCode, IdPEffect.IdP, + Random, SAMLUserStore ] r => @@ -143,7 +146,7 @@ apiSSO opts = :<|> authresp . Just :<|> ssoSettings -apiIDP :: Members '[GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, SAMLUserStore, Error SparError] r => ServerT APIIDP (Spar r) +apiIDP :: Members '[Random, GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, SAMLUserStore, Error SparError] r => ServerT APIIDP (Spar r) apiIDP = idpGet :<|> idpGetRaw @@ -171,7 +174,7 @@ authreqPrecheck msucc merr idpid = *> return NoContent authreq :: - Members '[BindCookieStore, AssIDStore, AReqIDStore, IdPEffect.IdP] r => + Members '[Random, BindCookieStore, AssIDStore, AReqIDStore, IdPEffect.IdP] r => NominalDiffTime -> DoInitiate -> Maybe UserId -> @@ -198,12 +201,12 @@ authreq authreqttl _ zusr msucc merr idpid = do -- | If the user is already authenticated, create bind cookie with a given life expectancy and our -- domain, and store it in C*. If the user is not authenticated, return a deletion 'SetCookie' -- value that deletes any bind cookies on the client. -initializeBindCookie :: Member BindCookieStore r => Maybe UserId -> NominalDiffTime -> Spar r SetBindCookie +initializeBindCookie :: Members '[Random, BindCookieStore] r => Maybe UserId -> NominalDiffTime -> Spar r SetBindCookie initializeBindCookie zusr authreqttl = do DerivedOpts {derivedOptsBindCookiePath} <- asks (derivedOpts . sparCtxOpts) msecret <- if isJust zusr - then liftIO $ Just . cs . ES.encode <$> randBytes 32 + then liftSem $ Just . cs . ES.encode <$> Random.bytes 32 else pure Nothing cky <- fmap SetBindCookie . SAML.toggleCookie derivedOptsBindCookiePath $ (,authreqttl) <$> msecret forM_ zusr $ \userid -> wrapMonadClientSem $ BindCookieStore.insert cky userid authreqttl @@ -229,7 +232,18 @@ validateRedirectURL uri = do authresp :: forall r. - Members '[GalleyAccess, BrigAccess, BindCookieStore, AssIDStore, AReqIDStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Members + '[ Random, + GalleyAccess, + BrigAccess, + BindCookieStore, + AssIDStore, + AReqIDStore, + ScimTokenStore, + IdPEffect.IdP, + SAMLUserStore + ] + r => Maybe TeamId -> Maybe ST -> SAML.AuthnResponseBody -> @@ -262,7 +276,7 @@ ssoSettings = do -- IdP API idpGet :: - Members '[GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => + Members '[Random, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => Maybe UserId -> SAML.IdPId -> Spar r IdP @@ -283,7 +297,7 @@ idpGetRaw zusr idpid = do Just txt -> pure $ RawIdPMetadata txt Nothing -> throwSpar $ SparIdPNotFound (cs $ show idpid) -idpGetAll :: Members '[GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => Maybe UserId -> Spar r IdPList +idpGetAll :: Members '[Random, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => Maybe UserId -> Spar r IdPList idpGetAll zusr = withDebugLog "idpGetAll" (const Nothing) $ do teamid <- liftSem $ Brig.getZUsrCheckPerm zusr ReadIdp _idplProviders <- wrapMonadClientSem $ IdPEffect.getConfigsByTeam teamid @@ -299,7 +313,7 @@ idpGetAll zusr = withDebugLog "idpGetAll" (const Nothing) $ do -- https://github.com/zinfra/backend-issues/issues/1314 idpDelete :: forall r. - Members '[GalleyAccess, BrigAccess, ScimTokenStore, SAMLUserStore, IdPEffect.IdP, Error SparError] r => + Members '[Random, GalleyAccess, BrigAccess, ScimTokenStore, SAMLUserStore, IdPEffect.IdP, Error SparError] r => Maybe UserId -> SAML.IdPId -> Maybe Bool -> @@ -359,7 +373,7 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons -- | This handler only does the json parsing, and leaves all authorization checks and -- application logic to 'idpCreateXML'. idpCreate :: - Members '[GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error SparError] r => + Members '[Random, GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error SparError] r => Maybe UserId -> IdPMetadataInfo -> Maybe SAML.IdPId -> @@ -369,7 +383,7 @@ idpCreate zusr (IdPMetadataValue raw xml) midpid apiversion = idpCreateXML zusr -- | We generate a new UUID for each IdP used as IdPConfig's path, thereby ensuring uniqueness. idpCreateXML :: - Members '[GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error SparError] r => + Members '[Random, GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error SparError] r => Maybe UserId -> Text -> SAML.IdPMetadata -> @@ -423,7 +437,7 @@ assertNoScimOrNoIdP teamid = do validateNewIdP :: forall m r. (HasCallStack, m ~ Spar r) => - Member IdPEffect.IdP r => + Members '[Random, IdPEffect.IdP] r => WireIdPAPIVersion -> SAML.IdPMetadata -> TeamId -> @@ -470,7 +484,7 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces = withDebugLog "validate -- 'idpCreate', which is not a good reason. make this one function and pass around -- 'IdPMetadataInfo' directly where convenient. idpUpdate :: - Members '[GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => + Members '[Random, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => Maybe UserId -> IdPMetadataInfo -> SAML.IdPId -> @@ -478,7 +492,7 @@ idpUpdate :: idpUpdate zusr (IdPMetadataValue raw xml) idpid = idpUpdateXML zusr raw xml idpid idpUpdateXML :: - Members '[GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => + Members '[Random, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => Maybe UserId -> Text -> SAML.IdPMetadata -> @@ -501,7 +515,7 @@ idpUpdateXML zusr raw idpmeta idpid = withDebugLog "idpUpdate" (Just . show . (^ validateIdPUpdate :: forall m r. (HasCallStack, m ~ Spar r) => - Members '[GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => + Members '[Random, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => Maybe UserId -> SAML.IdPMetadata -> SAML.IdPId -> diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index 67a73acafff..dfa6b1e29e2 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -59,7 +59,6 @@ import Data.Id import Data.String.Conversions import Data.Text.Ascii (encodeBase64, toText) import qualified Data.Text.Lazy as LT -import qualified Data.UUID.V4 as UUID import Imports hiding (log) import qualified Network.HTTP.Types.Status as Http import qualified Network.Wai.Utilities.Error as Wai @@ -114,6 +113,9 @@ import Spar.Sem.GalleyAccess.Http (galleyAccessToHttp) import Spar.Sem.IdP (GetIdPResult (..)) import qualified Spar.Sem.IdP as IdPEffect import Spar.Sem.IdP.Cassandra (idPToCassandra) +import Spar.Sem.Random (Random) +import qualified Spar.Sem.Random as Random +import Spar.Sem.Random.IO (randomToIO) import Spar.Sem.SAMLUserStore (SAMLUserStore) import qualified Spar.Sem.SAMLUserStore as SAMLUserStore import Spar.Sem.SAMLUserStore.Cassandra (interpretClientToIO, samlUserStoreToCassandra) @@ -175,7 +177,8 @@ instance HasConfig (Spar r) where instance HasNow (Spar r) -instance HasCreateUUID (Spar r) +instance Member Random r => HasCreateUUID (Spar r) where + createUUID = liftSem Random.uuid instance HasLogger (Spar r) where -- FUTUREWORK: optionally use 'field' to index user or idp ids for easier logfile processing. @@ -336,9 +339,9 @@ createSamlUserWithId teamid buid suid = do -- | If the team has no scim token, call 'createSamlUser'. Otherwise, raise "invalid -- credentials". -autoprovisionSamlUser :: Members '[GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe TeamId -> SAML.UserRef -> Spar r UserId +autoprovisionSamlUser :: Members '[Random, GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe TeamId -> SAML.UserRef -> Spar r UserId autoprovisionSamlUser mbteam suid = do - buid <- Id <$> liftIO UUID.nextRandom + buid <- liftSem $ Id <$> Random.uuid autoprovisionSamlUserWithId mbteam buid suid pure buid @@ -430,6 +433,7 @@ instance ReaderEff.Reader Opts, Error TTLError, Error SparError, + Random, Embed IO, Final IO ] @@ -448,23 +452,24 @@ instance liftIO $ runFinal $ embedToFinal @IO $ - runError @SparError $ - ttlErrorToSparError $ - ReaderEff.runReader (sparCtxOpts ctx) $ - galleyAccessToHttp (sparCtxLogger ctx) (sparCtxHttpManager ctx) (sparCtxHttpGalley ctx) $ - brigAccessToHttp (sparCtxLogger ctx) (sparCtxHttpManager ctx) (sparCtxHttpBrig ctx) $ - interpretClientToIO (sparCtxCas ctx) $ - samlUserStoreToCassandra @Cas.Client $ - idPToCassandra @Cas.Client $ - defaultSsoCodeToCassandra $ - scimTokenStoreToCassandra $ - scimUserTimesStoreToCassandra $ - scimExternalIdStoreToCassandra $ - aReqIDStoreToCassandra $ - assIDStoreToCassandra $ - bindCookieStoreToCassandra $ - runExceptT $ - runReaderT action ctx + randomToIO $ + runError @SparError $ + ttlErrorToSparError $ + ReaderEff.runReader (sparCtxOpts ctx) $ + galleyAccessToHttp (sparCtxLogger ctx) (sparCtxHttpManager ctx) (sparCtxHttpGalley ctx) $ + brigAccessToHttp (sparCtxLogger ctx) (sparCtxHttpManager ctx) (sparCtxHttpBrig ctx) $ + interpretClientToIO (sparCtxCas ctx) $ + samlUserStoreToCassandra @Cas.Client $ + idPToCassandra @Cas.Client $ + defaultSsoCodeToCassandra $ + scimTokenStoreToCassandra $ + scimUserTimesStoreToCassandra $ + scimExternalIdStoreToCassandra $ + aReqIDStoreToCassandra $ + assIDStoreToCassandra $ + bindCookieStoreToCassandra $ + runExceptT $ + runReaderT action ctx throwErrorAsHandlerException :: Either SparError a -> Handler a throwErrorAsHandlerException (Left err) = sparToServerErrorWithLogging (sparCtxLogger ctx) err >>= throwError @@ -481,7 +486,7 @@ instance -- latter. verdictHandler :: HasCallStack => - Members '[GalleyAccess, BrigAccess, BindCookieStore, AReqIDStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Members '[Random, GalleyAccess, BrigAccess, BindCookieStore, AReqIDStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe BindCookie -> Maybe TeamId -> SAML.AuthnResponse -> @@ -513,7 +518,7 @@ data VerdictHandlerResult verdictHandlerResult :: HasCallStack => - Members '[GalleyAccess, BrigAccess, BindCookieStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Members '[Random, GalleyAccess, BrigAccess, BindCookieStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> @@ -558,7 +563,7 @@ moveUserToNewIssuer oldUserRef newUserRef uid = do verdictHandlerResultCore :: HasCallStack => - Members '[GalleyAccess, BrigAccess, BindCookieStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Members '[Random, GalleyAccess, BrigAccess, BindCookieStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> diff --git a/services/spar/src/Spar/Scim.hs b/services/spar/src/Spar/Scim.hs index 5da6d5d02d5..65c4bb8de3f 100644 --- a/services/spar/src/Spar/Scim.hs +++ b/services/spar/src/Spar/Scim.hs @@ -86,6 +86,7 @@ import Spar.Scim.User import Spar.Sem.BrigAccess (BrigAccess) import Spar.Sem.GalleyAccess (GalleyAccess) import qualified Spar.Sem.IdP as IdPEffect +import Spar.Sem.Random (Random) import Spar.Sem.SAMLUserStore (SAMLUserStore) import Spar.Sem.ScimExternalIdStore (ScimExternalIdStore) import Spar.Sem.ScimTokenStore (ScimTokenStore) @@ -108,7 +109,7 @@ configuration :: Scim.Meta.Configuration configuration = Scim.Meta.empty apiScim :: - Members '[Error SparError, GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Members '[Random, Error SparError, GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => ServerT APIScim (Spar r) apiScim = hoistScim (toServant (server configuration)) diff --git a/services/spar/src/Spar/Scim/Auth.hs b/services/spar/src/Spar/Scim/Auth.hs index 773f5781129..b1259855357 100644 --- a/services/spar/src/Spar/Scim/Auth.hs +++ b/services/spar/src/Spar/Scim/Auth.hs @@ -36,11 +36,10 @@ where import Control.Lens hiding (Strict, (.=)) import qualified Data.ByteString.Base64 as ES -import Data.Id (ScimTokenId, UserId, randomId) +import Data.Id (ScimTokenId, UserId) import Data.String.Conversions (cs) import Data.Time (getCurrentTime) import Imports -import OpenSSL.Random (randBytes) -- FUTUREWORK: these imports are not very handy. split up Spar.Scim into -- Spar.Scim.{Core,User,Group} to avoid at least some of the hscim name clashes? @@ -55,6 +54,8 @@ import Spar.Sem.BrigAccess (BrigAccess) import qualified Spar.Sem.BrigAccess as BrigAccess import Spar.Sem.GalleyAccess (GalleyAccess) import qualified Spar.Sem.IdP as IdPEffect +import Spar.Sem.Random (Random) +import qualified Spar.Sem.Random as Random import Spar.Sem.ScimTokenStore (ScimTokenStore) import qualified Spar.Sem.ScimTokenStore as ScimTokenStore import qualified Web.Scim.Class.Auth as Scim.Class.Auth @@ -82,7 +83,7 @@ instance Member ScimTokenStore r => Scim.Class.Auth.AuthDB SparTag (Spar r) wher -- | API for manipulating SCIM tokens (protected by normal Wire authentication and available -- only to team owners). apiScimToken :: - Members '[GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error E.SparError] r => + Members '[Random, GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error E.SparError] r => ServerT APIScimToken (Spar r) apiScimToken = createScimToken @@ -94,7 +95,7 @@ apiScimToken = -- Create a token for user's team. createScimToken :: forall r. - Members '[GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error E.SparError] r => + Members '[Random, GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error E.SparError] r => -- | Who is trying to create a token Maybe UserId -> -- | Request body @@ -112,8 +113,8 @@ createScimToken zusr CreateScimToken {..} = do let caseOneOrNoIdP :: Maybe SAML.IdPId -> Spar r CreateScimTokenResponse caseOneOrNoIdP midpid = do - token <- ScimToken . cs . ES.encode <$> liftIO (randBytes 32) - tokenid <- randomId + token <- liftSem $ ScimToken . cs . ES.encode <$> Random.bytes 32 + tokenid <- liftSem $ Random.scimTokenId now <- liftIO getCurrentTime let info = ScimTokenInfo diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index bd245409b9f..18522c895ac 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -60,7 +60,6 @@ import Data.Json.Util (UTCTimeMillis, fromUTCTimeMillis, toUTCTimeMillis) import Data.String.Conversions (cs) import qualified Data.Text as Text import qualified Data.UUID as UUID -import qualified Data.UUID.V4 as UUID import Imports import Network.URI (URI, parseURI) import Polysemy @@ -73,6 +72,8 @@ import qualified Spar.Scim.Types as ST import Spar.Sem.BrigAccess as BrigAccess import Spar.Sem.GalleyAccess (GalleyAccess) import qualified Spar.Sem.IdP as IdPEffect +import Spar.Sem.Random (Random) +import qualified Spar.Sem.Random as Random import Spar.Sem.SAMLUserStore (SAMLUserStore) import qualified Spar.Sem.SAMLUserStore as SAMLUserStore import Spar.Sem.ScimExternalIdStore (ScimExternalIdStore) @@ -104,7 +105,7 @@ import qualified Wire.API.User.Scim as ST ---------------------------------------------------------------------------- -- UserDB instance -instance Members '[GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, IdPEffect.IdP, SAMLUserStore] r => Scim.UserDB ST.SparTag (Spar r) where +instance Members '[Random, GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, IdPEffect.IdP, SAMLUserStore] r => Scim.UserDB ST.SparTag (Spar r) where getUsers :: ScimTokenInfo -> Maybe Scim.Filter -> @@ -372,7 +373,7 @@ veidEmail (ST.EmailOnly email) = Just email createValidScimUser :: forall m r. (m ~ Scim.ScimHandler (Spar r)) => - Members '[GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore] r => + Members '[Random, GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore] r => ScimTokenInfo -> ST.ValidScimUser -> m (Scim.StoredUser ST.SparTag) @@ -396,9 +397,9 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid buid <- ST.runValidExternalId ( \uref -> - do - uid <- liftIO $ Id <$> UUID.nextRandom - liftSem $ BrigAccess.createSAML uref uid stiTeam name ManagedByScim + liftSem $ do + uid <- Id <$> Random.uuid + BrigAccess.createSAML uref uid stiTeam name ManagedByScim ) ( \email -> do liftSem $ BrigAccess.createNoSAML email stiTeam name @@ -455,7 +456,7 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid -- TODO(arianvp): how do we get this safe w.r.t. race conditions / crashes? updateValidScimUser :: forall m r. - Members '[GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, IdPEffect.IdP, SAMLUserStore] r => + Members '[Random, GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, IdPEffect.IdP, SAMLUserStore] r => (m ~ Scim.ScimHandler (Spar r)) => ScimTokenInfo -> UserId -> diff --git a/services/spar/src/Spar/Sem/Random.hs b/services/spar/src/Spar/Sem/Random.hs new file mode 100644 index 00000000000..d3de55f3851 --- /dev/null +++ b/services/spar/src/Spar/Sem/Random.hs @@ -0,0 +1,13 @@ +module Spar.Sem.Random where + +import Data.Id (ScimTokenId) +import Data.UUID (UUID) +import Imports +import Polysemy + +data Random m a where + Bytes :: Int -> Random m ByteString + Uuid :: Random m UUID + ScimTokenId :: Random m ScimTokenId + +makeSem ''Random diff --git a/services/spar/src/Spar/Sem/Random/IO.hs b/services/spar/src/Spar/Sem/Random/IO.hs new file mode 100644 index 00000000000..5188b7a146b --- /dev/null +++ b/services/spar/src/Spar/Sem/Random/IO.hs @@ -0,0 +1,17 @@ +module Spar.Sem.Random.IO where + +import Data.Id (randomId) +import qualified Data.UUID.V4 as UUID +import Imports +import OpenSSL.Random (randBytes) +import Polysemy +import Spar.Sem.Random (Random (..)) + +randomToIO :: + Member (Embed IO) r => + Sem (Random ': r) a -> + Sem r a +randomToIO = interpret $ \case + Bytes i -> embed $ randBytes i + Uuid -> embed $ UUID.nextRandom + ScimTokenId -> embed $ randomId @IO diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index e6c00b5820a..77ef9e7b572 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -195,6 +195,8 @@ import Spar.Sem.GalleyAccess (GalleyAccess) import Spar.Sem.GalleyAccess.Http (galleyAccessToHttp) import qualified Spar.Sem.IdP as IdPEffect import Spar.Sem.IdP.Cassandra +import Spar.Sem.Random (Random) +import Spar.Sem.Random.IO (randomToIO) import Spar.Sem.SAMLUserStore (SAMLUserStore) import qualified Spar.Sem.SAMLUserStore as SAMLUserStore import Spar.Sem.SAMLUserStore.Cassandra @@ -1258,6 +1260,7 @@ type RealInterpretation = ReaderEff.Reader Opts, ErrorEff.Error TTLError, ErrorEff.Error SparError, + Random, Embed IO, Final IO ] @@ -1273,23 +1276,24 @@ runSpar (Spar.Spar action) = do fmap join $ runFinal $ embedToFinal @IO $ - ErrorEff.runError @SparError $ - ttlErrorToSparError $ - ReaderEff.runReader (Spar.sparCtxOpts env) $ - interpretClientToIO (Spar.sparCtxCas env) $ - samlUserStoreToCassandra @Cas.Client $ - idPToCassandra @Cas.Client $ - defaultSsoCodeToCassandra @Cas.Client $ - scimTokenStoreToCassandra @Cas.Client $ - scimUserTimesStoreToCassandra @Cas.Client $ - scimExternalIdStoreToCassandra @Cas.Client $ - aReqIDStoreToCassandra @Cas.Client $ - assIDStoreToCassandra @Cas.Client $ - bindCookieStoreToCassandra @Cas.Client $ - brigAccessToHttp (Spar.sparCtxLogger env) (Spar.sparCtxHttpManager env) (Spar.sparCtxHttpBrig env) $ - galleyAccessToHttp (Spar.sparCtxLogger env) (Spar.sparCtxHttpManager env) (Spar.sparCtxHttpBrig env) $ - runExceptT $ - runReaderT action env + randomToIO $ + ErrorEff.runError @SparError $ + ttlErrorToSparError $ + ReaderEff.runReader (Spar.sparCtxOpts env) $ + interpretClientToIO (Spar.sparCtxCas env) $ + samlUserStoreToCassandra @Cas.Client $ + idPToCassandra @Cas.Client $ + defaultSsoCodeToCassandra @Cas.Client $ + scimTokenStoreToCassandra @Cas.Client $ + scimUserTimesStoreToCassandra @Cas.Client $ + scimExternalIdStoreToCassandra @Cas.Client $ + aReqIDStoreToCassandra @Cas.Client $ + assIDStoreToCassandra @Cas.Client $ + bindCookieStoreToCassandra @Cas.Client $ + brigAccessToHttp (Spar.sparCtxLogger env) (Spar.sparCtxHttpManager env) (Spar.sparCtxHttpBrig env) $ + galleyAccessToHttp (Spar.sparCtxLogger env) (Spar.sparCtxHttpManager env) (Spar.sparCtxHttpBrig env) $ + runExceptT $ + runReaderT action env either (throwIO . ErrorCall . show) pure result getSsoidViaSelf :: HasCallStack => UserId -> TestSpar UserSSOId From 7e7612550a803a2f3ef03572a0a3667203288116 Mon Sep 17 00:00:00 2001 From: fisx Date: Wed, 29 Sep 2021 07:49:14 +0200 Subject: [PATCH 62/72] Conference call initiation flag for personal accounts (#1811) * New behavior of `GET /feature-configs*`. * Cassandra migration: personal account feature "conf call init". * Clean up after ormolu. * Add optSettings.featureFlags.conferenceCalling to brig.yaml. With default for NULL and default for new records. * Internal brig PUT/GET/DELETE end-points for account features. * Move brig's internal servant api to wire-api. * Integration tests. * Hard-wired default for all account features should be "enabled". --- changelog.d/2-features/pr-1811 | 1 + docs/reference/cassandra-schema.cql | 1 + docs/reference/config-options.md | 41 +++- libs/brig-types/brig-types.cabal | 3 +- .../test/unit/Test/Brig/Types/User.hs | 2 +- libs/wire-api/package.yaml | 1 + .../src/Wire/API/Routes/Internal/Brig.hs | 97 +++++++++ .../Wire/API/Routes/Internal/Brig}/EJPD.hs | 2 +- libs/wire-api/src/Wire/API/Team/Feature.hs | 13 ++ libs/wire-api/wire-api.cabal | 6 +- services/brig/brig.cabal | 7 +- services/brig/brig.integration.yaml | 1 + services/brig/package.yaml | 2 + services/brig/schema/src/Main.hs | 4 +- .../src/V66_PersonalFeatureConfCallInit.hs | 32 +++ services/brig/src/Brig/API/Internal.hs | 70 +++---- services/brig/src/Brig/API/User.hs | 7 + services/brig/src/Brig/App.hs | 2 +- services/brig/src/Brig/Data/User.hs | 21 ++ services/brig/src/Brig/Options.hs | 70 ++++++- services/brig/src/Brig/Run.hs | 4 +- services/brig/src/Brig/User/EJPD.hs | 2 +- .../brig/test/integration/API/Internal.hs | 190 +++++++++--------- .../test/integration/API/Internal/Util.hs | 129 ++++++++++++ .../integration/API/UserPendingActivation.hs | 18 -- services/brig/test/integration/Main.hs | 2 +- services/brig/test/integration/Util.hs | 17 ++ services/brig/test/unit/Main.hs | 4 +- .../brig/test/unit/Test/Brig/Roundtrip.hs | 43 ++++ services/galley/galley.cabal | 7 +- services/galley/package.yaml | 1 + services/galley/src/Galley/API/Internal.hs | 2 +- .../galley/src/Galley/API/Teams/Features.hs | 121 ++++++++--- services/galley/src/Galley/App.hs | 4 +- services/galley/src/Galley/Data/Instances.hs | 12 -- services/galley/src/Galley/Options.hs | 1 + .../test/integration/API/Teams/Feature.hs | 10 +- 37 files changed, 728 insertions(+), 222 deletions(-) create mode 100644 changelog.d/2-features/pr-1811 create mode 100644 libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs rename libs/{brig-types/src/Brig/Types/User => wire-api/src/Wire/API/Routes/Internal/Brig}/EJPD.hs (99%) create mode 100644 services/brig/schema/src/V66_PersonalFeatureConfCallInit.hs create mode 100644 services/brig/test/integration/API/Internal/Util.hs create mode 100644 services/brig/test/unit/Test/Brig/Roundtrip.hs diff --git a/changelog.d/2-features/pr-1811 b/changelog.d/2-features/pr-1811 new file mode 100644 index 00000000000..4abd0898b53 --- /dev/null +++ b/changelog.d/2-features/pr-1811 @@ -0,0 +1 @@ +Per-account configuration of conference call initiation (details: /docs/reference/config-options.md#conference-calling-1) diff --git a/docs/reference/cassandra-schema.cql b/docs/reference/cassandra-schema.cql index 80d6cd8e373..5df3899b420 100644 --- a/docs/reference/cassandra-schema.cql +++ b/docs/reference/cassandra-schema.cql @@ -1058,6 +1058,7 @@ CREATE TABLE brig_test.user ( country ascii, email text, expires timestamp, + feature_conference_calling int, handle text, language ascii, managed_by int, diff --git a/docs/reference/config-options.md b/docs/reference/config-options.md index 03bbec884fd..2b9e79ee586 100644 --- a/docs/reference/config-options.md +++ b/docs/reference/config-options.md @@ -5,7 +5,7 @@ Fragment. This page is about the yaml files that determine the configuration of the Wire backend services. -## Settings +## Settings in galley ``` # [galley.yaml] @@ -141,6 +141,8 @@ conferenceCalling: The `conferenceCalling` section is optional in `featureFlags`. If it is omitted then it is assumed to be `enabled`. +See also: conference falling for personal accounts (below). + ### File Sharing File sharing is enabled by default. If you want to disable it for all teams, add this to your feature config settings: @@ -270,3 +272,40 @@ federator: clientCertificate: client.pem clientPrivateKey: client-key.pem ``` + +## Settings in brig + +Some features (as of the time of writing this: only +`conferenceCalling`) allow to set defaults for personal accounts in +brig. Those are taken into account in galley's end-points `GET +/feature-configs*`. + +To be specific: + +### Conference Calling + +Two values can be configured for personal accounts: a default for when +the user record contains `null` as feature config, and default that +should be inserted into the user record when creating new users: + +``` +# [brig.yaml] +settings: + setFeatureFlags: + conferenceCalling: + defaultForNew: + status: disabled + defaultForNull: + status: enabled +``` + +You can omit the entire `conferenceCalling` block, but not parts of +it. Built-in defaults are as above. + +When new users are created, their config will be initialized with +what's in `defaultForNew`. + +When a `null` value is encountered, it is assumed to be +`defaultForNull`. + +(Introduced in https://github.com/wireapp/wire-server/pull/1811.) diff --git a/libs/brig-types/brig-types.cabal b/libs/brig-types/brig-types.cabal index 0f161808565..2ce16e19919 100644 --- a/libs/brig-types/brig-types.cabal +++ b/libs/brig-types/brig-types.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 2b3c91a37e09e61ca32cf32ab80c46e8f019926c78165bec82d9c84a5b8d20a6 +-- hash: 42d648b07cd5a5d45e2ca36fd4631c37047fc74aea88fce77073a3efa99327a2 name: brig-types version: 1.35.0 @@ -40,7 +40,6 @@ library Brig.Types.Test.Arbitrary Brig.Types.User Brig.Types.User.Auth - Brig.Types.User.EJPD Brig.Types.User.Event other-modules: Paths_brig_types diff --git a/libs/brig-types/test/unit/Test/Brig/Types/User.hs b/libs/brig-types/test/unit/Test/Brig/Types/User.hs index 85921cfd805..9742dfc389d 100644 --- a/libs/brig-types/test/unit/Test/Brig/Types/User.hs +++ b/libs/brig-types/test/unit/Test/Brig/Types/User.hs @@ -30,11 +30,11 @@ module Test.Brig.Types.User where import Brig.Types.Connection (UpdateConnectionsInternal (..)) import Brig.Types.Intra (NewUserScimInvitation (..), ReAuthUser (..)) import Brig.Types.User (ManagedByUpdate (..), RichInfoUpdate (..)) -import Brig.Types.User.EJPD (EJPDRequestBody (..), EJPDResponseBody (..)) import Imports import Test.Brig.Roundtrip (testRoundTrip, testRoundTripWithSwagger) import Test.QuickCheck (Arbitrary (arbitrary)) import Test.Tasty +import Wire.API.Routes.Internal.Brig.EJPD (EJPDRequestBody (..), EJPDResponseBody (..)) tests :: TestTree tests = testGroup "User (types vs. aeson)" $ roundtripTests diff --git a/libs/wire-api/package.yaml b/libs/wire-api/package.yaml index 3dae32a4b82..b08c802a5a3 100644 --- a/libs/wire-api/package.yaml +++ b/libs/wire-api/package.yaml @@ -13,6 +13,7 @@ dependencies: - containers >=0.5 - imports - types-common >=0.16 +- servant-swagger-ui - case-insensitive - hscim library: diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs new file mode 100644 index 00000000000..76c56375f52 --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -0,0 +1,97 @@ +-- 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 Wire.API.Routes.Internal.Brig + ( API, + SwaggerDocsAPI, + swaggerDoc, + module Wire.API.Routes.Internal.Brig.EJPD, + ) +where + +import Control.Lens ((.~)) +import Data.Id as Id +import Data.Swagger (HasInfo (info), HasTitle (title), Swagger) +import Imports hiding (head) +import Servant hiding (Handler, JSON, addHeader, respond) +import qualified Servant +import Servant.Swagger (HasSwagger (toSwagger)) +import Servant.Swagger.Internal.Orphans () +import Servant.Swagger.UI +import Wire.API.Routes.Internal.Brig.EJPD +import qualified Wire.API.Team.Feature as ApiFt + +type EJPDRequest = + Summary + "Identify users for law enforcement. Wire has legal requirements to cooperate \ + \with the authorities. The wire backend operations team uses this to answer \ + \identification requests manually. It is our best-effort representation of the \ + \minimum required information we need to hand over about targets and (in some \ + \cases) their communication peers. For more information, consult ejpd.admin.ch." + :> "ejpd-request" + :> QueryParam' + [ Optional, + Strict, + Description "Also provide information about all contacts of the identified users" + ] + "include_contacts" + Bool + :> Servant.ReqBody '[Servant.JSON] EJPDRequestBody + :> Post '[Servant.JSON] EJPDResponseBody + +type GetAccountFeatureConfig = + Summary + "Read cassandra field 'brig.user.feature_conference_calling'" + :> "users" + :> Capture "uid" UserId + :> "features" + :> "conferenceCalling" + :> Get '[Servant.JSON] (ApiFt.TeamFeatureStatus 'ApiFt.TeamFeatureConferenceCalling) + +type PutAccountFeatureConfig = + Summary + "Write to cassandra field 'brig.user.feature_conference_calling'" + :> "users" + :> Capture "uid" UserId + :> "features" + :> "conferenceCalling" + :> Servant.ReqBody '[Servant.JSON] (ApiFt.TeamFeatureStatus 'ApiFt.TeamFeatureConferenceCalling) + :> Put '[Servant.JSON] NoContent + +type DeleteAccountFeatureConfig = + Summary + "Reset cassandra field 'brig.user.feature_conference_calling' to 'null'" + :> "users" + :> Capture "uid" UserId + :> "features" + :> "conferenceCalling" + :> Delete '[Servant.JSON] NoContent + +type API = + "i" + :> ( EJPDRequest + :<|> GetAccountFeatureConfig + :<|> PutAccountFeatureConfig + :<|> DeleteAccountFeatureConfig + ) + +type SwaggerDocsAPI = "api" :> "internal" :> SwaggerSchemaUI "swagger-ui" "swagger.json" + +swaggerDoc :: Swagger +swaggerDoc = + toSwagger (Proxy @API) + & info . title .~ "Wire-Server API as Swagger 2.0 (internal end-points; incomplete) " diff --git a/libs/brig-types/src/Brig/Types/User/EJPD.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig/EJPD.hs similarity index 99% rename from libs/brig-types/src/Brig/Types/User/EJPD.hs rename to libs/wire-api/src/Wire/API/Routes/Internal/Brig/EJPD.hs index a985e6b218d..0e4c357c448 100644 --- a/libs/brig-types/src/Brig/Types/User/EJPD.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig/EJPD.hs @@ -18,7 +18,7 @@ -- | Identify users for law enforcement. (Wire has legal requirements to cooperate with the -- authorities. The wire backend operations team uses this to answer identification requests -- manually.) -module Brig.Types.User.EJPD +module Wire.API.Routes.Internal.Brig.EJPD ( EJPDRequestBody (EJPDRequestBody, ejpdRequestBody), EJPDResponseBody (EJPDResponseBody, ejpdResponseBody), EJPDResponseItem (EJPDResponseItem, ejpdResponseHandle, ejpdResponsePushTokens, ejpdResponseContacts), diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index faff71963f5..c943a4db1e0 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -45,6 +45,7 @@ module Wire.API.Team.Feature ) where +import qualified Cassandra.CQL as Cass import Control.Lens.Combinators (dimap) import qualified Data.Aeson as Aeson import qualified Data.Attoparsec.ByteString as Parser @@ -254,6 +255,18 @@ instance FromByteString TeamFeatureStatusValue where Right t -> fail $ "Invalid TeamFeatureStatusValue: " <> T.unpack t Left e -> fail $ "Invalid TeamFeatureStatusValue: " <> show e +instance Cass.Cql TeamFeatureStatusValue where + ctype = Cass.Tagged Cass.IntColumn + + fromCql (Cass.CqlInt n) = case n of + 0 -> pure $ TeamFeatureDisabled + 1 -> pure $ TeamFeatureEnabled + _ -> Left "fromCql: Invalid TeamFeatureStatusValue" + fromCql _ = Left "fromCql: TeamFeatureStatusValue: CqlInt expected" + + toCql TeamFeatureDisabled = Cass.CqlInt 0 + toCql TeamFeatureEnabled = Cass.CqlInt 1 + ---------------------------------------------------------------------- -- TeamFeatureStatus diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 104753d4209..3434f71e51e 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: ec0f1e0e3e31d5771b93db6b6ee37ad444f98c3213696e98bbedbb4b1bb56c8c +-- hash: 9d49a92f6ad563b050a6e3e6ae7f68b8abda7fa71e1986573cd81edf97d7b508 name: wire-api version: 0.1.0 @@ -49,6 +49,8 @@ library Wire.API.Provider.Service.Tag Wire.API.Push.Token Wire.API.Push.V2.Token + Wire.API.Routes.Internal.Brig + Wire.API.Routes.Internal.Brig.EJPD Wire.API.Routes.MultiTablePaging Wire.API.Routes.MultiTablePaging.State Wire.API.Routes.MultiVerb @@ -152,6 +154,7 @@ library , servant-multipart , servant-server , servant-swagger + , servant-swagger-ui , singletons , sop-core , string-conversions @@ -450,6 +453,7 @@ test-suite wire-api-tests , pem , pretty , proto-lens + , servant-swagger-ui , string-conversions , swagger2 , tasty diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index b3fe3a5eee1..7aff982fc2b 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 40cef77c160c1ffa8500043f465ab4ee307cf751450745d55010ef637b03b152 +-- hash: d5382afdfc45e225067c7848e99d40349897ddd6eeb69be59038373e57ada716 name: brig version: 1.35.0 @@ -268,6 +268,7 @@ executable brig-integration API.Calling API.Federation API.Internal + API.Internal.Util API.Metrics API.Provider API.RichInfo.Util @@ -318,6 +319,7 @@ executable brig-integration , cassandra-util , containers , cookie + , cql-io , data-timeout , email-validate , exceptions @@ -436,6 +438,7 @@ executable brig-schema V63_AddUsersPendingActivation V64_ClientCapabilities V65_FederatedConnections + V66_PersonalFeatureConfCallInit V9 Paths_brig hs-source-dirs: @@ -461,6 +464,7 @@ test-suite brig-tests Test.Brig.API.Error Test.Brig.Calling Test.Brig.Calling.Internal + Test.Brig.Roundtrip Test.Brig.User.Search.Index.Types Paths_brig hs-source-dirs: @@ -484,6 +488,7 @@ test-suite brig-tests , servant-client-core , tasty , tasty-hunit + , tasty-quickcheck , time , tinylog , types-common diff --git a/services/brig/brig.integration.yaml b/services/brig/brig.integration.yaml index 636b6856ac2..ee9b28c2f26 100644 --- a/services/brig/brig.integration.yaml +++ b/services/brig/brig.integration.yaml @@ -176,6 +176,7 @@ optSettings: # Once set, DO NOT change it: if you do, existing users may have a broken experience and/or stop working # Remember to keep it the same in Galley. setFederationDomain: example.com + setFeatureFlags: # see #RefConfigOptions in `/docs/reference` logLevel: Warn # ^ NOTE: We log too much in brig, if we set this to Info like other services, running tests diff --git a/services/brig/package.yaml b/services/brig/package.yaml index d332323e364..7a78afb759c 100644 --- a/services/brig/package.yaml +++ b/services/brig/package.yaml @@ -154,6 +154,7 @@ tests: - servant-client-core - tasty - tasty-hunit + - tasty-quickcheck - time - tinylog - types-common @@ -197,6 +198,7 @@ executables: - cassandra-util - containers - cookie + - cql-io - data-timeout - email-validate - exceptions diff --git a/services/brig/schema/src/Main.hs b/services/brig/schema/src/Main.hs index 1f3b6c597c3..9256b8e2ba2 100644 --- a/services/brig/schema/src/Main.hs +++ b/services/brig/schema/src/Main.hs @@ -75,6 +75,7 @@ import qualified V62_RemoveFederationIdMapping import qualified V63_AddUsersPendingActivation import qualified V64_ClientCapabilities import qualified V65_FederatedConnections +import qualified V66_PersonalFeatureConfCallInit import qualified V9 main :: IO () @@ -139,7 +140,8 @@ main = do V62_RemoveFederationIdMapping.migration, V63_AddUsersPendingActivation.migration, V64_ClientCapabilities.migration, - V65_FederatedConnections.migration + V65_FederatedConnections.migration, + V66_PersonalFeatureConfCallInit.migration -- When adding migrations here, don't forget to update -- 'schemaVersion' in Brig.App diff --git a/services/brig/schema/src/V66_PersonalFeatureConfCallInit.hs b/services/brig/schema/src/V66_PersonalFeatureConfCallInit.hs new file mode 100644 index 00000000000..3c915cf40a5 --- /dev/null +++ b/services/brig/schema/src/V66_PersonalFeatureConfCallInit.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# 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 V66_PersonalFeatureConfCallInit + ( migration, + ) +where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = Migration 66 "Add personal account feature: conf call initiation" $ do + schema' [r| ALTER TABLE user ADD feature_conference_calling int; |] diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 03b736de31c..7ba3823e1af 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -19,8 +19,8 @@ module Brig.API.Internal ( sitemap, servantSitemap, swaggerDocsAPI, - ServantAPI, - SwaggerDocsAPI, + BrigIRoutes.API, + BrigIRoutes.SwaggerDocsAPI, ) where @@ -42,13 +42,12 @@ import Brig.Team.DB (lookupInvitationByEmail) import Brig.Types import Brig.Types.Intra import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) -import qualified Brig.Types.User.EJPD as EJPD import Brig.Types.User.Event (UserEvent (UserUpdated), UserUpdatedData (eupSSOId, eupSSOIdRemoved), emptyUserUpdatedData) import qualified Brig.User.API.Auth as Auth import qualified Brig.User.API.Search as Search import qualified Brig.User.EJPD import Control.Error hiding (bool) -import Control.Lens (view, (.~)) +import Control.Lens (view, (^.)) import Data.Aeson hiding (json) import Data.ByteString.Conversion import qualified Data.ByteString.Conversion as List @@ -57,7 +56,6 @@ import Data.Id as Id import qualified Data.List1 as List1 import qualified Data.Map.Strict as Map import qualified Data.Set as Set -import Data.Swagger (HasInfo (info), HasTitle (title), Swagger) import Galley.Types (UserClients (..)) import Imports hiding (head) import Network.HTTP.Types.Status @@ -67,12 +65,12 @@ import Network.Wai.Routing import Network.Wai.Utilities as Utilities import Network.Wai.Utilities.ZAuth (zauthConnId, zauthUserId) import Servant hiding (Handler, JSON, addHeader, respond) -import qualified Servant -import Servant.Swagger (HasSwagger (toSwagger)) import Servant.Swagger.Internal.Orphans () import Servant.Swagger.UI import qualified System.Logger.Class as Log import Wire.API.ErrorDescription +import qualified Wire.API.Routes.Internal.Brig as BrigIRoutes +import qualified Wire.API.Team.Feature as ApiFt import Wire.API.User import Wire.API.User.Client (UserClientsFull (..)) import Wire.API.User.RichInfo @@ -80,41 +78,29 @@ import Wire.API.User.RichInfo --------------------------------------------------------------------------- -- Sitemap (servant) -type EJPDRequest = - Summary - "Identify users for law enforcement. Wire has legal requirements to cooperate \ - \with the authorities. The wire backend operations team uses this to answer \ - \identification requests manually. It is our best-effort representation of the \ - \minimum required information we need to hand over about targets and (in some \ - \cases) their communication peers. For more information, consult ejpd.admin.ch." - :> "ejpd-request" - :> QueryParam' - [ Optional, - Strict, - Description "Also provide information about all contacts of the identified users" - ] - "include_contacts" - Bool - :> Servant.ReqBody '[Servant.JSON] EJPD.EJPDRequestBody - :> Post '[Servant.JSON] EJPD.EJPDResponseBody - -type ServantAPI = - "i" - :> ( EJPDRequest - ) - -servantSitemap :: ServerT ServantAPI Handler -servantSitemap = Brig.User.EJPD.ejpdRequest - -type SwaggerDocsAPI = "api" :> "internal" :> SwaggerSchemaUI "swagger-ui" "swagger.json" - -swaggerDocsAPI :: Servant.Server SwaggerDocsAPI -swaggerDocsAPI = swaggerSchemaUIServer swaggerDoc - -swaggerDoc :: Swagger -swaggerDoc = - toSwagger (Proxy @ServantAPI) - & info . title .~ "Wire-Server API as Swagger 2.0 (internal end-points; incomplete) " +servantSitemap :: ServerT BrigIRoutes.API Handler +servantSitemap = + Brig.User.EJPD.ejpdRequest + :<|> getAccountFeatureConfig + :<|> putAccountFeatureConfig + :<|> deleteAccountFeatureConfig + +-- | Responds with 'Nothing' if field is NULL in existing user or user does not exist. +getAccountFeatureConfig :: UserId -> Handler ApiFt.TeamFeatureStatusNoConfig +getAccountFeatureConfig uid = + lift (Data.lookupFeatureConferenceCalling uid) + >>= maybe (asks (^. settings . getAfcConferenceCallingDefNull)) pure + +putAccountFeatureConfig :: UserId -> ApiFt.TeamFeatureStatusNoConfig -> Handler NoContent +putAccountFeatureConfig uid status = + lift $ Data.updateFeatureConferenceCalling uid (Just status) $> NoContent + +deleteAccountFeatureConfig :: UserId -> Handler NoContent +deleteAccountFeatureConfig uid = + lift $ Data.updateFeatureConferenceCalling uid Nothing $> NoContent + +swaggerDocsAPI :: Servant.Server BrigIRoutes.SwaggerDocsAPI +swaggerDocsAPI = swaggerSchemaUIServer BrigIRoutes.swaggerDoc --------------------------------------------------------------------------- -- Sitemap (wai-route) diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index fe6bf6d931f..b29c7b00179 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -271,6 +271,8 @@ createUser new = do pdata <- handlePhoneActivation phone uid + lift $ initAccountFeatureConfig uid + return $! CreateUserResult account edata pdata createUserTeam where -- NOTE: all functions in the where block don't use any arguments of createUser @@ -402,6 +404,11 @@ createUser new = do return Nothing pure pdata +initAccountFeatureConfig :: UserId -> AppIO () +initAccountFeatureConfig uid = do + mbCciDefNew <- asks (^. settings . getAfcConferenceCallingDefNewMaybe) + forM_ mbCciDefNew $ Data.updateFeatureConferenceCalling uid . Just + -- | 'createUser' is becoming hard to maintian, and instead of adding more case distinctions -- all over the place there, we add a new function that handles just the one new flow where -- users are invited to the team via scim. diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index 8d7b08607e3..d30481333f7 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -134,7 +134,7 @@ import Wire.API.Federation.Client (HasFederatorConfig (..)) import Wire.API.User.Identity (Email) schemaVersion :: Int32 -schemaVersion = 65 +schemaVersion = 66 ------------------------------------------------------------------------------- -- Environment diff --git a/services/brig/src/Brig/Data/User.hs b/services/brig/src/Brig/Data/User.hs index 7de1775d83e..8187266ceb6 100644 --- a/services/brig/src/Brig/Data/User.hs +++ b/services/brig/src/Brig/Data/User.hs @@ -46,6 +46,7 @@ module Brig.Data.User lookupUserTeam, lookupServiceUsers, lookupServiceUsersForTeam, + lookupFeatureConferenceCalling, -- * Updates updateUser, @@ -60,6 +61,7 @@ module Brig.Data.User updateStatus, updateHandle, updateRichInfo, + updateFeatureConferenceCalling, -- * Deletions deleteEmail, @@ -90,6 +92,7 @@ import Data.Time (addUTCTime) import Data.UUID.V4 import Galley.Types.Bot import Imports +import qualified Wire.API.Team.Feature as ApiFt import Wire.API.User.RichInfo -- | Authentication errors. @@ -298,6 +301,15 @@ updatePassword u t = do updateRichInfo :: UserId -> RichInfoAssocList -> AppIO () updateRichInfo u ri = retry x5 $ write userRichInfoUpdate (params Quorum (ri, u)) +updateFeatureConferenceCalling :: UserId -> Maybe ApiFt.TeamFeatureStatusNoConfig -> AppIO (Maybe ApiFt.TeamFeatureStatusNoConfig) +updateFeatureConferenceCalling uid mbStatus = do + let flag = ApiFt.tfwoStatus <$> mbStatus + retry x5 $ write update (params Quorum (flag, uid)) + pure mbStatus + where + update :: PrepQuery W (Maybe ApiFt.TeamFeatureStatusValue, UserId) () + update = fromString $ "update user set feature_conference_calling = ? where id = ?" + deleteEmail :: UserId -> AppIO () deleteEmail u = retry x5 $ write userEmailDelete (params Quorum (Identity u)) @@ -452,6 +464,15 @@ lookupServiceUsersForTeam pid sid tid = "SELECT user, conv FROM service_team \ \WHERE provider = ? AND service = ? AND team = ?" +lookupFeatureConferenceCalling :: MonadClient m => UserId -> m (Maybe ApiFt.TeamFeatureStatusNoConfig) +lookupFeatureConferenceCalling uid = do + let q = query1 select (params Quorum (Identity uid)) + mStatusValue <- (>>= runIdentity) <$> retry x1 q + pure $ ApiFt.TeamFeatureStatusNoConfig <$> mStatusValue + where + select :: PrepQuery R (Identity UserId) (Identity (Maybe ApiFt.TeamFeatureStatusValue)) + select = fromString $ "select feature_conference_calling from user where id = ?" + ------------------------------------------------------------------------------- -- Queries diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 6580aaabe73..7710b7608ef 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -45,6 +45,8 @@ import Imports import qualified Network.DNS as DNS import System.Logger.Extended (Level, LogFormat) import Util.Options +import Wire.API.Arbitrary (Arbitrary, GenericUniform (GenericUniform)) +import qualified Wire.API.Team.Feature as ApiFT newtype Timeout = Timeout { timeoutDiff :: NominalDiffTime @@ -485,8 +487,8 @@ data Settings = Settings -- | Do not allow certain user creation flows. -- docs/reference/user/registration.md {#RefRestrictRegistration}. setRestrictUserCreation :: !(Maybe Bool), - -- Customer extensions - + -- | The analog to `Galley.Options.setFeatureFlags`. See 'AccountFeatureConfigs'. + setFeatureFlags :: !(Maybe AccountFeatureConfigs), -- | Customer extensions. Read 'CustomerExtensions' docs carefully! setCustomerExtensions :: !(Maybe CustomerExtensions), -- | When set; instead of using SRV lookups to discover SFTs the calls @@ -497,6 +499,70 @@ data Settings = Settings } deriving (Show, Generic) +-- | The analog to `GT.FeatureFlags`. This type tracks only the things that we need to +-- express our current cloud business logic. +-- +-- FUTUREWORK: it would be nice to have a system of feature configs that allows to coherently +-- express arbitrary logic accross personal and team accounts, teams, and instances; including +-- default values for new records, default for records that have a NULL value (eg., because +-- they are grandfathered), and feature-specific extra data (eg., TLL for self-deleting +-- messages). For now, we have something quick & simple. +data AccountFeatureConfigs = AccountFeatureConfigs + { afcConferenceCallingDefNew :: !(ApiFT.TeamFeatureStatus 'ApiFT.TeamFeatureConferenceCalling), + afcConferenceCallingDefNull :: !(ApiFT.TeamFeatureStatus 'ApiFT.TeamFeatureConferenceCalling) + } + deriving (Show, Eq, Generic) + deriving (Arbitrary) via (GenericUniform AccountFeatureConfigs) + +instance FromJSON AccountFeatureConfigs where + parseJSON = + Aeson.withObject + "AccountFeatureConfigs" + ( \obj -> do + confCallInit <- obj Aeson..: "conferenceCalling" + Aeson.withObject + "conferenceCalling" + ( \obj' -> do + AccountFeatureConfigs + <$> obj' Aeson..: "defaultForNew" + <*> obj' Aeson..: "defaultForNull" + ) + confCallInit + ) + +instance ToJSON AccountFeatureConfigs where + toJSON + AccountFeatureConfigs + { afcConferenceCallingDefNew, + afcConferenceCallingDefNull + } = + Aeson.object + [ "conferenceCalling" + Aeson..= Aeson.object + [ "defaultForNew" Aeson..= afcConferenceCallingDefNew, + "defaultForNull" Aeson..= afcConferenceCallingDefNull + ] + ] + +getAfcConferenceCallingDefNewMaybe :: Lens.Getter Settings (Maybe ApiFT.TeamFeatureStatusNoConfig) +getAfcConferenceCallingDefNewMaybe = Lens.to (Lens.^? (Lens.to setFeatureFlags . Lens._Just . Lens.to afcConferenceCallingDefNew)) + +getAfcConferenceCallingDefNullMaybe :: Lens.Getter Settings (Maybe ApiFT.TeamFeatureStatusNoConfig) +getAfcConferenceCallingDefNullMaybe = Lens.to (Lens.^? (Lens.to setFeatureFlags . Lens._Just . Lens.to afcConferenceCallingDefNull)) + +getAfcConferenceCallingDefNew :: Lens.Getter Settings ApiFT.TeamFeatureStatusNoConfig +getAfcConferenceCallingDefNew = Lens.to (afcConferenceCallingDefNew . fromMaybe defAccountFeatureConfigs . setFeatureFlags) + +getAfcConferenceCallingDefNull :: Lens.Getter Settings ApiFT.TeamFeatureStatusNoConfig +getAfcConferenceCallingDefNull = Lens.to (afcConferenceCallingDefNull . fromMaybe defAccountFeatureConfigs . setFeatureFlags) + +defAccountFeatureConfigs :: AccountFeatureConfigs +defAccountFeatureConfigs = + AccountFeatureConfigs + { afcConferenceCallingDefNew = ApiFT.TeamFeatureStatusNoConfig ApiFT.TeamFeatureEnabled, + afcConferenceCallingDefNull = ApiFT.TeamFeatureStatusNoConfig ApiFT.TeamFeatureEnabled + } + -- | Customer extensions naturally are covered by the AGPL like everything else, but use them -- at your own risk! If you use the default server config and do not set -- @customerExtensions@, none of this will have any effect. diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs index 7cde35593d1..dbd076d05cf 100644 --- a/services/brig/src/Brig/Run.hs +++ b/services/brig/src/Brig/Run.hs @@ -126,7 +126,7 @@ mkApp o = do (customFormatters :. Servant.EmptyContext) ( swaggerDocsAPI :<|> Servant.hoistServer (Proxy @ServantAPI) (toServantHandler e) servantSitemap - :<|> Servant.hoistServer (Proxy @IAPI.ServantAPI) (toServantHandler e) IAPI.servantSitemap + :<|> Servant.hoistServer (Proxy @IAPI.API) (toServantHandler e) IAPI.servantSitemap :<|> Servant.hoistServer (genericApi (Proxy @FederationBrig.Api)) (toServantHandler e) federationSitemap :<|> Servant.Tagged (app e) ) @@ -134,7 +134,7 @@ mkApp o = do type ServantCombinedAPI = ( SwaggerDocsAPI :<|> ServantAPI - :<|> IAPI.ServantAPI + :<|> IAPI.API :<|> ToServantApi FederationBrig.Api :<|> Servant.Raw ) diff --git a/services/brig/src/Brig/User/EJPD.hs b/services/brig/src/Brig/User/EJPD.hs index f41d885adeb..7742b9dfe71 100644 --- a/services/brig/src/Brig/User/EJPD.hs +++ b/services/brig/src/Brig/User/EJPD.hs @@ -27,7 +27,6 @@ import qualified Brig.Data.Connection as Conn import Brig.Data.User (lookupUser) import qualified Brig.IO.Intra as Intra import Brig.Types.User (HavePendingInvitations (NoPendingInvitations)) -import Brig.Types.User.EJPD (EJPDRequestBody (EJPDRequestBody), EJPDResponseBody (EJPDResponseBody), EJPDResponseItem (EJPDResponseItem)) import Control.Error hiding (bool) import Control.Lens (view, (^.)) import Data.Handle (Handle) @@ -37,6 +36,7 @@ import Imports hiding (head) import Servant.Swagger.Internal.Orphans () import Wire.API.Connection (Relation, RelationWithHistory (..), relationDropHistory) import qualified Wire.API.Push.Token as PushTok +import Wire.API.Routes.Internal.Brig.EJPD (EJPDRequestBody (EJPDRequestBody), EJPDResponseBody (EJPDResponseBody), EJPDResponseItem (EJPDResponseItem)) import qualified Wire.API.Team.Member as Team import Wire.API.User (User, userDisplayName, userEmail, userHandle, userId, userPhone, userTeam) diff --git a/services/brig/test/integration/API/Internal.hs b/services/brig/test/integration/API/Internal.hs index 3f8655bb709..a1c4b038f18 100644 --- a/services/brig/test/integration/API/Internal.hs +++ b/services/brig/test/integration/API/Internal.hs @@ -3,117 +3,37 @@ module API.Internal ) where -import API.Team.Util (createPopulatedBindingTeamWithNamesAndHandles) +import API.Internal.Util import Bilge -import qualified Brig.API.Internal as IAPI +import Brig.Data.User (lookupFeatureConferenceCalling) import qualified Brig.Options as Opt -import Brig.Types -import Brig.Types.User.EJPD as EJPD -import Control.Lens (view, (^.)) -import Control.Monad.Catch (MonadCatch, throwM) -import qualified Data.ByteString.Base16 as B16 -import Data.Handle (Handle) +import Brig.Types.User (userId) +import Control.Exception (ErrorCall (ErrorCall), throwIO) +import Control.Lens ((^.), (^?!)) +import qualified Data.Aeson.Lens as Aeson +import qualified Data.Aeson.Types as Aeson +import Data.ByteString.Conversion (toByteString') import Data.Id -import qualified Data.List1 as List1 -import Data.Proxy (Proxy (Proxy)) import qualified Data.Set as Set -import Data.String.Conversions (cs) -import qualified Data.Text.Encoding as T +import qualified Database.CQL.IO as Cass import Imports -import qualified Servant.Client as Client -import System.Random (randomIO) import Test.Tasty import Test.Tasty.HUnit import Util -import Util.Options (Endpoint, epHost, epPort) +import Util.Options (Endpoint) import qualified Wire.API.Connection as Conn -import qualified Wire.API.Push.V2.Token as PushToken +import Wire.API.Routes.Internal.Brig.EJPD as EJPD +import qualified Wire.API.Team.Feature as ApiFt import qualified Wire.API.Team.Member as Team -tests :: Opt.Opts -> Manager -> Brig -> Endpoint -> Gundeck -> IO TestTree -tests _opts mgr brig brigep gundeck = do +tests :: Opt.Opts -> Manager -> Cass.ClientState -> Brig -> Endpoint -> Gundeck -> Galley -> IO TestTree +tests opts mgr db brig brigep gundeck galley = do return $ testGroup "api/internal" $ - [ test mgr "ejpd requests" $ testEJPDRequest mgr brig brigep gundeck + [ test mgr "ejpd requests" $ testEJPDRequest mgr brig brigep gundeck, + test mgr "account features: conferenceCalling" $ testFeatureConferenceCallingByAccount opts mgr db brig brigep galley ] -type TestConstraints m = (MonadFail m, MonadCatch m, MonadIO m, MonadHttp m) - -type MkUsr = - Maybe (Set (Relation, EJPDResponseItem)) -> - Maybe (Set EJPDResponseItem, Team.NewListType) -> - EJPDResponseItem - -scaffolding :: - forall m. - (TestConstraints m) => - Brig -> - Gundeck -> - m (Handle, MkUsr, Handle, MkUsr, MkUsr) -scaffolding brig gundeck = do - (_tid, usr1, [usr3]) <- createPopulatedBindingTeamWithNamesAndHandles brig 1 - (_handle1, usr2) <- createUserWithHandle brig - connectUsers brig (userId usr1) (List1.singleton $ userId usr2) - tok1 <- registerPushToken gundeck $ userId usr1 - tok2 <- registerPushToken gundeck $ userId usr2 - tok3 <- registerPushToken gundeck $ userId usr2 - pure - ( fromJust $ userHandle usr1, - mkUsr usr1 (Set.fromList [tok1]), - fromJust $ userHandle usr2, - mkUsr usr2 (Set.fromList [tok2, tok3]), - mkUsr usr3 Set.empty - ) - where - mkUsr :: User -> Set Text -> MkUsr - mkUsr usr toks = - EJPDResponseItem - (userId usr) - (userTeam usr) - (userDisplayName usr) - (userHandle usr) - (userEmail usr) - (userPhone usr) - toks - - registerPushToken :: TestConstraints m => Gundeck -> UserId -> m Text - registerPushToken gd u = do - t <- randomToken - rsp <- registerPushTokenRequest gd u t - responseJsonEither rsp - & either - (error . show) - (pure . PushToken.tokenText . view PushToken.token) - - registerPushTokenRequest :: TestConstraints m => Gundeck -> UserId -> PushToken.PushToken -> m ResponseLBS - registerPushTokenRequest gd u t = do - post - ( gd - . path "/push/tokens" - . contentJson - . zUser u - . zConn "random" - . json t - ) - - randomToken :: MonadIO m => m PushToken.PushToken - randomToken = liftIO $ do - c <- liftIO $ newClientId <$> (randomIO :: IO Word64) - tok <- PushToken.Token . T.decodeUtf8 <$> B16.encode <$> randomBytes 32 - return $ PushToken.pushToken PushToken.APNSSandbox (PushToken.AppName "test") tok c - -ejpdRequestClientM :: Maybe Bool -> EJPDRequestBody -> Client.ClientM EJPDResponseBody -ejpdRequestClientM = Client.client (Proxy @IAPI.ServantAPI) - -ejpdRequestClient :: TestConstraints m => Endpoint -> Manager -> Maybe Bool -> EJPDRequestBody -> m EJPDResponseBody -ejpdRequestClient brigep mgr includeContacts ejpdReqBody = do - let env = Client.mkClientEnv mgr baseurl - baseurl = Client.BaseUrl Client.Http (cs $ brigep ^. epHost) (fromIntegral $ brigep ^. epPort) "" - liftIO $ - Client.runClientM (ejpdRequestClientM includeContacts ejpdReqBody) env >>= \case - Left err -> throwM err - Right val -> pure val - testEJPDRequest :: TestConstraints m => Manager -> Brig -> Endpoint -> Gundeck -> m () testEJPDRequest mgr brig brigep gundeck = do (handle1, mkUsr1, handle2, mkUsr2, mkUsr3) <- scaffolding brig gundeck @@ -161,3 +81,81 @@ testEJPDRequest mgr brig brigep gundeck = do ] have <- ejpdRequestClient brigep mgr (Just True) req liftIO $ assertEqual "" want have + +testFeatureConferenceCallingByAccount :: forall m. TestConstraints m => Opt.Opts -> Manager -> Cass.ClientState -> Brig -> Endpoint -> Galley -> m () +testFeatureConferenceCallingByAccount (Opt.optSettings -> settings) mgr db brig brigep galley = do + let check :: HasCallStack => ApiFt.TeamFeatureStatusNoConfig -> m () + check status = do + uid <- userId <$> createUser "joe" brig + _ <- + aFewTimes 12 (putAccountFeatureConfigClient brigep mgr uid status) isRight + >>= either (liftIO . throwIO . ErrorCall . ("putAccountFeatureConfigClient: " <>) . show) pure + + mbStatus' <- getAccountFeatureConfigClient brigep mgr uid + liftIO $ assertEqual "1" (Right status) mbStatus' + + featureConfigs <- getAllFeatureConfigs galley uid + liftIO $ assertEqual "2" status (readFeatureConfigs featureConfigs) + + featureConfigsConfCalling <- getFeatureConfig ApiFt.TeamFeatureConferenceCalling galley uid + liftIO $ assertEqual "3" status (responseJsonUnsafe featureConfigsConfCalling) + + check' :: m () + check' = do + uid <- userId <$> createUser "joe" brig + let defaultIfNull :: ApiFt.TeamFeatureStatusNoConfig + defaultIfNull = settings ^. Opt.getAfcConferenceCallingDefNull + + defaultIfNewRaw :: Maybe ApiFt.TeamFeatureStatusNoConfig + defaultIfNewRaw = + -- tested manually: whether we remove `defaultForNew` from `brig.yaml` or set it + -- to `enabled` or `disabled`, this test always passes. + settings ^. Opt.getAfcConferenceCallingDefNewMaybe + + do + cassandraResp :: Maybe ApiFt.TeamFeatureStatusNoConfig <- + aFewTimes + 12 + (Cass.runClient db (lookupFeatureConferenceCalling uid)) + isJust + liftIO $ assertEqual mempty defaultIfNewRaw cassandraResp + + _ <- + aFewTimes 12 (deleteAccountFeatureConfigClient brigep mgr uid) isRight + >>= either (liftIO . throwIO . ErrorCall . ("deleteAccountFeatureConfigClient: " <>) . show) pure + + do + cassandraResp :: Maybe ApiFt.TeamFeatureStatusNoConfig <- + aFewTimes + 12 + (Cass.runClient db (lookupFeatureConferenceCalling uid)) + isJust + liftIO $ assertEqual mempty Nothing cassandraResp + + mbStatus' <- getAccountFeatureConfigClient brigep mgr uid + liftIO $ assertEqual "1" (Right defaultIfNull) mbStatus' + + featureConfigs <- getAllFeatureConfigs galley uid + liftIO $ assertEqual "2" defaultIfNull (readFeatureConfigs featureConfigs) + + featureConfigsConfCalling <- getFeatureConfig ApiFt.TeamFeatureConferenceCalling galley uid + liftIO $ assertEqual "3" defaultIfNull (responseJsonUnsafe featureConfigsConfCalling) + + readFeatureConfigs :: HasCallStack => ResponseLBS -> ApiFt.TeamFeatureStatusNoConfig + readFeatureConfigs = + either (error . show) id + . Aeson.parseEither Aeson.parseJSON + . (^?! Aeson.key "conferenceCalling") + . responseJsonUnsafe @Aeson.Value + + check $ ApiFt.TeamFeatureStatusNoConfig ApiFt.TeamFeatureEnabled + check $ ApiFt.TeamFeatureStatusNoConfig ApiFt.TeamFeatureDisabled + check' + +getFeatureConfig :: (MonadIO m, MonadHttp m, HasCallStack) => ApiFt.TeamFeatureName -> (Request -> Request) -> UserId -> m ResponseLBS +getFeatureConfig feature galley uid = do + get $ galley . paths ["feature-configs", toByteString' feature] . zUser uid + +getAllFeatureConfigs :: (MonadIO m, MonadHttp m, HasCallStack) => (Request -> Request) -> UserId -> m ResponseLBS +getAllFeatureConfigs galley uid = do + get $ galley . paths ["feature-configs"] . zUser uid diff --git a/services/brig/test/integration/API/Internal/Util.hs b/services/brig/test/integration/API/Internal/Util.hs new file mode 100644 index 00000000000..55bd1b5e335 --- /dev/null +++ b/services/brig/test/integration/API/Internal/Util.hs @@ -0,0 +1,129 @@ +module API.Internal.Util + ( TestConstraints, + MkUsr, + scaffolding, + ejpdRequestClient, + getAccountFeatureConfigClient, + putAccountFeatureConfigClient, + deleteAccountFeatureConfigClient, + ) +where + +import API.Team.Util (createPopulatedBindingTeamWithNamesAndHandles) +import Bilge +import qualified Brig.API.Internal as IAPI +import Brig.Types +import Control.Lens (view, (^.)) +import Control.Monad.Catch (MonadCatch, MonadThrow, throwM) +import qualified Data.ByteString.Base16 as B16 +import Data.Handle (Handle) +import Data.Id +import qualified Data.List1 as List1 +import Data.Proxy (Proxy (Proxy)) +import qualified Data.Set as Set +import Data.String.Conversions (cs) +import qualified Data.Text.Encoding as T +import Imports +import Servant.API ((:<|>) ((:<|>))) +import Servant.API.ContentTypes (NoContent) +import qualified Servant.Client as Client +import System.Random (randomIO) +import Util +import Util.Options (Endpoint, epHost, epPort) +import qualified Wire.API.Push.V2.Token as PushToken +import Wire.API.Routes.Internal.Brig.EJPD as EJPD +import qualified Wire.API.Team.Feature as Public +import qualified Wire.API.Team.Member as Team + +type TestConstraints m = (MonadFail m, MonadCatch m, MonadIO m, MonadHttp m) + +type MkUsr = + Maybe (Set (Relation, EJPDResponseItem)) -> + Maybe (Set EJPDResponseItem, Team.NewListType) -> + EJPDResponseItem + +scaffolding :: + forall m. + (TestConstraints m) => + Brig -> + Gundeck -> + m (Handle, MkUsr, Handle, MkUsr, MkUsr) +scaffolding brig gundeck = do + (_tid, usr1, [usr3]) <- createPopulatedBindingTeamWithNamesAndHandles brig 1 + (_handle1, usr2) <- createUserWithHandle brig + connectUsers brig (userId usr1) (List1.singleton $ userId usr2) + tok1 <- registerPushToken gundeck $ userId usr1 + tok2 <- registerPushToken gundeck $ userId usr2 + tok3 <- registerPushToken gundeck $ userId usr2 + pure + ( fromJust $ userHandle usr1, + mkUsr usr1 (Set.fromList [tok1]), + fromJust $ userHandle usr2, + mkUsr usr2 (Set.fromList [tok2, tok3]), + mkUsr usr3 Set.empty + ) + where + mkUsr :: User -> Set Text -> MkUsr + mkUsr usr toks = + EJPDResponseItem + (userId usr) + (userTeam usr) + (userDisplayName usr) + (userHandle usr) + (userEmail usr) + (userPhone usr) + toks + + registerPushToken :: TestConstraints m => Gundeck -> UserId -> m Text + registerPushToken gd u = do + t <- randomToken + rsp <- registerPushTokenRequest gd u t + responseJsonEither rsp + & either + (error . show) + (pure . PushToken.tokenText . view PushToken.token) + + registerPushTokenRequest :: TestConstraints m => Gundeck -> UserId -> PushToken.PushToken -> m ResponseLBS + registerPushTokenRequest gd u t = do + post + ( gd + . path "/push/tokens" + . contentJson + . zUser u + . zConn "random" + . json t + ) + + randomToken :: MonadIO m => m PushToken.PushToken + randomToken = liftIO $ do + c <- liftIO $ newClientId <$> (randomIO :: IO Word64) + tok <- PushToken.Token . T.decodeUtf8 <$> B16.encode <$> randomBytes 32 + return $ PushToken.pushToken PushToken.APNSSandbox (PushToken.AppName "test") tok c + +ejpdRequestClientM :: Maybe Bool -> EJPDRequestBody -> Client.ClientM EJPDResponseBody +getAccountFeatureConfigClientM :: UserId -> Client.ClientM Public.TeamFeatureStatusNoConfig +putAccountFeatureConfigClientM :: UserId -> Public.TeamFeatureStatusNoConfig -> Client.ClientM NoContent +deleteAccountFeatureConfigClientM :: UserId -> Client.ClientM NoContent +( ejpdRequestClientM + :<|> getAccountFeatureConfigClientM + :<|> putAccountFeatureConfigClientM + :<|> deleteAccountFeatureConfigClientM + ) = Client.client (Proxy @IAPI.API) + +ejpdRequestClient :: (HasCallStack, MonadThrow m, MonadIO m, MonadHttp m) => Endpoint -> Manager -> Maybe Bool -> EJPDRequestBody -> m EJPDResponseBody +ejpdRequestClient brigep mgr includeContacts ejpdReqBody = runHereClientM brigep mgr (ejpdRequestClientM includeContacts ejpdReqBody) >>= either throwM pure + +getAccountFeatureConfigClient :: (HasCallStack, MonadIO m, MonadHttp m) => Endpoint -> Manager -> UserId -> m (Either Client.ClientError Public.TeamFeatureStatusNoConfig) +getAccountFeatureConfigClient brigep mgr uid = runHereClientM brigep mgr (getAccountFeatureConfigClientM uid) + +putAccountFeatureConfigClient :: (HasCallStack, MonadIO m, MonadHttp m) => Endpoint -> Manager -> UserId -> Public.TeamFeatureStatusNoConfig -> m (Either Client.ClientError NoContent) +putAccountFeatureConfigClient brigep mgr uid cfg = runHereClientM brigep mgr (putAccountFeatureConfigClientM uid cfg) + +deleteAccountFeatureConfigClient :: (HasCallStack, MonadIO m, MonadHttp m) => Endpoint -> Manager -> UserId -> m (Either Client.ClientError NoContent) +deleteAccountFeatureConfigClient brigep mgr uid = runHereClientM brigep mgr (deleteAccountFeatureConfigClientM uid) + +runHereClientM :: (HasCallStack, MonadIO m, MonadHttp m) => Endpoint -> Manager -> Client.ClientM a -> m (Either Client.ClientError a) +runHereClientM brigep mgr action = do + let env = Client.mkClientEnv mgr baseurl + baseurl = Client.BaseUrl Client.Http (cs $ brigep ^. epHost) (fromIntegral $ brigep ^. epPort) "" + liftIO $ Client.runClientM action env diff --git a/services/brig/test/integration/API/UserPendingActivation.hs b/services/brig/test/integration/API/UserPendingActivation.hs index 4aa3dbf775a..c228de38bbb 100644 --- a/services/brig/test/integration/API/UserPendingActivation.hs +++ b/services/brig/test/integration/API/UserPendingActivation.hs @@ -35,7 +35,6 @@ import Control.Exception (assert) import Control.Lens ((^.), (^?)) import Control.Monad.Catch (MonadCatch) import Control.Monad.Random -import Control.Retry (exponentialBackoff, limitRetries, retrying) import Data.Aeson hiding (json) import qualified Data.Aeson as Aeson import Data.Aeson.Lens (key, _String) @@ -363,20 +362,3 @@ acceptWithName name email code = "password" Aeson..= defPassword, "team_code" Aeson..= code ] - --- | Run a probe several times, until a "good" value materializes or until patience runs out -aFewTimes :: - (HasCallStack, MonadIO m) => - -- | Number of retries. Exponentially: 11 ~ total of 2 secs delay, 12 ~ 4 secs delay, ... - Int -> - m a -> - (a -> Bool) -> - m a -aFewTimes - retries - action - good = do - retrying - (exponentialBackoff 1000 <> limitRetries retries) - (\_ -> pure . not . good) - (\_ -> action) diff --git a/services/brig/test/integration/Main.hs b/services/brig/test/integration/Main.hs index b612166de07..ab31aa1d332 100644 --- a/services/brig/test/integration/Main.hs +++ b/services/brig/test/integration/Main.hs @@ -135,7 +135,7 @@ runTests iConf brigOpts otherArgs = do federationEnd2End <- Federation.End2end.spec brigOpts mg b g c f brigTwo galleyTwo federationEndpoints <- API.Federation.tests mg b fedBrigClient includeFederationTests <- (== Just "1") <$> Blank.getEnv "INTEGRATION_FEDERATION_TESTS" - internalApi <- API.Internal.tests brigOpts mg b (brig iConf) gd + internalApi <- API.Internal.tests brigOpts mg db b (brig iConf) gd g withArgs otherArgs . defaultMain $ testGroup "Brig API Integration" diff --git a/services/brig/test/integration/Util.hs b/services/brig/test/integration/Util.hs index cb6c5ffc717..e5840321566 100644 --- a/services/brig/test/integration/Util.hs +++ b/services/brig/test/integration/Util.hs @@ -868,3 +868,20 @@ withDomainsBlockedForRegistration opts domains sess = do blocked = Opts.CustomerExtensions (Opts.DomainsBlockedForRegistration (unsafeMkDomain <$> domains)) unsafeMkDomain = either error id . mkDomain withSettingsOverrides opts' sess + +-- | Run a probe several times, until a "good" value materializes or until patience runs out +aFewTimes :: + (HasCallStack, MonadIO m) => + -- | Number of retries. Exponentially: 11 ~ total of 2 secs delay, 12 ~ 4 secs delay, ... + Int -> + m a -> + (a -> Bool) -> + m a +aFewTimes + retries + action + good = do + retrying + (exponentialBackoff 1000 <> limitRetries retries) + (\_ -> pure . not . good) + (\_ -> action) diff --git a/services/brig/test/unit/Main.hs b/services/brig/test/unit/Main.hs index 68c09f01eb9..a3137ba25de 100644 --- a/services/brig/test/unit/Main.hs +++ b/services/brig/test/unit/Main.hs @@ -24,6 +24,7 @@ import Imports import qualified Test.Brig.API.Error import qualified Test.Brig.Calling import qualified Test.Brig.Calling.Internal +import qualified Test.Brig.Roundtrip import qualified Test.Brig.User.Search.Index.Types import Test.Tasty @@ -35,5 +36,6 @@ main = [ Test.Brig.User.Search.Index.Types.tests, Test.Brig.Calling.tests, Test.Brig.Calling.Internal.tests, - Test.Brig.API.Error.tests + Test.Brig.API.Error.tests, + Test.Brig.Roundtrip.tests ] diff --git a/services/brig/test/unit/Test/Brig/Roundtrip.hs b/services/brig/test/unit/Test/Brig/Roundtrip.hs new file mode 100644 index 00000000000..51a1f513c13 --- /dev/null +++ b/services/brig/test/unit/Test/Brig/Roundtrip.hs @@ -0,0 +1,43 @@ +-- 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.Brig.Roundtrip (tests) where + +import qualified Brig.Options as Options +import Data.Aeson (FromJSON, ToJSON, parseJSON, toJSON) +import Data.Aeson.Types (parseEither) +import Imports +import qualified Test.Tasty as T +import Test.Tasty.QuickCheck (Arbitrary, counterexample, testProperty, (===)) +import Type.Reflection (typeRep) + +tests :: T.TestTree +tests = + T.localOption (T.Timeout (60 * 1000000) "60s") . T.testGroup "JSON roundtrip tests" $ + [ testRoundTrip @Options.AccountFeatureConfigs + ] + +testRoundTrip :: + forall a. + (Arbitrary a, Typeable a, ToJSON a, FromJSON a, Eq a, Show a) => + T.TestTree +testRoundTrip = testProperty msg trip + where + msg = show (typeRep @a) + trip (v :: a) = + counterexample (show $ toJSON v) $ + Right v === (parseEither parseJSON . toJSON) v diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index b81f555bb6a..a43ea917332 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 0f1a6ec2e6bf117e21a1b8da6d851d6a5a60cd553c803a079a07aedefbcf0233 +-- hash: a5b2ec0bd44d4fcabec564b4e7683a01cfb75cdb1c78a6eee520d6c48c95bb1d name: galley version: 0.83.0 @@ -126,6 +126,7 @@ library , safe-exceptions >=0.1 , saml2-web-sso >=0.18 , servant + , servant-client , servant-server , servant-swagger , servant-swagger-ui @@ -176,6 +177,7 @@ executable galley , imports , raw-strings-qq >=1.0 , safe >=0.3 + , servant-client , ssl-util , tagged , types-common @@ -315,6 +317,7 @@ executable galley-migrate-data , optparse-applicative , raw-strings-qq >=1.0 , safe >=0.3 + , servant-client , ssl-util , tagged , text @@ -379,6 +382,7 @@ executable galley-schema , optparse-applicative , raw-strings-qq >=1.0 , safe >=0.3 + , servant-client , ssl-util , tagged , text @@ -416,6 +420,7 @@ test-suite galley-types-tests , lens , raw-strings-qq >=1.0 , safe >=0.3 + , servant-client , servant-swagger , ssl-util , tagged diff --git a/services/galley/package.yaml b/services/galley/package.yaml index 0ba2b59e4ff..a4bda422abc 100644 --- a/services/galley/package.yaml +++ b/services/galley/package.yaml @@ -19,6 +19,7 @@ dependencies: - wire-api - wire-api-federation - tagged +- servant-client library: source-dirs: src diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 6bfd6a00385..2f51149b5b4 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -256,7 +256,7 @@ servantSitemap = iGetTeamFeature :: forall a. Public.KnownTeamFeatureName a => - (Maybe TeamId -> Galley (Public.TeamFeatureStatus a)) -> + (Features.GetFeatureInternalParam -> Galley (Public.TeamFeatureStatus a)) -> TeamId -> Galley (Public.TeamFeatureStatus a) iGetTeamFeature getter = Features.getFeatureStatus @a getter DontDoAuth diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 4764aba7e96..bb51d0fb753 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -39,15 +39,18 @@ module Galley.API.Teams.Features getConferenceCallingInternal, setConferenceCallingInternal, DoAuth (..), + GetFeatureInternalParam, ) where +import Bilge (MonadHttp) import Control.Lens import Control.Monad.Catch import qualified Data.Aeson as Aeson import Data.ByteString.Conversion hiding (fromList) import qualified Data.HashMap.Strict as HashMap import Data.Id +import Data.Proxy (Proxy (Proxy)) import Data.String.Conversions (cs) import Galley.API.Error as Galley import Galley.API.LegalHold @@ -61,21 +64,28 @@ import Galley.Intra.Push (PushEvent (FeatureConfigEvent), newPush, push1) import Galley.Options import Galley.Types.Teams hiding (newTeam) import Imports +import Network.HTTP.Client (Manager) import Network.Wai import Network.Wai.Predicate hiding (Error, or, result, setStatus) import Network.Wai.Utilities +import Servant.API ((:<|>) ((:<|>))) +import qualified Servant.Client as Client import qualified System.Logger.Class as Log +import Util.Options (Endpoint, epHost, epPort) import Wire.API.Event.FeatureConfig (EventData (EdFeatureWithoutConfigChanged)) import qualified Wire.API.Event.FeatureConfig as Event +import qualified Wire.API.Routes.Internal.Brig as IAPI import Wire.API.Team.Feature (AllFeatureConfigs (..), FeatureHasNoConfig, KnownTeamFeatureName, TeamFeatureName) import qualified Wire.API.Team.Feature as Public data DoAuth = DoAuth UserId | DontDoAuth +-- | For team-settings, to administrate team feature configuration. Here we have an admin uid +-- and a team id, but no uid of the member for which the feature config holds. getFeatureStatus :: forall (a :: Public.TeamFeatureName). Public.KnownTeamFeatureName a => - (Maybe TeamId -> Galley (Public.TeamFeatureStatus a)) -> + (GetFeatureInternalParam -> Galley (Public.TeamFeatureStatus a)) -> DoAuth -> TeamId -> Galley (Public.TeamFeatureStatus a) @@ -86,8 +96,9 @@ getFeatureStatus getter doauth tid = do void $ permissionCheck (ViewTeamFeature (Public.knownTeamFeatureName @a)) zusrMembership DontDoAuth -> assertTeamExists tid - getter (Just tid) + getter (Right tid) +-- | For team-settings, like 'getFeatureStatus'. setFeatureStatus :: forall (a :: Public.TeamFeatureName). Public.KnownTeamFeatureName a => @@ -105,21 +116,22 @@ setFeatureStatus setter doauth tid status = do assertTeamExists tid setter tid status +-- | For individual users to get feature config for their account (personal or team). getFeatureConfig :: forall (a :: Public.TeamFeatureName). Public.KnownTeamFeatureName a => - (Maybe TeamId -> Galley (Public.TeamFeatureStatus a)) -> + (GetFeatureInternalParam -> Galley (Public.TeamFeatureStatus a)) -> UserId -> Galley (Public.TeamFeatureStatus a) getFeatureConfig getter zusr = do mbTeam <- Data.oneUserTeam zusr case mbTeam of - Nothing -> getter Nothing + Nothing -> getter (Left (Just zusr)) Just tid -> do zusrMembership <- Data.teamMember tid zusr void $ permissionCheck (ViewTeamFeature (Public.knownTeamFeatureName @a)) zusrMembership assertTeamExists tid - getter (Just tid) + getter (Right tid) getAllFeatureConfigs :: UserId -> Galley AllFeatureConfigs getAllFeatureConfigs zusr = do @@ -130,14 +142,15 @@ getAllFeatureConfigs zusr = do ( Public.KnownTeamFeatureName a, Aeson.ToJSON (Public.TeamFeatureStatus a) ) => - (Maybe TeamId -> Galley (Public.TeamFeatureStatus a)) -> + (GetFeatureInternalParam -> Galley (Public.TeamFeatureStatus a)) -> Galley (Text, Aeson.Value) getStatus getter = do when (isJust mbTeam) $ do void $ permissionCheck (ViewTeamFeature (Public.knownTeamFeatureName @a)) zusrMembership - status <- getter mbTeam + status <- getter (maybe (Left (Just zusr)) Right mbTeam) let feature = Public.knownTeamFeatureName @a pure $ (cs (toByteString' feature) Aeson..= status) + AllFeatureConfigs . HashMap.fromList <$> sequence [ getStatus @'Public.TeamFeatureLegalHold getLegalholdStatusInternal, @@ -175,7 +188,7 @@ getAllFeatures uid tid = do ( Public.KnownTeamFeatureName a, Aeson.ToJSON (Public.TeamFeatureStatus a) ) => - (Maybe TeamId -> Galley (Public.TeamFeatureStatus a)) -> + (GetFeatureInternalParam -> Galley (Public.TeamFeatureStatus a)) -> Galley (Text, Aeson.Value) getStatus getter = do status <- getFeatureStatus @a getter (DoAuth uid) tid @@ -206,10 +219,12 @@ setFeatureStatusNoConfig applyState tid status = do Event.Event Event.Update (Public.knownTeamFeatureName @a) (EdFeatureWithoutConfigChanged newStatus) pure newStatus -getSSOStatusInternal :: Maybe TeamId -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureSSO) +type GetFeatureInternalParam = Either (Maybe UserId) TeamId + +getSSOStatusInternal :: GetFeatureInternalParam -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureSSO) getSSOStatusInternal = - maybe - (Public.TeamFeatureStatusNoConfig <$> getDef) + either + (const $ Public.TeamFeatureStatusNoConfig <$> getDef) (getFeatureStatusNoConfig @'Public.TeamFeatureSSO getDef) where getDef :: Galley Public.TeamFeatureStatusValue @@ -223,10 +238,10 @@ setSSOStatusInternal = setFeatureStatusNoConfig @'Public.TeamFeatureSSO $ \case Public.TeamFeatureDisabled -> const (throwM disableSsoNotImplemented) Public.TeamFeatureEnabled -> const (pure ()) -getTeamSearchVisibilityAvailableInternal :: Maybe TeamId -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureSearchVisibility) +getTeamSearchVisibilityAvailableInternal :: GetFeatureInternalParam -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureSearchVisibility) getTeamSearchVisibilityAvailableInternal = - maybe - (Public.TeamFeatureStatusNoConfig <$> getDef) + either + (const $ Public.TeamFeatureStatusNoConfig <$> getDef) (getFeatureStatusNoConfig @'Public.TeamFeatureSearchVisibility getDef) where getDef = do @@ -239,10 +254,10 @@ setTeamSearchVisibilityAvailableInternal = setFeatureStatusNoConfig @'Public.Tea Public.TeamFeatureDisabled -> SearchVisibilityData.resetSearchVisibility Public.TeamFeatureEnabled -> const (pure ()) -getValidateSAMLEmailsInternal :: Maybe TeamId -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureValidateSAMLEmails) +getValidateSAMLEmailsInternal :: GetFeatureInternalParam -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureValidateSAMLEmails) getValidateSAMLEmailsInternal = - maybe - (Public.TeamFeatureStatusNoConfig <$> getDef) + either + (const $ Public.TeamFeatureStatusNoConfig <$> getDef) (getFeatureStatusNoConfig @'Public.TeamFeatureValidateSAMLEmails getDef) where -- FUTUREWORK: we may also want to get a default from the server config file here, like for @@ -253,10 +268,10 @@ getValidateSAMLEmailsInternal = setValidateSAMLEmailsInternal :: TeamId -> (Public.TeamFeatureStatus 'Public.TeamFeatureValidateSAMLEmails) -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureValidateSAMLEmails) setValidateSAMLEmailsInternal = setFeatureStatusNoConfig @'Public.TeamFeatureValidateSAMLEmails $ \_ _ -> pure () -getDigitalSignaturesInternal :: Maybe TeamId -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureDigitalSignatures) +getDigitalSignaturesInternal :: GetFeatureInternalParam -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureDigitalSignatures) getDigitalSignaturesInternal = - maybe - (Public.TeamFeatureStatusNoConfig <$> getDef) + either + (const $ Public.TeamFeatureStatusNoConfig <$> getDef) (getFeatureStatusNoConfig @'Public.TeamFeatureDigitalSignatures getDef) where -- FUTUREWORK: we may also want to get a default from the server config file here, like for @@ -267,10 +282,10 @@ getDigitalSignaturesInternal = setDigitalSignaturesInternal :: TeamId -> Public.TeamFeatureStatus 'Public.TeamFeatureDigitalSignatures -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureDigitalSignatures) setDigitalSignaturesInternal = setFeatureStatusNoConfig @'Public.TeamFeatureDigitalSignatures $ \_ _ -> pure () -getLegalholdStatusInternal :: Maybe TeamId -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureLegalHold) -getLegalholdStatusInternal Nothing = +getLegalholdStatusInternal :: GetFeatureInternalParam -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureLegalHold) +getLegalholdStatusInternal (Left _) = pure $ Public.TeamFeatureStatusNoConfig Public.TeamFeatureDisabled -getLegalholdStatusInternal (Just tid) = do +getLegalholdStatusInternal (Right tid) = do isLegalHoldEnabledForTeam tid <&> \case True -> Public.TeamFeatureStatusNoConfig Public.TeamFeatureEnabled False -> Public.TeamFeatureStatusNoConfig Public.TeamFeatureDisabled @@ -297,9 +312,9 @@ setLegalholdStatusInternal tid status@(Public.tfwoStatus -> statusValue) = do ensureNotTooLargeToActivateLegalHold tid TeamFeatures.setFeatureStatusNoConfig @'Public.TeamFeatureLegalHold tid status -getFileSharingInternal :: Maybe TeamId -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureFileSharing) +getFileSharingInternal :: GetFeatureInternalParam -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureFileSharing) getFileSharingInternal = - getFeatureStatusWithDefaultConfig @'Public.TeamFeatureFileSharing flagFileSharing + getFeatureStatusWithDefaultConfig @'Public.TeamFeatureFileSharing flagFileSharing . either (const Nothing) Just getFeatureStatusWithDefaultConfig :: forall (a :: TeamFeatureName). @@ -320,10 +335,10 @@ getFeatureStatusWithDefaultConfig lens' = setFileSharingInternal :: TeamId -> Public.TeamFeatureStatus 'Public.TeamFeatureFileSharing -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureFileSharing) setFileSharingInternal = setFeatureStatusNoConfig @'Public.TeamFeatureFileSharing $ \_status _tid -> pure () -getAppLockInternal :: Maybe TeamId -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureAppLock) +getAppLockInternal :: GetFeatureInternalParam -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureAppLock) getAppLockInternal mbtid = do Defaults defaultStatus <- view (options . optSettings . setFeatureFlags . flagAppLockDefaults) - status <- join <$> (TeamFeatures.getApplockFeatureStatus `mapM` mbtid) + status <- join <$> (TeamFeatures.getApplockFeatureStatus `mapM` either (const Nothing) Just mbtid) pure $ fromMaybe defaultStatus status setAppLockInternal :: TeamId -> Public.TeamFeatureStatus 'Public.TeamFeatureAppLock -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureAppLock) @@ -332,7 +347,7 @@ setAppLockInternal tid status = do throwM inactivityTimeoutTooLow TeamFeatures.setApplockFeatureStatus tid status -getClassifiedDomainsInternal :: Maybe TeamId -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureClassifiedDomains) +getClassifiedDomainsInternal :: GetFeatureInternalParam -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureClassifiedDomains) getClassifiedDomainsInternal _mbtid = do globalConfig <- view (options . optSettings . setFeatureFlags . flagClassifiedDomains) let config = globalConfig @@ -341,8 +356,13 @@ getClassifiedDomainsInternal _mbtid = do Public.TeamFeatureStatusWithConfig Public.TeamFeatureDisabled (Public.TeamFeatureClassifiedDomainsConfig []) Public.TeamFeatureEnabled -> config -getConferenceCallingInternal :: Maybe TeamId -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureConferenceCalling) -getConferenceCallingInternal = getFeatureStatusWithDefaultConfig @'Public.TeamFeatureConferenceCalling flagConferenceCalling +getConferenceCallingInternal :: GetFeatureInternalParam -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureConferenceCalling) +getConferenceCallingInternal (Left (Just uid)) = do + getFeatureConfigViaAccount @'Public.TeamFeatureConferenceCalling uid +getConferenceCallingInternal (Left Nothing) = do + getFeatureStatusWithDefaultConfig @'Public.TeamFeatureConferenceCalling flagConferenceCalling Nothing +getConferenceCallingInternal (Right tid) = do + getFeatureStatusWithDefaultConfig @'Public.TeamFeatureConferenceCalling flagConferenceCalling (Just tid) setConferenceCallingInternal :: TeamId -> Public.TeamFeatureStatus 'Public.TeamFeatureConferenceCalling -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureConferenceCalling) setConferenceCallingInternal = setFeatureStatusNoConfig @'Public.TeamFeatureConferenceCalling $ \_status _tid -> pure () @@ -360,3 +380,44 @@ pushFeatureConfigEvent tid event = do for_ (newPush (memList ^. teamMemberListType) Nothing (FeatureConfigEvent event) recipients) push1 + +-- | (Currently, we only have 'Public.TeamFeatureConferenceCalling' here, but we may have to +-- extend this in the future.) +getFeatureConfigViaAccount :: flag ~ 'Public.TeamFeatureConferenceCalling => UserId -> Galley (Public.TeamFeatureStatus flag) +getFeatureConfigViaAccount uid = do + mgr <- asks (^. manager) + brigep <- asks (^. brig) + getAccountFeatureConfigClient brigep mgr uid >>= handleResp + where + handleResp :: + Either Client.ClientError Public.TeamFeatureStatusNoConfig -> + Galley Public.TeamFeatureStatusNoConfig + handleResp (Right cfg) = pure cfg + handleResp (Left errmsg) = throwM . internalErrorWithDescription . cs . show $ errmsg + + getAccountFeatureConfigClient :: + (HasCallStack, MonadIO m, MonadHttp m) => + Endpoint -> + Manager -> + UserId -> + m (Either Client.ClientError Public.TeamFeatureStatusNoConfig) + getAccountFeatureConfigClient brigep mgr = runHereClientM brigep mgr . getAccountFeatureConfigClientM + + getAccountFeatureConfigClientM :: + UserId -> Client.ClientM Public.TeamFeatureStatusNoConfig + ( _ + :<|> getAccountFeatureConfigClientM + :<|> _ + :<|> _ + ) = Client.client (Proxy @IAPI.API) + + runHereClientM :: + (HasCallStack, MonadIO m, MonadHttp m) => + Endpoint -> + Manager -> + Client.ClientM a -> + m (Either Client.ClientError a) + runHereClientM brigep mgr action = do + let env = Client.mkClientEnv mgr baseurl + baseurl = Client.BaseUrl Client.Http (cs $ brigep ^. epHost) (fromIntegral $ brigep ^. epPort) "" + liftIO $ Client.runClientM action env diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index f84012f190b..3d938a8241d 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -27,6 +27,7 @@ module Galley.App applog, manager, federator, + brig, cstate, deleteQueue, createEnv, @@ -113,6 +114,7 @@ data Env = Env _applog :: Logger, _manager :: Manager, _federator :: Maybe Endpoint, -- FUTUREWORK: should we use a better type here? E.g. to avoid fresh connections all the time? + _brig :: Endpoint, -- FUTUREWORK: see _federator _cstate :: ClientState, _deleteQueue :: Q.Queue DeleteItem, _extEnv :: ExtEnv, @@ -205,7 +207,7 @@ createEnv m o = do cass <- initCassandra o l mgr <- initHttpManager o validateOptions l o - Env def m o l mgr (o ^. optFederator) cass + Env def m o l mgr (o ^. optFederator) (o ^. optBrig) cass <$> Q.new 16000 <*> initExtEnv <*> maybe (return Nothing) (fmap Just . Aws.mkEnv l mgr) (o ^. optJournal) diff --git a/services/galley/src/Galley/Data/Instances.hs b/services/galley/src/Galley/Data/Instances.hs index e71b73a94d0..b1d259548e4 100644 --- a/services/galley/src/Galley/Data/Instances.hs +++ b/services/galley/src/Galley/Data/Instances.hs @@ -125,18 +125,6 @@ instance Cql TeamStatus where n -> Left $ "unexpected team-status: " ++ show n fromCql _ = Left "team-status: int expected" -instance Cql Public.TeamFeatureStatusValue where - ctype = Tagged IntColumn - - fromCql (CqlInt n) = case n of - 0 -> pure $ Public.TeamFeatureDisabled - 1 -> pure $ Public.TeamFeatureEnabled - _ -> Left "fromCql: Invalid TeamFeatureStatusValue" - fromCql _ = Left "fromCql: TeamFeatureStatusValue: CqlInt expected" - - toCql Public.TeamFeatureDisabled = CqlInt 0 - toCql Public.TeamFeatureEnabled = CqlInt 1 - instance Cql TeamSearchVisibility where ctype = Tagged IntColumn diff --git a/services/galley/src/Galley/Options.hs b/services/galley/src/Galley/Options.hs index fd74f58d53d..d51a346bcdd 100644 --- a/services/galley/src/Galley/Options.hs +++ b/services/galley/src/Galley/Options.hs @@ -100,6 +100,7 @@ data Settings = Settings -- the owners. -- Defaults to false. _setEnableIndexedBillingTeamMembers :: !(Maybe Bool), + -- | FUTUREWORK: 'setFeatureFlags' should be renamed to 'setFeatureConfigs' in all types. _setFeatureFlags :: !FeatureFlags } deriving (Show, Generic) diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index a5faeabfe35..2c2394f0c80 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -384,17 +384,17 @@ testAllFeatures = do (_owner, tid, member : _) <- Util.createBindingTeamWithNMembers 1 Util.getAllTeamFeatures member tid !!! do statusCode === const 200 - responseJsonMaybe === const (Just expected) + responseJsonMaybe === const (Just (expected TeamFeatureEnabled {- determined by default in galley -})) Util.getAllTeamFeaturesPersonal member !!! do statusCode === const 200 - responseJsonMaybe === const (Just expected) + responseJsonMaybe === const (Just (expected TeamFeatureEnabled {- determined by default in galley -})) randomPersonalUser <- Util.randomUser Util.getAllTeamFeaturesPersonal randomPersonalUser !!! do statusCode === const 200 - responseJsonMaybe === const (Just expected) + responseJsonMaybe === const (Just (expected TeamFeatureEnabled {- determined by 'getAfcConferenceCallingDefNew' in brig -})) where - expected = + expected confCalling = object [ toS TeamFeatureLegalHold .= Public.TeamFeatureStatusNoConfig TeamFeatureDisabled, toS TeamFeatureSSO .= Public.TeamFeatureStatusNoConfig TeamFeatureDisabled, @@ -411,7 +411,7 @@ testAllFeatures = do TeamFeatureEnabled (Public.TeamFeatureClassifiedDomainsConfig [Domain "example.com"]), toS TeamFeatureConferenceCalling - .= Public.TeamFeatureStatusNoConfig TeamFeatureEnabled + .= Public.TeamFeatureStatusNoConfig confCalling ] toS :: TeamFeatureName -> Text toS = TE.decodeUtf8 . toByteString' From 5ebfb8166ac0622e02e0844e641f8b041d2bfbb2 Mon Sep 17 00:00:00 2001 From: fisx Date: Wed, 29 Sep 2021 10:50:21 +0200 Subject: [PATCH 63/72] Conference call initiation as a personal account feature: errata (#1818) * Tweak docs. * Fix CHANGELOG for pr-1811 (oops). * Fix CHANGELOG of last release (oops). * Correct mistake in docs. * Make servant-clients definitions more readable. * Make test failures more informative. * lens-fu. * FUTUREWORK. --- CHANGELOG.md | 2 +- changelog.d/0-release-notes/pr-1811 | 1 + changelog.d/0-release-notes/pr-1811-1 | 1 + changelog.d/2-features/pr-1755 | 3 --- changelog.d/2-features/pr-1811 | 2 +- docs/developer/cassandra-interaction.md | 2 +- docs/reference/config-options.md | 5 ++++- .../src/Wire/API/Routes/Internal/Brig.hs | 4 ++++ services/brig/src/Brig/API/Internal.hs | 4 ++-- services/brig/src/Brig/API/User.hs | 2 +- services/brig/test/integration/API/Internal.hs | 12 ++++++------ .../brig/test/integration/API/Internal/Util.hs | 17 +++++++++-------- .../galley/src/Galley/API/Teams/Features.hs | 2 ++ .../test-integration/Test/Spar/Scim/UserSpec.hs | 12 ++++++------ services/spar/test-integration/Util/Core.hs | 4 ++-- services/spar/test-integration/Util/Email.hs | 6 +++--- services/spar/test-integration/Util/Types.hs | 4 ++-- 17 files changed, 46 insertions(+), 37 deletions(-) create mode 100644 changelog.d/0-release-notes/pr-1811 create mode 100644 changelog.d/0-release-notes/pr-1811-1 delete mode 100644 changelog.d/2-features/pr-1755 diff --git a/CHANGELOG.md b/CHANGELOG.md index 15e4cfa1fb7..8c18c7df3bb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -16,7 +16,7 @@ ## Features * Disallow changing phone number to a black listed phone number (#1758) -* Support using a single IDP with a single EntityID (aka issuer ID) to set up two teams. Required to support multiple teams in environments where the IDP software cannot present anything but one EntityID (E.G.: DualShield). (#1755) +* Support using a single IDP with a single EntityID (aka issuer ID) to set up two teams. Sets up a migration, and makes teamID + EntityID unique, rather than relying on EntityID to be unique. Required to support multiple teams in environments where the IDP software cannot present anything but one EntityID (E.G.: DualShield). (#1755) ## Documentation diff --git a/changelog.d/0-release-notes/pr-1811 b/changelog.d/0-release-notes/pr-1811 new file mode 100644 index 00000000000..16a31194c6c --- /dev/null +++ b/changelog.d/0-release-notes/pr-1811 @@ -0,0 +1 @@ +Deploy brig before galley (#1811, #1818) diff --git a/changelog.d/0-release-notes/pr-1811-1 b/changelog.d/0-release-notes/pr-1811-1 new file mode 100644 index 00000000000..2ead169866b --- /dev/null +++ b/changelog.d/0-release-notes/pr-1811-1 @@ -0,0 +1 @@ +The conference call initiation feature can now be configured for personal accounts in `brig.yaml`. `enabled` is the default and the previous behavior. If you want to change that, read [/docs/reference/config-options.md#conference-calling-1](https://github.com/wireapp/wire-server/blob/develop/docs/reference/config-options.md#conference-calling-1) (#1811, #1818) \ No newline at end of file diff --git a/changelog.d/2-features/pr-1755 b/changelog.d/2-features/pr-1755 deleted file mode 100644 index 81624c4022e..00000000000 --- a/changelog.d/2-features/pr-1755 +++ /dev/null @@ -1,3 +0,0 @@ -Support using a single IDP with a single EntityID (aka issuer ID) to set up two teams. -Sets up a migration, and makes teamID + EntityID unique, rather than relying on EntityID to be unique. -Required to support multiple teams in environments where the IDP software cannot present anything but one EntityID (E.G.: DualShield). \ No newline at end of file diff --git a/changelog.d/2-features/pr-1811 b/changelog.d/2-features/pr-1811 index 4abd0898b53..a54efbd025f 100644 --- a/changelog.d/2-features/pr-1811 +++ b/changelog.d/2-features/pr-1811 @@ -1 +1 @@ -Per-account configuration of conference call initiation (details: /docs/reference/config-options.md#conference-calling-1) +Per-account configuration of conference call initiation (details: /docs/reference/config-options.md#conference-calling-1) (#1811, #1818) diff --git a/docs/developer/cassandra-interaction.md b/docs/developer/cassandra-interaction.md index da62ea90291..8cc9d3ee514 100644 --- a/docs/developer/cassandra-interaction.md +++ b/docs/developer/cassandra-interaction.md @@ -71,7 +71,7 @@ So usually with these safeguards in place, and backwards-compatible changes, we * At time t=0, old schema, old code serves traffic; all good. * At time t=1, new schema, old code serves traffic: all good since backwards compatible. * At time t=2, new schema, old code AND new code serve traffic: all good since backwards compatible. -* At time t=3, new schema, new code serves traffic: all good since backwards compatible. +* At time t=3, new schema, new code serves traffic: all good! If this order (apply schema first; then deploy code) is not safeguarded, then there will be code running in e.g. production which `SELECT my_new_field FROM my_new_table` even though this doesn't yet exist, leading to 500 server errors for as long as the mismatch between applied schema and code version persists. diff --git a/docs/reference/config-options.md b/docs/reference/config-options.md index 2b9e79ee586..ce3535eb736 100644 --- a/docs/reference/config-options.md +++ b/docs/reference/config-options.md @@ -300,7 +300,10 @@ settings: ``` You can omit the entire `conferenceCalling` block, but not parts of -it. Built-in defaults are as above. +it. Built-in defaults: `defaultForNew: null` (user record attribute +is left empty); `defaultForNull: enabled`. This maintains behavior +prior to the introduction of this change, while allowing site owners +to postpone the decision about the default setting. When new users are created, their config will be initialized with what's in `defaultForNew`. diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index 76c56375f52..ed89cf2c5e8 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -17,6 +17,10 @@ module Wire.API.Routes.Internal.Brig ( API, + EJPDRequest, + GetAccountFeatureConfig, + PutAccountFeatureConfig, + DeleteAccountFeatureConfig, SwaggerDocsAPI, swaggerDoc, module Wire.API.Routes.Internal.Brig.EJPD, diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 7ba3823e1af..225c4784ee7 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -47,7 +47,7 @@ import qualified Brig.User.API.Auth as Auth import qualified Brig.User.API.Search as Search import qualified Brig.User.EJPD import Control.Error hiding (bool) -import Control.Lens (view, (^.)) +import Control.Lens (view) import Data.Aeson hiding (json) import Data.ByteString.Conversion import qualified Data.ByteString.Conversion as List @@ -89,7 +89,7 @@ servantSitemap = getAccountFeatureConfig :: UserId -> Handler ApiFt.TeamFeatureStatusNoConfig getAccountFeatureConfig uid = lift (Data.lookupFeatureConferenceCalling uid) - >>= maybe (asks (^. settings . getAfcConferenceCallingDefNull)) pure + >>= maybe (view (settings . getAfcConferenceCallingDefNull)) pure putAccountFeatureConfig :: UserId -> ApiFt.TeamFeatureStatusNoConfig -> Handler NoContent putAccountFeatureConfig uid status = diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index b29c7b00179..e39aba706a7 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -406,7 +406,7 @@ createUser new = do initAccountFeatureConfig :: UserId -> AppIO () initAccountFeatureConfig uid = do - mbCciDefNew <- asks (^. settings . getAfcConferenceCallingDefNewMaybe) + mbCciDefNew <- view (settings . getAfcConferenceCallingDefNewMaybe) forM_ mbCciDefNew $ Data.updateFeatureConferenceCalling uid . Just -- | 'createUser' is becoming hard to maintian, and instead of adding more case distinctions diff --git a/services/brig/test/integration/API/Internal.hs b/services/brig/test/integration/API/Internal.hs index a1c4b038f18..2f19e86e1d1 100644 --- a/services/brig/test/integration/API/Internal.hs +++ b/services/brig/test/integration/API/Internal.hs @@ -92,13 +92,13 @@ testFeatureConferenceCallingByAccount (Opt.optSettings -> settings) mgr db brig >>= either (liftIO . throwIO . ErrorCall . ("putAccountFeatureConfigClient: " <>) . show) pure mbStatus' <- getAccountFeatureConfigClient brigep mgr uid - liftIO $ assertEqual "1" (Right status) mbStatus' + liftIO $ assertEqual "GET /i/users/:uid/features/conferenceCalling" (Right status) mbStatus' featureConfigs <- getAllFeatureConfigs galley uid - liftIO $ assertEqual "2" status (readFeatureConfigs featureConfigs) + liftIO $ assertEqual "GET /feature-configs" status (readFeatureConfigs featureConfigs) featureConfigsConfCalling <- getFeatureConfig ApiFt.TeamFeatureConferenceCalling galley uid - liftIO $ assertEqual "3" status (responseJsonUnsafe featureConfigsConfCalling) + liftIO $ assertEqual "GET /feature-configs/conferenceCalling" status (responseJsonUnsafe featureConfigsConfCalling) check' :: m () check' = do @@ -133,13 +133,13 @@ testFeatureConferenceCallingByAccount (Opt.optSettings -> settings) mgr db brig liftIO $ assertEqual mempty Nothing cassandraResp mbStatus' <- getAccountFeatureConfigClient brigep mgr uid - liftIO $ assertEqual "1" (Right defaultIfNull) mbStatus' + liftIO $ assertEqual "GET /i/users/:uid/features/conferenceCalling" (Right defaultIfNull) mbStatus' featureConfigs <- getAllFeatureConfigs galley uid - liftIO $ assertEqual "2" defaultIfNull (readFeatureConfigs featureConfigs) + liftIO $ assertEqual "GET /feature-configs" defaultIfNull (readFeatureConfigs featureConfigs) featureConfigsConfCalling <- getFeatureConfig ApiFt.TeamFeatureConferenceCalling galley uid - liftIO $ assertEqual "3" defaultIfNull (responseJsonUnsafe featureConfigsConfCalling) + liftIO $ assertEqual "GET /feature-configs/conferenceCalling" defaultIfNull (responseJsonUnsafe featureConfigsConfCalling) readFeatureConfigs :: HasCallStack => ResponseLBS -> ApiFt.TeamFeatureStatusNoConfig readFeatureConfigs = diff --git a/services/brig/test/integration/API/Internal/Util.hs b/services/brig/test/integration/API/Internal/Util.hs index 55bd1b5e335..4890231fa57 100644 --- a/services/brig/test/integration/API/Internal/Util.hs +++ b/services/brig/test/integration/API/Internal/Util.hs @@ -11,7 +11,6 @@ where import API.Team.Util (createPopulatedBindingTeamWithNamesAndHandles) import Bilge -import qualified Brig.API.Internal as IAPI import Brig.Types import Control.Lens (view, (^.)) import Control.Monad.Catch (MonadCatch, MonadThrow, throwM) @@ -24,14 +23,14 @@ import qualified Data.Set as Set import Data.String.Conversions (cs) import qualified Data.Text.Encoding as T import Imports -import Servant.API ((:<|>) ((:<|>))) +import Servant.API ((:>)) import Servant.API.ContentTypes (NoContent) import qualified Servant.Client as Client import System.Random (randomIO) import Util import Util.Options (Endpoint, epHost, epPort) import qualified Wire.API.Push.V2.Token as PushToken -import Wire.API.Routes.Internal.Brig.EJPD as EJPD +import Wire.API.Routes.Internal.Brig as IAPI import qualified Wire.API.Team.Feature as Public import qualified Wire.API.Team.Member as Team @@ -101,14 +100,16 @@ scaffolding brig gundeck = do return $ PushToken.pushToken PushToken.APNSSandbox (PushToken.AppName "test") tok c ejpdRequestClientM :: Maybe Bool -> EJPDRequestBody -> Client.ClientM EJPDResponseBody +ejpdRequestClientM = Client.client (Proxy @("i" :> IAPI.EJPDRequest)) + getAccountFeatureConfigClientM :: UserId -> Client.ClientM Public.TeamFeatureStatusNoConfig +getAccountFeatureConfigClientM = Client.client (Proxy @("i" :> IAPI.GetAccountFeatureConfig)) + putAccountFeatureConfigClientM :: UserId -> Public.TeamFeatureStatusNoConfig -> Client.ClientM NoContent +putAccountFeatureConfigClientM = Client.client (Proxy @("i" :> IAPI.PutAccountFeatureConfig)) + deleteAccountFeatureConfigClientM :: UserId -> Client.ClientM NoContent -( ejpdRequestClientM - :<|> getAccountFeatureConfigClientM - :<|> putAccountFeatureConfigClientM - :<|> deleteAccountFeatureConfigClientM - ) = Client.client (Proxy @IAPI.API) +deleteAccountFeatureConfigClientM = Client.client (Proxy @("i" :> IAPI.DeleteAccountFeatureConfig)) ejpdRequestClient :: (HasCallStack, MonadThrow m, MonadIO m, MonadHttp m) => Endpoint -> Manager -> Maybe Bool -> EJPDRequestBody -> m EJPDResponseBody ejpdRequestClient brigep mgr includeContacts ejpdReqBody = runHereClientM brigep mgr (ejpdRequestClientM includeContacts ejpdReqBody) >>= either throwM pure diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index bb51d0fb753..f0a25d91ebd 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -219,6 +219,8 @@ setFeatureStatusNoConfig applyState tid status = do Event.Event Event.Update (Public.knownTeamFeatureName @a) (EdFeatureWithoutConfigChanged newStatus) pure newStatus +-- | FUTUREWORK(fisx): (thanks pcapriotti) this should probably be a type family dependent on +-- the feature flag, so that we get more type safety. type GetFeatureInternalParam = Either (Maybe UserId) TeamId getSSOStatusInternal :: GetFeatureInternalParam -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureSSO) diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index 4f89898b79d..831c2951b48 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -581,7 +581,7 @@ testRichInfo = do }] }|] - brig <- asks (view teBrig) + brig <- view teBrig -- set things up (user, _) <- randomScimUserWithSubjectAndRichInfo richInfo (userOverwritten, _) <- randomScimUserWithSubjectAndRichInfo richInfoOverwritten @@ -767,7 +767,7 @@ testCreateUserTimeout = do tryquery (filterBy "externalId" $ fromEmail email) waitUserExpiration = do - timeoutSecs <- asks (cfgBrigSettingsTeamInvitationTimeout . view teTstOpts) + timeoutSecs <- view (teTstOpts . to cfgBrigSettingsTeamInvitationTimeout) Control.Exception.assert (timeoutSecs < 30) $ do threadDelay $ (timeoutSecs + 1) * 1_000_000 @@ -797,7 +797,7 @@ specListUsers = describe "GET /Users" $ do -- via SCIM are not listed. testListProvisionedUsers :: TestSpar () testListProvisionedUsers = do - spar <- asks (^. teSpar) + spar <- view teSpar (tok, _) <- registerIdPAndScimToken listUsers_ (Just tok) Nothing spar !!! do const 400 === statusCode @@ -1203,7 +1203,7 @@ testScimSideIsUpdated = do liftIO $ updatedUser `shouldBe` storedUser' -- Check that the updated user also matches the data that we sent with -- 'updateUser' - richInfoLimit <- asks (Spar.Types.richInfoLimit . view teOpts) + richInfoLimit <- view (teOpts . to Spar.Types.richInfoLimit) liftIO $ do Right (Scim.value (Scim.thing storedUser')) `shouldBe` whatSparReturnsFor idp richInfoLimit user' Scim.id (Scim.thing storedUser') `shouldBe` Scim.id (Scim.thing storedUser) @@ -1258,7 +1258,7 @@ testUpdateSameHandle = do storedUser' <- getUser tok userid liftIO $ updatedUser `shouldBe` storedUser' -- Check that the updated user also matches the data that we sent with 'updateUser' - richInfoLimit <- asks (Spar.Types.richInfoLimit . view teOpts) + richInfoLimit <- view (teOpts . to Spar.Types.richInfoLimit) liftIO $ do Right (Scim.value (Scim.thing storedUser')) `shouldBe` whatSparReturnsFor idp richInfoLimit user' Scim.id (Scim.thing storedUser') `shouldBe` Scim.id (Scim.thing storedUser) @@ -1700,7 +1700,7 @@ specEmailValidation = do mkValidExternalId (Just idp) (Scim.User.externalId . Scim.value . Scim.thing $ scimStoredUser) uid :: UserId <- getUserIdViaRef uref - brig <- asks (^. teBrig) + brig <- view teBrig -- we intentionally activate the email even if it's not set up to work, to make sure -- it doesn't if the feature is disabled. if enabled diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index 77ef9e7b572..a5151bd4334 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -766,7 +766,7 @@ ping req = void . get $ req . path "/i/status" . expect2xx makeTestIdP :: (HasCallStack, MonadReader TestEnv m, MonadRandom m, MonadIO m) => m (IdPConfig WireIdP) makeTestIdP = do - apiversion <- asks (^. teWireIdPAPIVersion) + apiversion <- view teWireIdPAPIVersion SampleIdP md _ _ _ <- makeSampleIdPMetadata IdPConfig <$> (IdPId <$> liftIO UUID.nextRandom) @@ -818,7 +818,7 @@ registerTestIdPFrom :: SparReq -> m (UserId, TeamId, IdP) registerTestIdPFrom metadata mgr brig galley spar = do - apiVersion <- asks (^. teWireIdPAPIVersion) + apiVersion <- view teWireIdPAPIVersion liftIO . runHttpT mgr $ do (uid, tid) <- createUserWithTeam brig galley (uid,tid,) <$> callIdpCreate apiVersion spar (Just uid) metadata diff --git a/services/spar/test-integration/Util/Email.hs b/services/spar/test-integration/Util/Email.hs index 371c6cbabea..3934098640e 100644 --- a/services/spar/test-integration/Util/Email.hs +++ b/services/spar/test-integration/Util/Email.hs @@ -21,7 +21,7 @@ module Util.Email where import Bilge hiding (accept, timeout) import Bilge.Assert import Brig.Types -import Control.Lens ((^.), (^?)) +import Control.Lens (view, (^?)) import Control.Monad.Catch (MonadCatch) import Data.Aeson.Lens import Data.ByteString.Conversion @@ -124,7 +124,7 @@ checkEmail :: Maybe Email -> TestSpar () checkEmail uid expectedEmail = do - brig <- asks (^. teBrig) + brig <- view teBrig call $ get (brig . path "/self" . zUser uid) !!! do const 200 === statusCode @@ -157,7 +157,7 @@ getActivationCode brig ep = do enableSamlEmailValidation :: HasCallStack => TeamId -> TestSpar () enableSamlEmailValidation tid = do - galley <- asks (^. teGalley) + galley <- view teGalley let req = put $ galley . paths p . json (Feature.TeamFeatureStatusNoConfig Feature.TeamFeatureEnabled) p = ["/i/teams", toByteString' tid, "features", "validate-saml-emails"] call req !!! const 200 === statusCode diff --git a/services/spar/test-integration/Util/Types.hs b/services/spar/test-integration/Util/Types.hs index be65f433444..0349de1e31b 100644 --- a/services/spar/test-integration/Util/Types.hs +++ b/services/spar/test-integration/Util/Types.hs @@ -43,7 +43,7 @@ where import Bilge import Cassandra as Cas import Control.Exception -import Control.Lens (makeLenses, (^.)) +import Control.Lens (makeLenses, view) import Crypto.Random.Types (MonadRandom (..)) import Data.Aeson import qualified Data.Aeson as Aeson @@ -132,5 +132,5 @@ _unitTestTestErrorLabel = do -- improvement that we can get out of this.) skipIdPAPIVersions :: (MonadIO m, MonadReader TestEnv m) => [WireIdPAPIVersion] -> m () skipIdPAPIVersions skip = do - asks (^. teWireIdPAPIVersion) >>= \vers -> when (vers `elem` skip) . liftIO $ do + view teWireIdPAPIVersion >>= \vers -> when (vers `elem` skip) . liftIO $ do pendingWith $ "skipping " <> show vers <> " for this test case (behavior covered by other versions)" From 126a5714995415d09eda18121399b42b1eabf451 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 29 Sep 2021 17:57:38 +0200 Subject: [PATCH 64/72] Fix check on conversation size (#1820) * Fix check on conversation size Before, we were checking whether the number of people added to a conversation was strictly less than the limit - 1, which was causing conversation with maximum size to be rejected. This was introduced by the refactoring in #1801. * Add test about conversation size limit Added a test checking that creating conversations of exactly the size limit is allowed. --- changelog.d/5-internal/conv-size-limit-test | 1 + services/galley/src/Galley/Validation.hs | 2 +- services/galley/test/integration/API.hs | 10 ++++++++++ 3 files changed, 12 insertions(+), 1 deletion(-) create mode 100644 changelog.d/5-internal/conv-size-limit-test diff --git a/changelog.d/5-internal/conv-size-limit-test b/changelog.d/5-internal/conv-size-limit-test new file mode 100644 index 00000000000..63fde18ce08 --- /dev/null +++ b/changelog.d/5-internal/conv-size-limit-test @@ -0,0 +1 @@ +Add a test checking that creating conversations of exactly the size limit is allowed diff --git a/services/galley/src/Galley/Validation.hs b/services/galley/src/Galley/Validation.hs index ccdd769de58..dc4f17a31ed 100644 --- a/services/galley/src/Galley/Validation.hs +++ b/services/galley/src/Galley/Validation.hs @@ -50,7 +50,7 @@ checkedConvSize x = do o <- view options let minV :: Integer = 0 limit = o ^. optSettings . setMaxConvSize - 1 - if length x < fromIntegral limit + if length x <= fromIntegral limit then return (ConvSizeChecked x) else throwErr (errorMsg minV limit "") diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 5d1a1fb1a5e..6654c30e714 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -134,6 +134,7 @@ tests s = test s "page through list-conversations (local conversations only)" listConvsPagingOk, test s "fail to create conversation when not connected" postConvFailNotConnected, test s "fail to create conversation with qualified users when not connected" postConvQualifiedFailNotConnected, + test s "M:N conversation creation with N - 1 invitees should be allowed" postConvLimitOk, test s "M:N conversation creation must have view tsMaxConvSize + alice <- randomUser + bob : others <- replicateM n randomUser + connectUsers alice (list1 bob others) + postConv alice (bob : others) Nothing [] Nothing Nothing !!! do + const 201 === statusCode + postConvFailNumMembers :: TestM () postConvFailNumMembers = do n <- fromIntegral <$> view tsMaxConvSize From eef0e83bdc565bff916eef2885eeed5b1e5f57eb Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Wed, 29 Sep 2021 14:14:54 -0700 Subject: [PATCH 65/72] Spar Polysemy: Logger effect (#1814) * Logger effect * make format and removed some logger calls * make format * Get everything compiling again * make format * Fix cabal file * Use Logger for the Galley and Brig interpreters * make format * Fake commit for CI * Don't be stupid about using MonadLogger * Fix * Changelog * Respond to review comments * Fake commit for CI * Another CI commit --- changelog.d/5-internal/logger-effect | 1 + services/spar/spar.cabal | 4 +- services/spar/src/Spar/API.hs | 56 +++++++---- services/spar/src/Spar/App.hs | 97 ++++++++----------- services/spar/src/Spar/Run.hs | 1 + services/spar/src/Spar/Scim.hs | 4 +- services/spar/src/Spar/Scim/User.hs | 26 ++--- services/spar/src/Spar/Sem/BrigAccess/Http.hs | 10 +- .../spar/src/Spar/Sem/GalleyAccess/Http.hs | 54 +++++++---- services/spar/src/Spar/Sem/Logger.hs | 42 ++++++++ services/spar/src/Spar/Sem/Logger/TinyLog.hs | 36 +++++++ services/spar/test-integration/Util/Core.hs | 51 +++++----- 12 files changed, 248 insertions(+), 134 deletions(-) create mode 100644 changelog.d/5-internal/logger-effect create mode 100644 services/spar/src/Spar/Sem/Logger.hs create mode 100644 services/spar/src/Spar/Sem/Logger/TinyLog.hs diff --git a/changelog.d/5-internal/logger-effect b/changelog.d/5-internal/logger-effect new file mode 100644 index 00000000000..21d7bf364fa --- /dev/null +++ b/changelog.d/5-internal/logger-effect @@ -0,0 +1 @@ +Add a Logger effect to Spar diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index 1849fb59de7..7086e210753 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 18af2f89c5e85abaed3b0ea0c9ad41d4a4360983b8eba93f626f14b8e3224f8c +-- hash: 573e0f5c3d7b76dbb9fbf48aff2a535df3059af23f8375307021c6c005d98a5b name: spar version: 0.1 @@ -50,6 +50,8 @@ library Spar.Sem.IdP Spar.Sem.IdP.Cassandra Spar.Sem.IdP.Mem + Spar.Sem.Logger + Spar.Sem.Logger.TinyLog Spar.Sem.Random Spar.Sem.Random.IO Spar.Sem.SAMLUserStore diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 3ff22c9d521..422f533d852 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -75,6 +75,8 @@ import qualified Spar.Sem.DefaultSsoCode as DefaultSsoCode import Spar.Sem.GalleyAccess (GalleyAccess) import qualified Spar.Sem.GalleyAccess as GalleyAccess import qualified Spar.Sem.IdP as IdPEffect +import Spar.Sem.Logger (Logger) +import qualified Spar.Sem.Logger as Logger import Spar.Sem.Random (Random) import qualified Spar.Sem.Random as Random import Spar.Sem.SAMLUserStore (SAMLUserStore) @@ -83,6 +85,7 @@ import Spar.Sem.ScimExternalIdStore (ScimExternalIdStore) import Spar.Sem.ScimTokenStore (ScimTokenStore) import qualified Spar.Sem.ScimTokenStore as ScimTokenStore import Spar.Sem.ScimUserTimesStore (ScimUserTimesStore) +import System.Logger (Msg) import qualified URI.ByteString as URI import Wire.API.Cookie import Wire.API.Routes.Public.Spar @@ -108,6 +111,8 @@ api :: IdPEffect.IdP, SAMLUserStore, Random, + Logger String, + Logger (Msg -> Msg), Error SparError ] r => @@ -124,6 +129,7 @@ api opts = apiSSO :: Members '[ GalleyAccess, + Logger String, BrigAccess, BindCookieStore, AssIDStore, @@ -146,7 +152,7 @@ apiSSO opts = :<|> authresp . Just :<|> ssoSettings -apiIDP :: Members '[Random, GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, SAMLUserStore, Error SparError] r => ServerT APIIDP (Spar r) +apiIDP :: Members '[Random, Logger String, GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, SAMLUserStore, Error SparError] r => ServerT APIIDP (Spar r) apiIDP = idpGet :<|> idpGetRaw @@ -174,7 +180,7 @@ authreqPrecheck msucc merr idpid = *> return NoContent authreq :: - Members '[Random, BindCookieStore, AssIDStore, AReqIDStore, IdPEffect.IdP] r => + Members '[Random, Logger String, BindCookieStore, AssIDStore, AReqIDStore, IdPEffect.IdP] r => NominalDiffTime -> DoInitiate -> Maybe UserId -> @@ -195,13 +201,13 @@ authreq authreqttl _ zusr msucc merr idpid = do SAML.authreq authreqttl (sparSPIssuer mbtid) idpid wrapMonadClientSem $ AReqIDStore.storeVerdictFormat authreqttl reqid vformat cky <- initializeBindCookie zusr authreqttl - SAML.logger SAML.Debug $ "setting bind cookie: " <> show cky + liftSem $ Logger.log SAML.Debug $ "setting bind cookie: " <> show cky pure $ addHeader cky form -- | If the user is already authenticated, create bind cookie with a given life expectancy and our -- domain, and store it in C*. If the user is not authenticated, return a deletion 'SetCookie' -- value that deletes any bind cookies on the client. -initializeBindCookie :: Members '[Random, BindCookieStore] r => Maybe UserId -> NominalDiffTime -> Spar r SetBindCookie +initializeBindCookie :: Members '[Random, Logger String, BindCookieStore] r => Maybe UserId -> NominalDiffTime -> Spar r SetBindCookie initializeBindCookie zusr authreqttl = do DerivedOpts {derivedOptsBindCookiePath} <- asks (derivedOpts . sparCtxOpts) msecret <- @@ -234,6 +240,7 @@ authresp :: forall r. Members '[ Random, + Logger String, GalleyAccess, BrigAccess, BindCookieStore, @@ -276,7 +283,7 @@ ssoSettings = do -- IdP API idpGet :: - Members '[Random, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => + Members '[Random, Logger String, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => Maybe UserId -> SAML.IdPId -> Spar r IdP @@ -297,7 +304,10 @@ idpGetRaw zusr idpid = do Just txt -> pure $ RawIdPMetadata txt Nothing -> throwSpar $ SparIdPNotFound (cs $ show idpid) -idpGetAll :: Members '[Random, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => Maybe UserId -> Spar r IdPList +idpGetAll :: + Members '[Random, Logger String, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => + Maybe UserId -> + Spar r IdPList idpGetAll zusr = withDebugLog "idpGetAll" (const Nothing) $ do teamid <- liftSem $ Brig.getZUsrCheckPerm zusr ReadIdp _idplProviders <- wrapMonadClientSem $ IdPEffect.getConfigsByTeam teamid @@ -313,7 +323,17 @@ idpGetAll zusr = withDebugLog "idpGetAll" (const Nothing) $ do -- https://github.com/zinfra/backend-issues/issues/1314 idpDelete :: forall r. - Members '[Random, GalleyAccess, BrigAccess, ScimTokenStore, SAMLUserStore, IdPEffect.IdP, Error SparError] r => + Members + '[ Random, + Logger String, + GalleyAccess, + BrigAccess, + ScimTokenStore, + SAMLUserStore, + IdPEffect.IdP, + Error SparError + ] + r => Maybe UserId -> SAML.IdPId -> Maybe Bool -> @@ -373,7 +393,7 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons -- | This handler only does the json parsing, and leaves all authorization checks and -- application logic to 'idpCreateXML'. idpCreate :: - Members '[Random, GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error SparError] r => + Members '[Random, Logger String, GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error SparError] r => Maybe UserId -> IdPMetadataInfo -> Maybe SAML.IdPId -> @@ -383,7 +403,7 @@ idpCreate zusr (IdPMetadataValue raw xml) midpid apiversion = idpCreateXML zusr -- | We generate a new UUID for each IdP used as IdPConfig's path, thereby ensuring uniqueness. idpCreateXML :: - Members '[Random, GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error SparError] r => + Members '[Random, Logger String, GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error SparError] r => Maybe UserId -> Text -> SAML.IdPMetadata -> @@ -437,7 +457,7 @@ assertNoScimOrNoIdP teamid = do validateNewIdP :: forall m r. (HasCallStack, m ~ Spar r) => - Members '[Random, IdPEffect.IdP] r => + Members '[Random, Logger String, IdPEffect.IdP] r => WireIdPAPIVersion -> SAML.IdPMetadata -> TeamId -> @@ -454,8 +474,8 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces = withDebugLog "validate _idpExtraInfo = WireIdP teamId (Just apiversion) oldIssuers Nothing enforceHttps requri idp <- wrapSpar $ getIdPConfigByIssuer (_idpMetadata ^. SAML.edIssuer) teamId - SAML.logger SAML.Debug $ show (apiversion, _idpMetadata, teamId, mReplaces) - SAML.logger SAML.Debug $ show (_idpId, oldIssuers, idp) + liftSem $ Logger.log SAML.Debug $ show (apiversion, _idpMetadata, teamId, mReplaces) + liftSem $ Logger.log SAML.Debug $ show (_idpId, oldIssuers, idp) let handleIdPClash :: Either id idp -> m () -- (HINT: using type vars above instead of the actual types constitutes a proof that @@ -484,7 +504,7 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces = withDebugLog "validate -- 'idpCreate', which is not a good reason. make this one function and pass around -- 'IdPMetadataInfo' directly where convenient. idpUpdate :: - Members '[Random, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => + Members '[Random, Logger String, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => Maybe UserId -> IdPMetadataInfo -> SAML.IdPId -> @@ -492,7 +512,7 @@ idpUpdate :: idpUpdate zusr (IdPMetadataValue raw xml) idpid = idpUpdateXML zusr raw xml idpid idpUpdateXML :: - Members '[Random, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => + Members '[Random, Logger String, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => Maybe UserId -> Text -> SAML.IdPMetadata -> @@ -515,7 +535,7 @@ idpUpdateXML zusr raw idpmeta idpid = withDebugLog "idpUpdate" (Just . show . (^ validateIdPUpdate :: forall m r. (HasCallStack, m ~ Spar r) => - Members '[Random, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => + Members '[Random, Logger String, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => Maybe UserId -> SAML.IdPMetadata -> SAML.IdPId -> @@ -554,12 +574,12 @@ validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateNewIdP" (Just uri = _idpMetadata ^. SAML.edIssuer . SAML.fromIssuer errUnknownIdPId = SAML.UnknownIdP . cs . SAML.idPIdToST $ _idpId -withDebugLog :: SAML.SP m => String -> (a -> Maybe String) -> m a -> m a +withDebugLog :: Member (Logger String) r => String -> (a -> Maybe String) -> Spar r a -> Spar r a withDebugLog msg showval action = do - SAML.logger SAML.Debug $ "entering " ++ msg + liftSem $ Logger.log SAML.Debug $ "entering " ++ msg val <- action let mshowedval = showval val - SAML.logger SAML.Debug $ "leaving " ++ msg ++ mconcat [": " ++ fromJust mshowedval | isJust mshowedval] + liftSem $ Logger.log SAML.Debug $ "leaving " ++ msg ++ mconcat [": " ++ fromJust mshowedval | isJust mshowedval] pure val authorizeIdP :: diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index dfa6b1e29e2..9ea7c9d35c8 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -24,7 +24,6 @@ module Spar.App ( Spar (..), Env (..), - toLevel, wrapMonadClientSem, verdictHandler, GetUserResult (..), @@ -113,6 +112,9 @@ import Spar.Sem.GalleyAccess.Http (galleyAccessToHttp) import Spar.Sem.IdP (GetIdPResult (..)) import qualified Spar.Sem.IdP as IdPEffect import Spar.Sem.IdP.Cassandra (idPToCassandra) +import Spar.Sem.Logger (Logger) +import qualified Spar.Sem.Logger as Logger +import Spar.Sem.Logger.TinyLog (loggerToTinyLog, stringLoggerToTinyLog) import Spar.Sem.Random (Random) import qualified Spar.Sem.Random as Random import Spar.Sem.Random.IO (randomToIO) @@ -127,8 +129,7 @@ import qualified Spar.Sem.ScimTokenStore as ScimTokenStore import Spar.Sem.ScimTokenStore.Cassandra (scimTokenStoreToCassandra) import Spar.Sem.ScimUserTimesStore (ScimUserTimesStore) import Spar.Sem.ScimUserTimesStore.Cassandra (scimUserTimesStoreToCassandra) -import qualified System.Logger as Log -import System.Logger.Class (MonadLogger (log)) +import qualified System.Logger as TinyLog import URI.ByteString as URI import Web.Cookie (SetCookie, renderSetCookie) import Wire.API.Cookie @@ -162,9 +163,12 @@ instance MonadError SparError (Spar r) where instance MonadIO (Spar r) where liftIO m = Spar $ lift $ lift $ embedFinal m +instance Member (Logger String) r => HasLogger (Spar r) where + logger lvl = liftSem . Logger.log lvl + data Env = Env { sparCtxOpts :: Opts, - sparCtxLogger :: Log.Logger, + sparCtxLogger :: TinyLog.Logger, sparCtxCas :: Cas.ClientState, sparCtxHttpManager :: Bilge.Manager, sparCtxHttpBrig :: Bilge.Request, @@ -180,26 +184,6 @@ instance HasNow (Spar r) instance Member Random r => HasCreateUUID (Spar r) where createUUID = liftSem Random.uuid -instance HasLogger (Spar r) where - -- FUTUREWORK: optionally use 'field' to index user or idp ids for easier logfile processing. - logger lv = log (toLevel lv) . Log.msg - -instance MonadLogger (Spar r) where - log level mg = do - lg <- asks sparCtxLogger - reqid <- asks sparCtxRequestId - let fields = Log.field "request" (unRequestId reqid) - Spar $ lift $ lift $ embedFinal $ Log.log lg level $ fields Log.~~ mg - -toLevel :: SAML.Level -> Log.Level -toLevel = \case - SAML.Fatal -> Log.Fatal - SAML.Error -> Log.Error - SAML.Warn -> Log.Warn - SAML.Info -> Log.Info - SAML.Debug -> Log.Debug - SAML.Trace -> Log.Trace - instance Member AReqIDStore r => SPStoreID AuthnRequest (Spar r) where storeID i r = wrapMonadClientSem $ AReqIDStore.store i r unStoreID r = wrapMonadClientSem $ AReqIDStore.unStore r @@ -433,6 +417,9 @@ instance ReaderEff.Reader Opts, Error TTLError, Error SparError, + -- TODO(sandy): Make this a Logger Text instead + Logger String, + Logger (TinyLog.Msg -> TinyLog.Msg), Random, Embed IO, Final IO @@ -448,28 +435,30 @@ instance where actionHandler :: Handler (Either SparError a) actionHandler = - fmap join $ - liftIO $ - runFinal $ - embedToFinal @IO $ - randomToIO $ - runError @SparError $ - ttlErrorToSparError $ - ReaderEff.runReader (sparCtxOpts ctx) $ - galleyAccessToHttp (sparCtxLogger ctx) (sparCtxHttpManager ctx) (sparCtxHttpGalley ctx) $ - brigAccessToHttp (sparCtxLogger ctx) (sparCtxHttpManager ctx) (sparCtxHttpBrig ctx) $ - interpretClientToIO (sparCtxCas ctx) $ - samlUserStoreToCassandra @Cas.Client $ - idPToCassandra @Cas.Client $ - defaultSsoCodeToCassandra $ - scimTokenStoreToCassandra $ - scimUserTimesStoreToCassandra $ - scimExternalIdStoreToCassandra $ - aReqIDStoreToCassandra $ - assIDStoreToCassandra $ - bindCookieStoreToCassandra $ - runExceptT $ - runReaderT action ctx + fmap join + . liftIO + . runFinal + . embedToFinal @IO + . randomToIO + . loggerToTinyLog (sparCtxLogger ctx) + . stringLoggerToTinyLog + . runError @SparError + . ttlErrorToSparError + . ReaderEff.runReader (sparCtxOpts ctx) + . galleyAccessToHttp (sparCtxHttpManager ctx) (sparCtxHttpGalley ctx) + . brigAccessToHttp (sparCtxHttpManager ctx) (sparCtxHttpBrig ctx) + . interpretClientToIO (sparCtxCas ctx) + . samlUserStoreToCassandra @Cas.Client + . idPToCassandra @Cas.Client + . defaultSsoCodeToCassandra + . scimTokenStoreToCassandra + . scimUserTimesStoreToCassandra + . scimExternalIdStoreToCassandra + . aReqIDStoreToCassandra + . assIDStoreToCassandra + . bindCookieStoreToCassandra + . runExceptT + $ runReaderT action ctx throwErrorAsHandlerException :: Either SparError a -> Handler a throwErrorAsHandlerException (Left err) = sparToServerErrorWithLogging (sparCtxLogger ctx) err >>= throwError @@ -486,7 +475,7 @@ instance -- latter. verdictHandler :: HasCallStack => - Members '[Random, GalleyAccess, BrigAccess, BindCookieStore, AReqIDStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Members '[Random, Logger String, GalleyAccess, BrigAccess, BindCookieStore, AReqIDStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe BindCookie -> Maybe TeamId -> SAML.AuthnResponse -> @@ -496,7 +485,7 @@ verdictHandler cky mbteam aresp verdict = do -- [3/4.1.4.2] -- [...] If the containing message is in response to an , then -- the InResponseTo attribute MUST match the request's ID. - SAML.logger SAML.Debug $ "entering verdictHandler: " <> show (fromBindCookie <$> cky, aresp, verdict) + liftSem $ Logger.log SAML.Debug $ "entering verdictHandler: " <> show (fromBindCookie <$> cky, aresp, verdict) reqid <- either (throwSpar . SparNoRequestRefInResponse . cs) pure $ SAML.rspInResponseTo aresp format :: Maybe VerdictFormat <- wrapMonadClientSem $ AReqIDStore.getVerdictFormat reqid resp <- case format of @@ -507,7 +496,7 @@ verdictHandler cky mbteam aresp verdict = do Nothing -> -- (this shouldn't happen too often, see 'storeVerdictFormat') throwSpar SparNoSuchRequest - SAML.logger SAML.Debug $ "leaving verdictHandler: " <> show resp + liftSem $ Logger.log SAML.Debug $ "leaving verdictHandler: " <> show resp pure resp data VerdictHandlerResult @@ -518,15 +507,15 @@ data VerdictHandlerResult verdictHandlerResult :: HasCallStack => - Members '[Random, GalleyAccess, BrigAccess, BindCookieStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Members '[Random, Logger String, GalleyAccess, BrigAccess, BindCookieStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> Spar r VerdictHandlerResult verdictHandlerResult bindCky mbteam verdict = do - SAML.logger SAML.Debug $ "entering verdictHandlerResult: " <> show (fromBindCookie <$> bindCky) + liftSem $ Logger.log SAML.Debug $ "entering verdictHandlerResult: " <> show (fromBindCookie <$> bindCky) result <- catchVerdictErrors $ verdictHandlerResultCore bindCky mbteam verdict - SAML.logger SAML.Debug $ "leaving verdictHandlerResult" <> show result + liftSem $ Logger.log SAML.Debug $ "leaving verdictHandlerResult" <> show result pure result catchVerdictErrors :: Spar r VerdictHandlerResult -> Spar r VerdictHandlerResult @@ -563,7 +552,7 @@ moveUserToNewIssuer oldUserRef newUserRef uid = do verdictHandlerResultCore :: HasCallStack => - Members '[Random, GalleyAccess, BrigAccess, BindCookieStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Members '[Random, Logger String, GalleyAccess, BrigAccess, BindCookieStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> @@ -612,7 +601,7 @@ verdictHandlerResultCore bindCky mbteam = \case (Just _, GetUserFound _, GetUserFound _) -> -- to see why, consider the condition on the call to 'findUserWithOldIssuer' above. error "impossible." - SAML.logger SAML.Debug ("granting sso login for " <> show uid) + liftSem $ Logger.log SAML.Debug ("granting sso login for " <> show uid) cky <- liftSem $ BrigAccess.ssoLogin uid pure $ VerifyHandlerGranted cky uid diff --git a/services/spar/src/Spar/Run.hs b/services/spar/src/Spar/Run.hs index 1a3846f29f8..8dd7bd7439b 100644 --- a/services/spar/src/Spar/Run.hs +++ b/services/spar/src/Spar/Run.hs @@ -51,6 +51,7 @@ import Spar.App import qualified Spar.Data as Data import Spar.Data.Instances () import Spar.Orphans () +import Spar.Sem.Logger.TinyLog (toLevel) import System.Logger.Class (Logger) import qualified System.Logger.Extended as Log import Util.Options (casEndpoint, casKeyspace, epHost, epPort) diff --git a/services/spar/src/Spar/Scim.hs b/services/spar/src/Spar/Scim.hs index 65c4bb8de3f..9a01a93b4e8 100644 --- a/services/spar/src/Spar/Scim.hs +++ b/services/spar/src/Spar/Scim.hs @@ -86,11 +86,13 @@ import Spar.Scim.User import Spar.Sem.BrigAccess (BrigAccess) import Spar.Sem.GalleyAccess (GalleyAccess) import qualified Spar.Sem.IdP as IdPEffect +import Spar.Sem.Logger (Logger) import Spar.Sem.Random (Random) import Spar.Sem.SAMLUserStore (SAMLUserStore) import Spar.Sem.ScimExternalIdStore (ScimExternalIdStore) import Spar.Sem.ScimTokenStore (ScimTokenStore) import Spar.Sem.ScimUserTimesStore (ScimUserTimesStore) +import System.Logger (Msg) import qualified Web.Scim.Capabilities.MetaSchema as Scim.Meta import qualified Web.Scim.Class.Auth as Scim.Auth import qualified Web.Scim.Class.User as Scim.User @@ -109,7 +111,7 @@ configuration :: Scim.Meta.Configuration configuration = Scim.Meta.empty apiScim :: - Members '[Random, Error SparError, GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Members '[Random, Logger (Msg -> Msg), Logger String, Error SparError, GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => ServerT APIScim (Spar r) apiScim = hoistScim (toServant (server configuration)) diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 18522c895ac..770528e4b9e 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -72,6 +72,8 @@ import qualified Spar.Scim.Types as ST import Spar.Sem.BrigAccess as BrigAccess import Spar.Sem.GalleyAccess (GalleyAccess) import qualified Spar.Sem.IdP as IdPEffect +import Spar.Sem.Logger (Logger) +import qualified Spar.Sem.Logger as Logger import Spar.Sem.Random (Random) import qualified Spar.Sem.Random as Random import Spar.Sem.SAMLUserStore (SAMLUserStore) @@ -105,7 +107,7 @@ import qualified Wire.API.User.Scim as ST ---------------------------------------------------------------------------- -- UserDB instance -instance Members '[Random, GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, IdPEffect.IdP, SAMLUserStore] r => Scim.UserDB ST.SparTag (Spar r) where +instance Members '[Random, Logger (Msg -> Msg), Logger String, GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, IdPEffect.IdP, SAMLUserStore] r => Scim.UserDB ST.SparTag (Spar r) where getUsers :: ScimTokenInfo -> Maybe Scim.Filter -> @@ -319,7 +321,7 @@ mkValidExternalId (Just idp) (Just extid) = do Scim.InvalidValue (Just $ "Can't construct a subject ID from externalId: " <> Text.pack err) -logScim :: forall m r a. (m ~ Scim.ScimHandler (Spar r)) => (Msg -> Msg) -> m a -> m a +logScim :: forall r a. (Member (Logger (Msg -> Msg)) r) => (Msg -> Msg) -> Scim.ScimHandler (Spar r) a -> Scim.ScimHandler (Spar r) a logScim context action = flip mapExceptT action $ \action' -> do eith <- action' @@ -329,10 +331,10 @@ logScim context action = case Scim.detail e of Just d -> d Nothing -> cs (Aeson.encode e) - Log.warn $ context . Log.msg errorMsg + liftSem $ Logger.warn $ context . Log.msg errorMsg pure (Left e) Right x -> do - Log.info $ context . Log.msg @Text "call without exception" + liftSem $ Logger.info $ context . Log.msg @Text "call without exception" pure (Right x) logEmail :: Email -> (Msg -> Msg) @@ -373,7 +375,7 @@ veidEmail (ST.EmailOnly email) = Just email createValidScimUser :: forall m r. (m ~ Scim.ScimHandler (Spar r)) => - Members '[Random, GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore] r => + Members '[Random, Logger (Msg -> Msg), Logger String, GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore] r => ScimTokenInfo -> ST.ValidScimUser -> m (Scim.StoredUser ST.SparTag) @@ -406,7 +408,7 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid ) veid - Log.debug (Log.msg $ "createValidScimUser: brig says " <> show buid) + liftSem $ Logger.debug ("createValidScimUser: brig says " <> show buid) -- {If we crash now, we have an active user that cannot login. And can not -- be bound this will be a zombie user that needs to be manually cleaned @@ -431,7 +433,7 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid lift (liftSem $ BrigAccess.getAccount Brig.WithPendingInvitations buid) >>= maybe (throwError $ Scim.serverError "Server error: user vanished") pure synthesizeStoredUser acc veid - lift $ Log.debug (Log.msg $ "createValidScimUser: spar says " <> show storedUser) + lift $ liftSem $ Logger.debug ("createValidScimUser: spar says " <> show storedUser) -- {(arianvp): these two actions we probably want to make transactional.} lift . wrapMonadClientSem $ do @@ -456,7 +458,7 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid -- TODO(arianvp): how do we get this safe w.r.t. race conditions / crashes? updateValidScimUser :: forall m r. - Members '[Random, GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, IdPEffect.IdP, SAMLUserStore] r => + Members '[Random, Logger (Msg -> Msg), Logger String, GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, IdPEffect.IdP, SAMLUserStore] r => (m ~ Scim.ScimHandler (Spar r)) => ScimTokenInfo -> UserId -> @@ -585,7 +587,7 @@ updScimStoredUser' now usr (Scim.WithMeta meta (Scim.WithId scimuid _)) = } deleteScimUser :: - Members '[BrigAccess, ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore, IdPEffect.IdP] r => + Members '[Logger (Msg -> Msg), BrigAccess, ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore, IdPEffect.IdP] r => ScimTokenInfo -> UserId -> Scim.ScimHandler (Spar r) () @@ -709,7 +711,7 @@ assertHandleNotUsedElsewhere uid hndl = do -- | Helper function that translates a given brig user into a 'Scim.StoredUser', with some -- effects like updating the 'ManagedBy' field in brig and storing creation and update time -- stamps. -synthesizeStoredUser :: forall r. Members '[BrigAccess, ScimUserTimesStore] r => UserAccount -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) (Scim.StoredUser ST.SparTag) +synthesizeStoredUser :: forall r. Members '[Logger (Msg -> Msg), BrigAccess, ScimUserTimesStore] r => UserAccount -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) (Scim.StoredUser ST.SparTag) synthesizeStoredUser usr veid = logScim ( logFunction "Spar.Scim.User.synthesizeStoredUser" @@ -796,7 +798,7 @@ synthesizeScimUser info = } scimFindUserByHandle :: - Members '[BrigAccess, ScimUserTimesStore] r => + Members '[Logger (Msg -> Msg), BrigAccess, ScimUserTimesStore] r => Maybe IdP -> TeamId -> Text -> @@ -817,7 +819,7 @@ scimFindUserByHandle mIdpConfig stiTeam hndl = do -- successful authentication with their SAML credentials. scimFindUserByEmail :: forall r. - Members '[BrigAccess, ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore] r => + Members '[Logger (Msg -> Msg), BrigAccess, ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore] r => Maybe IdP -> TeamId -> Text -> diff --git a/services/spar/src/Spar/Sem/BrigAccess/Http.hs b/services/spar/src/Spar/Sem/BrigAccess/Http.hs index 547756bab7d..8f739dae4cf 100644 --- a/services/spar/src/Spar/Sem/BrigAccess/Http.hs +++ b/services/spar/src/Spar/Sem/BrigAccess/Http.hs @@ -8,18 +8,18 @@ import Spar.Error (SparError) import qualified Spar.Intra.Brig as Intra import Spar.Sem.BrigAccess import Spar.Sem.GalleyAccess.Http (RunHttpEnv (..), viaRunHttp) -import qualified System.Logger as Log +import Spar.Sem.Logger (Logger) +import qualified System.Logger as TinyLog brigAccessToHttp :: - Members '[Error SparError, Embed IO] r => - Log.Logger -> + Members '[Logger (TinyLog.Msg -> TinyLog.Msg), Error SparError, Embed IO] r => Bilge.Manager -> Bilge.Request -> Sem (BrigAccess ': r) a -> Sem r a -brigAccessToHttp logger mgr req = +brigAccessToHttp mgr req = interpret $ - viaRunHttp (RunHttpEnv logger mgr req) . \case + viaRunHttp (RunHttpEnv mgr req) . \case CreateSAML u itlu itlt n m -> Intra.createBrigUserSAML u itlu itlt n m CreateNoSAML e itlt n -> Intra.createBrigUserNoSAML e itlt n UpdateEmail itlu e -> Intra.updateEmail itlu e diff --git a/services/spar/src/Spar/Sem/GalleyAccess/Http.hs b/services/spar/src/Spar/Sem/GalleyAccess/Http.hs index fca40c66bf1..127d34028cd 100644 --- a/services/spar/src/Spar/Sem/GalleyAccess/Http.hs +++ b/services/spar/src/Spar/Sem/GalleyAccess/Http.hs @@ -12,56 +12,68 @@ import Spar.Intra.Brig (MonadSparToBrig (..)) import Spar.Intra.Galley (MonadSparToGalley) import qualified Spar.Intra.Galley as Intra import Spar.Sem.GalleyAccess -import qualified System.Logger as Log -import qualified System.Logger.Class as LogClass +import Spar.Sem.Logger (Logger) +import qualified Spar.Sem.Logger as Logger +import Spar.Sem.Logger.TinyLog (fromLevel) +import qualified System.Logger as TinyLog +import qualified System.Logger.Class as TinyLog -data RunHttpEnv = RunHttpEnv - { rheLogger :: Log.Logger, - rheManager :: Bilge.Manager, +data RunHttpEnv r = RunHttpEnv + { rheManager :: Bilge.Manager, rheRequest :: Bilge.Request } -newtype RunHttp a = RunHttp - { unRunHttp :: ReaderT RunHttpEnv (ExceptT SparError (HttpT IO)) a +newtype RunHttp r a = RunHttp + { unRunHttp :: ReaderT (RunHttpEnv r) (ExceptT SparError (HttpT (Sem r))) a } - deriving newtype (Functor, Applicative, Monad, MonadError SparError, MonadIO, MonadHttp, MonadReader RunHttpEnv) + deriving newtype (Functor, Applicative, Monad, MonadError SparError, MonadReader (RunHttpEnv r)) + +instance Member (Embed IO) r => MonadIO (RunHttp r) where + liftIO = semToRunHttp . embed + +instance Member (Embed IO) r => MonadHttp (RunHttp r) where + handleRequestWithCont r fribia = + RunHttp $ + lift $ + lift $ + handleRequestWithCont r fribia + +semToRunHttp :: Sem r a -> RunHttp r a +semToRunHttp = RunHttp . lift . lift . lift viaRunHttp :: Members '[Error SparError, Embed IO] r => - RunHttpEnv -> - RunHttp a -> + RunHttpEnv r -> + RunHttp r a -> Sem r a viaRunHttp env m = do - ma <- embed @IO $ runHttpT (rheManager env) $ runExceptT $ flip runReaderT env $ unRunHttp m + ma <- runHttpT (rheManager env) $ runExceptT $ flip runReaderT env $ unRunHttp m case ma of Left err -> throw err Right a -> pure a -instance LogClass.MonadLogger RunHttp where - log lvl msg = do - logger <- asks rheLogger - Log.log logger lvl msg +instance Member (Logger (TinyLog.Msg -> TinyLog.Msg)) r => TinyLog.MonadLogger (RunHttp r) where + log lvl msg = semToRunHttp $ Logger.log (fromLevel lvl) msg -instance MonadSparToGalley RunHttp where +instance Members '[Logger (TinyLog.Msg -> TinyLog.Msg), Embed IO] r => MonadSparToGalley (RunHttp r) where call modreq = do req <- asks rheRequest httpLbs req modreq -instance MonadSparToBrig RunHttp where +instance Members '[Logger (TinyLog.Msg -> TinyLog.Msg), Embed IO] r => MonadSparToBrig (RunHttp r) where call modreq = do req <- asks rheRequest httpLbs req modreq galleyAccessToHttp :: - Members '[Error SparError, Embed IO] r => - Log.Logger -> + Members '[Logger (TinyLog.Msg -> TinyLog.Msg), Error SparError, Embed IO] r => Bilge.Manager -> Bilge.Request -> Sem (GalleyAccess ': r) a -> Sem r a -galleyAccessToHttp logger mgr req = +galleyAccessToHttp mgr req = interpret $ - viaRunHttp (RunHttpEnv logger mgr req) . \case + viaRunHttp (RunHttpEnv mgr req) . \case GetTeamMembers itlt -> Intra.getTeamMembers itlt AssertHasPermission itlt perm itlu -> Intra.assertHasPermission itlt perm itlu AssertSSOEnabled itlt -> Intra.assertSSOEnabled itlt diff --git a/services/spar/src/Spar/Sem/Logger.hs b/services/spar/src/Spar/Sem/Logger.hs new file mode 100644 index 00000000000..d8680c2c314 --- /dev/null +++ b/services/spar/src/Spar/Sem/Logger.hs @@ -0,0 +1,42 @@ +module Spar.Sem.Logger + ( module Spar.Sem.Logger, + SAML.Level (..), + ) +where + +import Imports hiding (log) +import Polysemy +import qualified SAML2.WebSSO as SAML + +data Logger msg m a where + Log :: SAML.Level -> msg -> Logger msg m () + +-- TODO(sandy): Inline this definition --- no TH +makeSem ''Logger + +mapLogger :: + forall msg msg' r a. + Member (Logger msg') r => + (msg -> msg') -> + Sem (Logger msg ': r) a -> + Sem r a +mapLogger f = interpret $ \case + Log lvl msg -> log lvl $ f msg + +trace :: Member (Logger msg) r => msg -> Sem r () +trace = log SAML.Trace + +debug :: Member (Logger msg) r => msg -> Sem r () +debug = log SAML.Debug + +info :: Member (Logger msg) r => msg -> Sem r () +info = log SAML.Info + +warn :: Member (Logger msg) r => msg -> Sem r () +warn = log SAML.Warn + +err :: Member (Logger msg) r => msg -> Sem r () +err = log SAML.Error + +fatal :: Member (Logger msg) r => msg -> Sem r () +fatal = log SAML.Fatal diff --git a/services/spar/src/Spar/Sem/Logger/TinyLog.hs b/services/spar/src/Spar/Sem/Logger/TinyLog.hs new file mode 100644 index 00000000000..1b8baf0d958 --- /dev/null +++ b/services/spar/src/Spar/Sem/Logger/TinyLog.hs @@ -0,0 +1,36 @@ +module Spar.Sem.Logger.TinyLog (loggerToTinyLog, stringLoggerToTinyLog, toLevel, fromLevel) where + +import Imports +import Polysemy +import Spar.Sem.Logger (Level (..), Logger (..), mapLogger) +import qualified System.Logger as Log + +loggerToTinyLog :: + Member (Embed IO) r => + Log.Logger -> + Sem (Logger (Log.Msg -> Log.Msg) ': r) a -> + Sem r a +loggerToTinyLog tinylog = interpret $ \case + Log lvl msg -> + embed @IO $ Log.log tinylog (toLevel lvl) msg + +stringLoggerToTinyLog :: Member (Logger (Log.Msg -> Log.Msg)) r => Sem (Logger String ': r) a -> Sem r a +stringLoggerToTinyLog = mapLogger @String Log.msg + +toLevel :: Level -> Log.Level +toLevel = \case + Fatal -> Log.Fatal + Error -> Log.Error + Warn -> Log.Warn + Info -> Log.Info + Debug -> Log.Debug + Trace -> Log.Trace + +fromLevel :: Log.Level -> Level +fromLevel = \case + Log.Fatal -> Fatal + Log.Error -> Error + Log.Warn -> Warn + Log.Info -> Info + Log.Debug -> Debug + Log.Trace -> Trace diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index a5151bd4334..a556927cc33 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -175,7 +175,7 @@ import qualified SAML2.WebSSO.API.Example as SAML import SAML2.WebSSO.Test.Lenses (userRefL) import SAML2.WebSSO.Test.MockResponse import SAML2.WebSSO.Test.Util (SampleIdP (..), makeSampleIdPMetadata) -import Spar.App (liftSem, toLevel) +import Spar.App (liftSem) import qualified Spar.App as Spar import Spar.Error (SparError) import qualified Spar.Intra.BrigApp as Intra @@ -195,6 +195,8 @@ import Spar.Sem.GalleyAccess (GalleyAccess) import Spar.Sem.GalleyAccess.Http (galleyAccessToHttp) import qualified Spar.Sem.IdP as IdPEffect import Spar.Sem.IdP.Cassandra +import Spar.Sem.Logger (Logger) +import Spar.Sem.Logger.TinyLog (loggerToTinyLog, stringLoggerToTinyLog, toLevel) import Spar.Sem.Random (Random) import Spar.Sem.Random.IO (randomToIO) import Spar.Sem.SAMLUserStore (SAMLUserStore) @@ -207,6 +209,7 @@ import Spar.Sem.ScimTokenStore (ScimTokenStore) import Spar.Sem.ScimTokenStore.Cassandra (scimTokenStoreToCassandra) import Spar.Sem.ScimUserTimesStore (ScimUserTimesStore) import Spar.Sem.ScimUserTimesStore.Cassandra (scimUserTimesStoreToCassandra) +import qualified System.Logger as TinyLog import qualified System.Logger.Extended as Log import System.Random (randomRIO) import Test.Hspec hiding (it, pending, pendingWith, xit) @@ -1260,6 +1263,8 @@ type RealInterpretation = ReaderEff.Reader Opts, ErrorEff.Error TTLError, ErrorEff.Error SparError, + Logger String, + Logger (TinyLog.Msg -> TinyLog.Msg), Random, Embed IO, Final IO @@ -1273,27 +1278,29 @@ runSpar (Spar.Spar action) = do env <- (^. teSparEnv) <$> ask liftIO $ do result <- - fmap join $ - runFinal $ - embedToFinal @IO $ - randomToIO $ - ErrorEff.runError @SparError $ - ttlErrorToSparError $ - ReaderEff.runReader (Spar.sparCtxOpts env) $ - interpretClientToIO (Spar.sparCtxCas env) $ - samlUserStoreToCassandra @Cas.Client $ - idPToCassandra @Cas.Client $ - defaultSsoCodeToCassandra @Cas.Client $ - scimTokenStoreToCassandra @Cas.Client $ - scimUserTimesStoreToCassandra @Cas.Client $ - scimExternalIdStoreToCassandra @Cas.Client $ - aReqIDStoreToCassandra @Cas.Client $ - assIDStoreToCassandra @Cas.Client $ - bindCookieStoreToCassandra @Cas.Client $ - brigAccessToHttp (Spar.sparCtxLogger env) (Spar.sparCtxHttpManager env) (Spar.sparCtxHttpBrig env) $ - galleyAccessToHttp (Spar.sparCtxLogger env) (Spar.sparCtxHttpManager env) (Spar.sparCtxHttpBrig env) $ - runExceptT $ - runReaderT action env + fmap join + . runFinal + . embedToFinal @IO + . randomToIO + . loggerToTinyLog (Spar.sparCtxLogger env) + . stringLoggerToTinyLog + . ErrorEff.runError @SparError + . ttlErrorToSparError + . ReaderEff.runReader (Spar.sparCtxOpts env) + . interpretClientToIO (Spar.sparCtxCas env) + . samlUserStoreToCassandra @Cas.Client + . idPToCassandra @Cas.Client + . defaultSsoCodeToCassandra @Cas.Client + . scimTokenStoreToCassandra @Cas.Client + . scimUserTimesStoreToCassandra @Cas.Client + . scimExternalIdStoreToCassandra @Cas.Client + . aReqIDStoreToCassandra @Cas.Client + . assIDStoreToCassandra @Cas.Client + . bindCookieStoreToCassandra @Cas.Client + . brigAccessToHttp (Spar.sparCtxHttpManager env) (Spar.sparCtxHttpBrig env) + . galleyAccessToHttp (Spar.sparCtxHttpManager env) (Spar.sparCtxHttpBrig env) + . runExceptT + $ runReaderT action env either (throwIO . ErrorCall . show) pure result getSsoidViaSelf :: HasCallStack => UserId -> TestSpar UserSSOId From 2ac318c2cda550431419b24fea7f045e39685477 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 30 Sep 2021 12:52:37 +0200 Subject: [PATCH 66/72] Federation: support conversation access updates (#1808) * Turn conversation access list into set Also changed the name of `ConversationAccessUpdate` to `ConversationAccessData`, since it is going to be used to keep track of the current access and role, instead of just updates. * Implement federation behaviour for access updates --- changelog.d/6-federation/fed-access | 1 + libs/galley-types/src/Galley/Types.hs | 2 +- libs/wire-api/src/Wire/API/Conversation.hs | 24 +-- .../src/Wire/API/Conversation/Action.hs | 4 + .../src/Wire/API/Event/Conversation.hs | 6 +- .../src/Wire/API/Routes/Public/Galley.hs | 4 +- libs/wire-api/src/Wire/API/Swagger.hs | 2 +- ...Object_ConversationAccessData_user_1.json} | 0 ...Object_ConversationAccessData_user_2.json} | 0 .../test/golden/testObject_Event_user_2.json | 4 +- .../unit/Test/Wire/API/Golden/Generated.hs | 12 +- ...user.hs => ConversationAccessData_user.hs} | 16 +- .../Wire/API/Golden/Generated/Event_user.hs | 2 +- .../unit/Test/Wire/API/Golden/Generator.hs | 2 +- .../unit/Test/Wire/API/Roundtrip/Aeson.hs | 2 +- libs/wire-api/wire-api.cabal | 4 +- .../brig/test/integration/API/Provider.hs | 6 +- services/galley/src/Galley/API/Federation.hs | 1 + services/galley/src/Galley/API/Update.hs | 152 +++++++----------- services/galley/src/Galley/API/Util.hs | 22 +++ services/galley/src/Galley/Data.hs | 13 +- services/galley/test/integration/API.hs | 18 ++- .../galley/test/integration/API/Federation.hs | 10 ++ services/galley/test/integration/API/Roles.hs | 53 +++++- services/galley/test/integration/API/Teams.hs | 2 +- services/galley/test/integration/API/Util.hs | 20 ++- 26 files changed, 227 insertions(+), 155 deletions(-) create mode 100644 changelog.d/6-federation/fed-access rename libs/wire-api/test/golden/{testObject_ConversationAccessUpdate_user_1.json => testObject_ConversationAccessData_user_1.json} (100%) rename libs/wire-api/test/golden/{testObject_ConversationAccessUpdate_user_2.json => testObject_ConversationAccessData_user_2.json} (100%) rename libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/{ConversationAccessUpdate_user.hs => ConversationAccessData_user.hs} (64%) diff --git a/changelog.d/6-federation/fed-access b/changelog.d/6-federation/fed-access new file mode 100644 index 00000000000..47bc0db4897 --- /dev/null +++ b/changelog.d/6-federation/fed-access @@ -0,0 +1 @@ +Notify remote users when a conversation access settings are updated diff --git a/libs/galley-types/src/Galley/Types.hs b/libs/galley-types/src/Galley/Types.hs index 9a9e2cdca81..6b0a86f099e 100644 --- a/libs/galley-types/src/Galley/Types.hs +++ b/libs/galley-types/src/Galley/Types.hs @@ -59,7 +59,7 @@ module Galley.Types AccessRole (..), ConversationList (..), ConversationRename (..), - ConversationAccessUpdate (..), + ConversationAccessData (..), ConversationReceiptModeUpdate (..), ConversationMessageTimerUpdate (..), ConvType (..), diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index d774cf46828..17d2fb21a39 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -65,7 +65,7 @@ module Wire.API.Conversation -- * update ConversationRename (..), - ConversationAccessUpdate (..), + ConversationAccessData (..), ConversationReceiptModeUpdate (..), ConversationMessageTimerUpdate (..), @@ -80,7 +80,7 @@ module Wire.API.Conversation modelNewConversation, modelTeamInfo, modelConversationUpdateName, - modelConversationAccessUpdate, + modelConversationAccessData, modelConversationReceiptModeUpdate, modelConversationMessageTimerUpdate, typeConversationType, @@ -791,23 +791,23 @@ modelConversationUpdateName = Doc.defineModel "ConversationUpdateName" $ do Doc.property "name" Doc.string' $ Doc.description "The new conversation name" -data ConversationAccessUpdate = ConversationAccessUpdate - { cupAccess :: [Access], +data ConversationAccessData = ConversationAccessData + { cupAccess :: Set Access, cupAccessRole :: AccessRole } deriving stock (Eq, Show, Generic) - deriving (Arbitrary) via (GenericUniform ConversationAccessUpdate) - deriving (FromJSON, ToJSON, S.ToSchema) via Schema ConversationAccessUpdate + deriving (Arbitrary) via (GenericUniform ConversationAccessData) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema ConversationAccessData -instance ToSchema ConversationAccessUpdate where +instance ToSchema ConversationAccessData where schema = - object "ConversationAccessUpdate" $ - ConversationAccessUpdate - <$> cupAccess .= field "access" (array schema) + object "ConversationAccessData" $ + ConversationAccessData + <$> cupAccess .= field "access" (set schema) <*> cupAccessRole .= field "access_role" schema -modelConversationAccessUpdate :: Doc.Model -modelConversationAccessUpdate = Doc.defineModel "ConversationAccessUpdate" $ do +modelConversationAccessData :: Doc.Model +modelConversationAccessData = Doc.defineModel "ConversationAccessData" $ do Doc.description "Contains conversation properties to update" Doc.property "access" (Doc.unique $ Doc.array typeAccess) $ Doc.description "List of conversation access modes." diff --git a/libs/wire-api/src/Wire/API/Conversation/Action.hs b/libs/wire-api/src/Wire/API/Conversation/Action.hs index 0cd526ae2d2..c96a77bc3ea 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Action.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Action.hs @@ -43,6 +43,7 @@ data ConversationAction | ConversationActionMessageTimerUpdate ConversationMessageTimerUpdate | ConversationActionReceiptModeUpdate ConversationReceiptModeUpdate | ConversationActionMemberUpdate (Qualified UserId) OtherMemberUpdate + | ConversationActionAccessUpdate ConversationAccessData deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform ConversationAction) deriving (ToJSON, FromJSON) via (CustomEncoded ConversationAction) @@ -68,6 +69,8 @@ conversationActionToEvent now quid qcnv (ConversationActionReceiptModeUpdate upd conversationActionToEvent now quid qcnv (ConversationActionMemberUpdate target (OtherMemberUpdate role)) = let update = MemberUpdateData target Nothing Nothing Nothing Nothing Nothing Nothing role in Event MemberStateUpdate qcnv quid now (EdMemberUpdate update) +conversationActionToEvent now quid qcnv (ConversationActionAccessUpdate update) = + Event ConvAccessUpdate qcnv quid now (EdConvAccessUpdate update) conversationActionTag :: Qualified UserId -> ConversationAction -> Action conversationActionTag _ (ConversationActionAddMembers _ _) = AddConversationMember @@ -78,3 +81,4 @@ conversationActionTag _ (ConversationActionRename _) = ModifyConversationName conversationActionTag _ (ConversationActionMessageTimerUpdate _) = ModifyConversationMessageTimer conversationActionTag _ (ConversationActionReceiptModeUpdate _) = ModifyConversationReceiptMode conversationActionTag _ (ConversationActionMemberUpdate _ _) = ModifyOtherConversationMember +conversationActionTag _ (ConversationActionAccessUpdate _) = ModifyConversationAccess diff --git a/libs/wire-api/src/Wire/API/Event/Conversation.hs b/libs/wire-api/src/Wire/API/Event/Conversation.hs index bc65f7ccead..0cc3da6702e 100644 --- a/libs/wire-api/src/Wire/API/Event/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Event/Conversation.hs @@ -51,7 +51,7 @@ module Wire.API.Event.Conversation -- * re-exports ConversationReceiptModeUpdate (..), ConversationRename (..), - ConversationAccessUpdate (..), + ConversationAccessData (..), ConversationMessageTimerUpdate (..), ConversationCode (..), Conversation (..), @@ -219,7 +219,7 @@ data EventData | EdConvReceiptModeUpdate ConversationReceiptModeUpdate | EdConvRename ConversationRename | EdConvDelete - | EdConvAccessUpdate ConversationAccessUpdate + | EdConvAccessUpdate ConversationAccessData | EdConvMessageTimerUpdate ConversationMessageTimerUpdate | EdConvCodeUpdate ConversationCode | EdConvCodeDelete @@ -252,7 +252,7 @@ modelConversationNameUpdateEvent = Doc.defineModel "ConversationNameUpdateEvent" modelConversationAccessUpdateEvent :: Doc.Model modelConversationAccessUpdateEvent = Doc.defineModel "ConversationAccessUpdateEvent" $ do Doc.description "conversation access update event" - Doc.property "data" (Doc.ref modelConversationAccessUpdate) $ Doc.description "conversation access data" + Doc.property "data" (Doc.ref modelConversationAccessData) $ Doc.description "conversation access data" modelConversationMessageTimerUpdateEvent :: Doc.Model modelConversationMessageTimerUpdateEvent = Doc.defineModel "ConversationMessageTimerUpdateEvent" $ do 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 d4786e74091..7fd3202e1d3 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -454,7 +454,7 @@ data Api routes = Api :> "conversations" :> Capture' '[Description "Conversation ID"] "cnv" ConvId :> "access" - :> ReqBody '[JSON] ConversationAccessUpdate + :> ReqBody '[JSON] ConversationAccessData :> MultiVerb 'PUT '[JSON] @@ -471,7 +471,7 @@ data Api routes = Api :> "conversations" :> QualifiedCapture' '[Description "Conversation ID"] "cnv" ConvId :> "access" - :> ReqBody '[JSON] ConversationAccessUpdate + :> ReqBody '[JSON] ConversationAccessData :> MultiVerb 'PUT '[JSON] diff --git a/libs/wire-api/src/Wire/API/Swagger.hs b/libs/wire-api/src/Wire/API/Swagger.hs index 3777e1d3544..17f75474c8a 100644 --- a/libs/wire-api/src/Wire/API/Swagger.hs +++ b/libs/wire-api/src/Wire/API/Swagger.hs @@ -65,7 +65,7 @@ models = Conversation.modelNewConversation, Conversation.modelTeamInfo, Conversation.modelConversationUpdateName, - Conversation.modelConversationAccessUpdate, + Conversation.modelConversationAccessData, Conversation.modelConversationReceiptModeUpdate, Conversation.modelConversationMessageTimerUpdate, Conversation.Code.modelConversationCode, diff --git a/libs/wire-api/test/golden/testObject_ConversationAccessUpdate_user_1.json b/libs/wire-api/test/golden/testObject_ConversationAccessData_user_1.json similarity index 100% rename from libs/wire-api/test/golden/testObject_ConversationAccessUpdate_user_1.json rename to libs/wire-api/test/golden/testObject_ConversationAccessData_user_1.json diff --git a/libs/wire-api/test/golden/testObject_ConversationAccessUpdate_user_2.json b/libs/wire-api/test/golden/testObject_ConversationAccessData_user_2.json similarity index 100% rename from libs/wire-api/test/golden/testObject_ConversationAccessUpdate_user_2.json rename to libs/wire-api/test/golden/testObject_ConversationAccessData_user_2.json diff --git a/libs/wire-api/test/golden/testObject_Event_user_2.json b/libs/wire-api/test/golden/testObject_Event_user_2.json index d59c7a6c87a..9a4665f8c08 100644 --- a/libs/wire-api/test/golden/testObject_Event_user_2.json +++ b/libs/wire-api/test/golden/testObject_Event_user_2.json @@ -2,11 +2,9 @@ "conversation": "0000064d-0000-7a7f-0000-5749000029e1", "data": { "access": [ - "invite", - "link", "private", "invite", - "invite" + "link" ], "access_role": "activated" }, 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 c08a1e30054..5c2c181d66c 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 @@ -58,7 +58,7 @@ import qualified Test.Wire.API.Golden.Generated.Contact_user import qualified Test.Wire.API.Golden.Generated.ConvMembers_user import qualified Test.Wire.API.Golden.Generated.ConvTeamInfo_user import qualified Test.Wire.API.Golden.Generated.ConvType_user -import qualified Test.Wire.API.Golden.Generated.ConversationAccessUpdate_user +import qualified Test.Wire.API.Golden.Generated.ConversationAccessData_user import qualified Test.Wire.API.Golden.Generated.ConversationCode_user import qualified Test.Wire.API.Golden.Generated.ConversationList_20Conversation_user import qualified Test.Wire.API.Golden.Generated.ConversationList_20_28Id_20_2a_20C_29_user @@ -484,13 +484,13 @@ tests = "testObject_ConversationRename_user_1.json" ) ], - testGroup "Golden: ConversationAccessUpdate_user" $ + testGroup "Golden: ConversationAccessData_user" $ testObjects - [ ( Test.Wire.API.Golden.Generated.ConversationAccessUpdate_user.testObject_ConversationAccessUpdate_user_1, - "testObject_ConversationAccessUpdate_user_1.json" + [ ( Test.Wire.API.Golden.Generated.ConversationAccessData_user.testObject_ConversationAccessData_user_1, + "testObject_ConversationAccessData_user_1.json" ), - ( Test.Wire.API.Golden.Generated.ConversationAccessUpdate_user.testObject_ConversationAccessUpdate_user_2, - "testObject_ConversationAccessUpdate_user_2.json" + ( Test.Wire.API.Golden.Generated.ConversationAccessData_user.testObject_ConversationAccessData_user_2, + "testObject_ConversationAccessData_user_2.json" ) ], testGroup "Golden: ConversationReceiptModeUpdate_user" $ diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/ConversationAccessUpdate_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/ConversationAccessData_user.hs similarity index 64% rename from libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/ConversationAccessUpdate_user.hs rename to libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/ConversationAccessData_user.hs index cb6522f2bf2..679ff788fcf 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/ConversationAccessUpdate_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/ConversationAccessData_user.hs @@ -16,18 +16,18 @@ -- -- 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.ConversationAccessUpdate_user where +module Test.Wire.API.Golden.Generated.ConversationAccessData_user where import Wire.API.Conversation ( Access (InviteAccess), AccessRole (ActivatedAccessRole, NonActivatedAccessRole), - ConversationAccessUpdate (..), + ConversationAccessData (..), ) -testObject_ConversationAccessUpdate_user_1 :: ConversationAccessUpdate -testObject_ConversationAccessUpdate_user_1 = - ConversationAccessUpdate {cupAccess = [], cupAccessRole = NonActivatedAccessRole} +testObject_ConversationAccessData_user_1 :: ConversationAccessData +testObject_ConversationAccessData_user_1 = + ConversationAccessData {cupAccess = [], cupAccessRole = NonActivatedAccessRole} -testObject_ConversationAccessUpdate_user_2 :: ConversationAccessUpdate -testObject_ConversationAccessUpdate_user_2 = - ConversationAccessUpdate {cupAccess = [InviteAccess], cupAccessRole = ActivatedAccessRole} +testObject_ConversationAccessData_user_2 :: ConversationAccessData +testObject_ConversationAccessData_user_2 = + ConversationAccessData {cupAccess = [InviteAccess], cupAccessRole = ActivatedAccessRole} 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 bd5cbfacae7..8ec156d9092 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 @@ -54,7 +54,7 @@ testObject_Event_user_2 = (Qualified (Id (fromJust (UUID.fromString "00006a88-0000-2acb-0000-6aa0000061b2"))) (Domain "faraway.example.com")) (read "1864-06-05 23:01:18.769 UTC") ( EdConvAccessUpdate - ( ConversationAccessUpdate + ( ConversationAccessData { cupAccess = [InviteAccess, LinkAccess, PrivateAccess, InviteAccess, InviteAccess], cupAccessRole = ActivatedAccessRole } diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generator.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generator.hs index 8d6db1e05ea..4d022f0eac0 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generator.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generator.hs @@ -166,7 +166,7 @@ generateTestModule = do generateBindingModule @Conversation.ConvTeamInfo "user" ref generateBindingModule @Conversation.Invite "user" ref generateBindingModule @Conversation.ConversationRename "user" ref - generateBindingModule @Conversation.ConversationAccessUpdate "user" ref + generateBindingModule @Conversation.ConversationAccessData "user" ref generateBindingModule @Conversation.ConversationReceiptModeUpdate "user" ref generateBindingModule @Conversation.ConversationMessageTimerUpdate "user" ref generateBindingModule @Conversation.Bot.AddBot "user" ref diff --git a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs index c16f54fcfbd..97dc0e0aa3d 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Roundtrip/Aeson.hs @@ -112,7 +112,7 @@ tests = testRoundTrip @Conversation.ConversationCoverView, testRoundTrip @Conversation.Invite, testRoundTrip @Conversation.ConversationRename, - testRoundTrip @Conversation.ConversationAccessUpdate, + testRoundTrip @Conversation.ConversationAccessData, testRoundTrip @Conversation.ConversationReceiptModeUpdate, testRoundTrip @Conversation.ConversationMessageTimerUpdate, testRoundTrip @Conversation.Bot.AddBot, diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 3434f71e51e..b85340b9ba8 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: 9d49a92f6ad563b050a6e3e6ae7f68b8abda7fa71e1986573cd81edf97d7b508 +-- hash: 4ba12caf3f3efd379bd7183a7661ac527d4da4072b7d92dd240af982bdab27de name: wire-api version: 0.1.0 @@ -216,7 +216,7 @@ test-suite wire-api-tests Test.Wire.API.Golden.Generated.ConnectionUpdate_user Test.Wire.API.Golden.Generated.Contact_user Test.Wire.API.Golden.Generated.Conversation_user - Test.Wire.API.Golden.Generated.ConversationAccessUpdate_user + Test.Wire.API.Golden.Generated.ConversationAccessData_user Test.Wire.API.Golden.Generated.ConversationCode_user Test.Wire.API.Golden.Generated.ConversationList_20_28Id_20_2a_20C_29_user Test.Wire.API.Golden.Generated.ConversationList_20Conversation_user diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index 7af5a32541a..0d31b984125 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/services/brig/test/integration/API/Provider.hs @@ -622,7 +622,7 @@ testBotTeamOnlyConv config db brig galley cannon = withTestService config db bri svcAssertConvAccessUpdate buf quid1 - (ConversationAccessUpdate [InviteAccess] TeamAccessRole) + (ConversationAccessData (Set.singleton InviteAccess) TeamAccessRole) qcid svcAssertMemberLeave buf qbuid [qbuid] qcid wsAssertMemberLeave ws qcid qbuid [qbuid] @@ -1345,7 +1345,7 @@ updateConversationAccess galley uid cid access role = . contentJson . body (RequestBodyLBS (encode upd)) where - upd = ConversationAccessUpdate access role + upd = ConversationAccessData (Set.fromList access) role -------------------------------------------------------------------------------- -- DB Operations @@ -1745,7 +1745,7 @@ svcAssertMemberLeave buf usr gone cnv = liftIO $ do assertEqual "event data" (EdMembersLeave msg) (evtData e) _ -> assertFailure "Event timeout (TestBotMessage: member-leave)" -svcAssertConvAccessUpdate :: MonadIO m => Chan TestBotEvent -> Qualified UserId -> ConversationAccessUpdate -> Qualified ConvId -> m () +svcAssertConvAccessUpdate :: MonadIO m => Chan TestBotEvent -> Qualified UserId -> ConversationAccessData -> Qualified ConvId -> m () svcAssertConvAccessUpdate buf usr upd cnv = liftIO $ do evt <- timeout (5 # Second) $ readChan buf case evt of diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 81cebef0159..512077e7de6 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -143,6 +143,7 @@ onConversationUpdated requestingDomain cu = do ConversationActionMessageTimerUpdate _ -> pure [] ConversationActionMemberUpdate _ _ -> pure [] ConversationActionReceiptModeUpdate _ -> pure [] + ConversationActionAccessUpdate _ -> pure [] -- Send notifications let event = conversationActionToEvent (cuTime cu) (cuOrigUserId cu) qconvId (cuAction cu) diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index ceaaa5aac21..152d0735af5 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -119,7 +119,6 @@ import Wire.API.Conversation.Role (roleNameWireAdmin) import Wire.API.ErrorDescription ( CodeNotFound, ConvNotFound, - InvalidTargetAccess, MissingLegalholdConsent, UnknownClient, mkErrorDescription, @@ -182,7 +181,7 @@ updateConversationAccess :: UserId -> ConnId -> Qualified ConvId -> - Public.ConversationAccessUpdate -> + Public.ConversationAccessData -> Galley (UpdateResult Event) updateConversationAccess usr con qcnv update = do lusr <- qualifyLocal usr @@ -197,7 +196,7 @@ updateConversationAccessUnqualified :: UserId -> ConnId -> ConvId -> - Public.ConversationAccessUpdate -> + Public.ConversationAccessData -> Galley (UpdateResult Event) updateConversationAccessUnqualified usr zcon cnv update = do lusr <- qualifyLocal usr @@ -208,99 +207,57 @@ updateLocalConversationAccess :: Local ConvId -> Local UserId -> ConnId -> - Public.ConversationAccessUpdate -> + Public.ConversationAccessData -> Galley (UpdateResult Event) -updateLocalConversationAccess (lUnqualified -> cnv) (lUnqualified -> usr) zcon update = do - let targetAccess = Set.fromList (toList (cupAccess update)) - targetRole = cupAccessRole update - -- 'PrivateAccessRole' is for self-conversations, 1:1 conversations and - -- so on; users are not supposed to be able to make other conversations - -- have 'PrivateAccessRole' - when (PrivateAccess `elem` targetAccess || PrivateAccessRole == targetRole) $ - throwErrorDescriptionType @InvalidTargetAccess - -- The user who initiated access change has to be a conversation member - (bots, users) <- localBotsAndUsers <$> Data.members cnv - ensureConvMember users usr - conv <- Data.conversation cnv >>= ifNothing (errorDescriptionTypeToWai @ConvNotFound) - -- The conversation has to be a group conversation - ensureGroupConvThrowing conv - self <- getSelfMemberFromLocalsLegacy usr users - ensureActionAllowed ModifyConversationAccess self - -- Team conversations incur another round of checks - case Data.convTeam conv of - Just tid -> checkTeamConv tid self - Nothing -> - when (targetRole == TeamAccessRole) $ - throwErrorDescriptionType @InvalidTargetAccess - -- When there is no update to be done, we return 204; otherwise we go - -- with 'uncheckedUpdateConversationAccess', which will potentially kick - -- out some users and do DB updates. - let currentAccess = Set.fromList (toList $ Data.convAccess conv) - currentRole = Data.convAccessRole conv - if currentAccess == targetAccess && currentRole == targetRole - then pure Unchanged - else - Updated - <$> uncheckedUpdateConversationAccess - update - usr - zcon - conv - (currentAccess, targetAccess) - (currentRole, targetRole) - users - bots - where - checkTeamConv tid self = do - -- Access mode change for managed conversation is not allowed - tcv <- Data.teamConversation tid cnv - when (maybe False (view managedConversation) tcv) $ - 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 +updateLocalConversationAccess lcnv lusr con target = + getUpdateResult + . updateLocalConversation lcnv (unTagged lusr) (Just con) + . ConversationActionAccessUpdate + $ target updateRemoteConversationAccess :: Remote ConvId -> Local UserId -> ConnId -> - Public.ConversationAccessUpdate -> + Public.ConversationAccessData -> Galley (UpdateResult Event) updateRemoteConversationAccess _ _ _ _ = throwM federationNotImplemented -uncheckedUpdateConversationAccess :: - ConversationAccessUpdate -> - UserId -> - ConnId -> +performAccessUpdateAction :: + Qualified UserId -> Data.Conversation -> - (Set Access, Set Access) -> - (AccessRole, AccessRole) -> - [LocalMember] -> - [BotMember] -> - Galley Event -uncheckedUpdateConversationAccess body usr zcon conv (currentAccess, targetAccess) (currentRole, targetRole) users bots = do - localDomain <- viewFederationDomain - let cnv = convId conv - qcnv = Qualified cnv localDomain - qusr = Qualified usr localDomain + ConversationAccessData -> + MaybeT Galley () +performAccessUpdateAction qusr conv target = do + lcnv <- qualifyLocal (Data.convId conv) + guard $ Data.convAccessData conv /= target + let (bots, users) = localBotsAndUsers (Data.convLocalMembers conv) -- Remove conversation codes if CodeAccess is revoked - when (CodeAccess `elem` currentAccess && CodeAccess `notElem` targetAccess) $ do - key <- mkKey cnv - Data.deleteCode key ReusableCode + when + ( CodeAccess `elem` Data.convAccess conv + && CodeAccess `notElem` cupAccess target + ) + $ lift $ do + key <- mkKey (lUnqualified lcnv) + Data.deleteCode key ReusableCode -- Depending on a variety of things, some bots and users have to be -- removed from the conversation. We keep track of them using 'State'. - (newUsers, newBots) <- flip execStateT (users, bots) $ do + (newUsers, newBots) <- lift . flip execStateT (users, bots) $ do -- We might have to remove non-activated members -- TODO(akshay): Remove Ord instance for AccessRole. It is dangerous -- to make assumption about the order of roles and implement policy -- based on those assumptions. - when (currentRole > ActivatedAccessRole && targetRole <= ActivatedAccessRole) $ do - mIds <- map lmId <$> use usersL - activated <- fmap User.userId <$> lift (lookupActivatedUsers mIds) - let isActivated user = lmId user `elem` activated - usersL %= filter isActivated + when + ( Data.convAccessRole conv > ActivatedAccessRole + && cupAccessRole target <= ActivatedAccessRole + ) + $ do + mIds <- map lmId <$> use usersL + activated <- fmap User.userId <$> lift (lookupActivatedUsers mIds) + let isActivated user = lmId user `elem` activated + usersL %= filter isActivated -- In a team-only conversation we also want to remove bots and guests - case (targetRole, Data.convTeam conv) of + case (cupAccessRole target, Data.convTeam conv) of (TeamAccessRole, Just tid) -> do currentUsers <- use usersL onlyTeamUsers <- flip filterM currentUsers $ \user -> @@ -308,26 +265,24 @@ uncheckedUpdateConversationAccess body usr zcon conv (currentAccess, targetAcces assign usersL onlyTeamUsers botsL .= [] _ -> return () - -- Update Cassandra & send an event - now <- liftIO getCurrentTime - let accessEvent = Event ConvAccessUpdate qcnv qusr now (EdConvAccessUpdate body) - Data.updateConversationAccess cnv targetAccess targetRole - pushConversationEvent (Just zcon) accessEvent (map lmId users) bots + -- Update Cassandra + lift $ Data.updateConversationAccess (lUnqualified lcnv) target -- Remove users and bots - let removedUsers = map lmId users \\ map lmId newUsers - removedBots = map botMemId bots \\ map botMemId newBots - mapM_ (deleteBot cnv) removedBots - for_ (nonEmpty removedUsers) $ \victims -> do - -- FUTUREWORK: deal with remote members, too, see updateLocalConversation (Jira SQCORE-903) - Data.removeLocalMembersFromLocalConv cnv victims - let qvictims = QualifiedUserIdList . map (`Qualified` localDomain) . toList $ victims - let e = Event MemberLeave qcnv qusr now (EdMembersLeave qvictims) - -- 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 - void . forkIO $ void $ External.deliver (newBots `zip` repeat e) - -- Return the event - pure accessEvent + lift . void . forkIO $ do + let removedUsers = map lmId users \\ map lmId newUsers + removedBots = map botMemId bots \\ map botMemId newBots + mapM_ (deleteBot (lUnqualified lcnv)) removedBots + for_ (nonEmpty removedUsers) $ \victims -> do + -- FUTUREWORK: deal with remote members, too, see updateLocalConversation (Jira SQCORE-903) + Data.removeLocalMembersFromLocalConv (lUnqualified lcnv) victims + now <- liftIO getCurrentTime + let qvictims = QualifiedUserIdList . map (unTagged . qualifyAs lcnv) . toList $ victims + let e = Event MemberLeave (unTagged lcnv) qusr now (EdMembersLeave qvictims) + -- push event to all clients, including zconn + -- since updateConversationAccess generates a second (member removal) event here + traverse_ push1 $ + newPushLocal ListComplete (qUnqualified qusr) (ConvEvent e) (recipient <$> users) + void . forkIO $ void $ External.deliver (newBots `zip` repeat e) where usersL :: Lens' ([LocalMember], [BotMember]) [LocalMember] usersL = _1 @@ -478,6 +433,9 @@ performAction qusr conv action = case action of void $ ensureOtherMember lcnv target conv Data.updateOtherMemberLocalConv lcnv target update pure (mempty, action) + ConversationActionAccessUpdate update -> do + performAccessUpdateAction qusr conv update + pure (mempty, action) addCodeH :: UserId ::: ConnId ::: ConvId -> Galley Response addCodeH (usr ::: zcon ::: cnv) = diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs index 4eaa39b1f7c..bd21ee4f924 100644 --- a/services/galley/src/Galley/API/Util.hs +++ b/services/galley/src/Galley/API/Util.hs @@ -157,6 +157,28 @@ ensureConversationActionAllowed action conv self = do -- extra action-specific checks case action of ConversationActionAddMembers _ role -> ensureConvRoleNotElevated self role + ConversationActionAccessUpdate target -> do + -- 'PrivateAccessRole' is for self-conversations, 1:1 conversations and + -- so on; users are not supposed to be able to make other conversations + -- have 'PrivateAccessRole' + when + ( PrivateAccess `elem` Public.cupAccess target + || PrivateAccessRole == Public.cupAccessRole target + ) + $ throwErrorDescriptionType @InvalidTargetAccess + -- Team conversations incur another round of checks + case Data.convTeam conv of + Just tid -> do + -- Access mode change for managed conversation is not allowed + tcv <- Data.teamConversation tid (Data.convId conv) + when (maybe False (view managedConversation) tcv) $ + 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 + Nothing -> + when (Public.cupAccessRole target == TeamAccessRole) $ + throwErrorDescriptionType @InvalidTargetAccess _ -> pure () ensureGroupConvThrowing :: Data.Conversation -> Galley () diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index eed0dcbb6fc..afb7d877131 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -56,6 +56,7 @@ module Galley.Data -- * Conversations Conversation (..), convMetadata, + convAccessData, acceptConnect, conversation, conversationIdsFrom, @@ -709,8 +710,10 @@ createOne2OneConversation loc a b name ti = do updateConversation :: MonadClient m => ConvId -> Range 1 256 Text -> m () updateConversation cid name = retry x5 $ write Cql.updateConvName (params Quorum (fromRange name, cid)) -updateConversationAccess :: MonadClient m => ConvId -> Set.Set Access -> AccessRole -> m () -updateConversationAccess cid acc role = retry x5 $ write Cql.updateConvAccess (params Quorum (Set (toList acc), role, cid)) +updateConversationAccess :: MonadClient m => ConvId -> ConversationAccessData -> m () +updateConversationAccess cid (ConversationAccessData acc role) = + retry x5 $ + write Cql.updateConvAccess (params Quorum (Set (toList acc), role, cid)) updateConversationReceiptMode :: MonadClient m => ConvId -> ReceiptMode -> m () updateConversationReceiptMode cid receiptMode = retry x5 $ write Cql.updateConvReceiptMode (params Quorum (receiptMode, cid)) @@ -780,6 +783,12 @@ convMetadata localDomain c = (convMessageTimer c) (convReceiptMode c) +convAccessData :: Conversation -> ConversationAccessData +convAccessData conv = + ConversationAccessData + (Set.fromList (convAccess conv)) + (convAccessRole conv) + defAccess :: ConvType -> Maybe (Set Access) -> [Access] defAccess SelfConv Nothing = [PrivateAccess] defAccess ConnectConv Nothing = [PrivateAccess] diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 6654c30e714..77584660721 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -1045,11 +1045,11 @@ postJoinCodeConvOk = do WS.assertMatchN (5 # Second) [wsA, wsB] $ wsAssertMemberJoinWithRole qconv qbob [qbob] roleNameWireMember -- changing access to non-activated should give eve access - let nonActivatedAccess = ConversationAccessUpdate [CodeAccess] NonActivatedAccessRole + let nonActivatedAccess = ConversationAccessData (Set.singleton CodeAccess) NonActivatedAccessRole putAccessUpdate alice conv nonActivatedAccess !!! const 200 === statusCode postJoinCodeConv eve payload !!! const 200 === statusCode -- after removing CodeAccess, no further people can join - let noCodeAccess = ConversationAccessUpdate [InviteAccess] NonActivatedAccessRole + let noCodeAccess = ConversationAccessData (Set.singleton InviteAccess) NonActivatedAccessRole putAccessUpdate alice conv noCodeAccess !!! const 200 === statusCode postJoinCodeConv dave payload !!! const 404 === statusCode @@ -1065,11 +1065,14 @@ postConvertCodeConv = do deleteConvCode alice conv !!! const 403 === statusCode getConvCode alice conv !!! const 403 === statusCode -- cannot change to TeamAccessRole as not a team conversation - let teamAccess = ConversationAccessUpdate [InviteAccess] TeamAccessRole + let teamAccess = ConversationAccessData (Set.singleton InviteAccess) TeamAccessRole putAccessUpdate alice conv teamAccess !!! const 403 === statusCode -- change access WS.bracketR c alice $ \wsA -> do - let nonActivatedAccess = ConversationAccessUpdate [InviteAccess, CodeAccess] NonActivatedAccessRole + let nonActivatedAccess = + ConversationAccessData + (Set.fromList [InviteAccess, CodeAccess]) + NonActivatedAccessRole putAccessUpdate alice conv nonActivatedAccess !!! const 200 === statusCode -- test no-op putAccessUpdate alice conv nonActivatedAccess !!! const 204 === statusCode @@ -1089,7 +1092,7 @@ postConvertCodeConv = do getConvCode alice conv !!! const 404 === statusCode -- create a new code; then revoking CodeAccess should make existing codes invalid void $ postConvCode alice conv - let noCodeAccess = ConversationAccessUpdate [InviteAccess] NonActivatedAccessRole + let noCodeAccess = ConversationAccessData (Set.singleton InviteAccess) NonActivatedAccessRole putAccessUpdate alice conv noCodeAccess !!! const 200 === statusCode getConvCode alice conv !!! const 403 === statusCode @@ -1126,7 +1129,10 @@ postConvertTeamConv = do WS.assertMatchN (5 # Second) [wsA, wsB, wsE] $ wsAssertMemberJoinWithRole qconv qmallory [qmallory] roleNameWireMember WS.bracketRN c [alice, bob, eve, mallory] $ \[wsA, wsB, wsE, wsM] -> do - let teamAccess = ConversationAccessUpdate [InviteAccess, CodeAccess] TeamAccessRole + let teamAccess = + ConversationAccessData + (Set.fromList [InviteAccess, CodeAccess]) + TeamAccessRole putAccessUpdate alice conv teamAccess !!! const 200 === statusCode void . liftIO $ WS.assertMatchN (5 # Second) [wsA, wsB, wsE, wsM] $ diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs index 5cc73f77a33..9e5895ab1a2 100644 --- a/services/galley/test/integration/API/Federation.hs +++ b/services/galley/test/integration/API/Federation.hs @@ -72,6 +72,7 @@ tests s = test s "POST /federation/on-conversation-updated : Notify local user about message timer update" notifyMessageTimer, test s "POST /federation/on-conversation-updated : Notify local user about member update" notifyMemberUpdate, test s "POST /federation/on-conversation-updated : Notify local user about receipt mode update" notifyReceiptMode, + test s "POST /federation/on-conversation-updated : Notify local user about access update" notifyAccess, test s "POST /federation/leave-conversation : Success" leaveConversationSuccess, test s "POST /federation/on-message-sent : Receive a message from another backend" onMessageSent, test s "POST /federation/send-message : Post a message sent from another backend" sendMessage @@ -365,6 +366,15 @@ notifyReceiptMode = do ConvReceiptModeUpdate (EdConvReceiptModeUpdate d) +notifyAccess :: TestM () +notifyAccess = do + let d = ConversationAccessData (Set.fromList [InviteAccess, LinkAccess]) TeamAccessRole + notifyUpdate + [] + (ConversationActionAccessUpdate d) + ConvAccessUpdate + (EdConvAccessUpdate d) + notifyMemberUpdate :: TestM () notifyMemberUpdate = do qdee <- randomQualifiedUser diff --git a/services/galley/test/integration/API/Roles.hs b/services/galley/test/integration/API/Roles.hs index 592fde684f1..8fe7b3e7bba 100644 --- a/services/galley/test/integration/API/Roles.hs +++ b/services/galley/test/integration/API/Roles.hs @@ -29,6 +29,7 @@ import Data.Id import Data.List1 import qualified Data.List1 as List1 import Data.Qualified +import qualified Data.Set as Set import Galley.Types import Galley.Types.Conversations.Roles import Gundeck.Types.Notification (Notification (..)) @@ -52,6 +53,7 @@ tests s = [ test s "conversation roles admin (and downgrade)" handleConversationRoleAdmin, test s "conversation roles member (and upgrade)" handleConversationRoleMember, test s "conversation role update with remote users present" roleUpdateWithRemotes, + test s "conversation access update with remote users present" accessUpdateWithRemotes, test s "conversation role update of remote member" roleUpdateRemoteMember, test s "get all conversation roles" testAllConversationRoles ] @@ -285,6 +287,51 @@ roleUpdateWithRemotes = do evtFrom e @?= qbob evtData e @?= EdMemberUpdate mu +accessUpdateWithRemotes :: TestM () +accessUpdateWithRemotes = do + c <- view tsCannon + let remoteDomain = Domain "alice.example.com" + qalice <- Qualified <$> randomId <*> pure remoteDomain + qbob <- randomQualifiedUser + qcharlie <- randomQualifiedUser + let bob = qUnqualified qbob + charlie = qUnqualified qcharlie + + connectUsers bob (singleton charlie) + resp <- + postConvWithRemoteUser + remoteDomain + (mkProfile qalice (Name "Alice")) + bob + [qalice, qcharlie] + let qconv = decodeQualifiedConvId resp + + opts <- view tsGConf + let access = ConversationAccessData (Set.singleton CodeAccess) NonActivatedAccessRole + WS.bracketR2 c bob charlie $ \(wsB, wsC) -> do + (_, requests) <- + withTempMockFederator opts remoteDomain (const ()) $ + putQualifiedAccessUpdate bob qconv access + !!! const 200 === statusCode + + req <- assertOne requests + liftIO $ do + F.domain req @?= domainText remoteDomain + fmap F.component (F.request req) @?= Just F.Galley + fmap F.path (F.request req) @?= Just "/federation/on-conversation-updated" + Just (Right cu) <- pure $ fmap (eitherDecode . LBS.fromStrict . F.body) (F.request req) + F.cuConvId cu @?= qUnqualified qconv + F.cuAction cu @?= ConversationActionAccessUpdate access + F.cuAlreadyPresentUsers cu @?= [qUnqualified qalice] + + liftIO . WS.assertMatchN_ (5 # Second) [wsB, wsC] $ \n -> do + let e = List1.head (WS.unpackPayload n) + ntfTransient n @?= False + evtConv e @?= qconv + evtType e @?= ConvAccessUpdate + evtFrom e @?= qbob + evtData e @?= EdConvAccessUpdate access + -- | Given an admin, another admin and a member run all -- the necessary checks targeting the admin wireAdminChecks :: @@ -319,9 +366,9 @@ wireAdminChecks cid admin otherAdmin mem = do putMessageTimerUpdate admin cid (ConversationMessageTimerUpdate $ Just 2000) !!! assertActionSucceeded putReceiptMode admin cid (ReceiptMode 0) !!! assertActionSucceeded putReceiptMode admin cid (ReceiptMode 1) !!! assertActionSucceeded - let nonActivatedAccess = ConversationAccessUpdate [CodeAccess] NonActivatedAccessRole + let nonActivatedAccess = ConversationAccessData (Set.singleton CodeAccess) NonActivatedAccessRole putAccessUpdate admin cid nonActivatedAccess !!! assertActionSucceeded - let activatedAccess = ConversationAccessUpdate [InviteAccess] NonActivatedAccessRole + let activatedAccess = ConversationAccessData (Set.singleton InviteAccess) NonActivatedAccessRole putAccessUpdate admin cid activatedAccess !!! assertActionSucceeded -- Update your own member state let memUpdate = memberUpdate {mupOtrArchive = Just True} @@ -364,7 +411,7 @@ wireMemberChecks cid mem admin otherMem = do -- No updates for message timer, receipt mode or access putMessageTimerUpdate mem cid (ConversationMessageTimerUpdate Nothing) !!! assertActionDenied putReceiptMode mem cid (ReceiptMode 0) !!! assertActionDenied - let nonActivatedAccess = ConversationAccessUpdate [CodeAccess] NonActivatedAccessRole + let nonActivatedAccess = ConversationAccessData (Set.singleton CodeAccess) NonActivatedAccessRole putAccessUpdate mem cid nonActivatedAccess !!! assertActionDenied -- Finally, you can still do the following actions: diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index e1b543d3ef7..6b289d65616 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -1171,7 +1171,7 @@ testDeleteTeamConv = do Util.connectUsers owner (list1 (member ^. userId) [extern]) tid <- Util.createNonBindingTeam "foo" owner [member] cid1 <- Util.createTeamConv owner tid [] (Just "blaa") Nothing Nothing - let access = ConversationAccessUpdate [InviteAccess, CodeAccess] ActivatedAccessRole + let access = ConversationAccessData (Set.fromList [InviteAccess, CodeAccess]) ActivatedAccessRole putAccessUpdate owner cid1 access !!! const 200 === statusCode code <- decodeConvCodeEvent <$> (postConvCode owner cid1 ConvId -> ConversationAccessUpdate -> TestM ResponseLBS +putAccessUpdate :: UserId -> ConvId -> ConversationAccessData -> TestM ResponseLBS putAccessUpdate u c acc = do g <- view tsGalley put $ @@ -1086,6 +1086,22 @@ putAccessUpdate u c acc = do . zType "access" . json acc +putQualifiedAccessUpdate :: + (MonadHttp m, HasGalley m, MonadIO m) => + UserId -> + Qualified ConvId -> + ConversationAccessData -> + m ResponseLBS +putQualifiedAccessUpdate u (Qualified c domain) acc = do + g <- viewGalley + put $ + g + . paths ["/conversations", toByteString' domain, toByteString' c, "access"] + . zUser u + . zConn "conn" + . zType "access" + . json acc + putMessageTimerUpdateQualified :: (HasGalley m, MonadIO m, MonadHttp m) => UserId -> @@ -1385,7 +1401,7 @@ wsAssertMemberUpdateWithRole conv usr target role n = do assertEqual "conversation_role" (Just role) (misConvRoleName mis) x -> assertFailure $ "Unexpected event data: " ++ show x -wsAssertConvAccessUpdate :: Qualified ConvId -> Qualified UserId -> ConversationAccessUpdate -> Notification -> IO () +wsAssertConvAccessUpdate :: Qualified ConvId -> Qualified UserId -> ConversationAccessData -> Notification -> IO () wsAssertConvAccessUpdate conv usr new n = do let e = List1.head (WS.unpackPayload n) ntfTransient n @?= False From 4f2e52e79a311821da603ac5b222a5faa3e56f74 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Thu, 30 Sep 2021 18:46:59 -0700 Subject: [PATCH 67/72] Spar Polysemy: Remove ReaderT from Spar (#1816) * Use Input effect instead of a MonadReader instance * Remove ReaderT * Fix package.yaml * Changelog * Review responses * Fake CI commit --- changelog.d/5-internal/spar-no-monad-reader | 1 + services/spar/src/Spar/API.hs | 123 ++++++++++++-- services/spar/src/Spar/App.hs | 160 ++++++++++++------ services/spar/src/Spar/Scim.hs | 30 +++- services/spar/src/Spar/Scim/Auth.hs | 30 +++- services/spar/src/Spar/Scim/User.hs | 105 ++++++++++-- .../src/Spar/Sem/AReqIDStore/Cassandra.hs | 6 +- .../spar/src/Spar/Sem/AssIDStore/Cassandra.hs | 6 +- .../src/Spar/Sem/BindCookieStore/Cassandra.hs | 6 +- services/spar/test-integration/Util/Core.hs | 77 +++------ stack.yaml | 1 + stack.yaml.lock | 7 + 12 files changed, 399 insertions(+), 153 deletions(-) create mode 100644 changelog.d/5-internal/spar-no-monad-reader diff --git a/changelog.d/5-internal/spar-no-monad-reader b/changelog.d/5-internal/spar-no-monad-reader new file mode 100644 index 00000000000..7eec0fb1971 --- /dev/null +++ b/changelog.d/5-internal/spar-no-monad-reader @@ -0,0 +1 @@ +Remove the ReaderT inside of the Spar newtype diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 422f533d852..4598a56cd76 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -54,6 +54,7 @@ import Galley.Types.Teams (HiddenPerm (CreateUpdateDeleteIdp, ReadIdp)) import Imports import Polysemy import Polysemy.Error +import Polysemy.Input import qualified SAML2.WebSSO as SAML import Servant import qualified Servant.Multipart as Multipart @@ -86,6 +87,7 @@ import Spar.Sem.ScimTokenStore (ScimTokenStore) import qualified Spar.Sem.ScimTokenStore as ScimTokenStore import Spar.Sem.ScimUserTimesStore (ScimUserTimesStore) import System.Logger (Msg) +import qualified System.Logger as TinyLog import qualified URI.ByteString as URI import Wire.API.Cookie import Wire.API.Routes.Public.Spar @@ -101,6 +103,8 @@ api :: Members '[ GalleyAccess, BrigAccess, + Input TinyLog.Logger, + Input Opts, BindCookieStore, AssIDStore, AReqIDStore, @@ -130,6 +134,8 @@ apiSSO :: Members '[ GalleyAccess, Logger String, + Input TinyLog.Logger, + Input Opts, BrigAccess, BindCookieStore, AssIDStore, @@ -152,7 +158,19 @@ apiSSO opts = :<|> authresp . Just :<|> ssoSettings -apiIDP :: Members '[Random, Logger String, GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, SAMLUserStore, Error SparError] r => ServerT APIIDP (Spar r) +apiIDP :: + Members + '[ Random, + Logger String, + GalleyAccess, + BrigAccess, + ScimTokenStore, + IdPEffect.IdP, + SAMLUserStore, + Error SparError + ] + r => + ServerT APIIDP (Spar r) apiIDP = idpGet :<|> idpGetRaw @@ -161,7 +179,15 @@ apiIDP = :<|> idpUpdate :<|> idpDelete -apiINTERNAL :: Members '[ScimTokenStore, DefaultSsoCode, IdPEffect.IdP, SAMLUserStore] r => ServerT APIINTERNAL (Spar r) +apiINTERNAL :: + Members + '[ ScimTokenStore, + DefaultSsoCode, + IdPEffect.IdP, + SAMLUserStore + ] + r => + ServerT APIINTERNAL (Spar r) apiINTERNAL = internalStatus :<|> internalDeleteTeam @@ -180,7 +206,16 @@ authreqPrecheck msucc merr idpid = *> return NoContent authreq :: - Members '[Random, Logger String, BindCookieStore, AssIDStore, AReqIDStore, IdPEffect.IdP] r => + Members + '[ Random, + Input Opts, + Logger String, + BindCookieStore, + AssIDStore, + AReqIDStore, + IdPEffect.IdP + ] + r => NominalDiffTime -> DoInitiate -> Maybe UserId -> @@ -207,9 +242,13 @@ authreq authreqttl _ zusr msucc merr idpid = do -- | If the user is already authenticated, create bind cookie with a given life expectancy and our -- domain, and store it in C*. If the user is not authenticated, return a deletion 'SetCookie' -- value that deletes any bind cookies on the client. -initializeBindCookie :: Members '[Random, Logger String, BindCookieStore] r => Maybe UserId -> NominalDiffTime -> Spar r SetBindCookie +initializeBindCookie :: + Members '[Random, Input Opts, Logger String, BindCookieStore] r => + Maybe UserId -> + NominalDiffTime -> + Spar r SetBindCookie initializeBindCookie zusr authreqttl = do - DerivedOpts {derivedOptsBindCookiePath} <- asks (derivedOpts . sparCtxOpts) + DerivedOpts {derivedOptsBindCookiePath} <- liftSem $ inputs derivedOpts msecret <- if isJust zusr then liftSem $ Just . cs . ES.encode <$> Random.bytes 32 @@ -241,6 +280,8 @@ authresp :: Members '[ Random, Logger String, + Input Opts, + Input TinyLog.Logger, GalleyAccess, BrigAccess, BindCookieStore, @@ -283,7 +324,15 @@ ssoSettings = do -- IdP API idpGet :: - Members '[Random, Logger String, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => + Members + '[ Random, + Logger String, + GalleyAccess, + BrigAccess, + IdPEffect.IdP, + Error SparError + ] + r => Maybe UserId -> SAML.IdPId -> Spar r IdP @@ -305,7 +354,15 @@ idpGetRaw zusr idpid = do Nothing -> throwSpar $ SparIdPNotFound (cs $ show idpid) idpGetAll :: - Members '[Random, Logger String, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => + Members + '[ Random, + Logger String, + GalleyAccess, + BrigAccess, + IdPEffect.IdP, + Error SparError + ] + r => Maybe UserId -> Spar r IdPList idpGetAll zusr = withDebugLog "idpGetAll" (const Nothing) $ do @@ -393,7 +450,16 @@ idpDelete zusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (cons -- | This handler only does the json parsing, and leaves all authorization checks and -- application logic to 'idpCreateXML'. idpCreate :: - Members '[Random, Logger String, GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error SparError] r => + Members + '[ Random, + Logger String, + GalleyAccess, + BrigAccess, + ScimTokenStore, + IdPEffect.IdP, + Error SparError + ] + r => Maybe UserId -> IdPMetadataInfo -> Maybe SAML.IdPId -> @@ -403,7 +469,16 @@ idpCreate zusr (IdPMetadataValue raw xml) midpid apiversion = idpCreateXML zusr -- | We generate a new UUID for each IdP used as IdPConfig's path, thereby ensuring uniqueness. idpCreateXML :: - Members '[Random, Logger String, GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error SparError] r => + Members + '[ Random, + Logger String, + GalleyAccess, + BrigAccess, + ScimTokenStore, + IdPEffect.IdP, + Error SparError + ] + r => Maybe UserId -> Text -> SAML.IdPMetadata -> @@ -504,7 +579,15 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces = withDebugLog "validate -- 'idpCreate', which is not a good reason. make this one function and pass around -- 'IdPMetadataInfo' directly where convenient. idpUpdate :: - Members '[Random, Logger String, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => + Members + '[ Random, + Logger String, + GalleyAccess, + BrigAccess, + IdPEffect.IdP, + Error SparError + ] + r => Maybe UserId -> IdPMetadataInfo -> SAML.IdPId -> @@ -512,7 +595,15 @@ idpUpdate :: idpUpdate zusr (IdPMetadataValue raw xml) idpid = idpUpdateXML zusr raw xml idpid idpUpdateXML :: - Members '[Random, Logger String, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => + Members + '[ Random, + Logger String, + GalleyAccess, + BrigAccess, + IdPEffect.IdP, + Error SparError + ] + r => Maybe UserId -> Text -> SAML.IdPMetadata -> @@ -535,7 +626,15 @@ idpUpdateXML zusr raw idpmeta idpid = withDebugLog "idpUpdate" (Just . show . (^ validateIdPUpdate :: forall m r. (HasCallStack, m ~ Spar r) => - Members '[Random, Logger String, GalleyAccess, BrigAccess, IdPEffect.IdP, Error SparError] r => + Members + '[ Random, + Logger String, + GalleyAccess, + BrigAccess, + IdPEffect.IdP, + Error SparError + ] + r => Maybe UserId -> SAML.IdPMetadata -> SAML.IdPId -> diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index 9ea7c9d35c8..733effb5e30 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -38,6 +38,7 @@ module Spar.App deleteTeam, wrapSpar, liftSem, + type RealInterpretation, ) where @@ -64,7 +65,7 @@ import qualified Network.Wai.Utilities.Error as Wai import Polysemy import Polysemy.Error import Polysemy.Final -import qualified Polysemy.Reader as ReaderEff +import Polysemy.Input (Input, input, inputs, runInputConst) import SAML2.Util (renderURI) import SAML2.WebSSO ( Assertion (..), @@ -138,11 +139,11 @@ import Wire.API.User.IdentityProvider import Wire.API.User.Saml import Wire.API.User.Scim (ValidExternalId (..)) -newtype Spar r a = Spar {fromSpar :: Member (Final IO) r => ReaderT Env (ExceptT SparError (Sem r)) a} +newtype Spar r a = Spar {fromSpar :: Member (Final IO) r => ExceptT SparError (Sem r) a} deriving (Functor) liftSem :: Sem r a -> Spar r a -liftSem r = Spar $ lift $ lift r +liftSem r = Spar $ lift r instance Applicative (Spar r) where pure a = Spar $ pure a @@ -152,18 +153,14 @@ instance Monad (Spar r) where return = pure f >>= a = Spar $ fromSpar f >>= fromSpar . a -instance MonadReader Env (Spar r) where - ask = Spar ask - local f m = Spar $ local f $ fromSpar m - instance MonadError SparError (Spar r) where throwError err = Spar $ throwError err catchError m handler = Spar $ catchError (fromSpar m) $ fromSpar . handler instance MonadIO (Spar r) where - liftIO m = Spar $ lift $ lift $ embedFinal m + liftIO m = Spar $ lift $ embedFinal m -instance Member (Logger String) r => HasLogger (Spar r) where +instance Members '[Input Opts, Logger String] r => HasLogger (Spar r) where logger lvl = liftSem . Logger.log lvl data Env = Env @@ -176,8 +173,8 @@ data Env = Env sparCtxRequestId :: RequestId } -instance HasConfig (Spar r) where - getConfig = asks (saml . sparCtxOpts) +instance Member (Input Opts) r => HasConfig (Spar r) where + getConfig = liftSem $ inputs saml instance HasNow (Spar r) @@ -228,14 +225,13 @@ instance Member (Final IO) r => Catch.MonadCatch (Sem r) where wrapMonadClientSem :: Sem r a -> Spar r a wrapMonadClientSem action = Spar $ - (lift $ lift action) + lift action `Catch.catch` (throwSpar . SparCassandraError . cs . show @SomeException) wrapSpar :: Spar r a -> Spar r a wrapSpar action = Spar $ do - env <- ask fromSpar $ - wrapMonadClientSem (runExceptT $ flip runReaderT env $ fromSpar action) >>= Spar . lift . except + wrapMonadClientSem (runExceptT $ fromSpar action) >>= Spar . except insertUser :: Member SAMLUserStore r => SAML.UserRef -> UserId -> Spar r () insertUser uref uid = wrapMonadClientSem $ SAMLUserStore.insert uref uid @@ -323,14 +319,39 @@ createSamlUserWithId teamid buid suid = do -- | If the team has no scim token, call 'createSamlUser'. Otherwise, raise "invalid -- credentials". -autoprovisionSamlUser :: Members '[Random, GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe TeamId -> SAML.UserRef -> Spar r UserId +autoprovisionSamlUser :: + Members + '[ Random, + GalleyAccess, + BrigAccess, + ScimTokenStore, + IdPEffect.IdP, + SAMLUserStore + ] + r => + Maybe TeamId -> + SAML.UserRef -> + Spar r UserId autoprovisionSamlUser mbteam suid = do buid <- liftSem $ Id <$> Random.uuid autoprovisionSamlUserWithId mbteam buid suid pure buid -- | Like 'autoprovisionSamlUser', but for an already existing 'UserId'. -autoprovisionSamlUserWithId :: forall r. Members '[GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => Maybe TeamId -> UserId -> SAML.UserRef -> Spar r () +autoprovisionSamlUserWithId :: + forall r. + Members + '[ GalleyAccess, + BrigAccess, + ScimTokenStore, + IdPEffect.IdP, + SAMLUserStore + ] + r => + Maybe TeamId -> + UserId -> + SAML.UserRef -> + Spar r () autoprovisionSamlUserWithId mbteam buid suid = do idp <- getIdPConfigByIssuerOptionalSPId (suid ^. uidTenant) mbteam guardReplacedIdP idp @@ -400,33 +421,32 @@ bindUser buid userref = do Ephemeral -> err oldStatus PendingInvitation -> liftSem $ BrigAccess.setStatus buid Active -instance - ( r - ~ '[ BindCookieStore, - AssIDStore, - AReqIDStore, - ScimExternalIdStore, - ScimUserTimesStore, - ScimTokenStore, - DefaultSsoCode, - IdPEffect.IdP, - SAMLUserStore, - Embed (Cas.Client), - BrigAccess, - GalleyAccess, - ReaderEff.Reader Opts, - Error TTLError, - Error SparError, - -- TODO(sandy): Make this a Logger Text instead - Logger String, - Logger (TinyLog.Msg -> TinyLog.Msg), - Random, - Embed IO, - Final IO - ] - ) => - SPHandler SparError (Spar r) - where +type RealInterpretation = + '[ BindCookieStore, + AssIDStore, + AReqIDStore, + ScimExternalIdStore, + ScimUserTimesStore, + ScimTokenStore, + DefaultSsoCode, + IdPEffect.IdP, + SAMLUserStore, + Embed (Cas.Client), + BrigAccess, + GalleyAccess, + Error TTLError, + Error SparError, + -- TODO(sandy): Make this a Logger Text instead + Logger String, + Logger (TinyLog.Msg -> TinyLog.Msg), + Input Opts, + Input TinyLog.Logger, + Random, + Embed IO, + Final IO + ] + +instance r ~ RealInterpretation => SPHandler SparError (Spar r) where type NTCTX (Spar r) = Env nt :: forall a. Env -> Spar r a -> Handler a nt ctx (Spar action) = do @@ -440,11 +460,12 @@ instance . runFinal . embedToFinal @IO . randomToIO + . runInputConst (sparCtxLogger ctx) + . runInputConst (sparCtxOpts ctx) . loggerToTinyLog (sparCtxLogger ctx) . stringLoggerToTinyLog . runError @SparError . ttlErrorToSparError - . ReaderEff.runReader (sparCtxOpts ctx) . galleyAccessToHttp (sparCtxHttpManager ctx) (sparCtxHttpGalley ctx) . brigAccessToHttp (sparCtxHttpManager ctx) (sparCtxHttpBrig ctx) . interpretClientToIO (sparCtxCas ctx) @@ -457,8 +478,7 @@ instance . aReqIDStoreToCassandra . assIDStoreToCassandra . bindCookieStoreToCassandra - . runExceptT - $ runReaderT action ctx + $ runExceptT action throwErrorAsHandlerException :: Either SparError a -> Handler a throwErrorAsHandlerException (Left err) = sparToServerErrorWithLogging (sparCtxLogger ctx) err >>= throwError @@ -475,7 +495,19 @@ instance -- latter. verdictHandler :: HasCallStack => - Members '[Random, Logger String, GalleyAccess, BrigAccess, BindCookieStore, AReqIDStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Members + '[ Random, + Input TinyLog.Logger, + Logger String, + GalleyAccess, + BrigAccess, + BindCookieStore, + AReqIDStore, + ScimTokenStore, + IdPEffect.IdP, + SAMLUserStore + ] + r => Maybe BindCookie -> Maybe TeamId -> SAML.AuthnResponse -> @@ -507,7 +539,18 @@ data VerdictHandlerResult verdictHandlerResult :: HasCallStack => - Members '[Random, Logger String, GalleyAccess, BrigAccess, BindCookieStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Members + '[ Random, + Input TinyLog.Logger, + Logger String, + GalleyAccess, + BrigAccess, + BindCookieStore, + ScimTokenStore, + IdPEffect.IdP, + SAMLUserStore + ] + r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> @@ -518,12 +561,13 @@ verdictHandlerResult bindCky mbteam verdict = do liftSem $ Logger.log SAML.Debug $ "leaving verdictHandlerResult" <> show result pure result -catchVerdictErrors :: Spar r VerdictHandlerResult -> Spar r VerdictHandlerResult +catchVerdictErrors :: forall r. Member (Input TinyLog.Logger) r => Spar r VerdictHandlerResult -> Spar r VerdictHandlerResult catchVerdictErrors = (`catchError` hndlr) where hndlr :: SparError -> Spar r VerdictHandlerResult hndlr err = do - logr <- asks sparCtxLogger + logr <- liftSem input + -- TODO(sandy): When we remove this line, we can get rid of the @Input TinyLog.Logger@ effect waiErr <- renderSparErrorWithLogging logr err pure $ case waiErr of Right (werr :: Wai.Error) -> VerifyHandlerError (cs $ Wai.label werr) (cs $ Wai.message werr) @@ -552,7 +596,17 @@ moveUserToNewIssuer oldUserRef newUserRef uid = do verdictHandlerResultCore :: HasCallStack => - Members '[Random, Logger String, GalleyAccess, BrigAccess, BindCookieStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + Members + '[ Random, + Logger String, + GalleyAccess, + BrigAccess, + BindCookieStore, + ScimTokenStore, + IdPEffect.IdP, + SAMLUserStore + ] + r => Maybe BindCookie -> Maybe TeamId -> SAML.AccessVerdict -> @@ -724,7 +778,7 @@ verdictHandlerMobile granted denied = \case -- | When getting stuck during login finalization, show a nice HTML error rather than the json -- blob. Show lots of debugging info for the customer to paste in any issue they might open. errorPage :: SparError -> [Multipart.Input] -> Maybe Text -> ServerError -errorPage err inputs mcky = +errorPage err mpInputs mcky = ServerError { errHTTPCode = Http.statusCode $ Wai.code werr, errReasonPhrase = cs $ Wai.label werr, @@ -742,7 +796,7 @@ errorPage err inputs mcky = "", " sorry, something went wrong :(
", " please copy the following debug information to your clipboard and provide it when opening an issue in our customer support.

", - " 
" <> (cs . toText . encodeBase64 . cs . show $ (err, inputs, mcky)) <> "
", + " 
" <> (cs . toText . encodeBase64 . cs . show $ (err, mpInputs, mcky)) <> "
", "" ] diff --git a/services/spar/src/Spar/Scim.hs b/services/spar/src/Spar/Scim.hs index 9a01a93b4e8..ac883f39d39 100644 --- a/services/spar/src/Spar/Scim.hs +++ b/services/spar/src/Spar/Scim.hs @@ -70,11 +70,12 @@ import Data.String.Conversions (cs) import Imports import Polysemy import Polysemy.Error (Error) +import Polysemy.Input (Input, input) import qualified SAML2.WebSSO as SAML import Servant import Servant.API.Generic import Servant.Server.Generic (AsServerT) -import Spar.App (Env (..), Spar (..)) +import Spar.App (Spar (..)) import Spar.Error ( SparCustomError (SparScimError), SparError, @@ -93,6 +94,7 @@ import Spar.Sem.ScimExternalIdStore (ScimExternalIdStore) import Spar.Sem.ScimTokenStore (ScimTokenStore) import Spar.Sem.ScimUserTimesStore (ScimUserTimesStore) import System.Logger (Msg) +import qualified System.Logger as TinyLog import qualified Web.Scim.Capabilities.MetaSchema as Scim.Meta import qualified Web.Scim.Class.Auth as Scim.Auth import qualified Web.Scim.Class.User as Scim.User @@ -101,6 +103,7 @@ import qualified Web.Scim.Schema.Error as Scim import qualified Web.Scim.Schema.Schema as Scim.Schema import qualified Web.Scim.Server as Scim import Wire.API.Routes.Public.Spar +import Wire.API.User.Saml (Opts) import Wire.API.User.Scim -- | SCIM config for our server. @@ -111,7 +114,23 @@ configuration :: Scim.Meta.Configuration configuration = Scim.Meta.empty apiScim :: - Members '[Random, Logger (Msg -> Msg), Logger String, Error SparError, GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, ScimTokenStore, IdPEffect.IdP, SAMLUserStore] r => + forall r. + Members + '[ Input TinyLog.Logger, + Random, + Input Opts, + Logger (Msg -> Msg), + Logger String, + Error SparError, + GalleyAccess, + BrigAccess, + ScimExternalIdStore, + ScimUserTimesStore, + ScimTokenStore, + IdPEffect.IdP, + SAMLUserStore + ] + r => ServerT APIScim (Spar r) apiScim = hoistScim (toServant (server configuration)) @@ -130,8 +149,8 @@ apiScim = -- for why it's hard to catch impure exceptions. wrapScimErrors :: Spar r a -> Spar r a wrapScimErrors act = Spar $ - ReaderT $ \env -> ExceptT $ do - result :: Either SomeException (Either SparError a) <- try $ runExceptT $ runReaderT (fromSpar $ act) env + ExceptT $ do + result :: Either SomeException (Either SparError a) <- try $ runExceptT $ fromSpar $ act case result of Left someException -> do -- We caught an exception that's not a Spar exception at all. It is wrapped into @@ -144,7 +163,8 @@ apiScim = Right (Left sparError) -> do -- We caught some other Spar exception. It is rendered and wrapped into a scim error -- with the same status and message, and no scim error type. - err :: ServerError <- embedFinal @IO $ sparToServerErrorWithLogging (sparCtxLogger env) sparError + logger <- input @TinyLog.Logger + err :: ServerError <- embedFinal @IO $ sparToServerErrorWithLogging logger sparError pure . Left . SAML.CustomError . SparScimError $ Scim.ScimError { schemas = [Scim.Schema.Error20], diff --git a/services/spar/src/Spar/Scim/Auth.hs b/services/spar/src/Spar/Scim/Auth.hs index b1259855357..6b8241f8c49 100644 --- a/services/spar/src/Spar/Scim/Auth.hs +++ b/services/spar/src/Spar/Scim/Auth.hs @@ -3,6 +3,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-} -- This file is part of the Wire Server implementation. -- @@ -45,9 +46,10 @@ import Imports import Polysemy import Polysemy.Error +import Polysemy.Input import qualified SAML2.WebSSO as SAML import Servant (NoContent (NoContent), ServerT, (:<|>) ((:<|>))) -import Spar.App (Spar, liftSem, sparCtxOpts, wrapMonadClientSem) +import Spar.App (Spar, liftSem, wrapMonadClientSem) import qualified Spar.Error as E import qualified Spar.Intra.BrigApp as Intra.Brig import Spar.Sem.BrigAccess (BrigAccess) @@ -62,7 +64,7 @@ import qualified Web.Scim.Class.Auth as Scim.Class.Auth import qualified Web.Scim.Handler as Scim import qualified Web.Scim.Schema.Error as Scim import Wire.API.Routes.Public.Spar (APIScimToken) -import Wire.API.User.Saml (maxScimTokens) +import Wire.API.User.Saml (Opts, maxScimTokens) import Wire.API.User.Scim -- | An instance that tells @hscim@ how authentication should be done for SCIM routes. @@ -83,7 +85,16 @@ instance Member ScimTokenStore r => Scim.Class.Auth.AuthDB SparTag (Spar r) wher -- | API for manipulating SCIM tokens (protected by normal Wire authentication and available -- only to team owners). apiScimToken :: - Members '[Random, GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error E.SparError] r => + Members + '[ Random, + Input Opts, + GalleyAccess, + BrigAccess, + ScimTokenStore, + IdPEffect.IdP, + Error E.SparError + ] + r => ServerT APIScimToken (Spar r) apiScimToken = createScimToken @@ -95,7 +106,16 @@ apiScimToken = -- Create a token for user's team. createScimToken :: forall r. - Members '[Random, GalleyAccess, BrigAccess, ScimTokenStore, IdPEffect.IdP, Error E.SparError] r => + Members + '[ Random, + Input Opts, + GalleyAccess, + BrigAccess, + ScimTokenStore, + IdPEffect.IdP, + Error E.SparError + ] + r => -- | Who is trying to create a token Maybe UserId -> -- | Request body @@ -106,7 +126,7 @@ createScimToken zusr CreateScimToken {..} = do teamid <- liftSem $ Intra.Brig.authorizeScimTokenManagement zusr liftSem $ BrigAccess.ensureReAuthorised zusr createScimTokenPassword tokenNumber <- fmap length $ wrapMonadClientSem $ ScimTokenStore.getByTeam teamid - maxTokens <- asks (maxScimTokens . sparCtxOpts) + maxTokens <- liftSem $ inputs maxScimTokens unless (tokenNumber < maxTokens) $ E.throwSpar E.SparProvisioningTokenLimitReached idps <- wrapMonadClientSem $ IdPEffect.getConfigsByTeam teamid diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 770528e4b9e..d74b3a65dc5 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -9,6 +9,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-} -- This file is part of the Wire Server implementation. -- @@ -63,8 +64,9 @@ import qualified Data.UUID as UUID import Imports import Network.URI (URI, parseURI) import Polysemy +import Polysemy.Input import qualified SAML2.WebSSO as SAML -import Spar.App (GetUserResult (..), Spar, getUserIdByScimExternalId, getUserIdByUref, liftSem, sparCtxOpts, validateEmailIfExists, wrapMonadClientSem) +import Spar.App (GetUserResult (..), Spar, getUserIdByScimExternalId, getUserIdByUref, liftSem, validateEmailIfExists, wrapMonadClientSem) import qualified Spar.Intra.BrigApp as Brig import Spar.Scim.Auth () import Spar.Scim.Types (normalizeLikeStored) @@ -100,14 +102,29 @@ import qualified Web.Scim.Schema.User as Scim.User (schemas) import Wire.API.User (Email) import Wire.API.User.IdentityProvider (IdP) import qualified Wire.API.User.RichInfo as RI -import Wire.API.User.Saml (derivedOpts, derivedOptsScimBaseURI, richInfoLimit) +import Wire.API.User.Saml (Opts, derivedOpts, derivedOptsScimBaseURI, richInfoLimit) import Wire.API.User.Scim (ScimTokenInfo (..)) import qualified Wire.API.User.Scim as ST ---------------------------------------------------------------------------- -- UserDB instance -instance Members '[Random, Logger (Msg -> Msg), Logger String, GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, IdPEffect.IdP, SAMLUserStore] r => Scim.UserDB ST.SparTag (Spar r) where +instance + Members + '[ Logger (Msg -> Msg), + Logger String, + Random, + Input Opts, + GalleyAccess, + BrigAccess, + ScimExternalIdStore, + ScimUserTimesStore, + IdPEffect.IdP, + SAMLUserStore + ] + r => + Scim.UserDB ST.SparTag (Spar r) + where getUsers :: ScimTokenInfo -> Maybe Scim.Filter -> @@ -183,14 +200,14 @@ instance Members '[Random, Logger (Msg -> Msg), Logger String, GalleyAccess, Bri validateScimUser :: forall m r. (m ~ Scim.ScimHandler (Spar r)) => - Member IdPEffect.IdP r => + Members '[Input Opts, IdPEffect.IdP] r => -- | Used to decide what IdP to assign the user to ScimTokenInfo -> Scim.User ST.SparTag -> m ST.ValidScimUser validateScimUser tokinfo user = do mIdpConfig <- tokenInfoToIdP tokinfo - richInfoLimit <- lift $ asks (richInfoLimit . sparCtxOpts) + richInfoLimit <- lift $ liftSem $ inputs richInfoLimit validateScimUser' mIdpConfig richInfoLimit user tokenInfoToIdP :: Member IdPEffect.IdP r => ScimTokenInfo -> Scim.ScimHandler (Spar r) (Maybe IdP) @@ -375,7 +392,18 @@ veidEmail (ST.EmailOnly email) = Just email createValidScimUser :: forall m r. (m ~ Scim.ScimHandler (Spar r)) => - Members '[Random, Logger (Msg -> Msg), Logger String, GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore] r => + Members + '[ Random, + Input Opts, + Logger (Msg -> Msg), + Logger String, + GalleyAccess, + BrigAccess, + ScimExternalIdStore, + ScimUserTimesStore, + SAMLUserStore + ] + r => ScimTokenInfo -> ST.ValidScimUser -> m (Scim.StoredUser ST.SparTag) @@ -458,7 +486,19 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid -- TODO(arianvp): how do we get this safe w.r.t. race conditions / crashes? updateValidScimUser :: forall m r. - Members '[Random, Logger (Msg -> Msg), Logger String, GalleyAccess, BrigAccess, ScimExternalIdStore, ScimUserTimesStore, IdPEffect.IdP, SAMLUserStore] r => + Members + '[ Random, + Input Opts, + Logger (Msg -> Msg), + Logger String, + GalleyAccess, + BrigAccess, + ScimExternalIdStore, + ScimUserTimesStore, + IdPEffect.IdP, + SAMLUserStore + ] + r => (m ~ Scim.ScimHandler (Spar r)) => ScimTokenInfo -> UserId -> @@ -514,7 +554,13 @@ updateValidScimUser tokinfo@ScimTokenInfo {stiTeam} uid newValidScimUser = pure newScimStoredUser updateVsuUref :: - Members '[GalleyAccess, BrigAccess, ScimExternalIdStore, SAMLUserStore] r => + Members + '[ GalleyAccess, + BrigAccess, + ScimExternalIdStore, + SAMLUserStore + ] + r => TeamId -> UserId -> ST.ValidExternalId -> @@ -587,7 +633,15 @@ updScimStoredUser' now usr (Scim.WithMeta meta (Scim.WithId scimuid _)) = } deleteScimUser :: - Members '[Logger (Msg -> Msg), BrigAccess, ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore, IdPEffect.IdP] r => + Members + '[ Logger (Msg -> Msg), + BrigAccess, + ScimExternalIdStore, + ScimUserTimesStore, + SAMLUserStore, + IdPEffect.IdP + ] + r => ScimTokenInfo -> UserId -> Scim.ScimHandler (Spar r) () @@ -711,7 +765,18 @@ assertHandleNotUsedElsewhere uid hndl = do -- | Helper function that translates a given brig user into a 'Scim.StoredUser', with some -- effects like updating the 'ManagedBy' field in brig and storing creation and update time -- stamps. -synthesizeStoredUser :: forall r. Members '[Logger (Msg -> Msg), BrigAccess, ScimUserTimesStore] r => UserAccount -> ST.ValidExternalId -> Scim.ScimHandler (Spar r) (Scim.StoredUser ST.SparTag) +synthesizeStoredUser :: + forall r. + Members + '[ Input Opts, + Logger (Msg -> Msg), + BrigAccess, + ScimUserTimesStore + ] + r => + UserAccount -> + ST.ValidExternalId -> + Scim.ScimHandler (Spar r) (Scim.StoredUser ST.SparTag) synthesizeStoredUser usr veid = logScim ( logFunction "Spar.Scim.User.synthesizeStoredUser" @@ -728,7 +793,7 @@ synthesizeStoredUser usr veid = readState = do richInfo <- liftSem $ BrigAccess.getRichInfo uid accessTimes <- wrapMonadClientSem (ScimUserTimesStore.read uid) - baseuri <- asks $ derivedOptsScimBaseURI . derivedOpts . sparCtxOpts + baseuri <- liftSem $ inputs $ derivedOptsScimBaseURI . derivedOpts pure (richInfo, accessTimes, baseuri) let writeState :: Maybe (UTCTimeMillis, UTCTimeMillis) -> ManagedBy -> RI.RichInfo -> Scim.StoredUser ST.SparTag -> Spar r () @@ -798,7 +863,13 @@ synthesizeScimUser info = } scimFindUserByHandle :: - Members '[Logger (Msg -> Msg), BrigAccess, ScimUserTimesStore] r => + Members + '[ Input Opts, + Logger (Msg -> Msg), + BrigAccess, + ScimUserTimesStore + ] + r => Maybe IdP -> TeamId -> Text -> @@ -819,7 +890,15 @@ scimFindUserByHandle mIdpConfig stiTeam hndl = do -- successful authentication with their SAML credentials. scimFindUserByEmail :: forall r. - Members '[Logger (Msg -> Msg), BrigAccess, ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore] r => + Members + '[ Input Opts, + Logger (Msg -> Msg), + BrigAccess, + ScimExternalIdStore, + ScimUserTimesStore, + SAMLUserStore + ] + r => Maybe IdP -> TeamId -> Text -> diff --git a/services/spar/src/Spar/Sem/AReqIDStore/Cassandra.hs b/services/spar/src/Spar/Sem/AReqIDStore/Cassandra.hs index 8189ab9c568..bd1c0292c62 100644 --- a/services/spar/src/Spar/Sem/AReqIDStore/Cassandra.hs +++ b/services/spar/src/Spar/Sem/AReqIDStore/Cassandra.hs @@ -7,7 +7,7 @@ import Control.Monad.Except (runExceptT) import Imports hiding (MonadReader (..), Reader) import Polysemy import Polysemy.Error -import Polysemy.Reader +import Polysemy.Input (Input, input) import SAML2.WebSSO (HasNow, fromTime, getNow) import qualified SAML2.WebSSO as SAML import qualified Spar.Data as Data @@ -19,12 +19,12 @@ instance Member (Embed IO) r => HasNow (Sem r) aReqIDStoreToCassandra :: forall m r a. - (MonadClient m, Members '[Embed m, Error TTLError, Embed IO, Reader Opts] r) => + (MonadClient m, Members '[Embed m, Error TTLError, Embed IO, Input Opts] r) => Sem (AReqIDStore ': r) a -> Sem r a aReqIDStoreToCassandra = interpret $ \case Store itla t -> do - denv <- Data.mkEnv <$> ask <*> (fromTime <$> getNow) + denv <- Data.mkEnv <$> input <*> (fromTime <$> getNow) a <- embed @m $ runExceptT $ runReaderT (Data.storeAReqID itla t) denv case a of Left err -> throw err diff --git a/services/spar/src/Spar/Sem/AssIDStore/Cassandra.hs b/services/spar/src/Spar/Sem/AssIDStore/Cassandra.hs index e746b1ed386..6b42bcc8d5e 100644 --- a/services/spar/src/Spar/Sem/AssIDStore/Cassandra.hs +++ b/services/spar/src/Spar/Sem/AssIDStore/Cassandra.hs @@ -5,7 +5,7 @@ import Control.Monad.Except (runExceptT) import Imports hiding (MonadReader (..), Reader) import Polysemy import Polysemy.Error -import Polysemy.Reader +import Polysemy.Input import SAML2.WebSSO (fromTime, getNow) import qualified Spar.Data as Data import Spar.Sem.AReqIDStore.Cassandra () @@ -14,13 +14,13 @@ import Wire.API.User.Saml (Opts, TTLError) assIDStoreToCassandra :: forall m r a. - (MonadClient m, Members '[Embed m, Error TTLError, Embed IO, Reader Opts] r) => + (MonadClient m, Members '[Embed m, Error TTLError, Embed IO, Input Opts] r) => Sem (AssIDStore ': r) a -> Sem r a assIDStoreToCassandra = interpret $ \case Store itla t -> do - denv <- Data.mkEnv <$> ask <*> (fromTime <$> getNow) + denv <- Data.mkEnv <$> input <*> (fromTime <$> getNow) a <- embed @m $ runExceptT $ runReaderT (Data.storeAssID itla t) denv case a of Left err -> throw err diff --git a/services/spar/src/Spar/Sem/BindCookieStore/Cassandra.hs b/services/spar/src/Spar/Sem/BindCookieStore/Cassandra.hs index 4a17043dcda..011ec4da469 100644 --- a/services/spar/src/Spar/Sem/BindCookieStore/Cassandra.hs +++ b/services/spar/src/Spar/Sem/BindCookieStore/Cassandra.hs @@ -8,7 +8,7 @@ import Control.Monad.Except (runExceptT) import Imports hiding (MonadReader (..), Reader) import Polysemy import Polysemy.Error -import Polysemy.Reader +import Polysemy.Input import SAML2.WebSSO (fromTime, getNow) import qualified Spar.Data as Data import Spar.Sem.AReqIDStore.Cassandra () @@ -17,12 +17,12 @@ import Wire.API.User.Saml (Opts, TTLError) bindCookieStoreToCassandra :: forall m r a. - (MonadClient m, Members '[Embed m, Error TTLError, Embed IO, Reader Opts] r) => + (MonadClient m, Members '[Embed m, Error TTLError, Embed IO, Input Opts] r) => Sem (BindCookieStore ': r) a -> Sem r a bindCookieStoreToCassandra = interpret $ \case Insert sbc uid ndt -> do - denv <- Data.mkEnv <$> ask <*> (fromTime <$> getNow) + denv <- Data.mkEnv <$> input <*> (fromTime <$> getNow) a <- embed @m $ runExceptT $ runReaderT (Data.insertBindCookie sbc uid ndt) denv case a of Left err -> throw err diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index a556927cc33..a4f799881c8 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -1,5 +1,6 @@ {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-} -- This file is part of the Wire Server implementation. -- @@ -168,48 +169,34 @@ import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Handler.Warp.Internal as Warp import qualified Options.Applicative as OPA import Polysemy -import qualified Polysemy.Error as ErrorEff -import qualified Polysemy.Reader as ReaderEff +import Polysemy.Error (runError) +import Polysemy.Input import SAML2.WebSSO as SAML import qualified SAML2.WebSSO.API.Example as SAML import SAML2.WebSSO.Test.Lenses (userRefL) import SAML2.WebSSO.Test.MockResponse import SAML2.WebSSO.Test.Util (SampleIdP (..), makeSampleIdPMetadata) -import Spar.App (liftSem) +import Spar.App (liftSem, type RealInterpretation) import qualified Spar.App as Spar import Spar.Error (SparError) import qualified Spar.Intra.BrigApp as Intra import qualified Spar.Options import Spar.Run -import Spar.Sem.AReqIDStore (AReqIDStore) import Spar.Sem.AReqIDStore.Cassandra (aReqIDStoreToCassandra, ttlErrorToSparError) -import Spar.Sem.AssIDStore (AssIDStore) import Spar.Sem.AssIDStore.Cassandra (assIDStoreToCassandra) -import Spar.Sem.BindCookieStore (BindCookieStore) import Spar.Sem.BindCookieStore.Cassandra (bindCookieStoreToCassandra) -import Spar.Sem.BrigAccess (BrigAccess) import Spar.Sem.BrigAccess.Http (brigAccessToHttp) -import Spar.Sem.DefaultSsoCode (DefaultSsoCode) import Spar.Sem.DefaultSsoCode.Cassandra (defaultSsoCodeToCassandra) -import Spar.Sem.GalleyAccess (GalleyAccess) import Spar.Sem.GalleyAccess.Http (galleyAccessToHttp) -import qualified Spar.Sem.IdP as IdPEffect import Spar.Sem.IdP.Cassandra -import Spar.Sem.Logger (Logger) import Spar.Sem.Logger.TinyLog (loggerToTinyLog, stringLoggerToTinyLog, toLevel) -import Spar.Sem.Random (Random) import Spar.Sem.Random.IO (randomToIO) -import Spar.Sem.SAMLUserStore (SAMLUserStore) import qualified Spar.Sem.SAMLUserStore as SAMLUserStore import Spar.Sem.SAMLUserStore.Cassandra -import Spar.Sem.ScimExternalIdStore (ScimExternalIdStore) import qualified Spar.Sem.ScimExternalIdStore as ScimExternalIdStore import Spar.Sem.ScimExternalIdStore.Cassandra (scimExternalIdStoreToCassandra) -import Spar.Sem.ScimTokenStore (ScimTokenStore) import Spar.Sem.ScimTokenStore.Cassandra (scimTokenStoreToCassandra) -import Spar.Sem.ScimUserTimesStore (ScimUserTimesStore) import Spar.Sem.ScimUserTimesStore.Cassandra (scimUserTimesStoreToCassandra) -import qualified System.Logger as TinyLog import qualified System.Logger.Extended as Log import System.Random (randomRIO) import Test.Hspec hiding (it, pending, pendingWith, xit) @@ -1247,60 +1234,38 @@ runSimpleSP action = do result <- SAML.runSimpleSP ctx action either (throwIO . ErrorCall . show) pure result -type RealInterpretation = - '[ GalleyAccess, - BrigAccess, - BindCookieStore, - AssIDStore, - AReqIDStore, - ScimExternalIdStore, - ScimUserTimesStore, - ScimTokenStore, - DefaultSsoCode, - IdPEffect.IdP, - SAMLUserStore, - Embed (Cas.Client), - ReaderEff.Reader Opts, - ErrorEff.Error TTLError, - ErrorEff.Error SparError, - Logger String, - Logger (TinyLog.Msg -> TinyLog.Msg), - Random, - Embed IO, - Final IO - ] - runSpar :: (MonadReader TestEnv m, MonadIO m) => Spar.Spar RealInterpretation a -> m a runSpar (Spar.Spar action) = do - env <- (^. teSparEnv) <$> ask + ctx <- (^. teSparEnv) <$> ask liftIO $ do result <- fmap join + . liftIO . runFinal . embedToFinal @IO . randomToIO - . loggerToTinyLog (Spar.sparCtxLogger env) + . runInputConst (Spar.sparCtxLogger ctx) + . runInputConst (Spar.sparCtxOpts ctx) + . loggerToTinyLog (Spar.sparCtxLogger ctx) . stringLoggerToTinyLog - . ErrorEff.runError @SparError + . runError @SparError . ttlErrorToSparError - . ReaderEff.runReader (Spar.sparCtxOpts env) - . interpretClientToIO (Spar.sparCtxCas env) + . galleyAccessToHttp (Spar.sparCtxHttpManager ctx) (Spar.sparCtxHttpGalley ctx) + . brigAccessToHttp (Spar.sparCtxHttpManager ctx) (Spar.sparCtxHttpBrig ctx) + . interpretClientToIO (Spar.sparCtxCas ctx) . samlUserStoreToCassandra @Cas.Client . idPToCassandra @Cas.Client - . defaultSsoCodeToCassandra @Cas.Client - . scimTokenStoreToCassandra @Cas.Client - . scimUserTimesStoreToCassandra @Cas.Client - . scimExternalIdStoreToCassandra @Cas.Client - . aReqIDStoreToCassandra @Cas.Client - . assIDStoreToCassandra @Cas.Client - . bindCookieStoreToCassandra @Cas.Client - . brigAccessToHttp (Spar.sparCtxHttpManager env) (Spar.sparCtxHttpBrig env) - . galleyAccessToHttp (Spar.sparCtxHttpManager env) (Spar.sparCtxHttpBrig env) - . runExceptT - $ runReaderT action env + . defaultSsoCodeToCassandra + . scimTokenStoreToCassandra + . scimUserTimesStoreToCassandra + . scimExternalIdStoreToCassandra + . aReqIDStoreToCassandra + . assIDStoreToCassandra + . bindCookieStoreToCassandra + $ runExceptT action either (throwIO . ErrorCall . show) pure result getSsoidViaSelf :: HasCallStack => UserId -> TestSpar UserSSOId diff --git a/stack.yaml b/stack.yaml index 6a545426778..191946cb296 100644 --- a/stack.yaml +++ b/stack.yaml @@ -175,6 +175,7 @@ extra-deps: - servant-swagger-ui-0.3.4.3.36.1 - tls-1.5.5 - cryptonite-0.28 +- polysemy-1.6.0.0 # needed for Polysemy.Input combinators # 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 3564d9533d9..439ca987af9 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -526,6 +526,13 @@ packages: sha256: 3737ee32d6629b4b915c01911fdb9dc0e255b96233799479c29420d986634726 original: hackage: cryptonite-0.28 +- completed: + hackage: polysemy-1.6.0.0@sha256:29a73b1bf3d0049b12041016b7ee25e76bd8f6e99f9c37c2dde2b46368246697,6184 + pantry-tree: + size: 4577 + sha256: c4ca508b4a6786fc27e0f484344ce8dba119ea2f7fe47fb7379a51313a94cd10 + original: + hackage: polysemy-1.6.0.0 - completed: name: servant-swagger version: 1.1.11 From d6b2abfe2b0e732c4586d9e2eff3a606f9de4624 Mon Sep 17 00:00:00 2001 From: fisx Date: Fri, 1 Oct 2021 09:56:15 +0200 Subject: [PATCH 68/72] Add clarifying comment. (#1548) --- services/galley/test/integration/API/Util.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index cdc059c6412..9e12f6e7dd0 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -154,6 +154,9 @@ createBindingTeamWithMembers numUsers = do members <- forM [2 .. numUsers] $ \n -> do mem <- addUserToTeam owner tid SQS.assertQueue "add member" $ SQS.tUpdate (fromIntegral n) [owner] + -- 'refreshIndex' needs to happen here to make tests more realistic. one effect of + -- refreshing the index once at the end would be that the hard member limit wouldn't hold + -- any more. refreshIndex return $ view Galley.Types.Teams.userId mem From ef40f7758ec25137a6de202b6122b6125dacbd5b Mon Sep 17 00:00:00 2001 From: fisx Date: Fri, 1 Oct 2021 13:20:02 +0200 Subject: [PATCH 69/72] Add missing features to stern/backoffice. (#1829) --- changelog.d/5-internal/stern-features | 1 + tools/stern/src/Stern/Swagger.hs | 13 +++++++++++-- 2 files changed, 12 insertions(+), 2 deletions(-) create mode 100644 changelog.d/5-internal/stern-features diff --git a/changelog.d/5-internal/stern-features b/changelog.d/5-internal/stern-features new file mode 100644 index 00000000000..a08924ee5f0 --- /dev/null +++ b/changelog.d/5-internal/stern-features @@ -0,0 +1 @@ +Update configurable boolean team feature list in backoffice/stern. \ No newline at end of file diff --git a/tools/stern/src/Stern/Swagger.hs b/tools/stern/src/Stern/Swagger.hs index d870836a6da..9ce1575f49d 100644 --- a/tools/stern/src/Stern/Swagger.hs +++ b/tools/stern/src/Stern/Swagger.hs @@ -44,9 +44,18 @@ typeTeamFeatureNameNoConfig = cs . toByteString' <$> [ Public.TeamFeatureLegalHold, Public.TeamFeatureSSO, - Public.TeamFeatureSearchVisibility, + Public.TeamFeatureSearchVisibility, -- TODO: is this working? then remove the custom entry below. Public.TeamFeatureValidateSAMLEmails, - Public.TeamFeatureDigitalSignatures + Public.TeamFeatureDigitalSignatures, + Public.TeamFeatureFileSharing, + Public.TeamFeatureClassifiedDomains, + Public.TeamFeatureConferenceCalling + -- you can keep this list updated by pulling all constructors `c` + -- `Public.TeamFeatureName` for which `TeamFeatureStatus c ~ + -- TeamFeatureStatusNoConfig` + -- + -- TODO: since we can't do this in code without dependent types, make an assertion + -- that we have not missed any. ] emailUpdate :: Model From 3e2b26e6cbbfb4dd6d902d5dc329a663882b83ff Mon Sep 17 00:00:00 2001 From: fisx Date: Fri, 1 Oct 2021 15:22:12 +0200 Subject: [PATCH 70/72] mk-changelog.sh: ignore emacs backup files. (#1817) --- changelog.d/mk-changelog.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/changelog.d/mk-changelog.sh b/changelog.d/mk-changelog.sh index 3d0391dd951..da6998647d8 100755 --- a/changelog.d/mk-changelog.sh +++ b/changelog.d/mk-changelog.sh @@ -16,7 +16,7 @@ for d in "$DIR"/*; do echo -n "## " sed '$ a\' "$d/.title" echo "" - for f in "$d"/*; do + for f in "$d"/*[^~]; do pr=$(getPRNumber $f) sed -r ' # create a bullet point on the first line From 48ac1dab7f375b62cff779d117cb7fa5658542d0 Mon Sep 17 00:00:00 2001 From: fisx Date: Fri, 1 Oct 2021 15:42:13 +0200 Subject: [PATCH 71/72] Expose internal EJPD request end-point to backoffice. (#1831) --- changelog.d/5-internal/stern-ejpd | 1 + tools/stern/src/Stern/API.hs | 15 +++++++++++++++ tools/stern/src/Stern/Intra.hs | 22 ++++++++++++++++++++++ 3 files changed, 38 insertions(+) create mode 100644 changelog.d/5-internal/stern-ejpd diff --git a/changelog.d/5-internal/stern-ejpd b/changelog.d/5-internal/stern-ejpd new file mode 100644 index 00000000000..f4135cf19bc --- /dev/null +++ b/changelog.d/5-internal/stern-ejpd @@ -0,0 +1 @@ +Expose wire.com internal EJDP process to backoffice/stern. \ No newline at end of file diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs index da37f3dc6f9..903c44fa422 100644 --- a/tools/stern/src/Stern/API.hs +++ b/tools/stern/src/Stern/API.hs @@ -262,6 +262,18 @@ routes = do Doc.response 403 "Only teams with 1 user can be deleted" (Doc.model Doc.errorModel) Doc.response 404 "Binding team mismatch" (Doc.model Doc.errorModel) + get "/ejpd-info" (continue ejpdInfoByHandles) $ + param "handles" + .&. def False (query "include_contacts") + document "GET" "ejpd-info" $ do + Doc.summary "internal wire.com process: https://wearezeta.atlassian.net/wiki/spaces/~463749889/pages/256738296/EJPD+official+requests+process" + Doc.parameter Doc.Query "handles" Doc.string' $ + Doc.description "Handles of the user, separated by comments" + Doc.parameter Doc.Query "include_contacts" Doc.bool' $ do + Doc.description "If 'true', this gives you more more exhaustive information about this user (including social network)" + Doc.optional + Doc.response 200 "Required information about the listed users (where found)" Doc.end + head "/users/blacklist" (continue isUserKeyBlacklisted) $ (query "email" ||| phoneParam) document "HEAD" "checkBlacklistStatus" $ do @@ -488,6 +500,9 @@ usersByIds = liftM json . Intra.getUserProfiles . Left . fromList usersByHandles :: List Handle -> Handler Response usersByHandles = liftM json . Intra.getUserProfiles . Right . fromList +ejpdInfoByHandles :: (List Handle ::: Bool) -> Handler Response +ejpdInfoByHandles (handles ::: includeContacts) = json <$> Intra.getEjpdInfo (fromList handles) includeContacts + userConnections :: UserId -> Handler Response userConnections uid = do conns <- Intra.getUserConnections uid diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index a1fa618edd5..86adc975301 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -29,6 +29,7 @@ module Stern.Intra getUsersConnections, getUserProfiles, getUserProfilesByIdentity, + getEjpdInfo, getUserProperties, getInvoiceUrl, revokeIdentity, @@ -77,6 +78,7 @@ import Data.Id import Data.Int import Data.List.Split (chunksOf) import Data.Qualified (qUnqualified) +import Data.String.Conversions (cs) import Data.Text (strip) import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Text.Lazy (pack) @@ -94,6 +96,7 @@ import Stern.Types import System.Logger.Class hiding (Error, name, (.=)) import qualified System.Logger.Class as Log import UnliftIO.Exception hiding (Handler) +import qualified Wire.API.Routes.Internal.Brig.EJPD as EJPD import qualified Wire.API.Team.Feature as Public ------------------------------------------------------------------------------- @@ -226,6 +229,25 @@ getUserProfilesByIdentity emailOrPhone = do ) parseResponse (mkError status502 "bad-upstream") r +getEjpdInfo :: [Handle] -> Bool -> Handler EJPD.EJPDResponseBody +getEjpdInfo handles includeContacts = do + info $ msg "Getting ejpd info on users by handle" + b <- view brig + let bdy :: Value + bdy = object ["ejpd_request" .= ((cs @_ @Text . toByteString') <$> handles)] + r <- + catchRpcErrors $ + rpc' + "brig" + b + ( method POST + . path "/i/ejpd-request" + . Bilge.json bdy + . (if includeContacts then queryItem "include_contacts" "true" else id) + . expect2xx + ) + parseResponse (mkError status502 "bad-upstream") r + getContacts :: UserId -> Text -> Int32 -> Handler (SearchResult Contact) getContacts u q s = do info $ msg "Getting user contacts" From d98b14244ca24df5953594119832fbf13b0f8def Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Fri, 1 Oct 2021 23:45:00 +0200 Subject: [PATCH 72/72] CHANGELOG --- CHANGELOG.md | 93 +++++++++++++++++++ changelog.d/0-release-notes/pr-1763 | 1 - changelog.d/0-release-notes/pr-1773 | 1 - changelog.d/0-release-notes/pr-1811 | 1 - changelog.d/0-release-notes/pr-1811-1 | 1 - .../1-api-changes/create-connection.md | 1 - changelog.d/1-api-changes/deprecate-access | 1 - .../deprecate-messager-timer-update | 1 - .../deprecate-other-member-update | 1 - .../deprecate-receipt-mode-update | 1 - changelog.d/1-api-changes/get-connection.md | 1 - changelog.d/1-api-changes/list-connections.md | 1 - changelog.d/1-api-changes/qualified-access | 1 - .../qualified-message-timer-update | 1 - .../qualified-other-member-update | 1 - .../qualified-receipt-mode-update | 1 - .../1-api-changes/update-connection.md | 1 - changelog.d/2-features/pr-1709 | 1 - changelog.d/2-features/pr-1811 | 1 - changelog.d/3-bug-fixes/pr-1763 | 1 - changelog.d/3-bug-fixes/pr-1763-2 | 1 - changelog.d/4-docs/list-ids | 1 - changelog.d/4-docs/multitable-docs | 1 - changelog.d/4-docs/pr-1763 | 1 - changelog.d/4-docs/reference-schemas | 1 - .../5-internal/abstract-multi-table-paging | 1 - .../5-internal/applicative-style-generators | 1 - changelog.d/5-internal/conv-size-limit-test | 1 - changelog.d/5-internal/delete-self-to-servant | 1 - changelog.d/5-internal/fix-conv-generator | 1 - changelog.d/5-internal/idp-effect | 1 - changelog.d/5-internal/last-spar-effects | 1 - changelog.d/5-internal/logger-effect | 1 - .../5-internal/member-update-refactoring | 3 - changelog.d/5-internal/merge-http2-client-fix | 1 - changelog.d/5-internal/misc-effects | 1 - changelog.d/5-internal/ncurses-deps | 1 - changelog.d/5-internal/pr-1763 | 5 - changelog.d/5-internal/raw-effect-row | 1 - .../5-internal/reduce-json-golden-tests | 1 - .../5-internal/remove-explicit-errdesc | 1 - changelog.d/5-internal/remove-flaky-test | 1 - .../5-internal/report-all-failures-at-once | 1 - changelog.d/5-internal/servantify-access | 1 - changelog.d/5-internal/servantify-connections | 1 - .../5-internal/servantify-delete-i-user | 1 - .../5-internal/servantify-message-timer | 1 - .../5-internal/servantify-other-member-update | 1 - .../5-internal/servantify-receipt-mode | 1 - changelog.d/5-internal/spar-no-io | 1 - changelog.d/5-internal/spar-no-monad-reader | 1 - changelog.d/5-internal/spar-random-effects | 1 - changelog.d/5-internal/stern-ejpd | 1 - changelog.d/5-internal/stern-features | 1 - changelog.d/5-internal/various-fixes-3 | 1 - changelog.d/6-federation/chain-of-trust | 1 - changelog.d/6-federation/convention | 1 - changelog.d/6-federation/fed-access | 1 - .../6-federation/fed-conv-member-update | 1 - .../6-federation/fed-conv-message-timer | 1 - changelog.d/6-federation/fed-conv-rename | 1 - .../fed-conv-update-notifications | 1 - changelog.d/6-federation/fed-receipt-mode | 1 - .../6-federation/fed-update-remote-members | 1 - .../new-remote-conversation-unqualify | 1 - changelog.d/6-federation/pr-1773 | 1 - .../6-federation/qualified-connections.md | 1 - .../6-federation/remote-connections-migration | 1 - .../remote-conversations-when-deleting-user | 1 - changelog.d/6-federation/search-endpoint | 1 - changelog.d/6-federation/self-member-status | 1 - 71 files changed, 93 insertions(+), 76 deletions(-) delete mode 100644 changelog.d/0-release-notes/pr-1763 delete mode 100644 changelog.d/0-release-notes/pr-1773 delete mode 100644 changelog.d/0-release-notes/pr-1811 delete mode 100644 changelog.d/0-release-notes/pr-1811-1 delete mode 100644 changelog.d/1-api-changes/create-connection.md delete mode 100644 changelog.d/1-api-changes/deprecate-access delete mode 100644 changelog.d/1-api-changes/deprecate-messager-timer-update delete mode 100644 changelog.d/1-api-changes/deprecate-other-member-update delete mode 100644 changelog.d/1-api-changes/deprecate-receipt-mode-update delete mode 100644 changelog.d/1-api-changes/get-connection.md delete mode 100644 changelog.d/1-api-changes/list-connections.md delete mode 100644 changelog.d/1-api-changes/qualified-access delete mode 100644 changelog.d/1-api-changes/qualified-message-timer-update delete mode 100644 changelog.d/1-api-changes/qualified-other-member-update delete mode 100644 changelog.d/1-api-changes/qualified-receipt-mode-update delete mode 100644 changelog.d/1-api-changes/update-connection.md delete mode 100644 changelog.d/2-features/pr-1709 delete mode 100644 changelog.d/2-features/pr-1811 delete mode 100644 changelog.d/3-bug-fixes/pr-1763 delete mode 100644 changelog.d/3-bug-fixes/pr-1763-2 delete mode 100644 changelog.d/4-docs/list-ids delete mode 100644 changelog.d/4-docs/multitable-docs delete mode 100644 changelog.d/4-docs/pr-1763 delete mode 100644 changelog.d/4-docs/reference-schemas delete mode 100644 changelog.d/5-internal/abstract-multi-table-paging delete mode 100644 changelog.d/5-internal/applicative-style-generators delete mode 100644 changelog.d/5-internal/conv-size-limit-test delete mode 100644 changelog.d/5-internal/delete-self-to-servant delete mode 100644 changelog.d/5-internal/fix-conv-generator delete mode 100644 changelog.d/5-internal/idp-effect delete mode 100644 changelog.d/5-internal/last-spar-effects delete mode 100644 changelog.d/5-internal/logger-effect delete mode 100644 changelog.d/5-internal/member-update-refactoring delete mode 100644 changelog.d/5-internal/merge-http2-client-fix delete mode 100644 changelog.d/5-internal/misc-effects delete mode 100644 changelog.d/5-internal/ncurses-deps delete mode 100644 changelog.d/5-internal/pr-1763 delete mode 100644 changelog.d/5-internal/raw-effect-row delete mode 100644 changelog.d/5-internal/reduce-json-golden-tests delete mode 100644 changelog.d/5-internal/remove-explicit-errdesc delete mode 100644 changelog.d/5-internal/remove-flaky-test delete mode 100644 changelog.d/5-internal/report-all-failures-at-once delete mode 100644 changelog.d/5-internal/servantify-access delete mode 100644 changelog.d/5-internal/servantify-connections delete mode 100644 changelog.d/5-internal/servantify-delete-i-user delete mode 100644 changelog.d/5-internal/servantify-message-timer delete mode 100644 changelog.d/5-internal/servantify-other-member-update delete mode 100644 changelog.d/5-internal/servantify-receipt-mode delete mode 100644 changelog.d/5-internal/spar-no-io delete mode 100644 changelog.d/5-internal/spar-no-monad-reader delete mode 100644 changelog.d/5-internal/spar-random-effects delete mode 100644 changelog.d/5-internal/stern-ejpd delete mode 100644 changelog.d/5-internal/stern-features delete mode 100644 changelog.d/5-internal/various-fixes-3 delete mode 100644 changelog.d/6-federation/chain-of-trust delete mode 100644 changelog.d/6-federation/convention delete mode 100644 changelog.d/6-federation/fed-access delete mode 100644 changelog.d/6-federation/fed-conv-member-update delete mode 100644 changelog.d/6-federation/fed-conv-message-timer delete mode 100644 changelog.d/6-federation/fed-conv-rename delete mode 100644 changelog.d/6-federation/fed-conv-update-notifications delete mode 100644 changelog.d/6-federation/fed-receipt-mode delete mode 100644 changelog.d/6-federation/fed-update-remote-members delete mode 100644 changelog.d/6-federation/new-remote-conversation-unqualify delete mode 100644 changelog.d/6-federation/pr-1773 delete mode 100644 changelog.d/6-federation/qualified-connections.md delete mode 100644 changelog.d/6-federation/remote-connections-migration delete mode 100644 changelog.d/6-federation/remote-conversations-when-deleting-user delete mode 100644 changelog.d/6-federation/search-endpoint delete mode 100644 changelog.d/6-federation/self-member-status diff --git a/CHANGELOG.md b/CHANGELOG.md index 8c18c7df3bb..cf1a2d9807f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,98 @@ +# [2021-10-01] + +## Release notes + +* Deploy brig before galley (#1811, #1818) +* The conference call initiation feature can now be configured for personal accounts in `brig.yaml`. `enabled` is the default and the previous behavior. If you want to change that, read [/docs/reference/config-options.md#conference-calling-1](https://github.com/wireapp/wire-server/blob/develop/docs/reference/config-options.md#conference-calling-1) (#1811, #1818) +* Only if you are an early adopter of multi-team IdP issuers on release [2021-09-14](https://github.com/wireapp/wire-server/releases/tag/v2021-09-14): note that the [query parameter for IdP creation has changed](https://github.com/wireapp/wire-server/pull/1763/files#diff-bd66bf2f3a2445e08650535a431fc33cc1f6a9e0763c7afd9c9d3f2d67fac196). This only affects future calls to this one end-point. (#1763) +* For wire.com cloud operators: reminder to also deploy nginz. (No special action needed for on-premise operators) (#1773) + +## API changes + +* Add endpoint `POST /connections/:domain/:userId` to create a connection (#1773) +* Deprecate `PUT /conversations/:cnv/access` endpoint (#1807) +* Deprecate `PUT /conversations/:cnv/message-timer` endpoint (#1780) +* Deprecate `PUT /conversations/:cnv/members/:usr` endpoint (#1784) +* Deprecate `PUT /conversations/:cnv/receipt-mode` endpoint (#1797) +* Add endpoint `GET /connections/:domain/:userId` to get a single connection (#1773) +* Add `POST /list-connections` endpoint to get connections (#1773) +* Add qualified endpoint for updating conversation access (#1807) +* Add qualified endpoint for updating message timer (#1780) +* Add qualified endpoint for updating conversation members (#1784) +* Add qualified endpoint for updating receipt mode (#1797) +* Add endpoint `PUT /connections/:domain/:userId` to update a connection (#1773) + +## Features + +* Helm charts to deploy [ldap-scim-bridge](https://github.com/wireapp/ldap-scim-bridge) (#1709) +* Per-account configuration of conference call initiation (details: /docs/reference/config-options.md#conference-calling-1) (#1811, #1818) + +## Bug fixes and other updates + +* An attempt to create a 3rd IdP with the same issuer was triggering an exception. (#1763) +* When a user was auto-provisioned into two teams under the same pair of `Issuer` and `NameID`, they where directed into the wrong team, and not rejected. (#1763) + +## Documentation + +* Expand documentation of `conversations/list-ids` endpoint (#1779) +* Add documentation of the multi-table paging abstraction (#1803) +* Document how to use IdP issuers for multiple teams (#1763) +* All named Swagger schemas are now displayed in the Swagger UI (#1802) + +## Internal changes + +* Abstract out multi-table-pagination used in list conversation-ids endpoint (#1788) +* Testing: rewrite monadic to applicative style generators (#1782) +* Add a test checking that creating conversations of exactly the size limit is allowed (#1820) +* Rewrite the DELETE /self endpoint to Servant (#1771) +* Fix conversation generator in mapping test (#1778) +* Polysemize spar (#1806, #1787, #1793, #1814, #1792, #1781, #1786, #1810, #1816, #1815) +* Refactored a few functions dealing with conversation updates, in an attempt to + make the conversation update code paths more uniform, and also reduce special + cases for local and remote objects. (#1801) +* Merged http2-client fixes as mentioned in the comments of #1703 (#1809) +* Some executables now have a runtime dependency on ncurses (#1791) +* Minor changes around SAML and multi-team Issuers. + - Change query param to not contain `-`, but `_`. (This is considered an internal change because the feature has been release in the last release, but only been documented in this one.) + - Haddocks. + - Simplify code. + - Remove unnecessary calls to cassandra. (#1763) +* Clean up JSON Golden Tests (Part 6) (#1769) +* Remove explicit instantiations of ErrorDescription (#1794) +* Remove one flaky integration test about ordering of search results (#1798) +* Report all failures in JSON golden tests in a group at once (#1746) +* Convert the `PUT /conversations/:cnv/access` endpoint to Servant (#1807) +* Move /connections/* endpoints to Servant (#1770) +* Servantify Galley's DELETE /i/user endpoint (#1772) +* Convert the `PUT /conversations/:cnv/message-timer` endpoint to Servant (#1780) +* Convert the `PUT /conversations/:cnv/members/:usr` endpoint to Servant (#1796) +* Convert the `PUT /conversations/:cnv/receipt-mode` endpoint to Servant (#1797) +* Expose wire.com internal EJDP process to backoffice/stern. (#1831) +* Update configurable boolean team feature list in backoffice/stern. (#1829) +* Handle upper/lower case more consistently in scim and rich-info data. (#1754) + +## Federation changes + +* Add value for verification depth of client certificates in federator ingress (#1812) +* Document federation API conventions and align already existing APIs (#1765) +* Notify remote users when a conversation access settings are updated (#1808) +* Notify remote users when a conversation member role is updated (#1785) +* Notify remote users when a conversation message timer is updated (#1783) +* Notify remote users when a conversation is renamed (#1767) +* Make sure that only users that are actually part of a conversation get notified about updates in the conversation metadata (#1767) +* Notify remote users when a conversation receipt mode is updated (#1801) +* Implement updates to remote members (#1785) +* Make conversation ID of the on-conversation-created RPC unqualified (#1766) +* 4 endpoints for create/update/get/list connections designed for remote users in mind. So far, the implementation only works for local users (actual implementation will come as a follow-up) (#1773) +* The returned `connection` object now has a `qualified_to` field with the domain of the (potentially remote) user. (#1773) +* Add migration for remote connection table (#1789) +* Remove a user from remote conversations upon deleting their account (#1790) +* Remove elasticsearch specific details from the search endpoint (#1768) +* Added support for updating self member status of remote conversations (#1753) + + # [2021-09-14] ## API changes diff --git a/changelog.d/0-release-notes/pr-1763 b/changelog.d/0-release-notes/pr-1763 deleted file mode 100644 index 80f3c3a16b2..00000000000 --- a/changelog.d/0-release-notes/pr-1763 +++ /dev/null @@ -1 +0,0 @@ -*Only if you are an early adopter of multi-team IdP issuers on release* [2021-09-14](https://github.com/wireapp/wire-server/releases/tag/v2021-09-14): that the [query parameter for IdP creation has changed](https://github.com/wireapp/wire-server/pull/1763/files#diff-bd66bf2f3a2445e08650535a431fc33cc1f6a9e0763c7afd9c9d3f2d67fac196). This only affects future calls to this one end-point. \ No newline at end of file diff --git a/changelog.d/0-release-notes/pr-1773 b/changelog.d/0-release-notes/pr-1773 deleted file mode 100644 index e7fc3d3137f..00000000000 --- a/changelog.d/0-release-notes/pr-1773 +++ /dev/null @@ -1 +0,0 @@ -For Wire.com Cloud operators: Reminder to also deploy nginz. (No special action needed for on-premise operators) diff --git a/changelog.d/0-release-notes/pr-1811 b/changelog.d/0-release-notes/pr-1811 deleted file mode 100644 index 16a31194c6c..00000000000 --- a/changelog.d/0-release-notes/pr-1811 +++ /dev/null @@ -1 +0,0 @@ -Deploy brig before galley (#1811, #1818) diff --git a/changelog.d/0-release-notes/pr-1811-1 b/changelog.d/0-release-notes/pr-1811-1 deleted file mode 100644 index 2ead169866b..00000000000 --- a/changelog.d/0-release-notes/pr-1811-1 +++ /dev/null @@ -1 +0,0 @@ -The conference call initiation feature can now be configured for personal accounts in `brig.yaml`. `enabled` is the default and the previous behavior. If you want to change that, read [/docs/reference/config-options.md#conference-calling-1](https://github.com/wireapp/wire-server/blob/develop/docs/reference/config-options.md#conference-calling-1) (#1811, #1818) \ No newline at end of file diff --git a/changelog.d/1-api-changes/create-connection.md b/changelog.d/1-api-changes/create-connection.md deleted file mode 100644 index 1d0e494731c..00000000000 --- a/changelog.d/1-api-changes/create-connection.md +++ /dev/null @@ -1 +0,0 @@ -Add endpoint `POST /connections/:domain/:userId` to create a connection diff --git a/changelog.d/1-api-changes/deprecate-access b/changelog.d/1-api-changes/deprecate-access deleted file mode 100644 index 08737dedb6d..00000000000 --- a/changelog.d/1-api-changes/deprecate-access +++ /dev/null @@ -1 +0,0 @@ -Deprecate `PUT /conversations/:cnv/access` endpoint diff --git a/changelog.d/1-api-changes/deprecate-messager-timer-update b/changelog.d/1-api-changes/deprecate-messager-timer-update deleted file mode 100644 index 07756d902fb..00000000000 --- a/changelog.d/1-api-changes/deprecate-messager-timer-update +++ /dev/null @@ -1 +0,0 @@ -Deprecate `PUT /conversations/:cnv/message-timer` endpoint diff --git a/changelog.d/1-api-changes/deprecate-other-member-update b/changelog.d/1-api-changes/deprecate-other-member-update deleted file mode 100644 index 52c6712c2e4..00000000000 --- a/changelog.d/1-api-changes/deprecate-other-member-update +++ /dev/null @@ -1 +0,0 @@ -Deprecate `PUT /conversations/:cnv/members/:usr` endpoint diff --git a/changelog.d/1-api-changes/deprecate-receipt-mode-update b/changelog.d/1-api-changes/deprecate-receipt-mode-update deleted file mode 100644 index 76510907a57..00000000000 --- a/changelog.d/1-api-changes/deprecate-receipt-mode-update +++ /dev/null @@ -1 +0,0 @@ -Deprecate `PUT /conversations/:cnv/receipt-mode` endpoint diff --git a/changelog.d/1-api-changes/get-connection.md b/changelog.d/1-api-changes/get-connection.md deleted file mode 100644 index 40c8876aa96..00000000000 --- a/changelog.d/1-api-changes/get-connection.md +++ /dev/null @@ -1 +0,0 @@ -Add endpoint `GET /connections/:domain/:userId` to get a single connection diff --git a/changelog.d/1-api-changes/list-connections.md b/changelog.d/1-api-changes/list-connections.md deleted file mode 100644 index d0943540ee8..00000000000 --- a/changelog.d/1-api-changes/list-connections.md +++ /dev/null @@ -1 +0,0 @@ -Add `POST /list-connections` endpoint to get connections diff --git a/changelog.d/1-api-changes/qualified-access b/changelog.d/1-api-changes/qualified-access deleted file mode 100644 index 8f973881301..00000000000 --- a/changelog.d/1-api-changes/qualified-access +++ /dev/null @@ -1 +0,0 @@ -Add qualified endpoint for updating conversation access diff --git a/changelog.d/1-api-changes/qualified-message-timer-update b/changelog.d/1-api-changes/qualified-message-timer-update deleted file mode 100644 index f80853678c3..00000000000 --- a/changelog.d/1-api-changes/qualified-message-timer-update +++ /dev/null @@ -1 +0,0 @@ -Add qualified endpoint for updating message timer diff --git a/changelog.d/1-api-changes/qualified-other-member-update b/changelog.d/1-api-changes/qualified-other-member-update deleted file mode 100644 index 45185a56848..00000000000 --- a/changelog.d/1-api-changes/qualified-other-member-update +++ /dev/null @@ -1 +0,0 @@ -Add qualified endpoint for updating conversation members diff --git a/changelog.d/1-api-changes/qualified-receipt-mode-update b/changelog.d/1-api-changes/qualified-receipt-mode-update deleted file mode 100644 index 9cd14f7fd9c..00000000000 --- a/changelog.d/1-api-changes/qualified-receipt-mode-update +++ /dev/null @@ -1 +0,0 @@ -Add qualified endpoint for updating receipt mode diff --git a/changelog.d/1-api-changes/update-connection.md b/changelog.d/1-api-changes/update-connection.md deleted file mode 100644 index 1d90098bf4f..00000000000 --- a/changelog.d/1-api-changes/update-connection.md +++ /dev/null @@ -1 +0,0 @@ -Add endpoint `PUT /connections/:domain/:userId` to update a connection diff --git a/changelog.d/2-features/pr-1709 b/changelog.d/2-features/pr-1709 deleted file mode 100644 index ea40a2e527b..00000000000 --- a/changelog.d/2-features/pr-1709 +++ /dev/null @@ -1 +0,0 @@ -Helm charts to deploy [ldap-scim-bridge](https://github.com/wireapp/ldap-scim-bridge) \ No newline at end of file diff --git a/changelog.d/2-features/pr-1811 b/changelog.d/2-features/pr-1811 deleted file mode 100644 index a54efbd025f..00000000000 --- a/changelog.d/2-features/pr-1811 +++ /dev/null @@ -1 +0,0 @@ -Per-account configuration of conference call initiation (details: /docs/reference/config-options.md#conference-calling-1) (#1811, #1818) diff --git a/changelog.d/3-bug-fixes/pr-1763 b/changelog.d/3-bug-fixes/pr-1763 deleted file mode 100644 index 0fe1a26a91c..00000000000 --- a/changelog.d/3-bug-fixes/pr-1763 +++ /dev/null @@ -1 +0,0 @@ -An attempt to create a 3rd IdP with the same issuer was triggering an exception. \ No newline at end of file diff --git a/changelog.d/3-bug-fixes/pr-1763-2 b/changelog.d/3-bug-fixes/pr-1763-2 deleted file mode 100644 index 93dd86ef48c..00000000000 --- a/changelog.d/3-bug-fixes/pr-1763-2 +++ /dev/null @@ -1 +0,0 @@ -When a user was auto-provisioned into two teams under the same pair of `Issuer` and `NameID`, they where directed into the wrong team, and not rejected. \ No newline at end of file diff --git a/changelog.d/4-docs/list-ids b/changelog.d/4-docs/list-ids deleted file mode 100644 index bfaf84fc366..00000000000 --- a/changelog.d/4-docs/list-ids +++ /dev/null @@ -1 +0,0 @@ -Expand documentation of `conversations/list-ids` endpoint diff --git a/changelog.d/4-docs/multitable-docs b/changelog.d/4-docs/multitable-docs deleted file mode 100644 index d648dfe4ce1..00000000000 --- a/changelog.d/4-docs/multitable-docs +++ /dev/null @@ -1 +0,0 @@ -Add documentation of the multi-table paging abstraction diff --git a/changelog.d/4-docs/pr-1763 b/changelog.d/4-docs/pr-1763 deleted file mode 100644 index 9ad084f071d..00000000000 --- a/changelog.d/4-docs/pr-1763 +++ /dev/null @@ -1 +0,0 @@ -Document how to use IdP issuers for multiple teams diff --git a/changelog.d/4-docs/reference-schemas b/changelog.d/4-docs/reference-schemas deleted file mode 100644 index 825bdb78edf..00000000000 --- a/changelog.d/4-docs/reference-schemas +++ /dev/null @@ -1 +0,0 @@ -All named Swagger schemas are now displayed in the Swagger UI diff --git a/changelog.d/5-internal/abstract-multi-table-paging b/changelog.d/5-internal/abstract-multi-table-paging deleted file mode 100644 index 74925882af6..00000000000 --- a/changelog.d/5-internal/abstract-multi-table-paging +++ /dev/null @@ -1 +0,0 @@ -Abstract out multi-table-pagination used in list conversation-ids endpoint \ No newline at end of file diff --git a/changelog.d/5-internal/applicative-style-generators b/changelog.d/5-internal/applicative-style-generators deleted file mode 100644 index d9d4c5a4346..00000000000 --- a/changelog.d/5-internal/applicative-style-generators +++ /dev/null @@ -1 +0,0 @@ -Testing: rewrite monadic to applicative style generators diff --git a/changelog.d/5-internal/conv-size-limit-test b/changelog.d/5-internal/conv-size-limit-test deleted file mode 100644 index 63fde18ce08..00000000000 --- a/changelog.d/5-internal/conv-size-limit-test +++ /dev/null @@ -1 +0,0 @@ -Add a test checking that creating conversations of exactly the size limit is allowed diff --git a/changelog.d/5-internal/delete-self-to-servant b/changelog.d/5-internal/delete-self-to-servant deleted file mode 100644 index fc715936157..00000000000 --- a/changelog.d/5-internal/delete-self-to-servant +++ /dev/null @@ -1 +0,0 @@ -Rewrite the DELETE /self endpoint to Servant diff --git a/changelog.d/5-internal/fix-conv-generator b/changelog.d/5-internal/fix-conv-generator deleted file mode 100644 index 9cbc05efcb6..00000000000 --- a/changelog.d/5-internal/fix-conv-generator +++ /dev/null @@ -1 +0,0 @@ -Fix conversation generator in mapping test diff --git a/changelog.d/5-internal/idp-effect b/changelog.d/5-internal/idp-effect deleted file mode 100644 index 0c0f28c3123..00000000000 --- a/changelog.d/5-internal/idp-effect +++ /dev/null @@ -1 +0,0 @@ -Spar: Extract IdP effect into Polysemy (#1787, #1793) diff --git a/changelog.d/5-internal/last-spar-effects b/changelog.d/5-internal/last-spar-effects deleted file mode 100644 index 02ec91eaca2..00000000000 --- a/changelog.d/5-internal/last-spar-effects +++ /dev/null @@ -1 +0,0 @@ -Polysemize the remainder of Spar's Cassandra effects diff --git a/changelog.d/5-internal/logger-effect b/changelog.d/5-internal/logger-effect deleted file mode 100644 index 21d7bf364fa..00000000000 --- a/changelog.d/5-internal/logger-effect +++ /dev/null @@ -1 +0,0 @@ -Add a Logger effect to Spar diff --git a/changelog.d/5-internal/member-update-refactoring b/changelog.d/5-internal/member-update-refactoring deleted file mode 100644 index 7356fde95b4..00000000000 --- a/changelog.d/5-internal/member-update-refactoring +++ /dev/null @@ -1,3 +0,0 @@ -Refactored a few functions dealing with conversation updates, in an attempt to -make the conversation update code paths more uniform, and also reduce special -cases for local and remote objects. diff --git a/changelog.d/5-internal/merge-http2-client-fix b/changelog.d/5-internal/merge-http2-client-fix deleted file mode 100644 index 0559d5c7734..00000000000 --- a/changelog.d/5-internal/merge-http2-client-fix +++ /dev/null @@ -1 +0,0 @@ -Merged http2-client fixes as mentioned in the comments of #1703 diff --git a/changelog.d/5-internal/misc-effects b/changelog.d/5-internal/misc-effects deleted file mode 100644 index c9dffe42031..00000000000 --- a/changelog.d/5-internal/misc-effects +++ /dev/null @@ -1 +0,0 @@ -Pull more polysemy effects out of Spar. diff --git a/changelog.d/5-internal/ncurses-deps b/changelog.d/5-internal/ncurses-deps deleted file mode 100644 index cde9f1140d1..00000000000 --- a/changelog.d/5-internal/ncurses-deps +++ /dev/null @@ -1 +0,0 @@ -Some executables now have a runtime dependency on ncurses diff --git a/changelog.d/5-internal/pr-1763 b/changelog.d/5-internal/pr-1763 deleted file mode 100644 index b9c57ee39c2..00000000000 --- a/changelog.d/5-internal/pr-1763 +++ /dev/null @@ -1,5 +0,0 @@ -Minor changes around SAML and multi-team Issuers. -- Change query param to not contain `-`, but `_`. (This is considered an internal change because the feature has been release in the last release, but only been documented in this one.) -- Haddocks. -- Simplify code. -- Remove unnecessary calls to cassandra. diff --git a/changelog.d/5-internal/raw-effect-row b/changelog.d/5-internal/raw-effect-row deleted file mode 100644 index 1ecad681e03..00000000000 --- a/changelog.d/5-internal/raw-effect-row +++ /dev/null @@ -1 +0,0 @@ -Add polysemy to spar; promote the SAMLUser CRUD interface to an effect (#1781, #1786) \ No newline at end of file diff --git a/changelog.d/5-internal/reduce-json-golden-tests b/changelog.d/5-internal/reduce-json-golden-tests deleted file mode 100644 index 1470dd69b9e..00000000000 --- a/changelog.d/5-internal/reduce-json-golden-tests +++ /dev/null @@ -1 +0,0 @@ -Clean up JSON Golden Tests (Part 6) diff --git a/changelog.d/5-internal/remove-explicit-errdesc b/changelog.d/5-internal/remove-explicit-errdesc deleted file mode 100644 index 1d73b72958e..00000000000 --- a/changelog.d/5-internal/remove-explicit-errdesc +++ /dev/null @@ -1 +0,0 @@ -Remove explicit instantiations of ErrorDescription diff --git a/changelog.d/5-internal/remove-flaky-test b/changelog.d/5-internal/remove-flaky-test deleted file mode 100644 index ac7e06b671f..00000000000 --- a/changelog.d/5-internal/remove-flaky-test +++ /dev/null @@ -1 +0,0 @@ -Remove one flaky integration test about ordering of search results diff --git a/changelog.d/5-internal/report-all-failures-at-once b/changelog.d/5-internal/report-all-failures-at-once deleted file mode 100644 index 4da415b60e6..00000000000 --- a/changelog.d/5-internal/report-all-failures-at-once +++ /dev/null @@ -1 +0,0 @@ -Report all failures in JSON golden tests in a group at once diff --git a/changelog.d/5-internal/servantify-access b/changelog.d/5-internal/servantify-access deleted file mode 100644 index e6c4ee8030a..00000000000 --- a/changelog.d/5-internal/servantify-access +++ /dev/null @@ -1 +0,0 @@ -Convert the `PUT /conversations/:cnv/access` endpoint to Servant diff --git a/changelog.d/5-internal/servantify-connections b/changelog.d/5-internal/servantify-connections deleted file mode 100644 index d99ace3e49d..00000000000 --- a/changelog.d/5-internal/servantify-connections +++ /dev/null @@ -1 +0,0 @@ -Move /connections/* endpoints to Servant diff --git a/changelog.d/5-internal/servantify-delete-i-user b/changelog.d/5-internal/servantify-delete-i-user deleted file mode 100644 index 4749699e651..00000000000 --- a/changelog.d/5-internal/servantify-delete-i-user +++ /dev/null @@ -1 +0,0 @@ -Servantify Galley's DELETE /i/user endpoint diff --git a/changelog.d/5-internal/servantify-message-timer b/changelog.d/5-internal/servantify-message-timer deleted file mode 100644 index ffdd35057f5..00000000000 --- a/changelog.d/5-internal/servantify-message-timer +++ /dev/null @@ -1 +0,0 @@ -Convert the `PUT /conversations/:cnv/message-timer` endpoint to Servant diff --git a/changelog.d/5-internal/servantify-other-member-update b/changelog.d/5-internal/servantify-other-member-update deleted file mode 100644 index ce3f92bc3fa..00000000000 --- a/changelog.d/5-internal/servantify-other-member-update +++ /dev/null @@ -1 +0,0 @@ -Convert the `PUT /conversations/:cnv/members/:usr` endpoint to Servant diff --git a/changelog.d/5-internal/servantify-receipt-mode b/changelog.d/5-internal/servantify-receipt-mode deleted file mode 100644 index 03433eb286f..00000000000 --- a/changelog.d/5-internal/servantify-receipt-mode +++ /dev/null @@ -1 +0,0 @@ -Convert the `PUT /conversations/:cnv/receipt-mode` endpoint to Servant diff --git a/changelog.d/5-internal/spar-no-io b/changelog.d/5-internal/spar-no-io deleted file mode 100644 index 31c02e241cf..00000000000 --- a/changelog.d/5-internal/spar-no-io +++ /dev/null @@ -1 +0,0 @@ -This PR pulls apart the Spar.Intra.(Brig|Galley) modules into polysemy effects, as part of ongoing work to excise all IO from Spar. diff --git a/changelog.d/5-internal/spar-no-monad-reader b/changelog.d/5-internal/spar-no-monad-reader deleted file mode 100644 index 7eec0fb1971..00000000000 --- a/changelog.d/5-internal/spar-no-monad-reader +++ /dev/null @@ -1 +0,0 @@ -Remove the ReaderT inside of the Spar newtype diff --git a/changelog.d/5-internal/spar-random-effects b/changelog.d/5-internal/spar-random-effects deleted file mode 100644 index c2f28fe7a31..00000000000 --- a/changelog.d/5-internal/spar-random-effects +++ /dev/null @@ -1 +0,0 @@ -Minimizes the MonadIO footprint still in Spar, by creating an effect that can generate random things diff --git a/changelog.d/5-internal/stern-ejpd b/changelog.d/5-internal/stern-ejpd deleted file mode 100644 index f4135cf19bc..00000000000 --- a/changelog.d/5-internal/stern-ejpd +++ /dev/null @@ -1 +0,0 @@ -Expose wire.com internal EJDP process to backoffice/stern. \ No newline at end of file diff --git a/changelog.d/5-internal/stern-features b/changelog.d/5-internal/stern-features deleted file mode 100644 index a08924ee5f0..00000000000 --- a/changelog.d/5-internal/stern-features +++ /dev/null @@ -1 +0,0 @@ -Update configurable boolean team feature list in backoffice/stern. \ No newline at end of file diff --git a/changelog.d/5-internal/various-fixes-3 b/changelog.d/5-internal/various-fixes-3 deleted file mode 100644 index ce09daa6efb..00000000000 --- a/changelog.d/5-internal/various-fixes-3 +++ /dev/null @@ -1 +0,0 @@ -Handle upper/lower case more consistently in scim and rich-info data. \ No newline at end of file diff --git a/changelog.d/6-federation/chain-of-trust b/changelog.d/6-federation/chain-of-trust deleted file mode 100644 index 3e8cd94baee..00000000000 --- a/changelog.d/6-federation/chain-of-trust +++ /dev/null @@ -1 +0,0 @@ -Add value for verification depth of client certificates in federator ingress diff --git a/changelog.d/6-federation/convention b/changelog.d/6-federation/convention deleted file mode 100644 index fee1c0d66af..00000000000 --- a/changelog.d/6-federation/convention +++ /dev/null @@ -1 +0,0 @@ -Document federation API conventions and align already existing APIs \ No newline at end of file diff --git a/changelog.d/6-federation/fed-access b/changelog.d/6-federation/fed-access deleted file mode 100644 index 47bc0db4897..00000000000 --- a/changelog.d/6-federation/fed-access +++ /dev/null @@ -1 +0,0 @@ -Notify remote users when a conversation access settings are updated diff --git a/changelog.d/6-federation/fed-conv-member-update b/changelog.d/6-federation/fed-conv-member-update deleted file mode 100644 index b3e0b3156a0..00000000000 --- a/changelog.d/6-federation/fed-conv-member-update +++ /dev/null @@ -1 +0,0 @@ -Notify remote users when a conversation member role is updated diff --git a/changelog.d/6-federation/fed-conv-message-timer b/changelog.d/6-federation/fed-conv-message-timer deleted file mode 100644 index db7879953b7..00000000000 --- a/changelog.d/6-federation/fed-conv-message-timer +++ /dev/null @@ -1 +0,0 @@ -Notify remote users when a conversation message timer is updated diff --git a/changelog.d/6-federation/fed-conv-rename b/changelog.d/6-federation/fed-conv-rename deleted file mode 100644 index 702e3c332c4..00000000000 --- a/changelog.d/6-federation/fed-conv-rename +++ /dev/null @@ -1 +0,0 @@ -Notify remote users when a conversation is renamed diff --git a/changelog.d/6-federation/fed-conv-update-notifications b/changelog.d/6-federation/fed-conv-update-notifications deleted file mode 100644 index 64d2525b1ce..00000000000 --- a/changelog.d/6-federation/fed-conv-update-notifications +++ /dev/null @@ -1 +0,0 @@ -Make sure that only users that are actually part of a conversation get notified about updates in the conversation metadata diff --git a/changelog.d/6-federation/fed-receipt-mode b/changelog.d/6-federation/fed-receipt-mode deleted file mode 100644 index ef5ba52aba7..00000000000 --- a/changelog.d/6-federation/fed-receipt-mode +++ /dev/null @@ -1 +0,0 @@ -Notify remote users when a conversation receipt mode is updated diff --git a/changelog.d/6-federation/fed-update-remote-members b/changelog.d/6-federation/fed-update-remote-members deleted file mode 100644 index afbf8e98ff4..00000000000 --- a/changelog.d/6-federation/fed-update-remote-members +++ /dev/null @@ -1 +0,0 @@ -Implement updates to remote members diff --git a/changelog.d/6-federation/new-remote-conversation-unqualify b/changelog.d/6-federation/new-remote-conversation-unqualify deleted file mode 100644 index fc556751d05..00000000000 --- a/changelog.d/6-federation/new-remote-conversation-unqualify +++ /dev/null @@ -1 +0,0 @@ -Make conversation ID of the on-conversation-created RPC unqualified diff --git a/changelog.d/6-federation/pr-1773 b/changelog.d/6-federation/pr-1773 deleted file mode 100644 index 649ed3508c5..00000000000 --- a/changelog.d/6-federation/pr-1773 +++ /dev/null @@ -1 +0,0 @@ -4 endpoints for create/update/get/list connections designed for remote users in mind. So far, the implementation only works for local users (actual implementation will come as a follow-up) diff --git a/changelog.d/6-federation/qualified-connections.md b/changelog.d/6-federation/qualified-connections.md deleted file mode 100644 index a128f7f4d70..00000000000 --- a/changelog.d/6-federation/qualified-connections.md +++ /dev/null @@ -1 +0,0 @@ -The returned `connection` object now has a `qualified_to` field with the domain of the (potentially remote) user. diff --git a/changelog.d/6-federation/remote-connections-migration b/changelog.d/6-federation/remote-connections-migration deleted file mode 100644 index facfec07c72..00000000000 --- a/changelog.d/6-federation/remote-connections-migration +++ /dev/null @@ -1 +0,0 @@ -Add migration for remote connection table diff --git a/changelog.d/6-federation/remote-conversations-when-deleting-user b/changelog.d/6-federation/remote-conversations-when-deleting-user deleted file mode 100644 index fa4d5416572..00000000000 --- a/changelog.d/6-federation/remote-conversations-when-deleting-user +++ /dev/null @@ -1 +0,0 @@ -Remove a user from remote conversations upon deleting their account diff --git a/changelog.d/6-federation/search-endpoint b/changelog.d/6-federation/search-endpoint deleted file mode 100644 index aa406f372be..00000000000 --- a/changelog.d/6-federation/search-endpoint +++ /dev/null @@ -1 +0,0 @@ -Remove elasticsearch specific details from the search endpoint \ No newline at end of file diff --git a/changelog.d/6-federation/self-member-status b/changelog.d/6-federation/self-member-status deleted file mode 100644 index 92794080bc6..00000000000 --- a/changelog.d/6-federation/self-member-status +++ /dev/null @@ -1 +0,0 @@ -Added support for updating self member status of remote conversations