✨ Add email blacklist mechanism

backend/src/app/auth.clj

@@ -6,9 +6,7 @@
 
 (ns app.auth
   (:require
-   [app.config :as cf]
+   [buddy.hashers :as hashers]))
-   [buddy.hashers :as hashers]
-   [cuerdas.core :as str]))
 
 (def default-params
   {:alg :argon2id
@@ -27,17 +25,3 @@
     (catch Throwable _
       {:update false
        :valid false})))
-
-(defn email-domain-in-whitelist?
-  "Returns true if email's domain is in the given whitelist or if
-  given whitelist is an empty string."
-  ([email]
-   (let [domains (cf/get :registration-domain-whitelist)]
-     (email-domain-in-whitelist? domains email)))
-  ([domains email]
-   (if (or (nil? domains) (empty? domains))
-     true
-     (let [[_ candidate] (-> (str/lower email)
-                             (str/split #"@" 2))]
-       (contains? domains candidate)))))
-

backend/src/app/auth/oidc.clj

@@ -7,7 +7,6 @@
 (ns app.auth.oidc
   "OIDC client implementation."
   (:require
-   [app.auth :as auth]
    [app.auth.oidc.providers :as-alias providers]
    [app.common.data :as d]
    [app.common.data.macros :as dm]
@@ -17,6 +16,8 @@
    [app.common.uri :as u]
    [app.config :as cf]
    [app.db :as db]
+   [app.email.blacklist :as email.blacklist]
+   [app.email.whitelist :as email.whitelist]
    [app.http.client :as http]
    [app.http.session :as session]
    [app.loggers.audit :as audit]
@@ -570,7 +571,12 @@
         (->> (redirect-to-verify-token token)
              (sxf request))))
 
-    (not (auth/email-domain-in-whitelist? (:email info)))
+    (and (email.blacklist/enabled? cfg)
+         (email.blacklist/contains? cfg (:email info)))
+    (redirect-with-error "email-domain-not-allowed")
+
+    (and (email.whitelist/enabled? cfg)
+         (not (email.whitelist/contains? cfg (:email info))))
     (redirect-with-error "email-domain-not-allowed")
 
     :else

backend/src/app/config.clj

@@ -101,6 +101,9 @@
 (s/def ::audit-log-archive-uri ::us/string)
 (s/def ::audit-log-http-handler-concurrency ::us/integer)
 
+(s/def ::email-domain-blacklist ::fs/path)
+(s/def ::email-domain-whitelist ::fs/path)
+
 (s/def ::deletion-delay ::dt/duration)
 
 (s/def ::admins ::us/set-of-valid-emails)
@@ -230,6 +233,8 @@
                    ::database-max-pool-size
                    ::default-blob-version
                    ::default-rpc-rlimit
+                   ::email-domain-blacklist
+                   ::email-domain-whitelist
                    ::error-report-webhook
                    ::default-executor-parallelism
                    ::scheduled-executor-parallelism

backend/src/app/email/blacklist.clj

@@ -0,0 +1,47 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.email.blacklist
+  "Email blacklist provider"
+  (:refer-clojure :exclude [contains?])
+  (:require
+   [app.common.logging :as l]
+   [app.config :as cf]
+   [app.email :as-alias email]
+   [clojure.core :as c]
+   [clojure.java.io :as io]
+   [cuerdas.core :as str]
+   [integrant.core :as ig]))
+
+(defmethod ig/init-key ::email/blacklist
+  [_ _]
+  (when (c/contains? cf/flags :email-blacklist)
+    (try
+      (let [path   (cf/get :email-domain-blacklist)
+            result (with-open [reader (io/reader path)]
+                     (reduce (fn [result line]
+                               (if (str/starts-with? line "#")
+                                 result
+                                 (conj result (-> line str/trim str/lower))))
+                             #{}
+                             (line-seq reader)))]
+        (l/inf :hint "initializing email blacklist" :domains (count result))
+        (not-empty result))
+
+      (catch Throwable cause
+        (l/wrn :hint "unexpected exception on initializing email blacklist"
+               :cause cause)))))
+
+(defn contains?
+  "Check if email is in the blacklist."
+  [{:keys [::email/blacklist]} email]
+  (let [[_ domain] (str/split email "@" 2)]
+    (c/contains? blacklist (str/lower domain))))
+
+(defn enabled?
+  "Check if the blacklist is enabled"
+  [{:keys [::email/blacklist]}]
+  (some? blacklist))

backend/src/app/email/whitelist.clj

@@ -0,0 +1,51 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.email.whitelist
+  "Email whitelist provider"
+  (:refer-clojure :exclude [contains?])
+  (:require
+   [app.common.logging :as l]
+   [app.config :as cf]
+   [app.email :as-alias email]
+   [clojure.core :as c]
+   [clojure.java.io :as io]
+   [cuerdas.core :as str]
+   [integrant.core :as ig]))
+
+(defmethod ig/init-key ::email/whitelist
+  [_ _]
+  (when (c/contains? cf/flags :email-whitelist)
+    (try
+      (let [path   (cf/get :email-domain-whitelist)
+            result (with-open [reader (io/reader path)]
+                     (reduce (fn [result line]
+                               (if (str/starts-with? line "#")
+                                 result
+                                 (conj result (-> line str/trim str/lower))))
+                             #{}
+                             (line-seq reader)))
+
+            ;; backward comapatibility with previous way to set a
+            ;; whitelist for email domains
+            result (into result (cf/get :registration-domain-whitelist))]
+
+        (l/inf :hint "initializing email whitelist" :domains (count result))
+        (not-empty result))
+      (catch Throwable cause
+        (l/wrn :hint "unexpected exception on initializing email whitelist"
+               :cause cause)))))
+
+(defn contains?
+  "Check if email is in the whitelist."
+  [{:keys [::email/whitelist]} email]
+  (let [[_ domain] (str/split email "@" 2)]
+    (c/contains? whitelist (str/lower domain))))
+
+(defn enabled?
+  "Check if the whitelist is enabled"
+  [{:keys [::email/whitelist]}]
+  (some? whitelist))

backend/src/app/main.clj

@@ -267,7 +267,9 @@
                           :github (ig/ref ::oidc.providers/github)
                           :gitlab (ig/ref ::oidc.providers/gitlab)
                           :oidc   (ig/ref ::oidc.providers/generic)}
