✨ Add better email cleaning mechanism

This commit separates the email cleaning mechanism to a separated
function, and enables a proper cleaning of `mailto:` prefix, usually
found on invitations because users just copy and paste from external
source.

backend/src/app/auth/oidc.clj

@@ -474,6 +474,7 @@
   [{:keys [::db/pool] :as cfg} info]
   (dm/with-open [conn (db/open pool)]
     (some->> (:email info)
+             (profile/clean-email)
              (profile/get-profile-by-email conn))))
 
 (defn- redirect-response

backend/src/app/http/debug.clj

@@ -347,7 +347,10 @@
               :code :missing-force
               :hint "missing force checkbox"))
 
-  (let [profile  (some->> params :email (profile/get-profile-by-email pool))]
+  (let [profile (some->> params
+                         :email
+                         (profile/clean-email)
+                         (profile/get-profile-by-email pool))]
 
     (when-not profile
       (ex/raise :type :validation

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

@@ -82,7 +82,8 @@
             profile)
 
           (login [{:keys [::db/conn] :as cfg}]
-            (let [profile    (->> (profile/get-profile-by-email conn email)
+            (let [profile    (->> (profile/clean-email email)
+                                  (profile/get-profile-by-email conn)
                                   (validate-profile cfg)
                                   (profile/strip-private-attrs))
 
@@ -202,11 +203,12 @@
     (pos? (compare elapsed register-retry-threshold))))
 
 (defn prepare-register
-  [{:keys [::db/pool] :as cfg} params]
+  [{:keys [::db/pool] :as cfg} {:keys [email] :as params}]
 
   (validate-register-attempt! cfg params)
 
-  (let [profile (when-let [profile (profile/get-profile-by-email pool (:email params))]
+  (let [email   (profile/clean-email email)
+        profile (when-let [profile (profile/get-profile-by-email pool email)]
                   (cond
                     (:is-blocked profile)
                     (ex/raise :type :restriction
@@ -221,7 +223,7 @@
                               :code :email-already-exists
                               :hint "profile already exists")))
 
-        params  {:email (:email params)
+        params  {:email email
                  :password (:password params)
                  :invitation-token (:invitation-token params)
                  :backend "penpot"
@@ -447,7 +449,8 @@
               nil))]
 
     (db/with-atomic [conn pool]
-      (when-let [profile (profile/get-profile-by-email conn email)]
+      (when-let [profile (->> (profile/clean-email email)
+                              (profile/get-profile-by-email conn))]
         (when-not (eml/allow-send-emails? conn profile)
           (ex/raise :type :validation
                     :code :profile-is-muted

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

@@ -82,8 +82,8 @@
   (db/tx-run! cfg
               (fn [{:keys [::db/conn] :as cfg}]
                 (or (some->> (:email info)
-                             (profile/get-profile-by-email conn)
+                             (profile/clean-email)
-                             (profile/decode-row))
+                             (profile/get-profile-by-email conn))
                     (->> (assoc info :is-active true :is-demo false)
                          (auth/create-profile! conn)
                          (auth/create-profile-rels! conn)

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

@@ -39,6 +39,15 @@
 (declare strip-private-attrs)
 (declare verify-password)
 
+(defn clean-email
+  "Clean and normalizes email address string"
+  [email]
+  (let [email (str/lower email)
+        email (if (str/starts-with? email "mailto:")
+                (subs email 7)
+                email)]
+    email))
+
 (def ^:private
   schema:profile
   (sm/define
@@ -147,8 +156,7 @@
                     (let [profile    (validate-password! cfg (assoc params :profile-id profile-id))
                           session-id (::session/id params)]
 
-                      (when (= (str/lower (:email profile))
+                      (when (= (:email profile) (str/lower (:password params)))
-                               (str/lower (:password params)))
                         (ex/raise :type :validation
                                   :code :email-as-password
                                   :hint "you can't use your email as password"))
@@ -270,7 +278,7 @@
           cfg     (assoc cfg ::conn conn)
           params  (assoc params
                          :profile profile
-                         :email (str/lower email))]
+                         :email (clean-email email))]
       (if (contains? cf/flags :smtp)
         (request-email-change! cfg params)
         (change-email-immediately! cfg params)))))
@@ -409,10 +417,9 @@
                    where email = ?
                      and deleted_at is null) as val")
 
-(defn check-profile-existence!
+(defn- check-profile-existence!
   [conn {:keys [email] :as params}]
-  (let [email  (str/lower email)
+  (let [result (db/exec-one! conn [sql:profile-existence email])]
-        result (db/exec-one! conn [sql:profile-existence email])]
     (when (:val result)
       (ex/raise :type :validation
                 :code :email-already-exists))
@@ -427,7 +434,7 @@
 (defn get-profile-by-email
   "Returns a profile looked up by email or `nil` if not match found."
   [conn email]
-  (->> (db/exec! conn [sql:profile-by-email (str/lower email)])
+  (->> (db/exec! conn [sql:profile-by-email (clean-email email)])
        (map decode-row)
        (first)))
 

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

@@ -709,7 +709,8 @@
 
 (defn- create-invitation
   [{:keys [::db/conn] :as cfg} {:keys [team profile role email] :as params}]
-  (let [member (profile/get-profile-by-email conn email)]
+  (let [email  (profile/clean-email email)
+        member (profile/get-profile-by-email conn email)]
 
     (when (and member (not (eml/allow-send-emails? conn member)))
       (ex/raise :type :validation
@@ -803,7 +804,8 @@
   (db/with-atomic [conn pool]
     (let [perms    (get-permissions conn profile-id team-id)
           profile  (db/get-by-id conn :profile profile-id)
-          team     (db/get-by-id conn :team team-id)]
+          team     (db/get-by-id conn :team team-id)
+          emails   (into #{} (map profile/clean-email) emails)]
 
       (run! (partial quotes/check-quote! conn)
             (list {::quotes/id ::quotes/invitations-per-team
@@ -834,7 +836,7 @@
                                ;;  We don't re-send inviation to already existing members
                                (remove (partial contains? members))
                                (map (fn [email]
-                                      {:email (str/lower email)
+                                      {:email email
                                        :team team
                                        :profile profile
                                        :role role}))
@@ -869,14 +871,15 @@
     (let [params   (assoc params :profile-id profile-id)
           cfg      (assoc cfg ::db/conn conn)
           team     (create-team cfg params)
-          profile  (db/get-by-id conn :profile profile-id)]
+          profile  (db/get-by-id conn :profile profile-id)
+          emails   (into #{} (map profile/clean-email) emails)]
 
       ;; Create invitations for all provided emails.
       (->> emails
            (map (fn [email]
                   {:team team
                    :profile profile
-                   :email (str/lower email)
+                   :email email
                    :role role}))
            (run! (partial create-invitation cfg)))
 
@@ -913,17 +916,20 @@
   {::doc/added "1.17"}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email] :as params}]
   (check-read-permissions! pool profile-id team-id)
-  (let [invit (-> (db/get pool :team-invitation
+  (let [email (profile/clean-email email)
+        invit (-> (db/get pool :team-invitation
                           {:team-id team-id
-                           :email-to (str/lower email)})
+                           :email-to email})
                   (update :role keyword))
+
         member (profile/get-profile-by-email pool (:email-to invit))
         token  (create-invitation-token cfg {:team-id (:team-id invit)
                                              :profile-id profile-id
                                              :valid-until (:valid-until invit)
                                              :role (:role invit)
                                              :member-id (:id member)
-                                             :member-email (or (:email member) (:email-to invit))})]
+                                             :member-email (or (:email member)
+                                                               (profile/clean-email (:email-to invit)))})]
     {:token token}))
 
 ;; --- Mutation: Update invitation role
@@ -944,7 +950,7 @@
 
       (db/update! conn :team-invitation
                   {:role (name role) :updated-at (dt/now)}
-                  {:team-id team-id :email-to (str/lower email)})
+                  {:team-id team-id :email-to (profile/clean-email email)})
       nil)))
 
 ;; --- Mutation: Delete invitation
@@ -965,6 +971,6 @@
 
       (let [invitation (db/delete! conn :team-invitation
                                    {:team-id team-id
-                                    :email-to (str/lower email)}
+                                    :email-to (profile/clean-email email)}
                                    {::db/return-keys true})]
         (rph/wrap nil {::audit/props {:invitation-id (:id invitation)}})))))

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

@@ -44,18 +44,19 @@
 
 (defmethod process-token :change-email
   [{:keys [conn] :as cfg} _params {:keys [profile-id email] :as claims}]
-  (when (profile/get-profile-by-email conn email)
+  (let [email (profile/clean-email email)]
-    (ex/raise :type :validation
+    (when (profile/get-profile-by-email conn email)
-              :code :email-already-exists))
+      (ex/raise :type :validation
+                :code :email-already-exists))
 
-  (db/update! conn :profile
+    (db/update! conn :profile
-              {:email email}
+                {:email email}
-              {:id profile-id})
+                {:id profile-id})
 
-  (rph/with-meta claims
+    (rph/with-meta claims
-    {::audit/name "update-profile-email"
+      {::audit/name "update-profile-email"
-     ::audit/props {:email email}
+       ::audit/props {:email email}
-     ::audit/profile-id profile-id}))
+       ::audit/profile-id profile-id})))
 
 (defmethod process-token :verify-email
   [{:keys [conn] :as cfg} _ {:keys [profile-id] :as claims}]

backend/src/app/srepl/main.clj

@@ -78,6 +78,7 @@
   [email]
   (let [sprops  (:app.setup/props main/system)
         pool    (:app.db/pool main/system)
+        email   (profile/clean-email email)
         profile (profile/get-profile-by-email pool email)]
 
     (auth/send-email-verification! pool sprops profile)