🐛 Fix email validation (#9037)

CHANGES.md

@@ -1,5 +1,11 @@
 # CHANGELOG
 
+## 2.14.4 (Unreleased)
+
+### :bug: Bugs fixed
+
+- Fix email validation [Taiga #14006](https://tree.taiga.io/project/penpot/issue/14006)
+
 ## 2.14.3
 
 ### :sparkles: New features & Enhancements

common/src/app/common/spec.cljc

@@ -113,12 +113,19 @@
             (tgen/fmap keyword)))))
 
 ;; --- SPEC: email
+;;
+;; Regex rules enforced:
+;;   local part  - valid RFC chars, no leading/trailing dot, no consecutive dots
+;;   domain      - labels can't start/end with hyphen, no empty labels
+;;   TLD         - at least 2 alphabetic chars
 
-(def email-re #"[a-zA-Z0-9_.+-\\\\]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+")
+(def email-re
+  #"^[a-zA-Z0-9!#$%&'*+/=?^_`{|}~-]+(\.[a-zA-Z0-9!#$%&'*+/=?^_`{|}~-]+)*@[a-zA-Z0-9]([a-zA-Z0-9-]{0,61}[a-zA-Z0-9])?(\.[a-zA-Z0-9]([a-zA-Z0-9-]{0,61}[a-zA-Z0-9])?)*\.[a-zA-Z]{2,63}$")
 
 (defn parse-email
   [s]
-  (some->> s (re-seq email-re) first))
+  (when (and (string? s) (re-matches email-re s))
+    s))
 
 (letfn [(conformer [v]
           (or (parse-email v) ::s/invalid))
@@ -126,11 +133,10 @@
           (dm/str v))]
   (s/def ::email
     (s/with-gen (s/conformer conformer unformer)
-      #(as-> (tgen/let [p1 (s/gen ::not-empty-string)
-                        p2 (s/gen ::not-empty-string)
-                        p3 (tgen/elements ["com" "net"])]
-               (str p1 "@" p2 "." p3)) $
-         (tgen/such-that (partial re-matches email-re) $ 50)))))
+      #(tgen/let [local (tgen/string-alphanumeric 1 20)
+                  label (tgen/string-alphanumeric 2 10)
+                  tld   (tgen/elements ["com" "net" "org" "io" "co" "dev"])]
+         (str local "@" label "." tld)))))
 
 ;; -- SPEC: uri
 

common/test/common_tests/runner.cljc

@@ -49,6 +49,7 @@
    [common-tests.path-names-test]
    [common-tests.record-test]
    [common-tests.schema-test]
+   [common-tests.spec-test]
    [common-tests.svg-path-test]
    [common-tests.svg-test]
    [common-tests.text-test]
@@ -122,6 +123,7 @@
    'common-tests.path-names-test
    'common-tests.record-test
    'common-tests.schema-test
+   'common-tests.spec-test
    'common-tests.svg-path-test
    'common-tests.svg-test
    'common-tests.text-test

common/test/common_tests/spec_test.cljc

@@ -0,0 +1,89 @@
+;; 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 common-tests.spec-test
+  (:require
+   [app.common.spec :as spec]
+   [clojure.test :as t]))
+
+(t/deftest valid-emails
+  (t/testing "accepts well-formed email addresses"
+    (doseq [email ["user@domain.com"
+                   "user.name@domain.com"
+                   "user+tag@domain.com"
+                   "user-name@domain.com"
+                   "user_name@domain.com"
+                   "user123@domain.com"
+                   "USER@DOMAIN.COM"
+                   "u@domain.io"
+                   "user@sub.domain.com"
+                   "user@domain.co.uk"
+                   "user@domain.dev"
+                   "a@bc.co"]]
+      (t/is (some? (spec/parse-email email)) (str "should accept: " email)))))
+
+(t/deftest rejects-invalid-local-part
+  (t/testing "rejects local part starting with a dot"
+    (t/is (nil? (spec/parse-email ".user@domain.com"))))
+
+  (t/testing "rejects local part with consecutive dots"
+    (t/is (nil? (spec/parse-email "user..name@domain.com"))))
+
+  (t/testing "rejects local part with spaces"
+    (t/is (nil? (spec/parse-email "us er@domain.com"))))
+
+  (t/testing "rejects local part with comma"
+    (t/is (nil? (spec/parse-email "user,name@domain.com")))
+    (t/is (nil? (spec/parse-email ",user@domain.com"))))
+
+  (t/testing "rejects empty local part"
+    (t/is (nil? (spec/parse-email "@domain.com")))))
+
+(t/deftest rejects-invalid-domain
+  (t/testing "rejects domain starting with a dot"
+    (t/is (nil? (spec/parse-email "user@.domain.com"))))
+
+  (t/testing "rejects domain part with comma"
+    (t/is (nil? (spec/parse-email "user@domain,com")))
+    (t/is (nil? (spec/parse-email "user@,domain.com"))))
+
+  (t/testing "rejects domain with consecutive dots"
+    (t/is (nil? (spec/parse-email "user@sub..domain.com"))))
+
+  (t/testing "rejects label starting with hyphen"
+    (t/is (nil? (spec/parse-email "user@-domain.com"))))
+
+  (t/testing "rejects label ending with hyphen"
+    (t/is (nil? (spec/parse-email "user@domain-.com"))))
+
+  (t/testing "rejects TLD shorter than 2 chars"
+    (t/is (nil? (spec/parse-email "user@domain.c"))))
+
+  (t/testing "rejects domain without a dot"
+    (t/is (nil? (spec/parse-email "user@domain"))))
+
+  (t/testing "rejects domain with spaces"
+    (t/is (nil? (spec/parse-email "user@do main.com"))))
+
+  (t/testing "rejects domain ending with a dot"
+    (t/is (nil? (spec/parse-email "user@domain.")))))
+
+(t/deftest rejects-invalid-structure
+  (t/testing "rejects nil"
+    (t/is (nil? (spec/parse-email nil))))
+
+  (t/testing "rejects empty string"
+    (t/is (nil? (spec/parse-email ""))))
+
+  (t/testing "rejects string without @"
+    (t/is (nil? (spec/parse-email "userdomain.com"))))
+
+  (t/testing "rejects string with multiple @"
+    (t/is (nil? (spec/parse-email "user@@domain.com")))
+    (t/is (nil? (spec/parse-email "us@er@domain.com"))))
+
+  (t/testing "rejects empty domain"
+    (t/is (nil? (spec/parse-email "user@")))))