-    ::session/manager    (ig/ref ::session/manager)}
+    ::session/manager    (ig/ref ::session/manager)
+    ::email/blacklist    (ig/ref ::email/blacklist)
+    ::email/whitelist    (ig/ref ::email/whitelist)}
 
    :app.http/router
    {::session/manager    (ig/ref ::session/manager)
@@ -322,7 +324,10 @@
     ::rpc/climit         (ig/ref ::rpc/climit)
     ::rpc/rlimit         (ig/ref ::rpc/rlimit)
     ::setup/templates    (ig/ref ::setup/templates)
-    ::setup/props        (ig/ref ::setup/props)}
+    ::setup/props        (ig/ref ::setup/props)
+
+    ::email/blacklist    (ig/ref ::email/blacklist)
+    ::email/whitelist    (ig/ref ::email/whitelist)}
 
    :app.rpc.doc/routes
    {:methods (ig/ref :app.rpc/methods)}
@@ -356,6 +361,12 @@
      :run-webhook
      (ig/ref ::webhooks/run-webhook-handler)}}
 
+   ::email/blacklist
+   {}
+
+   ::email/whitelist
+   {}
+
    ::email/sendmail
    {::email/host             (cf/get :smtp-host)
     ::email/port             (cf/get :smtp-port)

backend/src/app/rpc/commands/auth.clj

@@ -6,7 +6,6 @@
 
 (ns app.rpc.commands.auth
   (:require
-   [app.auth :as auth]
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
@@ -17,6 +16,8 @@
    [app.config :as cf]
    [app.db :as db]
    [app.email :as eml]
+   [app.email.blacklist :as email.blacklist]
+   [app.email.whitelist :as email.whitelist]
    [app.http.session :as session]
    [app.loggers.audit :as audit]
    [app.rpc :as-alias rpc]
@@ -186,8 +187,14 @@
                   :code :email-does-not-match-invitation
                   :hint "email should match the invitation"))))
 
