From d142082b835cd0d9eae2e4cb9d1eb02e43fb222a Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 13 Dec 2024 10:04:58 +0100 Subject: [PATCH] WPB-14306 [enterprise login] Implement common prerequisites for multiple endpoints (#4364) - new DB table - internal endpoints in brig - new optional config for audit mail recipients - backoffice/stern support --- cassandra-schema.cql | 39 +- changelog.d/2-features/WPB-14306 | 1 + charts/brig/templates/configmap.yaml | 3 + charts/brig/values.yaml | 168 ++++----- .../src/developer/reference/config-options.md | 11 + integration/integration.cabal | 1 + integration/test/API/BrigInternal.hs | 35 ++ integration/test/API/Common.hs | 5 + integration/test/Test/EnterpriseLogin.hs | 286 +++++++++++++++ libs/wire-api/src/Wire/API/EnterpriseLogin.hs | 231 ++++++++++++ .../src/Wire/API/Routes/Internal/Brig.hs | 3 + .../Routes/Internal/Brig/EnterpriseLogin.hs | 107 ++++++ .../golden/Test/Wire/API/Golden/Manual.hs | 19 + .../Wire/API/Golden/Manual/EnterpriseLogin.hs | 123 +++++++ ...testObject_DomainRegistrationUpdate_1.json | 4 + ...testObject_DomainRegistrationUpdate_2.json | 4 + ...testObject_DomainRegistrationUpdate_3.json | 5 + ...testObject_DomainRegistrationUpdate_4.json | 5 + ...testObject_DomainRegistrationUpdate_5.json | 4 + ...testObject_DomainRegistrationUpdate_6.json | 5 + .../testObject_DomainRegistration_1.json | 6 + .../testObject_DomainRegistration_2.json | 6 + .../testObject_DomainRegistration_3.json | 8 + .../testObject_DomainRegistration_4.json | 7 + .../testObject_DomainRegistration_5.json | 6 + .../testObject_DomainRegistration_6.json | 6 + libs/wire-api/wire-api.cabal | 3 + libs/wire-subsystems/default.nix | 2 + .../src/Wire/DomainRegistrationStore.hs | 32 ++ .../Wire/DomainRegistrationStore/Cassandra.hs | 48 +++ .../src/Wire/EnterpriseLoginSubsystem.hs | 18 + .../Wire/EnterpriseLoginSubsystem/Error.hs | 27 ++ .../EnterpriseLoginSubsystem/Interpreter.hs | 342 ++++++++++++++++++ libs/wire-subsystems/wire-subsystems.cabal | 6 + services/brig/brig.cabal | 1 + services/brig/src/Brig/API/Internal.hs | 15 +- .../brig/src/Brig/CanonicalInterpreter.hs | 21 +- services/brig/src/Brig/Options.hs | 4 +- services/brig/src/Brig/Schema/Run.hs | 4 +- .../Schema/V88_DomainRegistrationTable.hs | 43 +++ tools/stern/default.nix | 2 + tools/stern/src/Stern/API.hs | 1 + tools/stern/src/Stern/API/Routes.hs | 2 + tools/stern/src/Stern/App.hs | 34 +- tools/stern/src/Stern/Intra.hs | 45 ++- tools/stern/stern.cabal | 1 + tools/stern/test/integration/API.hs | 20 +- 47 files changed, 1662 insertions(+), 107 deletions(-) create mode 100644 changelog.d/2-features/WPB-14306 create mode 100644 integration/test/Test/EnterpriseLogin.hs create mode 100644 libs/wire-api/src/Wire/API/EnterpriseLogin.hs create mode 100644 libs/wire-api/src/Wire/API/Routes/Internal/Brig/EnterpriseLogin.hs create mode 100644 libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/EnterpriseLogin.hs create mode 100644 libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_1.json create mode 100644 libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_2.json create mode 100644 libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_3.json create mode 100644 libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_4.json create mode 100644 libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_5.json create mode 100644 libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_6.json create mode 100644 libs/wire-api/test/golden/testObject_DomainRegistration_1.json create mode 100644 libs/wire-api/test/golden/testObject_DomainRegistration_2.json create mode 100644 libs/wire-api/test/golden/testObject_DomainRegistration_3.json create mode 100644 libs/wire-api/test/golden/testObject_DomainRegistration_4.json create mode 100644 libs/wire-api/test/golden/testObject_DomainRegistration_5.json create mode 100644 libs/wire-api/test/golden/testObject_DomainRegistration_6.json create mode 100644 libs/wire-subsystems/src/Wire/DomainRegistrationStore.hs create mode 100644 libs/wire-subsystems/src/Wire/DomainRegistrationStore/Cassandra.hs create mode 100644 libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem.hs create mode 100644 libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Error.hs create mode 100644 libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs create mode 100644 services/brig/src/Brig/Schema/V88_DomainRegistrationTable.hs diff --git a/cassandra-schema.cql b/cassandra-schema.cql index bc454c6fa36..3e584a2126a 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -245,9 +245,11 @@ CREATE TABLE brig_test.mls_key_package_refs ( AND read_repair_chance = 0.0 AND speculative_retry = '99PERCENTILE'; -CREATE TABLE brig_test.excluded_phones ( - prefix text PRIMARY KEY, - comment text +CREATE TABLE brig_test.oauth_client ( + id uuid PRIMARY KEY, + name text, + redirect_uri blob, + secret blob ) WITH bloom_filter_fp_chance = 0.01 AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'} AND comment = '' @@ -432,6 +434,24 @@ CREATE TABLE brig_test.user_keys ( AND read_repair_chance = 0.0 AND speculative_retry = '99PERCENTILE'; +CREATE TABLE brig_test.excluded_phones ( + prefix text PRIMARY KEY, + comment text +) WITH bloom_filter_fp_chance = 0.01 + AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'} + AND comment = '' + AND compaction = {'class': 'org.apache.cassandra.db.compaction.SizeTieredCompactionStrategy', 'max_threshold': '32', 'min_threshold': '4'} + 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.mls_public_keys ( user uuid, client text, @@ -534,11 +554,14 @@ CREATE TABLE brig_test.federation_remote_teams ( AND read_repair_chance = 0.0 AND speculative_retry = '99PERCENTILE'; -CREATE TABLE brig_test.oauth_client ( - id uuid PRIMARY KEY, - name text, - redirect_uri blob, - secret blob +CREATE TABLE brig_test.domain_registration ( + domain text PRIMARY KEY, + backend_url blob, + dns_verification_token ascii, + domain_redirect int, + idp_id uuid, + team uuid, + team_invite int ) WITH bloom_filter_fp_chance = 0.01 AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'} AND comment = '' diff --git a/changelog.d/2-features/WPB-14306 b/changelog.d/2-features/WPB-14306 new file mode 100644 index 00000000000..a9ef32201bd --- /dev/null +++ b/changelog.d/2-features/WPB-14306 @@ -0,0 +1 @@ +Internal API and backoffice support for managing email domains for enterprise login diff --git a/charts/brig/templates/configmap.yaml b/charts/brig/templates/configmap.yaml index 3ee161a8c02..4646242c3bd 100644 --- a/charts/brig/templates/configmap.yaml +++ b/charts/brig/templates/configmap.yaml @@ -368,5 +368,8 @@ data: setOAuthMaxActiveRefreshTokens: {{ .setOAuthMaxActiveRefreshTokens }} {{- end }} setPasswordHashingOptions: {{ toYaml .setPasswordHashingOptions | nindent 8 }} + {{- if .setAuditLogEmailRecipient }} + setAuditLogEmailRecipient: {{ .setAuditLogEmailRecipient }} + {{- end }} {{- end }} {{- end }} diff --git a/charts/brig/values.yaml b/charts/brig/values.yaml index a7fd85eceb5..517fc59decb 100644 --- a/charts/brig/values.yaml +++ b/charts/brig/values.yaml @@ -24,13 +24,13 @@ config: logNetStrings: false cassandra: host: aws-cassandra -# To enable TLS provide a CA: -# tlsCa: -# -# Or refer to an existing secret (containing the CA): -# tlsCaSecretRef: -# name: -# key: + # To enable TLS provide a CA: + # tlsCa: + # + # Or refer to an existing secret (containing the CA): + # tlsCaSecretRef: + # name: + # key: elasticsearch: scheme: http @@ -38,25 +38,25 @@ config: port: 9200 index: directory insecureSkipVerifyTls: false -# To configure custom TLS CA, please provide one of these: -# tlsCa: -# -# Or refer to an existing secret (containing the CA): -# tlsCaSecretRef: -# name: -# key: + # To configure custom TLS CA, please provide one of these: + # tlsCa: + # + # Or refer to an existing secret (containing the CA): + # tlsCaSecretRef: + # name: + # key: additionalWriteScheme: http # additionalWriteHost: additionalWritePort: 9200 # additionalWriteIndex: additionalInsecureSkipVerifyTls: false -# To configure custom TLS CA, please provide one of these: -# additionalTlsCa: -# -# Or refer to an existing secret (containing the CA): -# additionalTlsCaSecretRef: -# name: -# key: + # To configure custom TLS CA, please provide one of these: + # additionalTlsCa: + # + # Or refer to an existing secret (containing the CA): + # additionalTlsCaSecretRef: + # name: + # key: aws: region: "eu-west-1" sesEndpoint: https://email.eu-west-1.amazonaws.com @@ -147,7 +147,7 @@ config: setOAuthMaxActiveRefreshTokens: 10 # Disable one ore more API versions. Please make sure the configuration value is the same in all these charts: # brig, cannon, cargohold, galley, gundeck, proxy, spar. - setDisabledAPIVersions: [ development ] + setDisabledAPIVersions: [development] setFederationStrategy: allowNone setFederationDomainConfigsUpdateFreq: 10 setPasswordHashingOptions: @@ -156,16 +156,17 @@ config: # iterations: # parallelism: # memory: + # setAuditLogEmailRecipient: security@wire.com smtp: passwordFile: /etc/wire/brig/secrets/smtp-password.txt proxy: {} turnStatic: v1: - - turn:localhost:3478 + - turn:localhost:3478 v2: - - turn:localhost:3478 - - turn:localhost:3478?transport=tcp + - turn:localhost:3478 + - turn:localhost:3478?transport=tcp turn: serversSource: files # files | dns @@ -191,7 +192,8 @@ podSecurityContext: seccompProfile: type: RuntimeDefault tests: - config: {} + config: + {} # uploadXml: # baseUrl: s3://bucket/path/ @@ -201,62 +203,62 @@ tests: # These "secrets" are only used in tests and are therefore safe to be stored unencrypted providerPrivateKey: | - -----BEGIN RSA PRIVATE KEY----- - MIIEpAIBAAKCAQEAu+Kg/PHHU3atXrUbKnw0G06FliXcNt3lMwl2os5twEDcPPFw - /feGiAKymxp+7JqZDrseS5D9THGrW+OQRIPHWvUBdiLfGrZqJO223DB6D8K2Su/o - dmnjZJ2z23rhXoEArTplu+Dg9K+c2LVeXTKVVPOaOzgtAB21XKRiQ4ermqgi3/nj - r03rXyq/qNkuNd6tNcg+HAfGxfGvvCSYBfiSbUKr/BeArYRcjzr/h5m1In6fG/if - 9GEI6m8dxHT9JbY53wiksowy6ajCuqskIFg87X883H+LA/d6X5CTiPv1VMxXdBUi - GPuC9IT/6CNQ1/LFt0P37ax58+LGYlaFo7lanQIDAQABAoIBAQC0doVy7zgpLsBv - Sz0AnbPe1pjxEwRlntRbJSfSULySALqJvs5s4adSVGUBHX3z/LousAP1SRpCppuU - 8wrLBFgjQVlaAzyQB84EEl+lNtrG8Jrvd2es9R/4sJDkqy50+yuPN5wnzWPFIjhg - 3jP5CHDu29y0LMzsY5yjkzDe9B0bueXEZVU+guRjhpwHHKOFeAr9J9bugFUwgeAr - jF0TztzFAb0fsUNPiQAho1J5PyjSVgItaPfAPv/p30ROG+rz+Rd5NSSvBC5F+yOo - azb84zzwCg/knAfIz7SOMRrmBh2qhGZFZ8gXdq65UaYv+cpT/qo28mpAT2vOkyeD - aPZp0ysBAoGBAOQROoDipe/5BTHBcXYuUE1qa4RIj3wgql5I8igXr4K6ppYBmaOg - DL2rrnqD86chv0P4l/XOomKFwYhVGXtqRkeYnk6mQXwNVkgqcGbY5PSNyMg5+ekq - jSOOPHGzzTWKzYuUDUpB/Lf6jbTv8fq2GYW3ZYiqQ/xiugOvglZrTE7NAoGBANLl - irjByfxAWGhzCrDx0x5MBpsetadI9wUA8u1BDdymsRg73FDn3z7NipVUAMDXMGVj - lqbCRlHESO2yP4GaPEA4FM+MbTZSuhAYV+SY07mEPLHF64/nJas83Zp91r5rhaqJ - L9rWCl3KJ5OUnr3YizCnHIW72FxjwtpjxHJLupsRAoGAGIbhy8qUHeKh9F/hW9xP - NoQjW+6Rv7+jktA1eqpRbbW1BJzXcQldVWiJMxPNuEOg1iZ98SlvvTi1P3wnaWZc - eIapP7wRfs3QYaJuxCC/Pq2g0ieqALFazGAXkALOJtvujvw1Ea9XBlIjuzmyxEuh - Iwg+Gxx0g0f6yTquwax4YGECgYEAnpAK3qKFNO1ECzQDo8oNy0ep59MNDPtlDhQK - katJus5xdCD9oq7TQKrVOTTxZAvmzTQ1PqfuqueDVYOhD9Zg2n/P1cRlEGTek99Z - pfvppB/yak6+r3FA9yBKFS/r1zuMQg3nNweav62QV/tz5pT7AdeDMGFtaPlwtTYx - qyWY5aECgYBPySbPccNj+xxQzxcti2y/UXjC04RgOA/Hm1D0exa0vBqS9uxlOdG8 - F47rKenpBrslvdfTVsCDB1xyP2ebWVzp6EqMycw6OLPxgo3fBfZ4pi6P+rByh0Cc - Lhfh+ET0CPnKCxtop3lUrn4ZvqchS0j3J+M0pDuqoWF5hfKxFhkEIw== - -----END RSA PRIVATE KEY----- + -----BEGIN RSA PRIVATE KEY----- + MIIEpAIBAAKCAQEAu+Kg/PHHU3atXrUbKnw0G06FliXcNt3lMwl2os5twEDcPPFw + /feGiAKymxp+7JqZDrseS5D9THGrW+OQRIPHWvUBdiLfGrZqJO223DB6D8K2Su/o + dmnjZJ2z23rhXoEArTplu+Dg9K+c2LVeXTKVVPOaOzgtAB21XKRiQ4ermqgi3/nj + r03rXyq/qNkuNd6tNcg+HAfGxfGvvCSYBfiSbUKr/BeArYRcjzr/h5m1In6fG/if + 9GEI6m8dxHT9JbY53wiksowy6ajCuqskIFg87X883H+LA/d6X5CTiPv1VMxXdBUi + GPuC9IT/6CNQ1/LFt0P37ax58+LGYlaFo7lanQIDAQABAoIBAQC0doVy7zgpLsBv + Sz0AnbPe1pjxEwRlntRbJSfSULySALqJvs5s4adSVGUBHX3z/LousAP1SRpCppuU + 8wrLBFgjQVlaAzyQB84EEl+lNtrG8Jrvd2es9R/4sJDkqy50+yuPN5wnzWPFIjhg + 3jP5CHDu29y0LMzsY5yjkzDe9B0bueXEZVU+guRjhpwHHKOFeAr9J9bugFUwgeAr + jF0TztzFAb0fsUNPiQAho1J5PyjSVgItaPfAPv/p30ROG+rz+Rd5NSSvBC5F+yOo + azb84zzwCg/knAfIz7SOMRrmBh2qhGZFZ8gXdq65UaYv+cpT/qo28mpAT2vOkyeD + aPZp0ysBAoGBAOQROoDipe/5BTHBcXYuUE1qa4RIj3wgql5I8igXr4K6ppYBmaOg + DL2rrnqD86chv0P4l/XOomKFwYhVGXtqRkeYnk6mQXwNVkgqcGbY5PSNyMg5+ekq + jSOOPHGzzTWKzYuUDUpB/Lf6jbTv8fq2GYW3ZYiqQ/xiugOvglZrTE7NAoGBANLl + irjByfxAWGhzCrDx0x5MBpsetadI9wUA8u1BDdymsRg73FDn3z7NipVUAMDXMGVj + lqbCRlHESO2yP4GaPEA4FM+MbTZSuhAYV+SY07mEPLHF64/nJas83Zp91r5rhaqJ + L9rWCl3KJ5OUnr3YizCnHIW72FxjwtpjxHJLupsRAoGAGIbhy8qUHeKh9F/hW9xP + NoQjW+6Rv7+jktA1eqpRbbW1BJzXcQldVWiJMxPNuEOg1iZ98SlvvTi1P3wnaWZc + eIapP7wRfs3QYaJuxCC/Pq2g0ieqALFazGAXkALOJtvujvw1Ea9XBlIjuzmyxEuh + Iwg+Gxx0g0f6yTquwax4YGECgYEAnpAK3qKFNO1ECzQDo8oNy0ep59MNDPtlDhQK + katJus5xdCD9oq7TQKrVOTTxZAvmzTQ1PqfuqueDVYOhD9Zg2n/P1cRlEGTek99Z + pfvppB/yak6+r3FA9yBKFS/r1zuMQg3nNweav62QV/tz5pT7AdeDMGFtaPlwtTYx + qyWY5aECgYBPySbPccNj+xxQzxcti2y/UXjC04RgOA/Hm1D0exa0vBqS9uxlOdG8 + F47rKenpBrslvdfTVsCDB1xyP2ebWVzp6EqMycw6OLPxgo3fBfZ4pi6P+rByh0Cc + Lhfh+ET0CPnKCxtop3lUrn4ZvqchS0j3J+M0pDuqoWF5hfKxFhkEIw== + -----END RSA PRIVATE KEY----- providerPublicKey: | - -----BEGIN PUBLIC KEY----- - MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAu+Kg/PHHU3atXrUbKnw0 - G06FliXcNt3lMwl2os5twEDcPPFw/feGiAKymxp+7JqZDrseS5D9THGrW+OQRIPH - WvUBdiLfGrZqJO223DB6D8K2Su/odmnjZJ2z23rhXoEArTplu+Dg9K+c2LVeXTKV - VPOaOzgtAB21XKRiQ4ermqgi3/njr03rXyq/qNkuNd6tNcg+HAfGxfGvvCSYBfiS - bUKr/BeArYRcjzr/h5m1In6fG/if9GEI6m8dxHT9JbY53wiksowy6ajCuqskIFg8 - 7X883H+LA/d6X5CTiPv1VMxXdBUiGPuC9IT/6CNQ1/LFt0P37ax58+LGYlaFo7la - nQIDAQAB - -----END PUBLIC KEY----- + -----BEGIN PUBLIC KEY----- + MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAu+Kg/PHHU3atXrUbKnw0 + G06FliXcNt3lMwl2os5twEDcPPFw/feGiAKymxp+7JqZDrseS5D9THGrW+OQRIPH + WvUBdiLfGrZqJO223DB6D8K2Su/odmnjZJ2z23rhXoEArTplu+Dg9K+c2LVeXTKV + VPOaOzgtAB21XKRiQ4ermqgi3/njr03rXyq/qNkuNd6tNcg+HAfGxfGvvCSYBfiS + bUKr/BeArYRcjzr/h5m1In6fG/if9GEI6m8dxHT9JbY53wiksowy6ajCuqskIFg8 + 7X883H+LA/d6X5CTiPv1VMxXdBUiGPuC9IT/6CNQ1/LFt0P37ax58+LGYlaFo7la + nQIDAQAB + -----END PUBLIC KEY----- providerPublicCert: | - -----BEGIN CERTIFICATE----- - MIIDdjCCAl4CCQCm0AiwERR/qjANBgkqhkiG9w0BAQsFADB9MQswCQYDVQQGEwJE - RTEPMA0GA1UECAwGQmVybGluMQ8wDQYDVQQHDAZCZXJsaW4xGDAWBgNVBAoMD1dp - cmUgU3dpc3MgR21iSDERMA8GA1UEAwwId2lyZS5jb20xHzAdBgkqhkiG9w0BCQEW - EGJhY2tlbmRAd2lyZS5jb20wHhcNMTYwODA0MTMxNDQyWhcNMzYwNzMwMTMxNDQy - WjB9MQswCQYDVQQGEwJERTEPMA0GA1UECAwGQmVybGluMQ8wDQYDVQQHDAZCZXJs - aW4xGDAWBgNVBAoMD1dpcmUgU3dpc3MgR21iSDERMA8GA1UEAwwId2lyZS5jb20x - HzAdBgkqhkiG9w0BCQEWEGJhY2tlbmRAd2lyZS5jb20wggEiMA0GCSqGSIb3DQEB - AQUAA4IBDwAwggEKAoIBAQC74qD88cdTdq1etRsqfDQbToWWJdw23eUzCXaizm3A - QNw88XD994aIArKbGn7smpkOux5LkP1Mcatb45BEg8da9QF2It8atmok7bbcMHoP - wrZK7+h2aeNknbPbeuFegQCtOmW74OD0r5zYtV5dMpVU85o7OC0AHbVcpGJDh6ua - qCLf+eOvTetfKr+o2S413q01yD4cB8bF8a+8JJgF+JJtQqv8F4CthFyPOv+HmbUi - fp8b+J/0YQjqbx3EdP0ltjnfCKSyjDLpqMK6qyQgWDztfzzcf4sD93pfkJOI+/VU - zFd0FSIY+4L0hP/oI1DX8sW3Q/ftrHnz4sZiVoWjuVqdAgMBAAEwDQYJKoZIhvcN - AQELBQADggEBAEuwlHElIGR56KVC1dJiw238mDGjMfQzSP76Wi4zWS6/zZwJUuog - BkC+vacfju8UAMvL+vdqkjOVUHor84/2wuq0qn91AjOITD7tRAZB+XLXxsikKv/v - OXE3A/lCiNi882NegPyXAfFPp/71CIiTQZps1eQkAvhD5t5WiFYPESxDlvEJrHFY - XP4+pp8fL8YPS7iZNIq+z+P8yVIw+B/Hs0ht7wFIYN0xACbU8m9+Rs08JMoT16c+ - hZMuK3BWD3fzkQVfW0yMwz6fWRXB483ZmekGkgndOTDoJQMdJXZxHpI3t2FcxQYj - T45GXxRd18neXtuYa/OoAw9UQFDN5XfXN0g= - -----END CERTIFICATE----- + -----BEGIN CERTIFICATE----- + MIIDdjCCAl4CCQCm0AiwERR/qjANBgkqhkiG9w0BAQsFADB9MQswCQYDVQQGEwJE + RTEPMA0GA1UECAwGQmVybGluMQ8wDQYDVQQHDAZCZXJsaW4xGDAWBgNVBAoMD1dp + cmUgU3dpc3MgR21iSDERMA8GA1UEAwwId2lyZS5jb20xHzAdBgkqhkiG9w0BCQEW + EGJhY2tlbmRAd2lyZS5jb20wHhcNMTYwODA0MTMxNDQyWhcNMzYwNzMwMTMxNDQy + WjB9MQswCQYDVQQGEwJERTEPMA0GA1UECAwGQmVybGluMQ8wDQYDVQQHDAZCZXJs + aW4xGDAWBgNVBAoMD1dpcmUgU3dpc3MgR21iSDERMA8GA1UEAwwId2lyZS5jb20x + HzAdBgkqhkiG9w0BCQEWEGJhY2tlbmRAd2lyZS5jb20wggEiMA0GCSqGSIb3DQEB + AQUAA4IBDwAwggEKAoIBAQC74qD88cdTdq1etRsqfDQbToWWJdw23eUzCXaizm3A + QNw88XD994aIArKbGn7smpkOux5LkP1Mcatb45BEg8da9QF2It8atmok7bbcMHoP + wrZK7+h2aeNknbPbeuFegQCtOmW74OD0r5zYtV5dMpVU85o7OC0AHbVcpGJDh6ua + qCLf+eOvTetfKr+o2S413q01yD4cB8bF8a+8JJgF+JJtQqv8F4CthFyPOv+HmbUi + fp8b+J/0YQjqbx3EdP0ltjnfCKSyjDLpqMK6qyQgWDztfzzcf4sD93pfkJOI+/VU + zFd0FSIY+4L0hP/oI1DX8sW3Q/ftrHnz4sZiVoWjuVqdAgMBAAEwDQYJKoZIhvcN + AQELBQADggEBAEuwlHElIGR56KVC1dJiw238mDGjMfQzSP76Wi4zWS6/zZwJUuog + BkC+vacfju8UAMvL+vdqkjOVUHor84/2wuq0qn91AjOITD7tRAZB+XLXxsikKv/v + OXE3A/lCiNi882NegPyXAfFPp/71CIiTQZps1eQkAvhD5t5WiFYPESxDlvEJrHFY + XP4+pp8fL8YPS7iZNIq+z+P8yVIw+B/Hs0ht7wFIYN0xACbU8m9+Rs08JMoT16c+ + hZMuK3BWD3fzkQVfW0yMwz6fWRXB483ZmekGkgndOTDoJQMdJXZxHpI3t2FcxQYj + T45GXxRd18neXtuYa/OoAw9UQFDN5XfXN0g= + -----END CERTIFICATE----- diff --git a/docs/src/developer/reference/config-options.md b/docs/src/developer/reference/config-options.md index 41748ebc3ba..f2108f44239 100644 --- a/docs/src/developer/reference/config-options.md +++ b/docs/src/developer/reference/config-options.md @@ -822,6 +822,17 @@ brig: accountPages: https://account.wire.com ``` +### Enterprise Login Audit Log + +Audit logs for any update (POST, PUT, DELETE) of a domain registration via the internal API are sent via email to the specified email address. If not specified no audit logs will be sent. + +```yaml +brig: + config: + optSettings: + setAuditLogEmailRecipient: security@wire.com +``` + ## Settings in cargohold AWS S3 (or an alternative provider / service) is used to upload and download diff --git a/integration/integration.cabal b/integration/integration.cabal index 3c15b930344..b264da1c346 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -120,6 +120,7 @@ library Test.Conversation Test.Demo Test.EJPD + Test.EnterpriseLogin Test.Errors Test.Events Test.ExternalPartner diff --git a/integration/test/API/BrigInternal.hs b/integration/test/API/BrigInternal.hs index ff8b6f40f61..0bc80b58714 100644 --- a/integration/test/API/BrigInternal.hs +++ b/integration/test/API/BrigInternal.hs @@ -329,3 +329,38 @@ putSSOId user args = do "subject" .= args.subject, "tenant" .= args.tenant ] + +domainRegistrationLock :: (HasCallStack, MakesValue domain) => domain -> String -> App Response +domainRegistrationLock domain registrationDomain = do + req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "domain-registration", registrationDomain, "lock"] + submit "POST" req + +domainRegistrationUnlock :: (HasCallStack, MakesValue domain) => domain -> String -> App Response +domainRegistrationUnlock domain registrationDomain = do + req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "domain-registration", registrationDomain, "unlock"] + submit "POST" req + +domainRegistrationPreAuthorize :: (HasCallStack, MakesValue domain) => domain -> String -> App Response +domainRegistrationPreAuthorize domain registrationDomain = do + req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "domain-registration", registrationDomain, "preauthorize"] + submit "POST" req + +domainRegistrationUnAuthorize :: (HasCallStack, MakesValue domain) => domain -> String -> App Response +domainRegistrationUnAuthorize domain registrationDomain = do + req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "domain-registration", registrationDomain, "unauthorize"] + submit "POST" req + +updateDomainRegistration :: (HasCallStack, MakesValue domain) => domain -> String -> Value -> App Response +updateDomainRegistration domain registrationDomain payload = do + req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "domain-registration", registrationDomain] + submit "PUT" $ req & addJSON payload + +deleteDomainRegistration :: (HasCallStack, MakesValue domain) => domain -> String -> App Response +deleteDomainRegistration domain registrationDomain = do + req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "domain-registration", registrationDomain] + submit "DELETE" req + +getDomainRegistration :: (HasCallStack, MakesValue domain) => domain -> String -> App Response +getDomainRegistration domain registrationDomain = do + req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "domain-registration", registrationDomain] + submit "GET" req diff --git a/integration/test/API/Common.hs b/integration/test/API/Common.hs index e1c91d05b7c..fe915c89ceb 100644 --- a/integration/test/API/Common.hs +++ b/integration/test/API/Common.hs @@ -20,6 +20,11 @@ randomEmail = do u <- randomName pure $ u <> "@example.com" +randomDomain :: App String +randomDomain = do + u <- randomName + pure $ (fmap toLower u) <> ".com" + randomExternalId :: App String randomExternalId = liftIO $ do -- external ID has no constraints, but we only generate human-readable samples diff --git a/integration/test/Test/EnterpriseLogin.hs b/integration/test/Test/EnterpriseLogin.hs new file mode 100644 index 00000000000..342ef04cd38 --- /dev/null +++ b/integration/test/Test/EnterpriseLogin.hs @@ -0,0 +1,286 @@ +module Test.EnterpriseLogin where + +import API.BrigInternal +import API.Common +import Testlib.Prelude + +testDomainRegistrationLock :: App () +testDomainRegistrationLock = do + domain <- randomDomain + -- it should not yet exist + assertStatus 404 =<< getDomainRegistration OwnDomain domain + -- add to deny-list + assertStatus 204 =<< domainRegistrationLock OwnDomain domain + -- idempotent + assertStatus 204 =<< domainRegistrationLock OwnDomain domain + -- it got created + bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain" `shouldMatch` domain + resp.json %. "domain_redirect" `shouldMatch` "locked" + resp.json %. "team_invite" `shouldMatch` "allowed" + -- remove from deny-list + assertStatus 204 =<< domainRegistrationUnlock OwnDomain domain + -- check that it got removed + bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain" `shouldMatch` domain + resp.json %. "domain_redirect" `shouldMatch` "none" + resp.json %. "team_invite" `shouldMatch` "allowed" + +testDomainRegistrationLockPreviousValueOverwritten :: App () +testDomainRegistrationLockPreviousValueOverwritten = do + domain <- randomDomain + -- pre-authorize + assertStatus 204 =<< domainRegistrationPreAuthorize OwnDomain domain + bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain" `shouldMatch` domain + resp.json %. "domain_redirect" `shouldMatch` "pre-authorized" + -- lock + assertStatus 204 =<< domainRegistrationLock OwnDomain domain + -- check that it got overwritten + bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain" `shouldMatch` domain + resp.json %. "domain_redirect" `shouldMatch` "locked" + +testDomainRegistrationUnlockErrorIfNotLocked :: App () +testDomainRegistrationUnlockErrorIfNotLocked = do + domain <- randomDomain + -- pre-authorize + assertStatus 204 =<< domainRegistrationPreAuthorize OwnDomain domain + bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain" `shouldMatch` domain + resp.json %. "domain_redirect" `shouldMatch` "pre-authorized" + -- attempt to unlock should fail + bindResponse (domainRegistrationUnlock OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 409 + resp.json %. "label" `shouldMatch` "unlock-error" + +testDomainRegistrationPreAuthorize :: App () +testDomainRegistrationPreAuthorize = do + domain <- randomDomain + -- it should not yet exist + assertStatus 404 =<< getDomainRegistration OwnDomain domain + -- pre-authorize + assertStatus 204 =<< domainRegistrationPreAuthorize OwnDomain domain + -- idempotent + assertStatus 204 =<< domainRegistrationPreAuthorize OwnDomain domain + -- it got created + bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain" `shouldMatch` domain + resp.json %. "domain_redirect" `shouldMatch` "pre-authorized" + resp.json %. "team_invite" `shouldMatch` "allowed" + +testDomainRegistrationPreAuthorizeFailsIfLocked :: App () +testDomainRegistrationPreAuthorizeFailsIfLocked = do + domain <- randomDomain + -- add to deny-list + assertStatus 204 =<< domainRegistrationLock OwnDomain domain + -- pre-authorize + bindResponse (domainRegistrationPreAuthorize OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 409 + resp.json %. "label" `shouldMatch` "preauthorize-error" + -- check that it was not set to pre-authorized + bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain" `shouldMatch` domain + resp.json %. "domain_redirect" `shouldMatch` "locked" + -- remove from deny-list + assertStatus 204 =<< domainRegistrationUnlock OwnDomain domain + -- now it should work + assertStatus 204 =<< domainRegistrationPreAuthorize OwnDomain domain + -- domain redirect should be pre-authorized + bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain" `shouldMatch` domain + resp.json %. "domain_redirect" `shouldMatch` "pre-authorized" + resp.json %. "team_invite" `shouldMatch` "allowed" + +testDomainRegistrationPreAuthorizeDoesNotAlterTeamInvite :: App () +testDomainRegistrationPreAuthorizeDoesNotAlterTeamInvite = do + domain <- randomDomain + -- it should not yet exist + assertStatus 404 =<< getDomainRegistration OwnDomain domain + let update = + object + [ "domain_redirect" .= "none", + "team_invite" .= "team", + "team" .= "3bc23f21-dc03-4922-9563-c3beedf895db" + ] + assertStatus 204 =<< updateDomainRegistration OwnDomain domain update + -- pre-authorize + assertStatus 204 =<< domainRegistrationPreAuthorize OwnDomain domain + bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain" `shouldMatch` domain + resp.json %. "domain_redirect" `shouldMatch` "pre-authorized" + resp.json %. "team_invite" `shouldMatch` "team" + resp.json %. "team" `shouldMatch` "3bc23f21-dc03-4922-9563-c3beedf895db" + lookupField resp.json "backend_url" `shouldMatch` (Nothing :: Maybe Value) + +testDomainRegistrationQueriesDoNotCreateEntry :: App () +testDomainRegistrationQueriesDoNotCreateEntry = do + domain <- randomDomain + assertStatus 404 =<< getDomainRegistration OwnDomain domain + assertStatus 404 =<< domainRegistrationUnlock OwnDomain domain + assertStatus 404 =<< domainRegistrationUnAuthorize OwnDomain domain + assertStatus 404 =<< getDomainRegistration OwnDomain domain + +testDomainRegistrationUpdate :: App () +testDomainRegistrationUpdate = do + domain <- randomDomain + -- it should not yet exist + assertStatus 404 =<< getDomainRegistration OwnDomain domain + updateDomain domain + $ object + [ "domain_redirect" .= "backend", + "backend_url" .= "https://example.com", + "team_invite" .= "not-allowed" + ] + updateDomain domain + $ object + [ "domain_redirect" .= "sso", + "sso_idp_id" .= "f82bad56-df61-49c0-bc9a-dc45c8ee1000", + "team_invite" .= "allowed" + ] + updateDomain domain + $ object + [ "domain_redirect" .= "no-registration", + "team_invite" .= "team", + "team" .= "3bc23f21-dc03-4922-9563-c3beedf895db" + ] + where + updateDomain :: String -> Value -> App () + updateDomain domain update = do + -- update + assertStatus 204 =<< updateDomainRegistration OwnDomain domain update + -- idempotent + assertStatus 204 =<< updateDomainRegistration OwnDomain domain update + -- it got created + bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain" `shouldMatch` domain + resp.json %. "domain_redirect" `shouldMatch` (update %. "domain_redirect") + resp.json %. "team_invite" `shouldMatch` (update %. "team_invite") + lookupField resp.json "backend_url" `shouldMatch` lookupField update "backend_url" + lookupField resp.json "sso_idp_id" `shouldMatch` lookupField update "sso_idp_id" + lookupField resp.json "team" `shouldMatch` lookupField update "team" + +testDomainRegistrationUpdateInvalidCases :: App () +testDomainRegistrationUpdateInvalidCases = do + domain <- randomDomain + checkUpdateFails domain $ object ["domain_redirect" .= "locked", "team_invite" .= "not-allowed"] + checkUpdateFails domain $ object ["domain_redirect" .= "locked", "team_invite" .= "team", "team" .= "3bc23f21-dc03-4922-9563-c3beedf895db"] + checkUpdateFails domain $ object ["domain_redirect" .= "backend", "backend_url" .= "https://example.com", "team_invite" .= "team", "team" .= "3bc23f21-dc03-4922-9563-c3beedf895db"] + checkUpdateFails domain $ object ["domain_redirect" .= "backend", "backend_url" .= "https://example.com", "team_invite" .= "allowed"] + where + checkUpdateFails :: String -> Value -> App () + checkUpdateFails domain update = do + bindResponse (updateDomainRegistration OwnDomain domain update) $ \resp -> do + resp.status `shouldMatchInt` 400 + resp.json %. "label" `shouldMatch` "update-failure" + +testDomainRegistrationPreAuthorizedToUnAuthorize :: App () +testDomainRegistrationPreAuthorizedToUnAuthorize = do + domain <- randomDomain + let update = + object + [ "domain_redirect" .= "pre-authorized", + "team_invite" .= "allowed" + ] + assertStatus 204 =<< updateDomainRegistration OwnDomain domain update + assertStatus 204 =<< domainRegistrationUnAuthorize OwnDomain domain + assertStatus 204 =<< domainRegistrationUnAuthorize OwnDomain domain + bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain" `shouldMatch` domain + resp.json %. "domain_redirect" `shouldMatch` "none" + resp.json %. "team_invite" `shouldMatch` "allowed" + +testDomainRegistrationBackendToUnAuthorize :: App () +testDomainRegistrationBackendToUnAuthorize = do + domain <- randomDomain + let update = + object + [ "domain_redirect" .= "backend", + "backend_url" .= "https://example.com", + "team_invite" .= "not-allowed" + ] + assertStatus 204 =<< updateDomainRegistration OwnDomain domain update + assertStatus 204 =<< domainRegistrationUnAuthorize OwnDomain domain + bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain" `shouldMatch` domain + resp.json %. "domain_redirect" `shouldMatch` "none" + resp.json %. "team_invite" `shouldMatch` "not-allowed" + assertStatus 204 =<< domainRegistrationUnAuthorize OwnDomain domain + +testDomainRegistrationNoRegistrationToUnAuthorize :: App () +testDomainRegistrationNoRegistrationToUnAuthorize = do + domain <- randomDomain + let update = + object + [ "domain_redirect" .= "no-registration", + "team_invite" .= "allowed" + ] + assertStatus 204 =<< updateDomainRegistration OwnDomain domain update + assertStatus 204 =<< domainRegistrationUnAuthorize OwnDomain domain + assertStatus 204 =<< domainRegistrationUnAuthorize OwnDomain domain + bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain" `shouldMatch` domain + resp.json %. "domain_redirect" `shouldMatch` "none" + resp.json %. "team_invite" `shouldMatch` "allowed" + +testDomainRegistrationUnAuthorizeFailureWhenLocked :: App () +testDomainRegistrationUnAuthorizeFailureWhenLocked = do + domain <- randomDomain + let update = + object + [ "domain_redirect" .= "locked", + "team_invite" .= "allowed" + ] + assertStatus 204 =<< updateDomainRegistration OwnDomain domain update + assertStatus 409 =<< domainRegistrationUnAuthorize OwnDomain domain + bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain" `shouldMatch` domain + resp.json %. "domain_redirect" `shouldMatch` "locked" + resp.json %. "team_invite" `shouldMatch` "allowed" + +testDomainRegistrationUnAuthorizeFailureWhenSso :: App () +testDomainRegistrationUnAuthorizeFailureWhenSso = do + domain <- randomDomain + let update = + object + [ "domain_redirect" .= "sso", + "sso_idp_id" .= "f82bad56-df61-49c0-bc9a-dc45c8ee1000", + "team_invite" .= "team", + "team" .= "3bc23f21-dc03-4922-9563-c3beedf895db" + ] + assertStatus 204 =<< updateDomainRegistration OwnDomain domain update + assertStatus 409 =<< domainRegistrationUnAuthorize OwnDomain domain + bindResponse (getDomainRegistration OwnDomain domain) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "domain" `shouldMatch` domain + resp.json %. "domain_redirect" `shouldMatch` "sso" + resp.json %. "team_invite" `shouldMatch` "team" + +testDomainRegistrationDelete :: App () +testDomainRegistrationDelete = do + domain <- randomDomain + let update = + object + [ "domain_redirect" .= "sso", + "sso_idp_id" .= "f82bad56-df61-49c0-bc9a-dc45c8ee1000", + "team_invite" .= "team", + "team" .= "3bc23f21-dc03-4922-9563-c3beedf895db" + ] + assertStatus 204 =<< updateDomainRegistration OwnDomain domain update + assertStatus 204 =<< deleteDomainRegistration OwnDomain domain + assertStatus 404 =<< getDomainRegistration OwnDomain domain + assertStatus 204 =<< deleteDomainRegistration OwnDomain domain diff --git a/libs/wire-api/src/Wire/API/EnterpriseLogin.hs b/libs/wire-api/src/Wire/API/EnterpriseLogin.hs new file mode 100644 index 00000000000..e6f1d34cd7c --- /dev/null +++ b/libs/wire-api/src/Wire/API/EnterpriseLogin.hs @@ -0,0 +1,231 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wire.API.EnterpriseLogin where + +import Cassandra qualified as C +import Control.Arrow +import Control.Lens (makePrisms) +import Data.Aeson (FromJSON, ToJSON) +import Data.Aeson qualified as Aeson +import Data.Domain +import Data.Id +import Data.Misc +import Data.OpenApi qualified as OpenApi +import Data.Schema +import Data.Text.Ascii (Ascii, AsciiText (toText)) +import Data.Text.Ascii qualified as Ascii +import Imports +import SAML2.WebSSO qualified as SAML + +data DomainRedirect + = None + | Locked + | SSO SAML.IdPId + | Backend HttpsUrl + | NoRegistration + | PreAuthorized + deriving stock (Eq, Show) + +makePrisms ''DomainRedirect + +data DomainRedirectTag + = NoneTag + | LockedTag + | SSOTag + | BackendTag + | NoRegistrationTag + | PreAuthorizedTag + deriving (Show, Ord, Eq, Enum, Bounded) + deriving (ToJSON, FromJSON, OpenApi.ToSchema) via Schema DomainRedirectTag + +instance ToSchema DomainRedirectTag where + schema = + enum @Text "DomainRedirect Tag" $ + mconcat + [ element "none" NoneTag, + element "locked" LockedTag, + element "sso" SSOTag, + element "backend" BackendTag, + element "no-registration" NoRegistrationTag, + element "pre-authorized" PreAuthorizedTag + ] + +domainRedirectTagSchema :: ObjectSchema SwaggerDoc DomainRedirectTag +domainRedirectTagSchema = field "domain_redirect" schema + +domainRedirectSchema :: ObjectSchema SwaggerDoc DomainRedirect +domainRedirectSchema = + snd + <$> (toTagged &&& id) + .= bind + (fst .= domainRedirectTagSchema) + (snd .= dispatch domainRedirectObjectSchema) + where + toTagged :: DomainRedirect -> DomainRedirectTag + toTagged None = NoneTag + toTagged Locked = LockedTag + toTagged (SSO _) = SSOTag + toTagged (Backend _) = BackendTag + toTagged NoRegistration = NoRegistrationTag + toTagged PreAuthorized = PreAuthorizedTag + + domainRedirectObjectSchema :: DomainRedirectTag -> ObjectSchema SwaggerDoc DomainRedirect + domainRedirectObjectSchema = \case + NoneTag -> tag _None (pure ()) + LockedTag -> tag _Locked (pure ()) + SSOTag -> tag _SSO samlIdPIdObjectSchema + BackendTag -> tag _Backend backendUrlSchema + NoRegistrationTag -> tag _NoRegistration (pure ()) + PreAuthorizedTag -> tag _PreAuthorized (pure ()) + +samlIdPIdObjectSchema :: ObjectSchema SwaggerDoc SAML.IdPId +samlIdPIdObjectSchema = SAML.IdPId <$> SAML.fromIdPId .= field "sso_idp_id" uuidSchema + +backendUrlSchema :: ObjectSchema SwaggerDoc HttpsUrl +backendUrlSchema = field "backend_url" schema + +instance ToSchema DomainRedirect where + schema = object "DomainRedirect " domainRedirectSchema + +deriving via (Schema DomainRedirect) instance FromJSON DomainRedirect + +deriving via (Schema DomainRedirect) instance ToJSON DomainRedirect + +deriving via (Schema DomainRedirect) instance OpenApi.ToSchema DomainRedirect + +data TeamInvite + = Allowed + | NotAllowed + | Team TeamId + deriving stock (Eq, Show) + +makePrisms ''TeamInvite + +data TeamInviteTag + = AllowedTag + | NotAllowedTag + | TeamTag + deriving (Show, Ord, Eq, Enum, Bounded) + deriving (ToJSON, FromJSON, OpenApi.ToSchema) via Schema TeamInviteTag + +instance ToSchema TeamInviteTag where + schema = + enum @Text "TeamInvite Tag" $ + mconcat + [ element "allowed" AllowedTag, + element "not-allowed" NotAllowedTag, + element "team" TeamTag + ] + +teamInviteTagSchema :: ObjectSchema SwaggerDoc TeamInviteTag +teamInviteTagSchema = field "team_invite" schema + +teamInviteObjectSchema :: ObjectSchema SwaggerDoc TeamInvite +teamInviteObjectSchema = + snd + <$> (toTagged &&& id) + .= bind + (fst .= teamInviteTagSchema) + (snd .= dispatch teamInviteDataSchema) + where + toTagged :: TeamInvite -> TeamInviteTag + toTagged Allowed = AllowedTag + toTagged NotAllowed = NotAllowedTag + toTagged (Team _) = TeamTag + + teamInviteDataSchema :: TeamInviteTag -> ObjectSchema SwaggerDoc TeamInvite + teamInviteDataSchema = \case + AllowedTag -> tag _Allowed (pure ()) + NotAllowedTag -> tag _NotAllowed (pure ()) + TeamTag -> tag _Team (field "team" schema) + +instance ToSchema TeamInvite where + schema = object "TeamInvite" teamInviteObjectSchema + +deriving via (Schema TeamInvite) instance FromJSON TeamInvite + +deriving via (Schema TeamInvite) instance ToJSON TeamInvite + +deriving via (Schema TeamInvite) instance OpenApi.ToSchema TeamInvite + +newtype DnsVerificationToken = DnsVerificationToken {unDnsVerificationToken :: Ascii} + deriving stock (Ord, Eq, Show) + deriving (ToJSON, FromJSON, OpenApi.ToSchema) via Schema DnsVerificationToken + +instance ToSchema DnsVerificationToken where + schema = DnsVerificationToken <$> unDnsVerificationToken .= schema + +data DomainRegistrationUpdate = DomainRegistrationUpdate + { domainRedirect :: DomainRedirect, + teamInvite :: TeamInvite + } + deriving stock (Eq, Show) + deriving (ToJSON, FromJSON, OpenApi.ToSchema) via Schema DomainRegistrationUpdate + +instance ToSchema DomainRegistrationUpdate where + schema = + object "DomainRegistrationUpdate" $ + DomainRegistrationUpdate + <$> (.domainRedirect) .= domainRedirectSchema + <*> (.teamInvite) .= teamInviteObjectSchema + +data DomainRegistration = DomainRegistration + { domain :: Domain, + domainRedirect :: DomainRedirect, + teamInvite :: TeamInvite, + dnsVerificationToken :: Maybe DnsVerificationToken + } + deriving stock (Eq, Show) + deriving (ToJSON, FromJSON, OpenApi.ToSchema) via Schema DomainRegistration + +instance ToSchema DomainRegistration where + schema = + object "DomainRegistration" $ + DomainRegistration + <$> (.domain) .= field "domain" schema + <*> (.domainRedirect) .= domainRedirectSchema + <*> (.teamInvite) .= teamInviteObjectSchema + <*> (.dnsVerificationToken) .= optField "dns_verification_token" (maybeWithDefault Aeson.Null schema) + +-------------------------------------------------------------------------------- +-- CQL instances + +instance C.Cql DomainRedirectTag where + ctype = C.Tagged C.IntColumn + + toCql NoneTag = C.CqlInt 1 + toCql LockedTag = C.CqlInt 2 + toCql SSOTag = C.CqlInt 3 + toCql BackendTag = C.CqlInt 4 + toCql NoRegistrationTag = C.CqlInt 5 + toCql PreAuthorizedTag = C.CqlInt 6 + + fromCql (C.CqlInt i) = case i of + 1 -> pure NoneTag + 2 -> pure LockedTag + 3 -> pure SSOTag + 4 -> pure BackendTag + 5 -> pure NoRegistrationTag + 6 -> pure PreAuthorizedTag + n -> Left $ "Unexpected DomainRedirectTag value: " ++ show n + fromCql _ = Left "DomainRedirectTag value: int expected" + +instance C.Cql TeamInviteTag where + ctype = C.Tagged C.IntColumn + + toCql AllowedTag = C.CqlInt 1 + toCql NotAllowedTag = C.CqlInt 2 + toCql TeamTag = C.CqlInt 3 + + fromCql (C.CqlInt i) = case i of + 1 -> pure AllowedTag + 2 -> pure NotAllowedTag + 3 -> pure TeamTag + n -> Left $ "Unexpected TeamInviteTag value: " ++ show n + fromCql _ = Left "TeamInviteTag value: int expected" + +instance C.Cql DnsVerificationToken where + ctype = C.Tagged C.AsciiColumn + toCql = C.toCql . toText . unDnsVerificationToken + fromCql (C.CqlAscii t) = DnsVerificationToken <$> Ascii.validate t + fromCql _ = Left "DnsVerificationToken value: text expected" 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 0c294f7a00d..a677c0172c9 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -38,6 +38,7 @@ module Wire.API.Routes.Internal.Brig swaggerDoc, module Wire.API.Routes.Internal.Brig.EJPD, FoundInvitationCode (..), + EnterpriseLoginApi, ) where @@ -69,6 +70,7 @@ import Wire.API.MLS.CipherSuite import Wire.API.Routes.FederationDomainConfig import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.Internal.Brig.EJPD +import Wire.API.Routes.Internal.Brig.EnterpriseLogin (EnterpriseLoginApi) import Wire.API.Routes.Internal.Brig.OAuth (OAuthAPI) import Wire.API.Routes.Internal.Brig.SearchIndex (ISearchIndexAPI) import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti qualified as Multi @@ -507,6 +509,7 @@ type API = :<|> ISearchIndexAPI :<|> FederationRemotesAPI :<|> ProviderAPI + :<|> EnterpriseLoginApi ) type IStatusAPI = diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig/EnterpriseLogin.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig/EnterpriseLogin.hs new file mode 100644 index 00000000000..c3864086a90 --- /dev/null +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig/EnterpriseLogin.hs @@ -0,0 +1,107 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2024 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Wire.API.Routes.Internal.Brig.EnterpriseLogin where + +import Data.Domain +import Servant +import Wire.API.EnterpriseLogin +import Wire.API.Routes.Named + +-------------------------------------------------------------------------------- +-- API Internal + +type EnterpriseLoginApi = + Named + "domain-registration-lock" + ( Summary "Adds a domain to the Deny-list" + :> Description + "This creates an entry in the email domain registration table with domain-redirect=locked \ + \and team-invites=allowed. Any previous entry for that domain is overwritten." + :> "domain-registration" + :> Capture "domain" Domain + :> "lock" + :> PostNoContent + ) + :<|> Named + "domain-registration-unlock" + ( Summary "Unlocks a domain" + :> Description + "If the domain-redirect value for that domain is locked, it will be set to none. \ + \Otherwise this results in and error. \ + \Does not modify the team-invites value and does not create an entry if it's missing." + :> "domain-registration" + :> Capture "domain" Domain + :> "unlock" + :> PostNoContent + ) + :<|> Named + "domain-registration-pre-authorize" + ( Summary "Pre-authorizes a domain" + :> Description + "If the domain-redirect value for that domain is none, or if there is no entry for that domain, \ + \this will set the status of the domain-redirect to pre-authorized. \ + \`team-invitation` is not altered (if the entry is missing, it will be set to allowed). \ + \This means that the customer claiming this domain has the necessary commercial contract with Wire \ + \and can continue to register the domain on their own." + :> "domain-registration" + :> Capture "domain" Domain + :> "preauthorize" + :> PostNoContent + ) + :<|> Named + "domain-registration-unauthorize" + ( Summary "Un-authorizes a domain" + :> Description + "If the domain-redirect value for that domain is `pre-authorized`, `backend:{url}` or `no-registration`, \ + \this will set it to none. Returns an error otherwise. \ + \Does not modify the `team-invites` value nor creates an entry if it's missing." + :> "domain-registration" + :> Capture "domain" Domain + :> "unauthorize" + :> PostNoContent + ) + :<|> Named + "domain-registration-update" + ( Summary "Updates a domain" + :> Description + "This creates or updates the entry in the email domain registration table \ + \for that domain with the given configuration. \ + \This is the most flexible endpoint, that can set any arbitrary value, to deal with edge cases in the process." + :> "domain-registration" + :> Capture "domain" Domain + :> ReqBody '[JSON] DomainRegistrationUpdate + :> PutNoContent + ) + :<|> Named + "domain-registration-delete" + ( Summary "Deletes a domain" + :> Description + "This deletes the entry in the domain table, making the domain available to be registered from scratch again. \ + \This also means that the domain is removed from the deny-list and is not pre-authorized." + :> "domain-registration" + :> Capture "domain" Domain + :> DeleteNoContent + ) + :<|> Named + "domain-registration-get" + ( Summary "Returns the current entry in the domain table for that domain" + :> Description "Returns the current entry in the domain table for that domain, as a JSON document" + :> "domain-registration" + :> Capture "domain" Domain + :> Get '[JSON] DomainRegistration + ) diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs index 3120bbdf928..c0f24d6f764 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs @@ -33,6 +33,7 @@ import Test.Wire.API.Golden.Manual.ConversationsResponse import Test.Wire.API.Golden.Manual.CreateGroupConversation import Test.Wire.API.Golden.Manual.CreateScimToken import Test.Wire.API.Golden.Manual.CreateScimTokenResponse +import Test.Wire.API.Golden.Manual.EnterpriseLogin import Test.Wire.API.Golden.Manual.FeatureConfigEvent import Test.Wire.API.Golden.Manual.FederationDomainConfig import Test.Wire.API.Golden.Manual.FederationRestriction @@ -319,5 +320,23 @@ tests = testObjects [ (testObject_InvitationUserView_team_1, "testObject_InvitationUserView_team_1.json"), (testObject_InvitationUserView_team_2, "testObject_InvitationUserView_team_2.json") + ], + testGroup "DomainRegistration" $ + testObjects + [ (testObject_DomainRegistration_1, "testObject_DomainRegistration_1.json"), + (testObject_DomainRegistration_2, "testObject_DomainRegistration_2.json"), + (testObject_DomainRegistration_3, "testObject_DomainRegistration_3.json"), + (testObject_DomainRegistration_4, "testObject_DomainRegistration_4.json"), + (testObject_DomainRegistration_5, "testObject_DomainRegistration_5.json"), + (testObject_DomainRegistration_6, "testObject_DomainRegistration_6.json") + ], + testGroup "DomainRegistrationUpdate" $ + testObjects + [ (testObject_DomainRegistrationUpdate_1, "testObject_DomainRegistrationUpdate_1.json"), + (testObject_DomainRegistrationUpdate_2, "testObject_DomainRegistrationUpdate_2.json"), + (testObject_DomainRegistrationUpdate_3, "testObject_DomainRegistrationUpdate_3.json"), + (testObject_DomainRegistrationUpdate_4, "testObject_DomainRegistrationUpdate_4.json"), + (testObject_DomainRegistrationUpdate_5, "testObject_DomainRegistrationUpdate_5.json"), + (testObject_DomainRegistrationUpdate_6, "testObject_DomainRegistrationUpdate_6.json") ] ] diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/EnterpriseLogin.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/EnterpriseLogin.hs new file mode 100644 index 00000000000..93f12b4f078 --- /dev/null +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/EnterpriseLogin.hs @@ -0,0 +1,123 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Test.Wire.API.Golden.Manual.EnterpriseLogin where + +import Data.Domain (Domain (Domain)) +import Data.Id +import Data.Misc (HttpsUrl (HttpsUrl)) +import Data.UUID qualified as UUID +import Imports +import SAML2.WebSSO qualified as SAML +import URI.ByteString (parseURI, strictURIParserOptions) +import Wire.API.EnterpriseLogin + +testObject_DomainRegistration_1 :: DomainRegistration +testObject_DomainRegistration_1 = + DomainRegistration + { domain = Domain "example.com", + domainRedirect = Locked, + teamInvite = Allowed, + dnsVerificationToken = Nothing + } + +testObject_DomainRegistration_2 :: DomainRegistration +testObject_DomainRegistration_2 = + DomainRegistration + { domain = Domain "example.com", + domainRedirect = None, + teamInvite = NotAllowed, + dnsVerificationToken = Nothing + } + +testObject_DomainRegistration_3 :: DomainRegistration +testObject_DomainRegistration_3 = + DomainRegistration + { domain = Domain "example.com", + domainRedirect = SSO (SAML.IdPId $ fromJust (UUID.fromString "abf7c0b2-f4e6-4588-8fbb-3b4bf2344284")), + teamInvite = Team $ Id (fromJust (UUID.fromString "abf7c0b2-f4e6-4588-8fbb-3b4bf2344284")), + dnsVerificationToken = Nothing + } + +testObject_DomainRegistration_4 :: DomainRegistration +testObject_DomainRegistration_4 = + DomainRegistration + { domain = Domain "example.com", + domainRedirect = Backend (HttpsUrl (fromRight' (parseURI strictURIParserOptions "https://example.com/inv14"))), + teamInvite = Allowed, + dnsVerificationToken = Nothing + } + +testObject_DomainRegistration_5 :: DomainRegistration +testObject_DomainRegistration_5 = + DomainRegistration + { domain = Domain "example.com", + domainRedirect = NoRegistration, + teamInvite = Allowed, + dnsVerificationToken = Nothing + } + +testObject_DomainRegistration_6 :: DomainRegistration +testObject_DomainRegistration_6 = + DomainRegistration + { domain = Domain "example.com", + domainRedirect = PreAuthorized, + teamInvite = Allowed, + dnsVerificationToken = Just $ DnsVerificationToken "wire-domain-::example.com" + } + +testObject_DomainRegistrationUpdate_1 :: DomainRegistrationUpdate +testObject_DomainRegistrationUpdate_1 = + DomainRegistrationUpdate + { domainRedirect = Locked, + teamInvite = Allowed + } + +testObject_DomainRegistrationUpdate_2 :: DomainRegistrationUpdate +testObject_DomainRegistrationUpdate_2 = + DomainRegistrationUpdate + { domainRedirect = None, + teamInvite = NotAllowed + } + +testObject_DomainRegistrationUpdate_3 :: DomainRegistrationUpdate +testObject_DomainRegistrationUpdate_3 = + DomainRegistrationUpdate + { domainRedirect = SSO (SAML.IdPId $ fromJust (UUID.fromString "abf7c0b2-f4e6-4588-8fbb-3b4bf2344284")), + teamInvite = Allowed + } + +testObject_DomainRegistrationUpdate_4 :: DomainRegistrationUpdate +testObject_DomainRegistrationUpdate_4 = + DomainRegistrationUpdate + { domainRedirect = Backend (HttpsUrl (fromRight' (parseURI strictURIParserOptions "https://example.com/inv14"))), + teamInvite = Allowed + } + +testObject_DomainRegistrationUpdate_5 :: DomainRegistrationUpdate +testObject_DomainRegistrationUpdate_5 = + DomainRegistrationUpdate + { domainRedirect = PreAuthorized, + teamInvite = Allowed + } + +testObject_DomainRegistrationUpdate_6 :: DomainRegistrationUpdate +testObject_DomainRegistrationUpdate_6 = + DomainRegistrationUpdate + { domainRedirect = NoRegistration, + teamInvite = Team $ Id (fromJust (UUID.fromString "abf7c0b2-f4e6-4588-8fbb-3b4bf2344284")) + } diff --git a/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_1.json b/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_1.json new file mode 100644 index 00000000000..f851ea30e0d --- /dev/null +++ b/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_1.json @@ -0,0 +1,4 @@ +{ + "domain_redirect": "locked", + "team_invite": "allowed" +} diff --git a/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_2.json b/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_2.json new file mode 100644 index 00000000000..abe41f70cd5 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_2.json @@ -0,0 +1,4 @@ +{ + "domain_redirect": "none", + "team_invite": "not-allowed" +} diff --git a/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_3.json b/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_3.json new file mode 100644 index 00000000000..3fd94eb5434 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_3.json @@ -0,0 +1,5 @@ +{ + "domain_redirect": "sso", + "sso_idp_id": "abf7c0b2-f4e6-4588-8fbb-3b4bf2344284", + "team_invite": "allowed" +} diff --git a/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_4.json b/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_4.json new file mode 100644 index 00000000000..6f4225ae888 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_4.json @@ -0,0 +1,5 @@ +{ + "backend_url": "https://example.com/inv14", + "domain_redirect": "backend", + "team_invite": "allowed" +} diff --git a/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_5.json b/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_5.json new file mode 100644 index 00000000000..a36e01cd1a8 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_5.json @@ -0,0 +1,4 @@ +{ + "domain_redirect": "pre-authorized", + "team_invite": "allowed" +} diff --git a/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_6.json b/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_6.json new file mode 100644 index 00000000000..c31a4601ecb --- /dev/null +++ b/libs/wire-api/test/golden/testObject_DomainRegistrationUpdate_6.json @@ -0,0 +1,5 @@ +{ + "domain_redirect": "no-registration", + "team": "abf7c0b2-f4e6-4588-8fbb-3b4bf2344284", + "team_invite": "team" +} diff --git a/libs/wire-api/test/golden/testObject_DomainRegistration_1.json b/libs/wire-api/test/golden/testObject_DomainRegistration_1.json new file mode 100644 index 00000000000..f495e59e8a7 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_DomainRegistration_1.json @@ -0,0 +1,6 @@ +{ + "dns_verification_token": null, + "domain": "example.com", + "domain_redirect": "locked", + "team_invite": "allowed" +} diff --git a/libs/wire-api/test/golden/testObject_DomainRegistration_2.json b/libs/wire-api/test/golden/testObject_DomainRegistration_2.json new file mode 100644 index 00000000000..d045b902f39 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_DomainRegistration_2.json @@ -0,0 +1,6 @@ +{ + "dns_verification_token": null, + "domain": "example.com", + "domain_redirect": "none", + "team_invite": "not-allowed" +} diff --git a/libs/wire-api/test/golden/testObject_DomainRegistration_3.json b/libs/wire-api/test/golden/testObject_DomainRegistration_3.json new file mode 100644 index 00000000000..e584ad6cb6f --- /dev/null +++ b/libs/wire-api/test/golden/testObject_DomainRegistration_3.json @@ -0,0 +1,8 @@ +{ + "dns_verification_token": null, + "domain": "example.com", + "domain_redirect": "sso", + "sso_idp_id": "abf7c0b2-f4e6-4588-8fbb-3b4bf2344284", + "team": "abf7c0b2-f4e6-4588-8fbb-3b4bf2344284", + "team_invite": "team" +} diff --git a/libs/wire-api/test/golden/testObject_DomainRegistration_4.json b/libs/wire-api/test/golden/testObject_DomainRegistration_4.json new file mode 100644 index 00000000000..ab9f562c57a --- /dev/null +++ b/libs/wire-api/test/golden/testObject_DomainRegistration_4.json @@ -0,0 +1,7 @@ +{ + "backend_url": "https://example.com/inv14", + "dns_verification_token": null, + "domain": "example.com", + "domain_redirect": "backend", + "team_invite": "allowed" +} diff --git a/libs/wire-api/test/golden/testObject_DomainRegistration_5.json b/libs/wire-api/test/golden/testObject_DomainRegistration_5.json new file mode 100644 index 00000000000..79951e58026 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_DomainRegistration_5.json @@ -0,0 +1,6 @@ +{ + "dns_verification_token": null, + "domain": "example.com", + "domain_redirect": "no-registration", + "team_invite": "allowed" +} diff --git a/libs/wire-api/test/golden/testObject_DomainRegistration_6.json b/libs/wire-api/test/golden/testObject_DomainRegistration_6.json new file mode 100644 index 00000000000..b0e88693ad9 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_DomainRegistration_6.json @@ -0,0 +1,6 @@ +{ + "dns_verification_token": "wire-domain-::example.com", + "domain": "example.com", + "domain_redirect": "pre-authorized", + "team_invite": "allowed" +} diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index a4568c2aa27..cebcabd0640 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -88,6 +88,7 @@ library Wire.API.Conversation.Typing Wire.API.CustomBackend Wire.API.Deprecated + Wire.API.EnterpriseLogin Wire.API.Error Wire.API.Error.Brig Wire.API.Error.Cannon @@ -161,6 +162,7 @@ library Wire.API.Routes.Internal.Brig Wire.API.Routes.Internal.Brig.Connection Wire.API.Routes.Internal.Brig.EJPD + Wire.API.Routes.Internal.Brig.EnterpriseLogin Wire.API.Routes.Internal.Brig.OAuth Wire.API.Routes.Internal.Brig.SearchIndex Wire.API.Routes.Internal.Cannon @@ -590,6 +592,7 @@ test-suite wire-api-golden-tests Test.Wire.API.Golden.Manual.CreateGroupConversation Test.Wire.API.Golden.Manual.CreateScimToken Test.Wire.API.Golden.Manual.CreateScimTokenResponse + Test.Wire.API.Golden.Manual.EnterpriseLogin Test.Wire.API.Golden.Manual.FeatureConfigEvent Test.Wire.API.Golden.Manual.FederationDomainConfig Test.Wire.API.Golden.Manual.FederationRestriction diff --git a/libs/wire-subsystems/default.nix b/libs/wire-subsystems/default.nix index 3653e611057..ac1b63bb452 100644 --- a/libs/wire-subsystems/default.nix +++ b/libs/wire-subsystems/default.nix @@ -4,6 +4,7 @@ # dependencies are added or removed. { mkDerivation , aeson +, aeson-pretty , amazonka , amazonka-core , amazonka-ses @@ -94,6 +95,7 @@ mkDerivation { src = gitignoreSource ./.; libraryHaskellDepends = [ aeson + aeson-pretty amazonka amazonka-core amazonka-ses diff --git a/libs/wire-subsystems/src/Wire/DomainRegistrationStore.hs b/libs/wire-subsystems/src/Wire/DomainRegistrationStore.hs new file mode 100644 index 00000000000..aa7ed5acd4f --- /dev/null +++ b/libs/wire-subsystems/src/Wire/DomainRegistrationStore.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wire.DomainRegistrationStore where + +import Data.Domain +import Data.Id +import Data.Misc +import Database.CQL.Protocol (Record (..), TupleType, recordInstance) +import Imports +import Polysemy +import SAML2.WebSSO qualified as SAML +import Wire.API.EnterpriseLogin + +data StoredDomainRegistration = StoredDomainRegistration + { domain :: Domain, + domainRedirect :: DomainRedirectTag, + teamInvite :: TeamInviteTag, + idpId :: Maybe SAML.IdPId, + backendUrl :: Maybe HttpsUrl, + team :: Maybe TeamId, + dnsVerificationToken :: Maybe DnsVerificationToken + } + deriving (Show, Eq, Ord, Generic) + +recordInstance ''StoredDomainRegistration + +data DomainRegistrationStore m a where + Upsert :: StoredDomainRegistration -> DomainRegistrationStore m () + Lookup :: Domain -> DomainRegistrationStore m (Maybe StoredDomainRegistration) + Delete :: Domain -> DomainRegistrationStore m () + +makeSem ''DomainRegistrationStore diff --git a/libs/wire-subsystems/src/Wire/DomainRegistrationStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/DomainRegistrationStore/Cassandra.hs new file mode 100644 index 00000000000..a5062481bce --- /dev/null +++ b/libs/wire-subsystems/src/Wire/DomainRegistrationStore/Cassandra.hs @@ -0,0 +1,48 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Wire.DomainRegistrationStore.Cassandra + ( interpretDomainRegistrationStoreToCassandra, + ) +where + +import Cassandra +import Data.Domain +import Database.CQL.Protocol (Record (..), TupleType, asTuple) +import Imports hiding (lookup) +import Polysemy +import SAML2.WebSSO qualified as SAML +import Wire.DomainRegistrationStore (DomainRegistrationStore (..), StoredDomainRegistration (..)) + +deriving instance Cql SAML.IdPId + +interpretDomainRegistrationStoreToCassandra :: + forall r. + (Member (Embed IO) r) => + ClientState -> + InterpreterFor DomainRegistrationStore r +interpretDomainRegistrationStoreToCassandra casClient = + interpret $ + embed @IO . runClient casClient . \case + Upsert dr -> upsert dr + Lookup domain -> lookup domain + Delete domain -> delete domain + +upsert :: (MonadClient m) => StoredDomainRegistration -> m () +upsert dr = retry x5 $ write cqlUpsert (params LocalQuorum (asTuple dr)) + +lookup :: (MonadClient m) => Domain -> m (Maybe StoredDomainRegistration) +lookup domain = + fmap asRecord + <$> retry x1 (query1 cqlSelect (params LocalQuorum (Identity domain))) + +delete :: (MonadClient m) => Domain -> m () +delete domain = retry x5 $ write cqlDelete (params LocalQuorum (Identity domain)) + +cqlUpsert :: PrepQuery W (TupleType StoredDomainRegistration) () +cqlUpsert = "INSERT INTO domain_registration (domain, domain_redirect, team_invite, idp_id, backend_url, team, dns_verification_token) VALUES (?,?,?,?,?,?,?)" + +cqlSelect :: PrepQuery R (Identity Domain) (TupleType StoredDomainRegistration) +cqlSelect = "SELECT domain, domain_redirect, team_invite, idp_id, backend_url, team, dns_verification_token FROM domain_registration WHERE domain = ?" + +cqlDelete :: PrepQuery W (Identity Domain) () +cqlDelete = "DELETE FROM domain_registration WHERE domain = ?" diff --git a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem.hs b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem.hs new file mode 100644 index 00000000000..8d839eb50cf --- /dev/null +++ b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wire.EnterpriseLoginSubsystem where + +import Data.Domain +import Polysemy +import Wire.API.EnterpriseLogin + +data EnterpriseLoginSubsystem m a where + LockDomain :: Domain -> EnterpriseLoginSubsystem m () + UnlockDomain :: Domain -> EnterpriseLoginSubsystem m () + PreAuthorizeDomain :: Domain -> EnterpriseLoginSubsystem m () + UnAuthorizeDomain :: Domain -> EnterpriseLoginSubsystem m () + UpdateDomainRegistration :: Domain -> DomainRegistrationUpdate -> EnterpriseLoginSubsystem m () + DeleteDomain :: Domain -> EnterpriseLoginSubsystem m () + GetDomainRegistration :: Domain -> EnterpriseLoginSubsystem m DomainRegistration + +makeSem ''EnterpriseLoginSubsystem diff --git a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Error.hs b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Error.hs new file mode 100644 index 00000000000..9392c41f4a4 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Error.hs @@ -0,0 +1,27 @@ +module Wire.EnterpriseLoginSubsystem.Error where + +import Imports +import Network.HTTP.Types +import Network.Wai.Utilities qualified as Wai +import Wire.Error + +data EnterpriseLoginSubsystemError + = EnterpriseLoginSubsystemErrorNotFound + | EnterpriseLoginSubsystemInternalError LText + | EnterpriseLoginSubsystemErrorUpdateFailure LText + | EnterpriseLoginSubsystemUnlockError + | EnterpriseLoginSubsystemUnAuthorizeError + | EnterpriseLoginSubsystemPreAuthorizeError + deriving (Show, Eq) + +instance Exception EnterpriseLoginSubsystemError + +enterpriseLoginSubsystemErrorToHttpError :: EnterpriseLoginSubsystemError -> HttpError +enterpriseLoginSubsystemErrorToHttpError = + StdError . \case + EnterpriseLoginSubsystemErrorNotFound -> Wai.mkError status404 "not-found" "Not Found" + EnterpriseLoginSubsystemInternalError msg -> Wai.mkError status500 "internal-error" msg + EnterpriseLoginSubsystemErrorUpdateFailure msg -> Wai.mkError status400 "update-failure" msg + EnterpriseLoginSubsystemUnlockError -> Wai.mkError status409 "unlock-error" "Domain can only be unlocked from a locked state" + EnterpriseLoginSubsystemUnAuthorizeError -> Wai.mkError status409 "unauthorize-error" "Domain redirect can not bet set to unauthorized when locked or SSO" + EnterpriseLoginSubsystemPreAuthorizeError -> Wai.mkError status409 "preauthorize-error" "Domain redirect must be 'none' to be pre-authorized" diff --git a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs new file mode 100644 index 00000000000..5eda2649349 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs @@ -0,0 +1,342 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} + +module Wire.EnterpriseLoginSubsystem.Interpreter + ( runEnterpriseLoginSubsystem, + EnterpriseLoginSubsystemConfig (..), + ) +where + +import Data.Aeson qualified as Aeson +import Data.Aeson.Encode.Pretty qualified as Aeson +import Data.ByteString.Conversion (toByteString') +import Data.Domain (Domain, domainText) +import Data.Id +import Data.Misc (HttpsUrl (..)) +import Data.Text.Internal.Builder (fromLazyText, fromText, toLazyText) +import Data.Text.Lazy.Builder (Builder) +import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8) +import Imports hiding (lookup) +import Network.Mail.Mime (Address (Address), Mail (mailHeaders, mailParts, mailTo), emptyMail, plainPart) +import Polysemy +import Polysemy.Error (Error, throw) +import Polysemy.Input (Input, input) +import Polysemy.TinyLog (TinyLog) +import Polysemy.TinyLog qualified as Log +import SAML2.WebSSO qualified as SAML +import System.Logger.Message qualified as Log +import Wire.API.EnterpriseLogin +import Wire.API.User.EmailAddress (EmailAddress, fromEmail) +import Wire.DomainRegistrationStore +import Wire.EmailSending (EmailSending, sendMail) +import Wire.EnterpriseLoginSubsystem +import Wire.EnterpriseLoginSubsystem.Error + +data EnterpriseLoginSubsystemConfig = EnterpriseLoginSubsystemConfig + { auditEmailSender :: EmailAddress, + auditEmailRecipient :: EmailAddress + } + +runEnterpriseLoginSubsystem :: + ( Member DomainRegistrationStore r, + Member (Error EnterpriseLoginSubsystemError) r, + Member TinyLog r, + Member (Input (Maybe EnterpriseLoginSubsystemConfig)) r, + Member EmailSending r + ) => + Sem (EnterpriseLoginSubsystem ': r) a -> + Sem r a +runEnterpriseLoginSubsystem = interpret $ + \case + LockDomain domain -> lockDomainImpl domain + UnlockDomain domain -> unlockDomainImpl domain + PreAuthorizeDomain domain -> preAuthorizeImpl domain + UnAuthorizeDomain domain -> unauthorizeImpl domain + UpdateDomainRegistration domain update -> updateDomainRegistrationImpl domain update + DeleteDomain domain -> deleteDomainImpl domain + GetDomainRegistration domain -> getDomainRegistrationImpl domain + +deleteDomainImpl :: + ( Member DomainRegistrationStore r, + Member (Error EnterpriseLoginSubsystemError) r, + Member TinyLog r, + Member (Input (Maybe EnterpriseLoginSubsystemConfig)) r, + Member EmailSending r + ) => + Domain -> + Sem r () +deleteDomainImpl domain = do + mOld <- tryGetDomainRegistrationImpl domain + sendAuditMail url "Domain deleted" mOld Nothing + delete domain + where + url :: Builder + url = + "DELETE /i/domain-registration/" + <> fromText (domainText domain) + +unauthorizeImpl :: + forall r. + ( Member DomainRegistrationStore r, + Member (Error EnterpriseLoginSubsystemError) r, + Member TinyLog r, + Member (Input (Maybe EnterpriseLoginSubsystemConfig)) r, + Member EmailSending r + ) => + Domain -> + Sem r () +unauthorizeImpl domain = do + old <- getDomainRegistrationImpl domain + let new = old {domainRedirect = None} :: DomainRegistration + case old.domainRedirect of + PreAuthorized -> audit old new *> upsert (toStored new) + Backend _ -> audit old new *> upsert (toStored new) + NoRegistration -> audit old new *> upsert (toStored new) + None -> pure () + Locked -> throw EnterpriseLoginSubsystemUnAuthorizeError + SSO _ -> throw EnterpriseLoginSubsystemUnAuthorizeError + where + audit :: DomainRegistration -> DomainRegistration -> Sem r () + audit old new = sendAuditMail url "Domain unauthorized" (Just old) (Just new) + + url :: Builder + url = + "POST /i/domain-registration/" + <> fromText (domainText domain) + <> "/unauthorized" + +updateDomainRegistrationImpl :: + forall r. + ( Member DomainRegistrationStore r, + Member (Error EnterpriseLoginSubsystemError) r, + Member TinyLog r, + Member (Input (Maybe EnterpriseLoginSubsystemConfig)) r, + Member EmailSending r + ) => + Domain -> + DomainRegistrationUpdate -> + Sem r () +updateDomainRegistrationImpl domain update = do + validate update + mOld <- (>>= fromStored) <$> lookup domain + case mOld of + Just dr -> do + let new = dr {teamInvite = update.teamInvite, domainRedirect = update.domainRedirect} :: DomainRegistration + audit mOld new *> upsert (toStored new) + Nothing -> do + let new = DomainRegistration domain update.domainRedirect update.teamInvite Nothing + audit mOld new *> upsert (toStored new) + where + audit :: Maybe DomainRegistration -> DomainRegistration -> Sem r () + audit old new = sendAuditMail url "Domain registration updated" old (Just new) + + url :: Builder + url = + "PUT /i/domain-registration/" + <> fromText (domainText domain) + +lockDomainImpl :: + forall r. + ( Member DomainRegistrationStore r, + Member (Error EnterpriseLoginSubsystemError) r, + Member TinyLog r, + Member (Input (Maybe EnterpriseLoginSubsystemConfig)) r, + Member EmailSending r + ) => + Domain -> + Sem r () +lockDomainImpl domain = do + mOld <- tryGetDomainRegistrationImpl domain + let new = DomainRegistration domain Locked Allowed Nothing + audit mOld new *> upsert (toStored new) + where + url :: Builder + url = + "POST /i/domain-registration/" + <> fromText (domainText domain) + <> "/lock" + + audit :: Maybe DomainRegistration -> DomainRegistration -> Sem r () + audit old new = sendAuditMail url "Domain locked" old (Just new) + +unlockDomainImpl :: + forall r. + ( Member DomainRegistrationStore r, + Member (Error EnterpriseLoginSubsystemError) r, + Member TinyLog r, + Member (Input (Maybe EnterpriseLoginSubsystemConfig)) r, + Member EmailSending r + ) => + Domain -> + Sem r () +unlockDomainImpl domain = do + old <- getDomainRegistrationImpl domain + let new = old {domainRedirect = None} :: DomainRegistration + case old.domainRedirect of + Locked -> audit old new *> upsert (toStored new) + _ -> throw EnterpriseLoginSubsystemUnlockError + where + url :: Builder + url = + "POST /i/domain-registration/" + <> fromText (domainText domain) + <> "/unlock" + + audit :: DomainRegistration -> DomainRegistration -> Sem r () + audit old new = sendAuditMail url "Domain locked" (Just old) (Just new) + +preAuthorizeImpl :: + forall r. + ( Member DomainRegistrationStore r, + Member (Error EnterpriseLoginSubsystemError) r, + Member TinyLog r, + Member (Input (Maybe EnterpriseLoginSubsystemConfig)) r, + Member EmailSending r + ) => + Domain -> + Sem r () +preAuthorizeImpl domain = do + mOld <- tryGetDomainRegistrationImpl domain + case mOld of + Nothing -> do + let new = DomainRegistration domain PreAuthorized Allowed Nothing + audit mOld new *> upsert (toStored new) + Just old | old.domainRedirect == None -> do + let new = old {domainRedirect = PreAuthorized} :: DomainRegistration + audit (Just old) new *> upsert (toStored new) + Just old | old.domainRedirect == PreAuthorized -> pure () + _ -> throw $ EnterpriseLoginSubsystemPreAuthorizeError + where + url :: Builder + url = + "POST /i/domain-registration/" + <> fromText (domainText domain) + <> "/preauthorize" + + audit :: Maybe DomainRegistration -> DomainRegistration -> Sem r () + audit old new = sendAuditMail url "Domain locked" old (Just new) + +getDomainRegistrationImpl :: + ( Member DomainRegistrationStore r, + Member (Error EnterpriseLoginSubsystemError) r, + Member TinyLog r + ) => + Domain -> + Sem r DomainRegistration +getDomainRegistrationImpl domain = do + mSdr <- tryGetDomainRegistrationImpl domain + case mSdr of + Just dr -> pure dr + Nothing -> throw EnterpriseLoginSubsystemErrorNotFound + +tryGetDomainRegistrationImpl :: + forall r. + ( Member DomainRegistrationStore r, + Member (Error EnterpriseLoginSubsystemError) r, + Member TinyLog r + ) => + Domain -> + Sem r (Maybe DomainRegistration) +tryGetDomainRegistrationImpl domain = do + mSdr <- lookup domain + maybe (pure Nothing) (fmap Just . fromStoredWithExcept) mSdr + where + fromStoredWithExcept :: StoredDomainRegistration -> Sem r DomainRegistration + fromStoredWithExcept sdr = do + case fromStored sdr of + Nothing -> do + Log.err $ Log.field "domain" (toByteString' domain) . Log.msg (Log.val "Invalid stored domain registration") + throw $ EnterpriseLoginSubsystemInternalError "The stored domain registration is invalid. Please update or delete and recreate it with a valid configuration." + Just dr -> pure dr + +fromStored :: StoredDomainRegistration -> Maybe DomainRegistration +fromStored sdr = + DomainRegistration sdr.domain + <$> getDomainRedirect sdr + <*> getTeamInvite sdr + <*> pure sdr.dnsVerificationToken + where + getTeamInvite :: StoredDomainRegistration -> Maybe TeamInvite + getTeamInvite = \case + StoredDomainRegistration _ _ ti _ _ tid _ -> case (ti, tid) of + (AllowedTag, Nothing) -> Just Allowed + (NotAllowedTag, Nothing) -> Just NotAllowed + (TeamTag, Just teamId) -> Just $ Team teamId + _ -> Nothing + + getDomainRedirect :: StoredDomainRegistration -> Maybe DomainRedirect + getDomainRedirect = \case + StoredDomainRegistration _ dr _ ssoId url _ _ -> case (dr, ssoId, url) of + (NoneTag, Nothing, Nothing) -> Just None + (LockedTag, Nothing, Nothing) -> Just Locked + (PreAuthorizedTag, Nothing, Nothing) -> Just PreAuthorized + (SSOTag, Just idpId, Nothing) -> Just $ SSO idpId + (BackendTag, Nothing, Just beUrl) -> Just $ Backend beUrl + (NoRegistrationTag, Nothing, Nothing) -> Just NoRegistration + _ -> Nothing + +toStored :: DomainRegistration -> StoredDomainRegistration +toStored dr = + let (domainRedirect, idpId, backendUrl) = fromDomainRedirect dr.domainRedirect + (teamInvite, team) = fromTeamInvite dr.teamInvite + in StoredDomainRegistration dr.domain domainRedirect teamInvite idpId backendUrl team (dr.dnsVerificationToken) + where + fromTeamInvite :: TeamInvite -> (TeamInviteTag, Maybe TeamId) + fromTeamInvite Allowed = (AllowedTag, Nothing) + fromTeamInvite NotAllowed = (NotAllowedTag, Nothing) + fromTeamInvite (Team teamId) = (TeamTag, Just teamId) + + fromDomainRedirect :: DomainRedirect -> (DomainRedirectTag, Maybe SAML.IdPId, Maybe HttpsUrl) + fromDomainRedirect None = (NoneTag, Nothing, Nothing) + fromDomainRedirect Locked = (LockedTag, Nothing, Nothing) + fromDomainRedirect (SSO idpId) = (SSOTag, Just idpId, Nothing) + fromDomainRedirect (Backend url) = (BackendTag, Nothing, Just url) + fromDomainRedirect NoRegistration = (NoRegistrationTag, Nothing, Nothing) + fromDomainRedirect PreAuthorized = (PreAuthorizedTag, Nothing, Nothing) + +validate :: (Member (Error EnterpriseLoginSubsystemError) r) => DomainRegistrationUpdate -> Sem r () +validate dr = do + case dr.domainRedirect of + Locked -> when (dr.teamInvite /= Allowed) $ throw (EnterpriseLoginSubsystemErrorUpdateFailure "Team invite must be allowed for a locked domain") + Backend _ -> when (dr.teamInvite /= NotAllowed) $ throw (EnterpriseLoginSubsystemErrorUpdateFailure "Team invite must not be allowed for a backend domain") + _ -> pure () + +mkAuditMail :: EmailAddress -> EmailAddress -> Text -> LText -> Mail +mkAuditMail from to subject body = + (emptyMail (Address Nothing (fromEmail from))) + { mailTo = [Address Nothing (fromEmail to)], + mailHeaders = + [ ("Subject", subject), + ("X-Zeta-Purpose", "audit") + ], + mailParts = [[plainPart body]] + } + +sendAuditMail :: + ( Member (Input (Maybe EnterpriseLoginSubsystemConfig)) r, + Member TinyLog r, + Member EmailSending r + ) => + Builder -> + Text -> + Maybe DomainRegistration -> + Maybe DomainRegistration -> + Sem r () +sendAuditMail url subject mBefore mAfter = do + let auditLog :: LText = + toLazyText $ + url + <> " called;\nOld value:\n" + <> fromLazyText (decodeUtf8 (maybe "null" Aeson.encodePretty mBefore)) + <> "\nNew value:\n" + <> fromLazyText (decodeUtf8 (maybe "null" Aeson.encodePretty mAfter)) + Log.info $ + Log.msg (Log.val "Domain registration audit log") + . Log.field "url" (encodeUtf8 $ toLazyText url) + . Log.field "old_value" (maybe "null" Aeson.encode mBefore) + . Log.field "new_value" (maybe "null" Aeson.encode mAfter) + mConfig <- input + for_ mConfig $ \config -> do + let mail = mkAuditMail (config.auditEmailSender) (config.auditEmailRecipient) subject auditLog + sendMail mail diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index f4e19a433bd..9e2652d6605 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -79,12 +79,17 @@ library Wire.BlockListStore.Cassandra Wire.DeleteQueue Wire.DeleteQueue.InMemory + Wire.DomainRegistrationStore + Wire.DomainRegistrationStore.Cassandra Wire.EmailSending Wire.EmailSending.SES Wire.EmailSending.SMTP Wire.EmailSubsystem Wire.EmailSubsystem.Interpreter Wire.EmailSubsystem.Template + Wire.EnterpriseLoginSubsystem + Wire.EnterpriseLoginSubsystem.Error + Wire.EnterpriseLoginSubsystem.Interpreter Wire.Error Wire.Events Wire.FederationAPIAccess @@ -146,6 +151,7 @@ library hs-source-dirs: src build-depends: , aeson + , aeson-pretty , amazonka , amazonka-core , amazonka-ses diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 29cc881005c..2f551c0b8e3 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -185,6 +185,7 @@ library Brig.Schema.V85_DropUserKeysHashed Brig.Schema.V86_WriteTimeBumper Brig.Schema.V87_DropInvitationTables + Brig.Schema.V88_DomainRegistrationTable Brig.Team.API Brig.Team.Email Brig.Team.Template diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 75a80dde93e..a53de855176 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -93,6 +93,7 @@ import Wire.AuthenticationSubsystem (AuthenticationSubsystem) import Wire.BlockListStore (BlockListStore) import Wire.DeleteQueue (DeleteQueue) import Wire.EmailSubsystem (EmailSubsystem) +import Wire.EnterpriseLoginSubsystem import Wire.Events (Events) import Wire.Events qualified as Events import Wire.FederationConfigStore @@ -151,7 +152,8 @@ servantSitemap :: Member HashPassword r, Member (Embed IO) r, Member ActivationCodeStore r, - Member (Input UserSubsystemConfig) r + Member (Input UserSubsystemConfig) r, + Member EnterpriseLoginSubsystem r ) => ServerT BrigIRoutes.API (Handler r) servantSitemap = @@ -168,6 +170,7 @@ servantSitemap = :<|> internalSearchIndexAPI :<|> federationRemotesAPI :<|> Provider.internalProviderAPI + :<|> enterpriseLoginApi istatusAPI :: forall r. ServerT BrigIRoutes.IStatusAPI (Handler r) istatusAPI = Named @"get-status" (pure NoContent) @@ -427,6 +430,16 @@ internalSearchIndexAPI :: forall r. ServerT BrigIRoutes.ISearchIndexAPI (Handler internalSearchIndexAPI = Named @"indexRefresh" (NoContent <$ lift (wrapClient Search.refreshIndex)) +enterpriseLoginApi :: (Member EnterpriseLoginSubsystem r) => ServerT BrigIRoutes.EnterpriseLoginApi (Handler r) +enterpriseLoginApi = + Named @"domain-registration-lock" (fmap (const NoContent) . lift . liftSem . lockDomain) + :<|> Named @"domain-registration-unlock" (fmap (const NoContent) . lift . liftSem . unlockDomain) + :<|> Named @"domain-registration-pre-authorize" (fmap (const NoContent) . lift . liftSem . preAuthorizeDomain) + :<|> Named @"domain-registration-unauthorize" (fmap (const NoContent) . lift . liftSem . unAuthorizeDomain) + :<|> Named @"domain-registration-update" (\d p -> fmap (const NoContent) . lift . liftSem $ updateDomainRegistration d p) + :<|> Named @"domain-registration-delete" (fmap (const NoContent) . lift . liftSem . deleteDomain) + :<|> Named @"domain-registration-get" (lift . liftSem . getDomainRegistration) + --------------------------------------------------------------------------- -- Handlers diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index 7b2ceeb4b37..71be677d8d1 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -40,11 +40,16 @@ import Wire.AuthenticationSubsystem.Interpreter import Wire.BlockListStore import Wire.BlockListStore.Cassandra import Wire.DeleteQueue +import Wire.DomainRegistrationStore +import Wire.DomainRegistrationStore.Cassandra import Wire.EmailSending import Wire.EmailSending.SES import Wire.EmailSending.SMTP import Wire.EmailSubsystem import Wire.EmailSubsystem.Interpreter +import Wire.EnterpriseLoginSubsystem +import Wire.EnterpriseLoginSubsystem.Error (EnterpriseLoginSubsystemError, enterpriseLoginSubsystemErrorToHttpError) +import Wire.EnterpriseLoginSubsystem.Interpreter import Wire.Error import Wire.Events import Wire.FederationAPIAccess qualified @@ -103,7 +108,8 @@ import Wire.VerificationCodeSubsystem.Interpreter type BrigCanonicalEffects = '[ AuthenticationSubsystem, TeamInvitationSubsystem, - UserSubsystem + UserSubsystem, + EnterpriseLoginSubsystem ] `Append` BrigLowerLevelEffects @@ -115,6 +121,7 @@ type BrigLowerLevelEffects = DeleteQueue, Wire.Events.Events, NotificationSubsystem, + Error EnterpriseLoginSubsystemError, Error UserSubsystemError, Error TeamInvitationSubsystemError, Error AuthenticationSubsystemError, @@ -123,6 +130,7 @@ type BrigLowerLevelEffects = Error PropertySubsystemError, Error HttpError, Wire.FederationAPIAccess.FederationAPIAccess Wire.API.Federation.Client.FederatorClient, + DomainRegistrationStore, HashPassword, UserKeyStore, UserStore, @@ -141,6 +149,7 @@ type BrigLowerLevelEffects = Input (Local ()), Input (Maybe AllowlistEmailDomains), Input TeamTemplates, + Input (Maybe EnterpriseLoginSubsystemConfig), GundeckAPIAccess, FederationConfigStore, Jwk, @@ -250,6 +259,7 @@ runBrigToIO e (AppT ma) = do . interpretJwk . interpretFederationDomainConfig e.casClient e.settings.federationStrategy (foldMap (remotesMapFromCfgFile . fmap (.federationDomainConfig)) e.settings.federationDomainConfigs) . runGundeckAPIAccess e.gundeckEndpoint + . runInputConst (mkEnterpriseLoginSubsystemConfig e) . runInputConst (teamTemplatesNoLocale e) . runInputConst e.settings.allowlistEmailDomains . runInputConst (toLocalUnsafe e.settings.federationDomain ()) @@ -268,6 +278,7 @@ runBrigToIO e (AppT ma) = do . interpretUserStoreCassandra e.casClient . interpretUserKeyStoreCassandra e.casClient . runHashPassword e.settings.passwordHashingOptions + . interpretDomainRegistrationStoreToCassandra e.casClient . interpretFederationAPIAccess federationApiAccessConfig . rethrowHttpErrorIO . mapError propertySubsystemErrorToHttpError @@ -276,12 +287,14 @@ runBrigToIO e (AppT ma) = do . mapError authenticationSubsystemErrorToHttpError . mapError teamInvitationErrorToHttpError . mapError userSubsystemErrorToHttpError + . mapError enterpriseLoginSubsystemErrorToHttpError . runNotificationSubsystemGundeck (defaultNotificationSubsystemConfig e.requestId) . runEvents . runDeleteQueue e.internalEvents . interpretPropertySubsystem propertySubsystemConfig . interpretVerificationCodeSubsystem . emailSubsystemInterpreter e.userTemplates e.teamTemplates e.templateBranding + . runEnterpriseLoginSubsystem . userSubsystemInterpreter . runTeamInvitationSubsystem teamInvitationSubsystemConfig . authSubsystemInterpreter @@ -289,6 +302,12 @@ runBrigToIO e (AppT ma) = do ) $ runReaderT ma e +mkEnterpriseLoginSubsystemConfig :: Env -> Maybe EnterpriseLoginSubsystemConfig +mkEnterpriseLoginSubsystemConfig env = do + recipient <- env.settings.auditLogEmailRecipient + let sender = env.emailSender + pure $ EnterpriseLoginSubsystemConfig {auditEmailSender = sender, auditEmailRecipient = recipient} + rethrowHttpErrorIO :: (Member (Final IO) r) => InterpreterFor (Error HttpError) r rethrowHttpErrorIO act = do eithError <- errorToIOFinal act diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 04da3707661..1f44b17c0f6 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -586,7 +586,9 @@ data Settings = Settings -- use `oAuthMaxActiveRefreshTokens` as the getter function which always provides a default value oAuthMaxActiveRefreshTokensInternal :: !(Maybe Word32), -- | Options to override the default Argon2id settings for specific operators. - passwordHashingOptions :: !(PasswordHashingOptions) + passwordHashingOptions :: !(PasswordHashingOptions), + -- | Optional recipient email address for email domain registration audit logs + auditLogEmailRecipient :: !(Maybe EmailAddress) } deriving (Show, Generic) diff --git a/services/brig/src/Brig/Schema/Run.hs b/services/brig/src/Brig/Schema/Run.hs index 173c5b15bc0..f5c102e7d15 100644 --- a/services/brig/src/Brig/Schema/Run.hs +++ b/services/brig/src/Brig/Schema/Run.hs @@ -62,6 +62,7 @@ import Brig.Schema.V84_DropTeamInvitationPhone qualified as V84_DropTeamInvitati import Brig.Schema.V85_DropUserKeysHashed qualified as V85_DropUserKeysHashed import Brig.Schema.V86_WriteTimeBumper qualified as V86_WriteTimeBumper import Brig.Schema.V87_DropInvitationTables qualified as V87_DropInvitationTables +import Brig.Schema.V88_DomainRegistrationTable qualified as V88_DomainRegistrationTable import Cassandra.MigrateSchema (migrateSchema) import Cassandra.Schema import Control.Exception (finally) @@ -130,7 +131,8 @@ migrations = V84_DropTeamInvitationPhone.migration, V85_DropUserKeysHashed.migration, V86_WriteTimeBumper.migration, - V87_DropInvitationTables.migration + V87_DropInvitationTables.migration, + V88_DomainRegistrationTable.migration -- FUTUREWORK: undo V41 (searchable flag); we stopped using it in -- https://github.com/wireapp/wire-server/pull/964 ] diff --git a/services/brig/src/Brig/Schema/V88_DomainRegistrationTable.hs b/services/brig/src/Brig/Schema/V88_DomainRegistrationTable.hs new file mode 100644 index 00000000000..16f2d8f5d90 --- /dev/null +++ b/services/brig/src/Brig/Schema/V88_DomainRegistrationTable.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE QuasiQuotes #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2023 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Brig.Schema.V88_DomainRegistrationTable + ( migration, + ) +where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = + Migration 88 "Add domain_registration table" $ do + schema' + [r| + CREATE TABLE IF NOT EXISTS domain_registration + ( domain text PRIMARY KEY, + , domain_redirect int, + , idp_id uuid, + , backend_url blob, + , team_invite int, + , team uuid + , dns_verification_token ascii + ) + |] diff --git a/tools/stern/default.nix b/tools/stern/default.nix index 18246b4fc52..628a2a3a1d9 100644 --- a/tools/stern/default.nix +++ b/tools/stern/default.nix @@ -32,6 +32,7 @@ , retry , schema-profunctor , servant +, servant-client , servant-openapi3 , servant-server , servant-swagger-ui @@ -78,6 +79,7 @@ mkDerivation { openapi3 schema-profunctor servant + servant-client servant-openapi3 servant-server servant-swagger-ui diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs index 53616908c64..e2af401c9ca 100644 --- a/tools/stern/src/Stern/API.hs +++ b/tools/stern/src/Stern/API.hs @@ -187,6 +187,7 @@ sitemap' = :<|> Named @"stern-get-oauth-client" Intra.getOAuthClient :<|> Named @"update-oauth-client" Intra.updateOAuthClient :<|> Named @"delete-oauth-client" Intra.deleteOAuthClient + :<|> Intra.enterpriseLogin sitemapInternal :: Servant.Server SternAPIInternal sitemapInternal = diff --git a/tools/stern/src/Stern/API/Routes.hs b/tools/stern/src/Stern/API/Routes.hs index 777bd118c5d..c008a552d54 100644 --- a/tools/stern/src/Stern/API/Routes.hs +++ b/tools/stern/src/Stern/API/Routes.hs @@ -40,6 +40,7 @@ import Servant.Swagger.UI import Stern.Types import Wire.API.CustomBackend import Wire.API.OAuth +import Wire.API.Routes.Internal.Brig import Wire.API.Routes.Internal.Brig.Connection (ConnectionStatus) import Wire.API.Routes.Internal.Brig.EJPD qualified as EJPD import Wire.API.Routes.Named @@ -438,6 +439,7 @@ type SternAPI = :> Capture "id" OAuthClientId :> Delete '[JSON] () ) + :<|> EnterpriseLoginApi ------------------------------------------------------------------------------- -- Swagger diff --git a/tools/stern/src/Stern/App.hs b/tools/stern/src/Stern/App.hs index 7f9ba34850b..097d85f2c49 100644 --- a/tools/stern/src/Stern/App.hs +++ b/tools/stern/src/Stern/App.hs @@ -33,11 +33,13 @@ import Control.Monad.Reader.Class import Control.Monad.Trans.Class import Data.ByteString.Conversion (toByteString') import Data.Id +import Data.Text qualified as Text import Data.Text.Encoding (encodeUtf8) import Imports import Network.HTTP.Client (responseTimeoutMicro) import Network.Wai (Response, ResponseReceived) import Network.Wai.Utilities (Error (..)) +import Servant.Client qualified as SC import Stern.Options as Opts import System.Logger qualified as Log import System.Logger.Class hiding (Error, info) @@ -54,7 +56,8 @@ data Env = Env galeb :: !Bilge.Request, appLogger :: !Logger, requestId :: !Bilge.RequestId, - httpManager :: !Bilge.Manager + httpManager :: !Bilge.Manager, + brigServantClientEnv :: !SC.ClientEnv } makeLensesWith (lensRules & lensField .~ suffixNamer) ''Env @@ -62,19 +65,30 @@ makeLensesWith (lensRules & lensField .~ suffixNamer) ''Env newEnv :: Opts -> IO Env newEnv opts = do l <- Log.mkLogger opts.logLevel opts.logNetStrings opts.logFormat - Env - (mkRequest opts.brig) - (mkRequest opts.galley) - (mkRequest opts.gundeck) - (mkRequest opts.ibis) - (mkRequest opts.galeb) - l - (RequestId defRequestId) - <$> newManager + manager <- newManager + pure $ + Env + (mkRequest opts.brig) + (mkRequest opts.galley) + (mkRequest opts.gundeck) + (mkRequest opts.ibis) + (mkRequest opts.galeb) + l + (RequestId defRequestId) + manager + (mkClientEnv manager) where + mkRequest :: Endpoint -> Bilge.Request mkRequest s = Bilge.host (encodeUtf8 s.host) . Bilge.port s.port $ Bilge.empty + + newManager :: IO Bilge.Manager newManager = Bilge.newManager (Bilge.defaultManagerSettings {Bilge.managerResponseTimeout = responseTimeoutMicro 10000000}) + mkClientEnv :: Bilge.Manager -> SC.ClientEnv + mkClientEnv manager = + let url = SC.BaseUrl SC.Http (Text.unpack opts.brig.host) (fromIntegral opts.brig.port) "" + in SC.mkClientEnv manager url + -- Monads newtype AppT m a = AppT (ReaderT Env m a) deriving diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index 3c0ad708181..1cf5252cbbf 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -67,6 +67,7 @@ module Stern.Intra getOAuthClient, updateOAuthClient, deleteOAuthClient, + enterpriseLogin, ) where @@ -82,11 +83,13 @@ import Data.Aeson.Types (emptyArray) import Data.ByteString.Char8 qualified as BS import Data.ByteString.Conversion import Data.ByteString.UTF8 qualified as UTF8 +import Data.Domain import Data.Handle (Handle) import Data.Id import Data.Int import Data.List.Split (chunksOf) import Data.Map qualified as Map +import Data.Proxy import Data.Qualified (qUnqualified) import Data.Text (strip) import Data.Text.Encoding @@ -98,7 +101,9 @@ import Network.HTTP.Types (urlEncode) import Network.HTTP.Types.Method import Network.HTTP.Types.Status hiding (statusCode, statusMessage) import Network.Wai.Utilities (Error (..), mkError) -import Servant.API (toUrlPiece) +import Servant.API +import Servant.Client qualified as SC +import Servant.Server qualified as SS import Stern.App import Stern.Types import System.Logger.Class hiding (Error, name, (.=)) @@ -107,13 +112,16 @@ import UnliftIO.Exception hiding (Handler) import Wire.API.Connection import Wire.API.Conversation import Wire.API.CustomBackend +import Wire.API.EnterpriseLogin import Wire.API.Internal.Notification import Wire.API.OAuth (OAuthClient, OAuthClientConfig, OAuthClientCredentials) import Wire.API.Properties +import Wire.API.Routes.Internal.Brig import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.Internal.Brig.EJPD qualified as EJPD import Wire.API.Routes.Internal.Galley.TeamsIntra import Wire.API.Routes.Internal.Galley.TeamsIntra qualified as Team +import Wire.API.Routes.Named import Wire.API.Routes.Version import Wire.API.Routes.Versioned import Wire.API.Team @@ -1038,3 +1046,38 @@ deleteOAuthClient cid = do . expect2xx ) parseResponse (mkError status502 "bad-upstream") r + +---------------------------------------------------------------------- + +enterpriseLogin :: SS.ServerT EnterpriseLoginApi Handler +enterpriseLogin = + Named @"domain-registration-lock" (runClientToHandler . domRegLock) + :<|> Named @"domain-registration-unlock" (runClientToHandler . domRegUnlock) + :<|> Named @"domain-registration-pre-authorize" (runClientToHandler . domRegPreAuthorize) + :<|> Named @"domain-registration-unauthorize" (runClientToHandler . domRegUnauthorize) + :<|> Named @"domain-registration-update" (\d p -> runClientToHandler (domRegUpdate d p)) + :<|> Named @"domain-registration-delete" (runClientToHandler . domRegDelete) + :<|> Named @"domain-registration-get" (runClientToHandler . domRegGet) + +runClientToHandler :: SC.ClientM a -> Handler a +runClientToHandler client = do + clientEnv <- asks (.brigServantClientEnv) + res <- liftIO $ SC.runClientM client clientEnv + either (throwE . mkError status400 "servant-client-error" . LT.pack . displayException) pure res + +domRegLock :: Domain -> SC.ClientM NoContent +domRegUnlock :: Domain -> SC.ClientM NoContent +domRegPreAuthorize :: Domain -> SC.ClientM NoContent +domRegUnauthorize :: Domain -> SC.ClientM NoContent +domRegUpdate :: Domain -> DomainRegistrationUpdate -> SC.ClientM NoContent +domRegDelete :: Domain -> SC.ClientM NoContent +domRegGet :: Domain -> SC.ClientM DomainRegistration +( domRegLock + :<|> domRegUnlock + :<|> domRegPreAuthorize + :<|> domRegUnauthorize + :<|> domRegUpdate + :<|> domRegDelete + :<|> domRegGet + ) = + SC.client (Proxy @("i" :> EnterpriseLoginApi)) diff --git a/tools/stern/stern.cabal b/tools/stern/stern.cabal index b7e04c9de2b..551bc8ffee8 100644 --- a/tools/stern/stern.cabal +++ b/tools/stern/stern.cabal @@ -91,6 +91,7 @@ library , openapi3 , schema-profunctor , servant + , servant-client , servant-openapi3 , servant-server , servant-swagger-ui diff --git a/tools/stern/test/integration/API.hs b/tools/stern/test/integration/API.hs index 0e8b84cb5f1..7943c22ad45 100644 --- a/tools/stern/test/integration/API.hs +++ b/tools/stern/test/integration/API.hs @@ -37,6 +37,7 @@ import Data.Range (unsafeRange) import Data.Schema import Data.Set qualified as Set import Data.String.Conversions +import Data.UUID.V4 (nextRandom) import GHC.TypeLits import Imports import Stern.API.Routes (UserConnectionGroups (..)) @@ -45,6 +46,7 @@ import Test.Tasty import Test.Tasty.HUnit import TestSetup import Util +import Wire.API.EnterpriseLogin (DomainRedirect (NoRegistration), DomainRegistrationUpdate (DomainRegistrationUpdate), TeamInvite (Allowed)) import Wire.API.OAuth (OAuthApplicationName (OAuthApplicationName), OAuthClientConfig (..), OAuthClientCredentials (..)) import Wire.API.Properties (PropertyKey) import Wire.API.Routes.Internal.Brig.Connection @@ -98,7 +100,8 @@ tests s = test s "GET i/user/meta-info?id=..." testGetUserMetaInfo, test s "/teams/:tid/search-visibility" testSearchVisibility, test s "/sso-domain-redirect" testRudSsoDomainRedirect, - test s "i/oauth/clients" testCrudOAuthClient + test s "i/oauth/clients" testCrudOAuthClient, + test s "i/domain-registration" testDomainRegistration -- The following endpoints can not be tested here because they require ibis: -- - `GET /teams/:tid/billing` -- - `GET /teams/:tid/invoice/:inr` @@ -773,3 +776,18 @@ deleteOAuthClient :: OAuthClientId -> TestM () deleteOAuthClient cid = do s <- view tsStern void $ delete (s . paths ["i", "oauth", "clients", toByteString' cid] . expect2xx) + +testDomainRegistration :: TestM () +testDomainRegistration = do + s <- view tsStern + dom <- (<> ".example.com") . cs . show <$> liftIO nextRandom + void $ post (s . paths ["domain-registration", dom, "lock"] . expect2xx) + void $ get (s . paths ["domain-registration", dom] . expect2xx) + void $ post (s . paths ["domain-registration", dom, "unlock"] . expect2xx) + void $ post (s . paths ["domain-registration", dom, "preauthorize"] . expect2xx) + void $ post (s . paths ["domain-registration", dom, "unauthorize"] . expect2xx) + void $ delete (s . paths ["domain-registration", dom] . expect2xx) + void $ get (s . paths ["domain-registration", dom] . expect4xx) + let upd = DomainRegistrationUpdate NoRegistration Allowed + void $ put (s . paths ["domain-registration", dom] . json upd . expect2xx) + void $ get (s . paths ["domain-registration", dom] . expect2xx)