-  (when-not (auth/email-domain-in-whitelist? (:email params))
+  (when (and (email.blacklist/enabled? cfg)
-    (ex/raise :type :validation
+             (email.blacklist/contains? cfg (:email params)))
+    (ex/raise :type :restriction
+              :code :email-domain-is-not-allowed))
+
+  (when (and (email.whitelist/enabled? cfg)
+             (not (email.whitelist/contains? cfg (:email params))))
+    (ex/raise :type :restriction
               :code :email-domain-is-not-allowed))
 
   ;; Perform a basic validation of email & password
@@ -423,10 +430,8 @@
    ::doc/added "1.15"
    ::sm/params schema:register-profile
    ::climit/id :auth/global}
-  [{:keys [::db/pool] :as cfg} params]
+  [cfg params]
-  (db/with-atomic [conn pool]
+  (db/tx-run! cfg register-profile params))
-    (-> (assoc cfg ::db/conn conn)
-        (register-profile params))))
 
 ;; ---- COMMAND: Request Profile Recovery
 

backend/test/backend_tests/rpc_profile_test.clj

@@ -6,10 +6,11 @@
 
 (ns backend-tests.rpc-profile-test
   (:require
-   [app.auth :as auth]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
+   [app.email.blacklist :as email.blacklist]
+   [app.email.whitelist :as email.whitelist]
    [app.rpc :as-alias rpc]
    [app.rpc.commands.profile :as profile]
    [app.tokens :as tokens]
@@ -177,14 +178,15 @@
       (let [result (:result out)]
         (t/is (= uuid/zero (:id result)))))))
 
-(t/deftest registration-domain-whitelist
+(t/deftest email-blacklist-1
-  (let [whitelist #{"gmail.com" "hey.com" "ya.ru"}]
+  (t/is (false? (email.blacklist/enabled? th/*system*)))
-    (t/testing "allowed email domain"
+  (t/is (true? (email.blacklist/enabled? (assoc th/*system* :app.email/blacklist []))))
-      (t/is (true? (auth/email-domain-in-whitelist? whitelist "username@ya.ru")))
+  (t/is (true? (email.blacklist/contains? (assoc th/*system* :app.email/blacklist #{"foo.com"}) "AA@FOO.COM"))))
-      (t/is (true? (auth/email-domain-in-whitelist? #{} "username@somedomain.com"))))
 
-    (t/testing "not allowed email domain"
+(t/deftest email-whitelist-1
-      (t/is (false? (auth/email-domain-in-whitelist? whitelist "username@somedomain.com"))))))
+  (t/is (false? (email.whitelist/enabled? th/*system*)))
+  (t/is (true? (email.whitelist/enabled? (assoc th/*system* :app.email/whitelist []))))
+  (t/is (true? (email.whitelist/contains? (assoc th/*system* :app.email/whitelist #{"foo.com"}) "AA@FOO.COM"))))
 
 (t/deftest prepare-register-and-register-profile-1
   (let [data  {::th/type :prepare-register-profile

frontend/src/app/main/ui/auth/login.cljs

@@ -100,7 +100,6 @@
                    (= :ldap-not-initialized (:code cause)))
               (st/emit! (msg/error (tr "errors.ldap-disabled")))
 
-
               (and (= :restriction (:type cause))
                    (= :admin-only-profile (:code cause)))
               (reset! error (tr "errors.profile-blocked"))

frontend/src/app/main/ui/auth/register.cljs

@@ -58,6 +58,9 @@
       [:restriction :registration-disabled]
       (st/emit! (msg/error (tr "errors.registration-disabled")))
 
+      [:restriction :email-domain-is-not-allowed]
+      (st/emit! (msg/error (tr "errors.email-domain-not-allowed")))
+
       [:validation :email-as-password]
       (swap! form assoc-in [:errors :password]
              {:message "errors.email-as-password"})